diff --git a/data/tls/certificates/foo b/data/tls/certificates/foo new file mode 100644 index 00000000..8a3a8c3b --- /dev/null +++ b/data/tls/certificates/foo @@ -0,0 +1,29 @@ +-----BEGIN CERTIFICATE----- +MIIFCTCCAvGgAwIBAgIUBmSRa4019HvyNTHuxkoAXMgVs0YwDQYJKoZIhvcNAQEL +BQAwFDESMBAGA1UEAwwJbG9jYWxob3N0MB4XDTI1MTEwMjE1MDQ1M1oXDTI2MTEw +MjE1MDQ1M1owFDESMBAGA1UEAwwJbG9jYWxob3N0MIICIjANBgkqhkiG9w0BAQEF +AAOCAg8AMIICCgKCAgEA7gACN8U+sg5nFZ8hNPpBT7kxXqP1vI4F/AYzjbjonjMZ +7UtWoOoMa49OfzYW4KjJO1oRVGlYLg3pR8iS2kZhwSivTZoKLepBFM5EzlOeB4JJ +uJcBbzB17rpJfl37Wr+Tp76gUY2PV7wXWtkFe14LmnqxKuVCTj/a8TogN22h/Skz +ZB34wds4QGKKfNjdkzl5hInICwztoOCd5xAM19+0dpCB2TlHajgr1/5Syuygb33J +n1SxPSjborZGWC9DOcsHaArmD/+aO0Fkta2M20SgxWg6pUc3VBP4JgXLf+J490Dd +hTm+QM6aqpoBeAG6oYEE2mVPk1kWXrCPLQVKOJx8qe9ciG1nw0Zw3JlDplTgTOhu +d9NCUC7Be+NNeOe8/chPz40Yx5YMy3FsTrn5m7P/U0W3C5hJ0u0tCUJwR4aoI8+c +JMxw+6RyW9IyQP11dFsX2XfGYiVYug7tcB+UBzUXHkqFm/pryVduxCaMW6GBuYj4 +lQt5+9w0Udtmmy1fLdPNd976xjs44py9lug8ZjrBqLgovpplP/nlENeUAhDOTcvJ +7+wkgAUbSjmmmCQysn1+kIM1E8G/5IWWpnrFVc8/AeHX6xl77SHsZNWPglrR2U48 +dMVFWg9Iow4/wo2Q/98U3JXJFCMgYNnLsmqLJAt/kwn+50Oe1vvrZpuDONc9sKEC +AwEAAaNTMFEwHQYDVR0OBBYEFBLecWdZ6LfT3DOxGt1laLUXEMD7MB8GA1UdIwQY +MBaAFBLecWdZ6LfT3DOxGt1laLUXEMD7MA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZI +hvcNAQELBQADggIBADfY6Urz93TXI37qzls91yRD+EtEgrmKk3XGD4fIEso7z7Ds +1g6CUZk9Yqv66ETtJIjZUYp6Gm4I3gGdrC6dQS0ubhRy1VPkxfpZxL6keFaN/S1i +r9Xt8L/FT7umUB7xBInvgXTaJhhwFh6okzALAKe69QPQtGHO3d8mz/PBsS+yqr/h +7WQOLkcIS+hAnKGCRDvdIbLwdFny17QiHK/W17OKCPH7Re6lDaA2QmWJIaL/oFII +8agLr68Wv2/zE6FYS0bAaSyu4jIDOzVEUWS57vx70SFtbtYRQXHK2egWZH9iubmn +rBzGpNlPhRiS7CWkSxfocJJXqEd7FLWDpAnl8GRDmCwHixr4Ip76dOt1Wo7EgSfO +3INHKi2cuM0+JwcpfafnJ0HL4+mWso//ZficQWfrBcsRmdM/x1Tl8IgHtqmW2SxF +dNf5Dt47WHrQgg1PuJu88GGUSyN6NKn9xV/SipZM+ZGfjHusTnaQEwkJZD0P2sDm +n4R37BvAmiGDY1ri9h2AzO0qXrsGZKQup2Q5VtgOadX26sa1DeFhUHGwMgpuq/qT +rED/wfcJ4VfI9phorPoaKEBoOv81hjlQ4byEYNgyGJzhdRgcmkUXNOIoiu0iB01Y +YXDB9XEwwu3Gotx4RFv03V4Dlj3Cn9aRZ3LB9w5UnYA0PsFh8Wm5Tld1J1AJ +-----END CERTIFICATE----- diff --git a/data/tls/keys/foo b/data/tls/keys/foo new file mode 100644 index 00000000..78f6a7b6 --- /dev/null +++ b/data/tls/keys/foo @@ -0,0 +1,52 @@ +-----BEGIN PRIVATE KEY----- +MIIJQgIBADANBgkqhkiG9w0BAQEFAASCCSwwggkoAgEAAoICAQDuAAI3xT6yDmcV +nyE0+kFPuTFeo/W8jgX8BjONuOieMxntS1ag6gxrj05/NhbgqMk7WhFUaVguDelH +yJLaRmHBKK9Nmgot6kEUzkTOU54Hgkm4lwFvMHXuukl+Xftav5OnvqBRjY9XvBda +2QV7XguaerEq5UJOP9rxOiA3baH9KTNkHfjB2zhAYop82N2TOXmEicgLDO2g4J3n +EAzX37R2kIHZOUdqOCvX/lLK7KBvfcmfVLE9KNuitkZYL0M5ywdoCuYP/5o7QWS1 +rYzbRKDFaDqlRzdUE/gmBct/4nj3QN2FOb5AzpqqmgF4AbqhgQTaZU+TWRZesI8t +BUo4nHyp71yIbWfDRnDcmUOmVOBM6G5300JQLsF7401457z9yE/PjRjHlgzLcWxO +ufmbs/9TRbcLmEnS7S0JQnBHhqgjz5wkzHD7pHJb0jJA/XV0WxfZd8ZiJVi6Du1w +H5QHNRceSoWb+mvJV27EJoxboYG5iPiVC3n73DRR22abLV8t08133vrGOzjinL2W +6DxmOsGouCi+mmU/+eUQ15QCEM5Ny8nv7CSABRtKOaaYJDKyfX6QgzUTwb/khZam +esVVzz8B4dfrGXvtIexk1Y+CWtHZTjx0xUVaD0ijDj/CjZD/3xTclckUIyBg2cuy +aoskC3+TCf7nQ57W++tmm4M41z2woQIDAQABAoICAAoBXdaAoCm93YNNDukyXpnG +hi7te2SPf2yoiZULCZtx+ERvqv8Fi9tfOUxzhotwCRKpzwnyikqYWt7hzZunww8K +4fDEGaqzuwPwBng6j22PIoCEN6MYIVMViYaqlokqfd96zfRTvEuSzJQNBNQagGgg +gY91NyABQvfqasWNwjY5e8+5C1bB+6fIRLxqJQl+DG/gF3TweJJvcu/ubq3KGaT0 +3wKV6/zJCv3P8yTVBQse2YGtXqycqbwZx9QH+55jvMZY0/Jm+1HDpmNVXhMvO8eE +wddmKqsqEj/t9S/FgnKZi16BDpCcpuemZQqpnvIQcZbpVKqz/3LgXwqEWwoNeRea +h0GiuzHuPrd6XrU9EhSD/aWDcs7/wnaZx5iNmF4gqEfmb/gj9M586jyoIvO5vxDd +2BkaT56YtShNC49VDF5opApC3ZDwqirY0sUufTZ41ZtJCs6lNpMoDPddORA9FLja +rrIemSlzcdOp+bwlx2hXfqIXpskzeHKy1m7ZXPp0ugpHYvwSiU2YvBJLF+tYwcCj +goZ1v79QjEfjNoVw8M/OPA2A0LpA5fR/jALwBBl/sZYbMl4Z2mz7lI+PNlWHaFRQ +hlp+ua9kqU4JvFMksrkwYv4hEKQtGJ/q4XyQZWoRqt569GFNih7n24X6HWy0Tfgs +7rHLfHu8dzQxXyPWNC4ZAoIBAQD5kfPN3gKS5P7WYGiLrucZenAK0227A/PoR7aU +j5KUg8nwWKfnGI6TT7QMJ7iWq/fkFql3qFOZx7t45Btjz2+3GSFBVu1ajyghXiFM +r/s0cYLyeo61TYApZRlH1KV+6ooSemB3YqnI1FRNqc6UUAfVm2ysLJ8Iu8xyEQQ6 +KkJDe3oRb0j36cgU9XblEbFJFgKHFwdRLD32JylSMLy18ooyI6I0WILUyhTCBvVB +28KGcH7KHMadqJb8m9Gaj7JpaFkgqcKm5hTIdbaEQZfdpQneVGonioekT9i51AOv +Iba6+OuctDBCc1JJk+znk6lDZqvmaiIz+oNe8SQVeLJgDAgJAoIBAQD0Ib7SE+37 +KR7UmyZ77+Tvv/AgZXVTU8HedItPvDZvMQef5gngvVoO3G0dVZN3Mkp9hEfXFsqX +9QAW2EWV5RPA8QmdciL84jC611ordLJNeG/lieyL+uJ+7amOi/eHL0Sb4RzYS95U +m8A6UZCL2PVFxQ4M02YGOZC1kp6Ht4hpv4eAj6+fVRWgH0d/qx/sJPCVMjGKUMb8 +AlgjT1lV9O76E5lmbQhE5AdMcGyDWdnti9QpdUjJxcJywb5sJFVKI5MPbLaI5F9x +YhTEa0Ee+v5fo/pNv7ljqVUx4EIIfl1msMIxk7Lt17MZdsYFepSCmhVo1xSPBJSR +Q46mq7fashnZAoIBABUauIlCKumNH9e1E2IsijJnXi4sLu1PqkKMPe5WLckNU/hV +Ju2t7/CZHtqgSUXEiRPqrq4Ft/wbHcldUMuh8QqEv4Es/qlXzcb0lNBNWWrX5oDm +yEagpSPa/sZKPyx6XO6vFpVB7KWk/vQKVgPIuMDhgdEVfOVaLDHBKqBYjn3yZSIw +TPVZ+ad8Em/QjTNm/xO5aM7+dMbqDN58bJjeR71xsffHPFkONa8qs3a8RLjlrnMc +99bBOPNnodP2LtonDtJqSKGgd0V0XtjUSyldGXaJoOhzGIFWlzcvrJgUu8UX46S+ +wA3+fojmT3RN0lR2zDaR5w6KMq3Gqox+RmdE3TECggEBAO9VedZH9YHJ8VCq/dJ4 +/27PM2D/NkNHlIM6rCyyLodZgMkQY1SxLW3uSQZ+E8DCS+a7XRaPYHQSm1DKG4X0 ++yWm6C8zavuR4AX8A4kgsYBjdweH7J/aiFu5MQXvT+52t4M98OJXlpJJ0u0Zc2S2 +gNYydjC6uoWVv7lSERqqIhDR1MyDkL/aUQYWRCj0IaqHGFibyZd402rR/Yg4TTOI +mRQPTM7uSzIGfuVAPhGTb6OC9q7iLUaqGpQYPk+UWw0AzTZM9LJFeRAWAJgDMedm +VyR6BHReZig/JKdt3C6pe3WmCetCiiLD2PA40a8jWh6jYiPS33PKIMA8g8gABpFf +ExkCggEAUzoVzOD/zzC04icPmIbwO3cpEfCT/JwEF/qOteKWu50Uj8K2Yf96+BRb +u9bSjIPEedjm21kcZLHcJJ+RW/uVq8RhtKmriXSxB81jC0EHGZShav12fTHwmPXk +jipUclGjbug0LkQsgI5ayO2jo6lfJuKMpby9BANFeujRTe2M7IrUlDkEhWfgwNmo +0bOTl1VgdAFCh0zraOhrLlRwIDKIrL3ptKj2rc/LNb7NwrvCY0nz0bctcrwiyB+Z +wwrrCQskHfB6j2l+H6OWaGEZBxRku/7JPXvBvjxSpOn/Fjlj0W8bRKmlW5qn0nFg +cMST03o2tFqgpeUPjWGaRM+nsa1Pfg== +-----END PRIVATE KEY----- diff --git a/unikernel/dist/dune b/unikernel/dist/dune new file mode 100644 index 00000000..4d257728 --- /dev/null +++ b/unikernel/dist/dune @@ -0,0 +1,10 @@ +;; Generated by mirage.v4.10.3 + +(rule + (mode + (promote (until-clean))) + (target mte) + (enabled_if + (= %{context_name} "default")) + (action + (copy ../mte %{target}))) diff --git a/unikernel/dune.build b/unikernel/dune.build new file mode 100644 index 00000000..2a0828d8 --- /dev/null +++ b/unikernel/dune.build @@ -0,0 +1,44 @@ +;; Generated by mirage.v4.10.3 + +(copy_files# ./mirage/main.ml) + +(rule + (target mte) + (enabled_if (= %{context_name} "default")) + (deps main.exe) + (action + (copy main.exe %{target}))) + +(executable + (name main) + (libraries caqti caqti-driver-pgx caqti-lwt caqti-mirage caqti-tls + cmdliner-stdlib dns-client-mirage duration h2 happy-eyeballs-mirage + logs lwt mimic-happy-eyeballs mirage-bootvar mirage-bootvar.unix + mirage-crypto-rng-mirage mirage-kv-mem mirage-logs mirage-mtime + mirage-mtime.unix mirage-ptime mirage-ptime.unix mirage-runtime + mirage-runtime.network mirage-sleep mirage-sleep.unix mirage-unix + paf.mirage tcpip.stack-direct tcpip.stack-socket tcpip.tcpv4v6-socket + tcpip.udpv4v6-socket mte) + (link_flags (-thread)) + (modules (:standard \ config)) + (flags :standard -w -70 -color always) + (enabled_if (= %{context_name} "default")) +) + +(rule + (targets Static____data_assets.ml Static____data_assets.mli) + (deps (source_tree ../data/assets)) + (action + (run ocaml-crunch -o Static____data_assets.ml ../data/assets))) + +(rule + (targets Static____data_tls_certificates.ml Static____data_tls_certificates.mli) + (deps (source_tree ../data/tls/certificates)) + (action + (run ocaml-crunch -o Static____data_tls_certificates.ml ../data/tls/certificates))) + +(rule + (targets Static____data_tls_keys.ml Static____data_tls_keys.mli) + (deps (source_tree ../data/tls/keys)) + (action + (run ocaml-crunch -o Static____data_tls_keys.ml ../data/tls/keys))) diff --git a/unikernel/dune.config b/unikernel/dune.config new file mode 100644 index 00000000..3c419c19 --- /dev/null +++ b/unikernel/dune.config @@ -0,0 +1,9 @@ +;; Generated by mirage.v4.10.3 + +(data_only_dirs duniverse dist) + +(executable + (name config) + (modules config) + (flags :standard -warn-error -A) + (libraries mirage)) diff --git a/unikernel/duniverse/README.md b/unikernel/duniverse/README.md new file mode 100644 index 00000000..2017b925 --- /dev/null +++ b/unikernel/duniverse/README.md @@ -0,0 +1,24 @@ +# duniverse + +This folder contains vendored source code of the dependencies of the project, +created by the [opam-monorepo](https://github.com/ocamllabs/opam-monorepo) +tool. You can find the packages and versions that are included in this folder +in the `.opam.locked` files. + +To update the packages do not modify the files and directories by hand, instead +use `opam-monorepo` to keep the lockfiles and directory contents accurate and +in sync: + +```sh +opam monorepo lock +opam monorepo pull +``` + +If you happen to include the `duniverse/` folder in your Git repository make +sure to commit all files: + +```sh +git add -A duniverse/ +``` + +For more information check out the homepage and manual of `opam-monorepo`. diff --git a/unikernel/duniverse/Zarith/.gitattributes b/unikernel/duniverse/Zarith/.gitattributes new file mode 100644 index 00000000..3aa538a4 --- /dev/null +++ b/unikernel/duniverse/Zarith/.gitattributes @@ -0,0 +1,4 @@ +# Default behaviour, for if core.autocrlf isn't set +* text=auto + +configure text eol=lf diff --git a/unikernel/duniverse/Zarith/.github/workflows/CI.yml b/unikernel/duniverse/Zarith/.github/workflows/CI.yml new file mode 100644 index 00000000..adfa7d35 --- /dev/null +++ b/unikernel/duniverse/Zarith/.github/workflows/CI.yml @@ -0,0 +1,32 @@ +name: CI + +on: [push, pull_request] + +jobs: + Ubuntu: + runs-on: ubuntu-latest + steps: + - name: Install packages + run: sudo apt-get install ocaml-nox libgmp-dev + - name: Checkout + uses: actions/checkout@v2 + - name: configure tree + run: ./configure + - name: Build + run: make + - name: Run the testsuite + run: make -C tests test + + MacOS: + runs-on: macos-latest + steps: + - name: Install packages + run: brew install ocaml ocaml-findlib gmp + - name: Checkout + uses: actions/checkout@v2 + - name: configure tree + run: ./configure + - name: Build + run: make + - name: Run the testsuite + run: make -C tests test diff --git a/unikernel/duniverse/Zarith/.github/workflows/build.yml b/unikernel/duniverse/Zarith/.github/workflows/build.yml new file mode 100644 index 00000000..425a3b98 --- /dev/null +++ b/unikernel/duniverse/Zarith/.github/workflows/build.yml @@ -0,0 +1,49 @@ +name: build + +on: + pull_request: + push: + branches: + - master + schedule: + # Prime the caches every Monday + - cron: 0 1 * * MON + +jobs: + build: + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + - windows-latest + - macos-latest + ocaml-compiler: + - "4.14" + - "5.2" + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v4 + + - name: Set-up OCaml ${{ matrix.ocaml-compiler }} + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + + - run: opam install . --with-test --deps-only + + - name: configure tree + run: opam exec -- sh ./configure + + - name: Build + run: opam exec -- make + + - name: Run the testsuite + run: opam exec -- make -C tests test + + - run: opam install . --with-test + + - run: opam exec -- git diff --exit-code diff --git a/unikernel/duniverse/Zarith/.gitignore b/unikernel/duniverse/Zarith/.gitignore new file mode 100644 index 00000000..6ee9be03 --- /dev/null +++ b/unikernel/duniverse/Zarith/.gitignore @@ -0,0 +1,12 @@ +*.a +*.cm? +*.cmxa +*.cmxs +*.cmti +*.exe +*.byt +*.o +*.so +Makefile +depend +zarith_version.ml diff --git a/unikernel/duniverse/Zarith/.ocamlformat b/unikernel/duniverse/Zarith/.ocamlformat new file mode 100644 index 00000000..aad65873 --- /dev/null +++ b/unikernel/duniverse/Zarith/.ocamlformat @@ -0,0 +1,2 @@ +version=0.20.1 +disable=true diff --git a/unikernel/duniverse/Zarith/Changes b/unikernel/duniverse/Zarith/Changes new file mode 100644 index 00000000..3d7e4131 --- /dev/null +++ b/unikernel/duniverse/Zarith/Changes @@ -0,0 +1,143 @@ +Release 1.14 (2024-07-10) +- #148, #149: Fail unmarshaling when it would produce non-canonical big ints +- #145, #150: Use standard hash function for `Z.hash` and add `Z.seeded_hash` +- #140, #147: Add fast path for `Z.divisible` on small arguments + +Release 1.13 (2023-07-19) +- #113: add conversions to/from small unsigned integers `(to|fits)_(int32|int64|nativeint)_unsigned` [Antoine Miné] +- #128: add functions to pseudo-randomly generate integers [Xavier Leroy] +- #105: add `Big_int.big_int_of_float` [Yishuai Li] +- #90: add fast path to `Z.extract` when extraction leads to a small integer [Frédéric Recoules] +- #137: more precise bounds for of_float conversion to small ints [Antoine Miné] +- #118: fix Z_mlgmpidl interface for mlgmpidl >= 1.2 [Simmo Saan] +- #109: fix typo in `ml_z_mul` function [Bernhard Schommer] +- #108: fix dependency on C evaluation order in `ml_z_remove` [Xavier Clerc] +- #117 #120 #129 #132 #135 #139 #141: configure & build simplifications and fixes [various authors] +- #134: CI testing: add Windows, test both 4.14 and 5.0 [Hugo Heuzard] + +Release 1.12 (2021-03-03) +- PR #79: fast path in OCaml (instead of assembly language) [Xavier Leroy] +- PR #94: remove source preprocessing and simplify configuration [Xavier Leroy] +- PR #93: fix parallel build [Guillaume Melquiond] +- PR #92: fix benchmark for subtraction [Guillaume Melquiond] +- Require OCaml 4.04 or later [Xavier Leroy] +- Add CI testing on macOS [Xavier Leroy] + +Release 1.11 (2020-11-09) +- Fixes #72, #75, #78: multiple fixes for of_string, support for underscores [hhugo] +- Fix #74: fix Q.to_float for denormal numbers [pascal-cuoq] +- Fix #84: always represent min_int by a tagged integer [xavierleroy] +- muliple fixes for min_int arguments [xavierleroy] +- Improvement #85: optimize the fast paths for comparison and equality tests [xavierleroy] +- Fix #80: ar tool is detected in configure [jsmolic] + +Release 1.10 (2020-09-11) +- Improvement #66: added some mpz functions (divisible, congruent, jacobi, legendre, krobecker, remove, fac, primorial, bin, fib, lucnum) +- Improvement #65: Q.of_string now handles decimal point and scientific notation [Ghiles Ziat] +- Fix #60: Z.root now raises an exception for invalid arguments +- Fix #62: raise division by 0 for 0-modulo in powm +- Fix #59: improved abs for negative arguments +- Fix #58: gcd, lcm, gcdext now behave as gmp for negative arguments +- Fix #57: clean compile with safe strings [hhugo] + +Release 1.9.1 (2019-08-28) (bugfix): +- Fix configure issue for non-bash sh introduced in #45 +- Tweaks to opam file [kit-ty-kate] + +Release 1.9 (2019-08-22): +- Issue #50: add opam file, make it easy to "opam publish" new versions +- Issue #38: configure detects 32bit OCaml switch on 64bit host +- Fix #36: change Q.equal, leq, geq comparisons for undef +- Request #47: move infix comparison operators of Z in submodule + avoid shadowing the polymorphic compare [Bernhard Schommer] +- Fix #49: INT_MAX undeclared +- Request #46: add prefixnonocaml option [Et7f3] +- Request #45: fix ocamllibdir/caml/mlvalues.h bug (Cygwin) [Et7f3] +- Fix: attempting to build numbers too large for GMP raises an OCaml exception + instead of crashing with "gmp: overflow in mpz type" + +Release 1.8 (2019-03-30): +- Request #20: infix comparison operators for Q and Z [Max Mouratov] +- Request #39: gdc(x,0) = gcd(0,x) = x [Vincent Laporte] +- Request #41: support for upcoming OCaml 4.08 [Daniel Hillerström] +- Issue #17: add package zarith.top with REPL printer [Christophe Troestler] +- Issue #22: wrong stack marking directive in caml_z_x86_64_mingw64.S + [Bernhard Schommer] +- Issue #24: generate and install .cmti files for easy access to documentation +- Issue #25: false alarm in tests/zq.ml owing to unreliable printing + of FP values +- Request #28: better handling of absolute paths in "configure" + +Release 1.7 (2017-10-13): +- Issue#14, pull request#15: ARM assembly code was broken. +- Fix tests so that they work even if the legacy Num library is unavailable. + +Release 1.6 (2017-09-23): +- On Linux and BSD, keep the stack non-executable. +- Issue#10: clarify documentation of Q.of_string +- Fixed spurious installation error if shared libraries not supported + [Bernhard Schommer] + +Release 1.5 (2017-05-26): +- Install all .cmx files, improving performance of clients and + avoiding a warning from OCaml 4.03 and up. +- Z.of_float: fix a bug in the fast path [Richard Jones] + (See https://bugzilla.redhat.com/show_bug.cgi?id=1392247) +- Improve compatibility with OCaml 4.03 and up + [Bernhard Schommer] +- Overflow issue in Z.pow and Z.root with very large exponents (GPR#5) + [Andre Maroneze] +- Added function Q.to_float. + +Release 1.4.1 (2015-11-09): +- Fixed ml_z_of_substring_base and Z.of_substring [Thomas Braibant] +- Integrated Opam fix for Perl scripts [Thomas Braibant] + +Release 1.4 (2015-11-02): +- Improvements to Q (using divexact) [Bertrand Jeannet] +- Fixed div_2exp bug [Bertrand Jeannet] +- Improvements for divexact [Bertrand Jeannet] +- Added of_substring, with fast path for native integers [Thomas Braibant] +- Added Z.powm_sec (constant-time modular exponentiation) +- Reimplemented Z.to_float, now produces correctly rounded FP numbers +- Added Z.trailing_zeros. +- Added Z.testbit, Z.is_even, Z.is_odd. +- Added Z.numbits, Z.log2 and Z.log2up. +- PR#1467: Z.hash is declared as "noalloc" [François Bobot] +- PR#1451: configure fix [Spiros Eliopoulos] +- PR#1436: disable "(void)" trick for unused variables on Windows [Bernhard Schommer] +- PR#1434: removed dependencies on printf & co when Z_PERFORM_CHECK is 0 [Hannes Mehnert] +- PR#1462: issues with Z.to_float and large numbers. + +Release 1.3 (2014-09-03): +- Fixed inefficiencies in asm fast path for ARM. +- Revised detection of NaNs and infinities in Z.of_float +- Suppress the redundant fast paths written in C if a corresponding + fast path exists in asm. +- Use to ensure compatibility with OCaml 4.02. +- More prudent implementation of Z.of_int, avoids GC problem + with OCaml < 4.02 (PR#6501 in the OCaml bug tracker). +- PR#1429: of_string accepts 'a' in base 10. +- Macro change to avoid compiler warnings on unused variables. + +Release 1.2.1 (2013-06-12): +- Install fixes + +Release 1.2 (2013-05-19): +- Added fast asm path for ARMv7 processors. +- PR#1192: incorrect behavior of div_2exp +- Issue with aggressive C compiler optimization in the fast path for multiply +- Better support for Windows/Mingw32 + +Release 1.1 (2012-03-24): +- Various improvements in the asm fast path for i686 and x86_64 +- PR#1034: support for static linking of GMP/MPIR +- PR#1046: autodetection of ocamlopt and dynlink +- PR#1048: autodetection of more platforms that we support +- PR#1051: support architectures with strict alignment constraints for + 64-bit integers (e.g. Sparc) +- Fixed 1-bit precision loss when converting doubles to rationals +- Improved support for the forthcoming release 4.00 of OCaml + +Release 1.0 (2011-08-18): +- First public release diff --git a/unikernel/duniverse/Zarith/LICENSE b/unikernel/duniverse/Zarith/LICENSE new file mode 100644 index 00000000..604c2ba6 --- /dev/null +++ b/unikernel/duniverse/Zarith/LICENSE @@ -0,0 +1,501 @@ +This Library is distributed under the terms of the GNU Library General +Public License version 2 (included below). + +As a special exception to the GNU Library General Public License, you +may link, statically or dynamically, a "work that uses the Library" +with a publicly distributed version of the Library to produce an +executable file containing portions of the Library, and distribute +that executable file under terms of your choice, without any of the +additional requirements listed in clause 6 of the GNU Library General +Public License. By "a publicly distributed version of the Library", +we mean either the unmodified Library as distributed by INRIA, or a +modified version of the Library that is distributed under the +conditions defined in clause 3 of the GNU Library General Public +License. This exception does not however invalidate any other reasons +why the executable file might be covered by the GNU Library General +Public License. + +---------------------------------------------------------------------- + + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called "this License"). Each licensee is +addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also compile or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + c) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + d) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/unikernel/duniverse/Zarith/META b/unikernel/duniverse/Zarith/META new file mode 100644 index 00000000..72bd4ca2 --- /dev/null +++ b/unikernel/duniverse/Zarith/META @@ -0,0 +1,18 @@ +description = "Arbitrary precision integers" +requires = "" +version = "1.14" +archive(byte) = "zarith.cma" +archive(native) = "zarith.cmxa" +plugin(byte) = "zarith.cma" +plugin(native) = "zarith.cmxs" + +package "top" ( + version = "1.13" + description = "ZArith toplevel support" + requires = "zarith" + archive(byte) = "zarith_top.cma" + archive(native) = "zarith_top.cmxa" + plugin(byte) = "zarith_top.cma" + plugin(native) = "zarith_top.cmxs" + exists_if = "zarith_top.cma" +) diff --git a/unikernel/duniverse/Zarith/README.md b/unikernel/duniverse/Zarith/README.md new file mode 100644 index 00000000..d5526630 --- /dev/null +++ b/unikernel/duniverse/Zarith/README.md @@ -0,0 +1,129 @@ +# The Zarith library + +## OVERVIEW + +This library implements arithmetic and logical operations over +arbitrary-precision integers. + +The module is simply named `Z`. Its interface is similar to that of +the `Int32`, `Int64` and `Nativeint` modules from the OCaml standard +library, with some additional functions. See the file `z.mli` for +documentation. + +The implementation uses GMP (the GNU Multiple Precision arithmetic +library) to compute over big integers. +However, small integers are represented as unboxed Caml integers, to save +space and improve performance. Big integers are allocated in the Caml heap, +bypassing GMP's memory management and achieving better GC behavior than e.g. +the MLGMP library. +Computations on small integers use a special, faster path (in C or OCaml) +eschewing calls to GMP, while computations on large intergers use the +low-level MPN functions from GMP. + +Arbitrary-precision integers can be compared correctly using OCaml's +polymorphic comparison operators (`=`, `<`, `>`, etc.). + +Additional features include: +* a module `Q` for rationals, built on top of `Z` (see `q.mli`) +* a compatibility layer `Big_int_Z` that implements the same API as Big_int from the legacy `Num` library, but uses `Z` internally + +Support for [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml/) is +provided by [Zarith_stubs_js](https://github.com/janestreet/zarith_stubs_js). + +## REQUIREMENTS + +* OCaml, version 4.04.0 or later. +* Either the GMP library or the MPIR library, including development files. +* GCC or Clang or a gcc-compatible C compiler and assembler (other compilers may work). +* The Findlib package manager (optional, recommended). + + +## INSTALLATION + +1) First, run the "configure" script by typing: +``` + ./configure +``` +The `configure` script has a few options. Use the `-help` option to get a +list and short description of each option. + +2) It creates a Makefile, which can be invoked by: +``` + make +``` +This builds native and bytecode versions of the library. + +3) The libraries are installed by typing: +``` + make install +``` +or, if you install to a system location but are not an administrator +``` + sudo make install +``` +If Findlib is detected, it is used to install files. +Otherwise, the files are copied to a `zarith/` subdirectory of the directory +given by `ocamlc -where`. + +The libraries are named `zarith.cmxa` and `zarith.cma`, and the Findlib module +is named `zarith`. + +Compiling and linking with the library requires passing the `-I +zarith` +option to `ocamlc` / `ocamlopt`, or the `-package zarith` option to `ocamlfind`. + +4) (optional, recommended) Test programs are built and run by the additional command +``` + make tests +``` +(but these are not installed). + +5) (optional) HTML API documentation is built (using `ocamldoc`) by the additional command +``` + make doc +``` + +## ONLINE DOCUMENTATION + +The documentation for the latest release is hosted on [GitHub Pages](https://antoinemine.github.io/Zarith/doc/latest/index.html). + + +## LICENSE + +This Library is distributed under the terms of the GNU Library General +Public License version 2, with a special exception allowing unconstrained +static linking. +See LICENSE file for details. + + +## AUTHORS + +* Antoine Miné, Sorbonne Université, formerly at ENS Paris. +* Xavier Leroy, Collège de France, formerly at Inria Paris. +* Pascal Cuoq, TrustInSoft. +* Christophe Troestler (toplevel module) + + +## COPYRIGHT + +Copyright (c) 2010-2011 Antoine Miné, Abstraction project. +Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), +a joint laboratory by: +CNRS (Centre national de la recherche scientifique, France), +ENS (École normale supérieure, Paris, France), +INRIA Rocquencourt (Institut national de recherche en informatique, France). + + +## CONTENTS + +Source files | Description +--------------------|----------------------------------------- + configure | configuration script + z.ml[i] | Z module and implementation for small integers + caml_z.c | C implementation + big_int_z.ml[i] | wrapper to provide a Big_int compatible API to Z + q.ml[i] | rational library, pure OCaml on top of Z + zarith_top.ml | toplevel module to provide pretty-printing + projet.mak | builds Z, Q and the tests + zarith.opam | package description for opam + z_mlgmpidl.ml[i] | conversion between Zarith and MLGMPIDL + tests/ | simple regression tests and benchmarks diff --git a/unikernel/duniverse/Zarith/big_int_Z.ml b/unikernel/duniverse/Zarith/big_int_Z.ml new file mode 100644 index 00000000..31d54f3e --- /dev/null +++ b/unikernel/duniverse/Zarith/big_int_Z.ml @@ -0,0 +1,144 @@ +(** + [Big_int] interface for Z module. + + This modules provides an interface compatible with [Big_int], but using + [Z] functions internally. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + +type big_int = Z.t + +let zero_big_int = Z.zero + +let unit_big_int = Z.one + +let minus_big_int = Z.neg + +let abs_big_int = Z.abs + +let add_big_int = Z.add + +let succ_big_int = Z.succ + +let add_int_big_int x y = Z.add (Z.of_int x) y + +let sub_big_int = Z.sub + +let pred_big_int = Z.pred + +let mult_big_int = Z.mul + +let mult_int_big_int x y = Z.mul (Z.of_int x) y + +let square_big_int x = Z.mul x x + +let sqrt_big_int = Z.sqrt + +let quomod_big_int = Z.ediv_rem + +let div_big_int = Z.ediv + +let mod_big_int = Z.erem + +let gcd_big_int = Z.gcd + +let power = Z.pow + +let power_big a b = + Z.pow a (Z.to_int b) + +let power_int_positive_int a b = + if b < 0 then raise (Invalid_argument "power_int_positive_int"); + power (Z.of_int a) b + +let power_big_int_positive_int a b = + if b < 0 then raise (Invalid_argument "power_big_int_positive_int"); + power a b + +let power_int_positive_big_int a b = + if Z.sign b < 0 then raise (Invalid_argument "power_int_positive_big_int"); + power_big (Z.of_int a) b + +let power_big_int_positive_big_int a b = + if Z.sign b < 0 then raise (Invalid_argument "power_big_int_positive_big_int"); + power_big a b + +let sign_big_int = Z.sign + +let compare_big_int = Z.compare + +let eq_big_int = Z.equal + +let le_big_int a b = Z.compare a b <= 0 + +let ge_big_int a b = Z.compare a b >= 0 + +let lt_big_int a b = Z.compare a b < 0 + +let gt_big_int a b = Z.compare a b > 0 + +let max_big_int = Z.max + +let min_big_int = Z.min + +let num_digits_big_int = Z.size + +let string_of_big_int = Z.to_string + +let big_int_of_string = Z.of_string + +let big_int_of_int = Z.of_int + +let is_int_big_int = Z.fits_int + +let int_of_big_int x = + try Z.to_int x with Z.Overflow -> failwith "int_of_big_int" + +let big_int_of_int32 = Z.of_int32 + +let big_int_of_nativeint = Z.of_nativeint + +let big_int_of_int64 = Z.of_int64 + +let int32_of_big_int x = + try Z.to_int32 x with Z.Overflow -> failwith "int32_of_big_int" + +let nativeint_of_big_int x = + try Z.to_nativeint x with Z.Overflow -> failwith "nativeint_of_big_int" + +let int64_of_big_int x = + try Z.to_int64 x with Z.Overflow -> failwith "int64_of_big_int" + +let float_of_big_int = Z.to_float + +let big_int_of_float = Z.of_float + +let and_big_int = Z.logand + +let or_big_int = Z.logor + +let xor_big_int = Z.logxor + +let shift_left_big_int = Z.shift_left + +let shift_right_big_int = Z.shift_right + +let shift_right_towards_zero_big_int = Z.shift_right_trunc + +let extract_big_int = Z.extract + + + diff --git a/unikernel/duniverse/Zarith/big_int_Z.mli b/unikernel/duniverse/Zarith/big_int_Z.mli new file mode 100644 index 00000000..a888820f --- /dev/null +++ b/unikernel/duniverse/Zarith/big_int_Z.mli @@ -0,0 +1,78 @@ +(** + [Big_int] interface for Z module. + + This modules provides an interface compatible with [Big_int], but using + [Z] functions internally. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + +(* note: generated with ocamlc -i *) + +type big_int = Z.t + +val zero_big_int : Z.t +val unit_big_int : Z.t +val minus_big_int : Z.t -> Z.t +val abs_big_int : Z.t -> Z.t +val add_big_int : Z.t -> Z.t -> Z.t +val succ_big_int : Z.t -> Z.t +val add_int_big_int : int -> Z.t -> Z.t +val sub_big_int : Z.t -> Z.t -> Z.t +val pred_big_int : Z.t -> Z.t +val mult_big_int : Z.t -> Z.t -> Z.t +val mult_int_big_int : int -> Z.t -> Z.t +val square_big_int : Z.t -> Z.t +val sqrt_big_int : Z.t -> Z.t +val quomod_big_int : Z.t -> Z.t -> Z.t * Z.t +val div_big_int : Z.t -> Z.t -> Z.t +val mod_big_int : Z.t -> Z.t -> Z.t +val gcd_big_int : Z.t -> Z.t -> Z.t +val power : Z.t -> int -> Z.t +val power_big : Z.t -> Z.t -> Z.t +val power_int_positive_int : int -> int -> Z.t +val power_big_int_positive_int : Z.t -> int -> Z.t +val power_int_positive_big_int : int -> Z.t -> Z.t +val power_big_int_positive_big_int : Z.t -> Z.t -> Z.t +val sign_big_int : Z.t -> int +val compare_big_int : Z.t -> Z.t -> int +val eq_big_int : Z.t -> Z.t -> bool +val le_big_int : Z.t -> Z.t -> bool +val ge_big_int : Z.t -> Z.t -> bool +val lt_big_int : Z.t -> Z.t -> bool +val gt_big_int : Z.t -> Z.t -> bool +val max_big_int : Z.t -> Z.t -> Z.t +val min_big_int : Z.t -> Z.t -> Z.t +val num_digits_big_int : Z.t -> int +val string_of_big_int : Z.t -> string +val big_int_of_string : string -> Z.t +val big_int_of_int : int -> Z.t +val is_int_big_int : Z.t -> bool +val int_of_big_int : Z.t -> int +val big_int_of_int32 : int32 -> Z.t +val big_int_of_nativeint : nativeint -> Z.t +val big_int_of_int64 : int64 -> Z.t +val int32_of_big_int : Z.t -> int32 +val nativeint_of_big_int : Z.t -> nativeint +val int64_of_big_int : Z.t -> int64 +val float_of_big_int : Z.t -> float +val big_int_of_float : float -> Z.t +val and_big_int : Z.t -> Z.t -> Z.t +val or_big_int : Z.t -> Z.t -> Z.t +val xor_big_int : Z.t -> Z.t -> Z.t +val shift_left_big_int : Z.t -> int -> Z.t +val shift_right_big_int : Z.t -> int -> Z.t +val shift_right_towards_zero_big_int : Z.t -> int -> Z.t +val extract_big_int : Z.t -> int -> int -> Z.t diff --git a/unikernel/duniverse/Zarith/caml_z.c b/unikernel/duniverse/Zarith/caml_z.c new file mode 100644 index 00000000..a60637c2 --- /dev/null +++ b/unikernel/duniverse/Zarith/caml_z.c @@ -0,0 +1,3543 @@ +/** + Implementation of Z module. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + +*/ + + +/*--------------------------------------------------- + INCLUDES + ---------------------------------------------------*/ + +#include +#include +#include +#include +#include +#include + +#ifdef HAS_GMP +#include +#endif +#ifdef HAS_MPIR +#include +#endif + +#include "zarith.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define inline __inline + +#ifdef _MSC_VER +#include +#include +#endif + +/* The "__has_builtin" special macro from Clang */ +#ifdef __has_builtin +#define HAS_BUILTIN(x) __has_builtin(x) +#else +#define HAS_BUILTIN(x) 0 +#endif + +/*--------------------------------------------------- + CONFIGURATION + ---------------------------------------------------*/ + +/* Whether to enable native (i.e. non-mpn_) operations and output + ocaml integers when possible. + Highly recommended. + */ +#define Z_FAST_PATH 1 +#define Z_USE_NATINT 1 + +/* Whether the fast path (arguments and result are small integers) + has already be handled in OCaml, so that there is no need to + re-test for it in C functions. + Applies to: neg, abs, add, sub, mul, div, rem, succ, pred, + logand, logor, logxor, lognot, shifts, divexact. +*/ +#define Z_FAST_PATH_IN_OCAML 1 + +/* Sanity checks. */ +#define Z_PERFORM_CHECK 0 + +/* Enable performance counters. + Prints some info on stdout at exit. +*/ +/* + #define Z_PERF_COUNTER 0 + now set by configure +*/ + +/* whether to use custom blocks (supporting serialization, comparison & + hashing) instead of abstract tags +*/ +#define Z_CUSTOM_BLOCK 1 + +/*--------------------------------------------------- + DATA STRUCTURES + ---------------------------------------------------*/ + +/* + we assume that: + - intnat is a signed integer type + - mp_limb_t is an unsigned integer type + - sizeof(intnat) == sizeof(mp_limb_t) == either 4 or 8 +*/ + +#ifdef _WIN64 +#define PRINTF_LIMB "I64" +#else +#define PRINTF_LIMB "l" +#endif + +/* + A z object x can be: + - either an ocaml int + - or a block with abstract or custom tag and containing: + . a 1 value header containing the sign Z_SIGN(x) and the size Z_SIZE(x) + . Z_SIZE(x) mp_limb_t + + Invariant: + - if the number fits in an int, it is stored in an int, not a block + - if the number is stored in a block, then Z_SIZE(x) >= 1 and + the most significant limb Z_LIMB(x)[Z_SIZE(x)] is not 0 + */ + + +/* a sign is always denoted as 0 (+) or Z_SIGN_MASK (-) */ +#ifdef ARCH_SIXTYFOUR +#define Z_SIGN_MASK 0x8000000000000000 +#define Z_SIZE_MASK 0x7fffffffffffffff +#else +#define Z_SIGN_MASK 0x80000000 +#define Z_SIZE_MASK 0x7fffffff +#endif + +#if Z_CUSTOM_BLOCK +#define Z_HEAD(x) (*((value*)Data_custom_val((x)))) +#define Z_LIMB(x) ((mp_limb_t*)Data_custom_val((x)) + 1) +#else +#define Z_HEAD(x) (Field((x),0)) +#define Z_LIMB(x) ((mp_limb_t*)&(Field((x),1))) +#endif +#define Z_SIGN(x) (Z_HEAD((x)) & Z_SIGN_MASK) +#define Z_SIZE(x) (Z_HEAD((x)) & Z_SIZE_MASK) + +/* bounds of an Ocaml int */ +#ifdef ARCH_SIXTYFOUR +#define Z_MAX_INT 0x3fffffffffffffff +#define Z_MIN_INT (-0x4000000000000000) +#else +#define Z_MAX_INT 0x3fffffff +#define Z_MIN_INT (-0x40000000) +#endif +#define Z_FITS_INT(v) ((v) >= Z_MIN_INT && (v) <= Z_MAX_INT) + +/* greatest/smallest double that can fit in an int */ +#ifdef ARCH_SIXTYFOUR +#define Z_MAX_INT_FL 0x3ffffffffffffe00 +#define Z_MIN_INT_FL (-0x4000000000000000) +#else +#define Z_MAX_INT_FL Z_MAX_INT +#define Z_MIN_INT_FL Z_MIN_INT +#endif + +/* safe bounds to avoid overflow in multiplication */ +#ifdef ARCH_SIXTYFOUR +#define Z_MAX_HINT 0x3fffffff +#else +#define Z_MAX_HINT 0x3fff +#endif +#define Z_MIN_HINT (-Z_MAX_HINT) +#define Z_FITS_HINT(v) ((v) >= Z_MIN_HINT && (v) <= Z_MAX_HINT) + +/* hi bit of OCaml int32, int64 & nativeint */ +#define Z_HI_INT32 0x80000000 +#define Z_HI_UINT32 0x100000000LL +#define Z_HI_INT64 0x8000000000000000LL +#ifdef ARCH_SIXTYFOUR +#define Z_HI_INTNAT Z_HI_INT64 +#define Z_HI_INT 0x4000000000000000 +#else +#define Z_HI_INTNAT Z_HI_INT32 +#define Z_HI_INT 0x40000000 +#endif + +/* safe bounds for the length of a base n string fitting in a native + int. Defined as the result of (n - 2) log_base(2) with n = 64 or + 32. +*/ +#ifdef ARCH_SIXTYFOUR +#define Z_BASE16_LENGTH_OP 15 +#define Z_BASE10_LENGTH_OP 18 +#define Z_BASE8_LENGTH_OP 20 +#define Z_BASE2_LENGTH_OP 62 +#else +#define Z_BASE16_LENGTH_OP 7 +#define Z_BASE10_LENGTH_OP 9 +#define Z_BASE8_LENGTH_OP 10 +#define Z_BASE2_LENGTH_OP 30 +#endif + +#define Z_LIMB_BITS (8 * sizeof(mp_limb_t)) + + +/* performance counters */ +unsigned long ml_z_ops = 0; +unsigned long ml_z_slow = 0; +unsigned long ml_z_ops_as = 0; + +#if Z_PERF_COUNTER +#define Z_MARK_OP ml_z_ops++ +#define Z_MARK_SLOW ml_z_slow++ +#else +#define Z_MARK_OP +#define Z_MARK_SLOW +#endif + +/*--------------------------------------------------- + UTILITIES + ---------------------------------------------------*/ + +extern struct custom_operations ml_z_custom_ops; + +static double ml_z_2p32; /* 2 ^ 32 in double */ + +#if Z_PERFORM_CHECK +/* for debugging: dump a mp_limb_t array */ +static void ml_z_dump(const char* msg, mp_limb_t* p, mp_size_t sz) +{ + mp_size_t i; + printf("%s %i: ",msg,(int)sz); + for (i = 0; i < sz; i++) +#ifdef ARCH_SIXTYFOUR + printf("%08" PRINTF_LIMB "x ",p[i]); +#else + printf("%04" PRINTF_LIMB "x ",p[i]); +#endif + printf("\n"); + fflush(stdout); +} +#endif + +#if Z_PERFORM_CHECK +/* for debugging: check invariant */ +void ml_z_check(const char* fn, int line, const char* arg, value v) +{ + mp_size_t sz; + + if (Is_long(v)) { +#if Z_USE_NATINT + return; +#else + printf("ml_z_check: unexpected tagged integer for %s at %s:%i.\n", arg, fn, line); + exit(1); +#endif + } +#if Z_CUSTOM_BLOCK + if (Custom_ops_val(v) != &ml_z_custom_ops) { + printf("ml_z_check: wrong custom block for %s at %s:%i.\n", + arg, fn, line); + exit(1); + } + sz = Wosize_val(v) - 1; +#else + sz = Wosize_val(v); +#endif + if (Z_SIZE(v) + 2 > sz) { + printf("ml_z_check: invalid block size (%i / %i) for %s at %s:%i.\n", + (int)Z_SIZE(v), (int)sz, + arg, fn, line); + exit(1); + } + if ((mp_size_t) Z_LIMB(v)[sz - 2] != (mp_size_t)(0xDEADBEEF ^ (sz - 2))) { + printf("ml_z_check: corrupted block for %s at %s:%i.\n", + arg, fn, line); + exit(1); + } + if (Z_SIZE(v) && !Z_LIMB(v)[Z_SIZE(v)-1]) { + printf("ml_z_check: unreduced argument for %s at %s:%i.\n", arg, fn, line); + ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v)); + exit(1); + } +#if Z_USE_NATINT + if (Z_SIZE(v) == 0 + || (Z_SIZE(v) <= 1 + && (Z_LIMB(v)[0] <= Z_MAX_INT + || (Z_LIMB(v)[0] == -Z_MIN_INT && Z_SIGN(v))))) { + printf("ml_z_check: expected a tagged integer for %s at %s:%i.\n", arg, fn, line); + ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v)); + exit(1); + } +#else + if (!Z_SIZE(v) && Z_SIGN(v)) { + printf("ml_z_check: invalid sign of 0 for %s at %s:%i.\n", + arg, fn, line); + exit(1); + } +#endif +} +#endif + +/* for debugging */ +#if Z_PERFORM_CHECK +#define Z_CHECK(v) ml_z_check(__FUNCTION__, __LINE__, #v, v) +#else +#define Z_CHECK(v) +#endif + +/* allocates z object block with space for sz mp_limb_t; + does not set the header + */ + +#if !Z_PERFORM_CHECK +/* inlined allocation */ +#if Z_CUSTOM_BLOCK +#define ml_z_alloc(sz) \ + caml_alloc_custom(&ml_z_custom_ops, (1 + (sz)) * sizeof(value), 0, 1) +#else +#define ml_z_alloc(sz) \ + caml_alloc(1 + (sz), Abstract_tag); +#endif + +#else +/* out-of-line allocation, inserting a canary after the last limb */ +static value ml_z_alloc(mp_size_t sz) +{ + value v; +#if Z_CUSTOM_BLOCK + v = caml_alloc_custom(&ml_z_custom_ops, (1 + sz + 1) * sizeof(value), 0, 1); +#else + v = caml_alloc(1 + sz + 1, Abstract_tag); +#endif + Z_LIMB(v)[sz] = 0xDEADBEEF ^ sz; + return v; +} +#endif + +/* duplicates the caml block src */ +static inline void ml_z_cpy_limb(mp_limb_t* dst, mp_limb_t* src, mp_size_t sz) +{ + memcpy(dst, src, sz * sizeof(mp_limb_t)); +} + +/* duplicates the mp_limb_t array src */ +static inline mp_limb_t* ml_z_dup_limb(mp_limb_t* src, mp_size_t sz) +{ + mp_limb_t* r = (mp_limb_t*) malloc(sz * sizeof(mp_limb_t)); + memcpy(r, src, sz * sizeof(mp_limb_t)); + return r; +} + + +#ifdef _MSC_VER +#define MAYBE_UNUSED +#else +#define MAYBE_UNUSED (void) +#endif + +/* given a z object, define: + - ptr_arg: a pointer to the first mp_limb_t + - size_arg: the number of mp-limb_t + - sign_arg: the sign of the number + if arg is an int, it is converted to a 1-limb number +*/ +#define Z_DECL(arg) \ + mp_limb_t loc_##arg, *ptr_##arg; \ + mp_size_t size_##arg; \ + intnat sign_##arg; \ + MAYBE_UNUSED loc_##arg; \ + MAYBE_UNUSED ptr_##arg; \ + MAYBE_UNUSED size_##arg; \ + MAYBE_UNUSED sign_##arg; + +#define Z_ARG(arg) \ + if (Is_long(arg)) { \ + intnat n = Long_val(arg); \ + loc_##arg = n < 0 ? -n : n; \ + sign_##arg = n & Z_SIGN_MASK; \ + size_##arg = n != 0; \ + ptr_##arg = &loc_##arg; \ + } \ + else { \ + size_##arg = Z_SIZE(arg); \ + sign_##arg = Z_SIGN(arg); \ + ptr_##arg = Z_LIMB(arg); \ + } + +/* After an allocation, a heap-allocated Z argument may have moved and + its ptr_arg pointer can be invalid. Reset the ptr_arg pointer to + its correct value. */ + +#define Z_REFRESH(arg) \ + if (! Is_long(arg)) ptr_##arg = Z_LIMB(arg); + +/* computes the actual size of the z object r and updates its header, + either returns r or, if the number is small enough, an int + */ +static value ml_z_reduce(value r, mp_size_t sz, intnat sign) +{ + while (sz > 0 && !Z_LIMB(r)[sz-1]) sz--; +#if Z_USE_NATINT + if (!sz) return Val_long(0); + if (sz <= 1) { + if (Z_LIMB(r)[0] <= Z_MAX_INT) { + if (sign) return Val_long(-Z_LIMB(r)[0]); + else return Val_long(Z_LIMB(r)[0]); + } + if (Z_LIMB(r)[0] == -Z_MIN_INT && sign) { + return Val_long(Z_MIN_INT); + } + } +#else + if (!sz) sign = 0; +#endif + Z_HEAD(r) = sz | sign; + return r; +} + +static void ml_z_raise_overflow() +{ + caml_raise_constant(*caml_named_value("ml_z_overflow")); +} + +#define ml_z_raise_divide_by_zero() \ + caml_raise_zero_divide() + + + +/*--------------------------------------------------- + CONVERSION FUNCTIONS + ---------------------------------------------------*/ + +CAMLprim value ml_z_of_int(value v) +{ +#if Z_USE_NATINT + Z_MARK_OP; + return v; +#else + intnat x; + value r; + Z_MARK_OP; + Z_MARK_SLOW; + x = Long_val(v); + r = ml_z_alloc(1); + if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } + else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; } + else Z_HEAD(r) = 0; + Z_CHECK(r); + return r; +#endif +} + +CAMLprim value ml_z_of_nativeint(value v) +{ + intnat x; + value r; + Z_MARK_OP; + x = Nativeint_val(v); +#if Z_USE_NATINT + if (Z_FITS_INT(x)) return Val_long(x); +#endif + Z_MARK_SLOW; + r = ml_z_alloc(1); + if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } + else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; } + else Z_HEAD(r) = 0; + Z_CHECK(r); + return r; +} + +CAMLprim value ml_z_of_int32(value v) +{ + int32_t x; + Z_MARK_OP; + x = Int32_val(v); +#if Z_USE_NATINT && defined(ARCH_SIXTYFOUR) + return Val_long(x); +#else +#if Z_USE_NATINT + if (Z_FITS_INT(x)) return Val_long(x); +#endif + { + value r; + Z_MARK_SLOW; + r = ml_z_alloc(1); + if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } + else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -(mp_limb_t)x; } + else Z_HEAD(r) = 0; + Z_CHECK(r); + return r; + } +#endif +} + +CAMLprim value ml_z_of_int64(value v) +{ + int64_t x; + value r; + Z_MARK_OP; + x = Int64_val(v); +#if Z_USE_NATINT + if (Z_FITS_INT(x)) return Val_long(x); +#endif + Z_MARK_SLOW; +#ifdef ARCH_SIXTYFOUR + r = ml_z_alloc(1); + if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } + else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; } + else Z_HEAD(r) = 0; +#else + { + mp_limb_t sign; + r = ml_z_alloc(2); + if (x >= 0) { sign = 0; } + else { sign = Z_SIGN_MASK; x = -x; } + Z_LIMB(r)[0] = x; + Z_LIMB(r)[1] = x >> 32; + r = ml_z_reduce(r, 2, sign); + } +#endif + Z_CHECK(r); + return r; +} + +CAMLprim value ml_z_of_float(value v) +{ + double x; + int exp; + int64_t y, m; + value r; + Z_MARK_OP; + x = Double_val(v); +#if Z_USE_NATINT + if (x >= Z_MIN_INT_FL && x <= Z_MAX_INT_FL) return Val_long((intnat) x); +#endif + Z_MARK_SLOW; +#ifdef ARCH_ALIGN_INT64 + memcpy(&y, (void *) v, 8); +#else + y = *((int64_t*)v); +#endif + exp = ((y >> 52) & 0x7ff) - 1023; /* exponent */ + if (exp < 0) return(Val_long(0)); + if (exp == 1024) ml_z_raise_overflow(); /* NaN or infinity */ + m = (y & 0x000fffffffffffffLL) | 0x0010000000000000LL; /* mantissa */ + if (exp <= 52) { + m >>= 52-exp; +#ifdef ARCH_SIXTYFOUR + r = Val_long((x >= 0.) ? m : -m); +#else + r = ml_z_alloc(2); + Z_LIMB(r)[0] = m; + Z_LIMB(r)[1] = m >> 32; + r = ml_z_reduce(r, 2, (x >= 0.) ? 0 : Z_SIGN_MASK); +#endif + } + else { + int c1 = (exp-52) / Z_LIMB_BITS; + int c2 = (exp-52) % Z_LIMB_BITS; + mp_size_t i; +#ifdef ARCH_SIXTYFOUR + r = ml_z_alloc(c1 + 2); + for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0; + Z_LIMB(r)[c1] = m << c2; + Z_LIMB(r)[c1+1] = c2 ? (m >> (64-c2)) : 0; + r = ml_z_reduce(r, c1 + 2, (x >= 0.) ? 0 : Z_SIGN_MASK); +#else + r = ml_z_alloc(c1 + 3); + for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0; + Z_LIMB(r)[c1] = m << c2; + Z_LIMB(r)[c1+1] = m >> (32-c2); + Z_LIMB(r)[c1+2] = c2 ? (m >> (64-c2)) : 0; + r = ml_z_reduce(r, c1 + 3, (x >= 0.) ? 0 : Z_SIGN_MASK); +#endif + } + Z_CHECK(r); + return r; +} + +CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value length) +{ + CAMLparam1(v); + CAMLlocal1(r); + intnat ofs = Long_val(offset); + intnat len = Long_val(length); + /* make sure the ofs/length make sense */ + if (ofs < 0 + || len < 0 + || (intnat)caml_string_length(v) < ofs + len) + caml_invalid_argument("Z.of_substring_base: invalid offset or length"); + /* process the string */ + const char *d = String_val(v) + ofs; + const char *end = d + len; + mp_size_t i, j, sz, sz2, num_digits = 0; + mp_limb_t sign = 0; + intnat base = Long_val(b); + /* We allow [d] to advance beyond [end] while parsing the prefix: + sign, base, and/or leading zeros. + This simplifies the code, and reading these locations is safe since + we don't progress beyond a terminating null character. + At the end of the prefix, if we ran past the end, we return 0. + */ + /* get optional sign */ + if (*d == '-') { sign ^= Z_SIGN_MASK; d++; } + if (*d == '+') d++; + /* get optional base */ + if (!base) { + base = 10; + if (*d == '0') { + d++; + if (*d == 'o' || *d == 'O') { base = 8; d++; } + else if (*d == 'x' || *d == 'X') { base = 16; d++; } + else if (*d == 'b' || *d == 'B') { base = 2; d++; } + else { + /* The leading zero is not part of a base prefix. This is an + important distinction for the check below looking at + leading underscore + */ + d--; } + } + } + if (base < 2 || base > 16) + caml_invalid_argument("Z.of_substring_base: base must be between 2 and 16"); + /* we do not allow leading underscore */ + if (*d == '_') + caml_invalid_argument("Z.of_substring_base: invalid digit"); + while (*d == '0' || *d == '_') d++; + /* sz is the length of the substring that has not been consumed above. */ + sz = end - d; + for(i = 0; i < sz; i++){ + /* underscores are going to be ignored below. Assuming the string + is well formatted, this will give us the exact number of digits */ + if(d[i] != '_') num_digits++; + } +#if Z_USE_NATINT + if (sz <= 0) { + /* "+", "-", "0x" are parsed as 0. */ + r = Val_long(0); + } + /* Process common case (fits into a native integer) */ + else if ((base == 10 && num_digits <= Z_BASE10_LENGTH_OP) + || (base == 16 && num_digits <= Z_BASE16_LENGTH_OP) + || (base == 8 && num_digits <= Z_BASE8_LENGTH_OP) + || (base == 2 && num_digits <= Z_BASE2_LENGTH_OP)) { + Z_MARK_OP; + intnat ret = 0; + for (i = 0; i < sz; i++) { + int digit = 0; + if (d[i] == '_') continue; + if (d[i] >= '0' && d[i] <= '9') digit = d[i] - '0'; + else if (d[i] >= 'a' && d[i] <= 'f') digit = d[i] - 'a' + 10; + else if (d[i] >= 'A' && d[i] <= 'F') digit = d[i] - 'A' + 10; + else caml_invalid_argument("Z.of_substring_base: invalid digit"); + if (digit >= base) + caml_invalid_argument("Z.of_substring_base: invalid digit"); + ret = ret * base + digit; + } + r = Val_long(ret * (sign ? -1 : 1)); + } else +#endif + { + /* converts to sequence of digits */ + char* digits = (char*)malloc(num_digits+1); + for (i = 0, j = 0; i < sz; i++) { + if (d[i] == '_') continue; + if (d[i] >= '0' && d[i] <= '9') digits[j] = d[i] - '0'; + else if (d[i] >= 'a' && d[i] <= 'f') digits[j] = d[i] - 'a' + 10; + else if (d[i] >= 'A' && d[i] <= 'F') digits[j] = d[i] - 'A' + 10; + else { + free(digits); + caml_invalid_argument("Z.of_substring_base: invalid digit"); + } + if (digits[j] >= base) { + free(digits); + caml_invalid_argument("Z.of_substring_base: invalid digit"); + } + j++; + } + /* make sure that digits is nul terminated */ + digits[j] = 0; + r = ml_z_alloc(1 + j / (2 * sizeof(mp_limb_t))); + sz2 = mpn_set_str(Z_LIMB(r), (unsigned char*)digits, j, base); + r = ml_z_reduce(r, sz2, sign); + free(digits); + } + Z_CHECK(r); + CAMLreturn(r); +} + +/* either stores the result in r and returns 0 (no overflow), + or returns 1 and leave r undefined (overflow) +*/ +static int ml_to_int(value v, intnat* r) +{ + Z_DECL(v); + Z_MARK_OP; + Z_CHECK(v); + if (Is_long(v)) { *r = v; return 0; } + Z_MARK_SLOW; + Z_ARG(v); + if (size_v > 1) return 1; + else if (!size_v) { *r = Val_long(0); return 0; } + else { + intnat x = *ptr_v; + if (sign_v) { + if ((uintnat)x > Z_HI_INT) return 1; + *r = Val_long(-x); + } + else { + if ((uintnat)x >= Z_HI_INT) return 1; + *r = Val_long(x); + } + return 0; + } +} + +CAMLprim value ml_z_to_int(value v) +{ + value x; + if (ml_to_int(v, &x)) ml_z_raise_overflow(); + return x; +} + +CAMLprim value ml_z_fits_int(value v) +{ + value x; + if (ml_to_int(v, &x)) return Val_false; + return Val_true; +} + +static int ml_to_nativeint(value v, intnat* r) +{ + Z_DECL(v); + Z_MARK_OP; + Z_CHECK(v); + if (Is_long(v)) { *r = Long_val(v); return 0; } + Z_MARK_SLOW; + Z_ARG(v); + if (size_v > 1) return 1; + if (!size_v) { *r = 0; return 0; } + else { + intnat x; + x = *ptr_v; + if (sign_v) { + if ((uintnat)x > Z_HI_INTNAT) return 1; + *r = -x; + } + else { + if ((uintnat)x >= Z_HI_INTNAT) return 1; + *r = x; + } + return 0; + } +} + +CAMLprim value ml_z_to_nativeint(value v) +{ + intnat x; + if (ml_to_nativeint(v, &x)) ml_z_raise_overflow(); + return caml_copy_nativeint(x); +} + +CAMLprim value ml_z_fits_nativeint(value v) +{ + intnat x; + if (ml_to_nativeint(v, &x)) return Val_false; + return Val_true; +} + +static int ml_to_nativeint_unsigned(value v, uintnat* r) +{ + Z_DECL(v); + Z_MARK_OP; + Z_CHECK(v); + if (Is_long(v)) { + intnat x = Long_val(v); + if (x < 0) return 1; + *r = (uintnat)x; + return 0; + } + Z_MARK_SLOW; + Z_ARG(v); + if (!size_v) { *r = 0; return 0; } + else if (sign_v || size_v > 1) return 1; + else { + *r = *ptr_v; + return 0; + } +} + +CAMLprim value ml_z_to_nativeint_unsigned(value v) +{ + uintnat x; + if (ml_to_nativeint_unsigned(v, &x)) ml_z_raise_overflow(); + return caml_copy_nativeint(x); +} + +CAMLprim value ml_z_fits_nativeint_unsigned(value v) +{ + uintnat x; + if (ml_to_nativeint_unsigned(v, &x)) return Val_false; + return Val_true; +} + +static int ml_to_int32(value v, int32_t* r) +{ + Z_DECL(v); + Z_MARK_OP; + Z_CHECK(v); + if (Is_long(v)) { + intnat x = Long_val(v); +#ifdef ARCH_SIXTYFOUR + if (x >= (intnat)Z_HI_INT32 || x < -(intnat)Z_HI_INT32) + return 1; +#endif + *r = x; + return 0; + } + else { + Z_ARG(v); + Z_MARK_SLOW; + if (size_v > 1) return 1; + if (!size_v) { *r = 0; return 0; } + else { + uintnat x = *ptr_v; + if (sign_v) { + if (x > Z_HI_INT32) return 1; + *r = -x; + } + else { + if (x >= Z_HI_INT32) return 1; + *r = x; + } + return 0; + } + } +} + +CAMLprim value ml_z_to_int32(value v) +{ + int32_t x; + if (ml_to_int32(v, &x)) ml_z_raise_overflow(); + return caml_copy_int32(x); +} + +CAMLprim value ml_z_fits_int32(value v) +{ + int32_t x; + if (ml_to_int32(v, &x)) return Val_false; + return Val_true; +} + +static int ml_to_int32_unsigned(value v, uint32_t* r) +{ + Z_DECL(v); + Z_MARK_OP; + Z_CHECK(v); + if (Is_long(v)) { + intnat x = Long_val(v); +#ifdef ARCH_SIXTYFOUR + if (x < 0 || x >= Z_HI_UINT32) +#else + if (x < 0) +#endif + return 1; + *r = x; + return 0; + } + else { + Z_ARG(v); + Z_MARK_SLOW; + if (!size_v) { *r = 0; return 0; } + else if (sign_v || size_v > 1) return 1; + else { + uintnat x = *ptr_v; +#ifdef ARCH_SIXTYFOUR + if (x >= Z_HI_UINT32) return 1; +#endif + *r = x; + return 0; + } + } +} + +CAMLprim value ml_z_to_int32_unsigned(value v) +{ + uint32_t x; + if (ml_to_int32_unsigned(v, &x)) ml_z_raise_overflow(); + return caml_copy_int32(x); +} + +CAMLprim value ml_z_fits_int32_unsigned(value v) +{ + uint32_t x; + if (ml_to_int32_unsigned(v, &x)) return Val_false; + return Val_true; +} + +static int ml_to_int64(value v, int64_t* r) +{ + int64_t x; + Z_DECL(v); + Z_MARK_OP; + Z_CHECK(v); + if (Is_long(v)) { *r = Long_val(v); return 0; } + Z_MARK_SLOW; + Z_ARG(v); + switch (size_v) { + case 0: x = 0; break; + case 1: x = ptr_v[0]; break; +#ifndef ARCH_SIXTYFOUR + case 2: x = ptr_v[0] | ((uint64_t)ptr_v[1] << 32); break; +#endif + default: return 1; + } + if (sign_v) { + if ((uint64_t)x > Z_HI_INT64) return 1; + *r = -x; + } + else { + if ((uint64_t)x >= Z_HI_INT64) return 1; + *r = x; + } + return 0; +} + +CAMLprim value ml_z_to_int64(value v) +{ + int64_t x; + if (ml_to_int64(v, &x)) ml_z_raise_overflow(); + return caml_copy_int64(x); +} + +CAMLprim value ml_z_fits_int64(value v) +{ + int64_t x; + if (ml_to_int64(v, &x)) return Val_false; + return Val_true; +} + +static int ml_to_int64_unsigned(value v, uint64_t* r) +{ + Z_DECL(v); + Z_MARK_OP; + Z_CHECK(v); + if (Is_long(v)) { + intnat x = Long_val(v); + if (x < 0) return 1; + *r = x; + return 0; + } + Z_MARK_SLOW; + Z_ARG(v); + if (sign_v) return 1; + switch (size_v) { + case 0: *r = 0; return 0; + case 1: *r = ptr_v[0]; return 0; +#ifndef ARCH_SIXTYFOUR + case 2: *r = ptr_v[0] | ((uint64_t) ptr_v[1] << 32); return 0; +#endif + default: return 1; + } +} + +CAMLprim value ml_z_to_int64_unsigned(value v) +{ + uint64_t x; + if (ml_to_int64_unsigned(v, &x)) ml_z_raise_overflow(); + return caml_copy_int64(x); +} + +CAMLprim value ml_z_fits_int64_unsigned(value v) +{ + uint64_t x; + if (ml_to_int64_unsigned(v, &x)) return Val_false; + return Val_true; +} + +/* XXX: characters that do not belong to the format are ignored, this departs + from the classic printf behavior (it copies them in the output) + */ +CAMLprim value ml_z_format(value f, value v) +{ + CAMLparam2(f,v); + Z_DECL(v); + const char tab[2][16] = + { { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' }, + { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' } }; + char* buf, *dst; + mp_size_t i, size_dst, max_size; + value r; + const char* fmt = String_val(f); + int base = 10; /* base */ + int cas = 0; /* uppercase X / lowercase x */ + int width = 0; + int alt = 0; /* alternate # */ + int dir = 0; /* right / left adjusted */ + char sign = 0; /* sign char */ + char pad = ' '; /* padding char */ + char *prefix = ""; + Z_MARK_OP; + Z_CHECK(v); + Z_ARG(v); + Z_MARK_SLOW; + + /* parse format */ + while (*fmt == '%') fmt++; + for (; ; fmt++) { + if (*fmt == '#') alt = 1; + else if (*fmt == '0') pad = '0'; + else if (*fmt == '-') dir = 1; + else if (*fmt == ' ' || *fmt == '+') sign = *fmt; + else break; + } + if (sign_v) sign = '-'; + for (;*fmt>='0' && *fmt<='9';fmt++) + width = 10*width + *fmt-'0'; + switch (*fmt) { + case 'i': case 'd': case 'u': break; + case 'b': base = 2; if (alt) prefix = "0b"; break; + case 'o': base = 8; if (alt) prefix = "0o"; break; + case 'x': base = 16; if (alt) prefix = "0x"; cas = 1; break; + case 'X': base = 16; if (alt) prefix = "0X"; break; + default: caml_invalid_argument("Z.format: invalid format"); + } + if (dir) pad = ' '; + /* get digits */ + /* we need space for sign + prefix + digits + 1 + padding + terminal 0 */ + max_size = 1 + 2 + Z_LIMB_BITS * size_v + 1 + 2 * width + 1; + buf = (char*) malloc(max_size); + dst = buf + 1 + 2 + width; + if (!size_v) { + size_dst = 1; + *dst = '0'; + } + else { + mp_limb_t* copy_v = ml_z_dup_limb(ptr_v, size_v); + size_dst = mpn_get_str((unsigned char*)dst, base, copy_v, size_v); + if (dst + size_dst >= buf + max_size) + caml_failwith("Z.format: internal error"); + free(copy_v); + while (size_dst && !*dst) { dst++; size_dst--; } + for (i = 0; i < size_dst; i++) + dst[i] = tab[cas][ (int) dst[i] ]; + } + /* add prefix, sign & padding */ + if (pad == ' ') { + if (dir) { + /* left alignment */ + for (i = strlen(prefix); i > 0; i--, size_dst++) + *(--dst) = prefix[i-1]; + if (sign) { *(--dst) = sign; size_dst++; } + for (; size_dst < width; size_dst++) + dst[size_dst] = pad; + } + else { + /* right alignment, space padding */ + for (i = strlen(prefix); i > 0; i--, size_dst++) + *(--dst) = prefix[i-1]; + if (sign) { *(--dst) = sign; size_dst++; } + for (; size_dst < width; size_dst++) *(--dst) = pad; + } + } + else { + /* right alignment, non-space padding */ + width -= strlen(prefix) + (sign ? 1 : 0); + for (; size_dst < width; size_dst++) *(--dst) = pad; + for (i = strlen(prefix); i > 0; i--, size_dst++) + *(--dst) = prefix[i-1]; + if (sign) { *(--dst) = sign; size_dst++; } + } + dst[size_dst] = 0; + if (dst < buf || dst + size_dst >= buf + max_size) + caml_failwith("Z.format: internal error"); + r = caml_copy_string(dst); + free(buf); + CAMLreturn(r); +} + +/* Fast path since len < BITS_PER_WORD */ +CAMLprim value ml_z_extract_small(value arg, value off, value len) +{ + Z_DECL(arg); + uintnat o, l; /* caml code ensures off and len are non signed */ + intnat x; + mp_size_t c1, c2, csz, i; + mp_limb_t cr; + Z_ARG(arg); + o = (uintnat)Long_val(off); + l = (uintnat)Long_val(len); + c1 = o / Z_LIMB_BITS; + c2 = o % Z_LIMB_BITS; + csz = size_arg - c1; + if (csz > 0) { + if (c2) { + x = ptr_arg[c1] >> c2; + if ((c2 + l > (intnat)Z_LIMB_BITS) && (csz > 1)) + x |= (ptr_arg[c1 + 1] << (Z_LIMB_BITS - c2)); + } + else x = ptr_arg[c1]; + } + else x = 0; + if (sign_arg) { + x = ~x; + if (csz > 0) { + /* carry (cr=0 if all shifted-out bits are 0) */ + cr = ptr_arg[c1] & (((intnat)1 << c2) - 1); + for (i = 0; !cr && i < c1; i++) + cr = ptr_arg[i]; + if (!cr) x ++; + } + } + x &= ((intnat)1 << l) - 1; + return Val_long(x); +} + +CAMLprim value ml_z_extract(value arg, value off, value len) +{ + uintnat o, l; /* caml code ensures off and len are non signed */ + intnat x; + mp_size_t sz, c1, c2, csz, i; + mp_limb_t cr; + value r; + Z_DECL(arg); + Z_MARK_OP; + MAYBE_UNUSED x; + o = (uintnat)Long_val(off); + l = (uintnat)Long_val(len); + Z_MARK_SLOW; + { + CAMLparam1(arg); + Z_ARG(arg); + sz = (l + Z_LIMB_BITS - 1) / Z_LIMB_BITS; + r = ml_z_alloc(sz + 1); + Z_REFRESH(arg); + c1 = o / Z_LIMB_BITS; + c2 = o % Z_LIMB_BITS; + /* shift or copy */ + csz = size_arg - c1; + if (csz > sz + 1) csz = sz + 1; + cr = 0; + if (csz > 0) { + if (c2) cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, csz, c2); + else ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, csz); + } + else csz = 0; + /* 0-pad */ + for (i = csz; i < sz; i++) + Z_LIMB(r)[i] = 0; + /* 2's complement */ + if (sign_arg) { + for (i = 0; i < sz; i++) + Z_LIMB(r)[i] = ~Z_LIMB(r)[i]; + /* carry (cr=0 if all shifted-out bits are 0) */ + for (i = 0; !cr && i < c1 && i < size_arg; i++) + cr = ptr_arg[i]; + if (!cr) mpn_add_1(Z_LIMB(r), Z_LIMB(r), sz, 1); + } + /* mask out high bits */ + l %= Z_LIMB_BITS; + if (l) Z_LIMB(r)[sz-1] &= ((uintnat)(intnat)-1) >> (Z_LIMB_BITS - l); + r = ml_z_reduce(r, sz, 0); + CAMLreturn(r); + } +} + +/* NOTE: the sign is not stored */ +CAMLprim value ml_z_to_bits(value arg) +{ + CAMLparam1(arg); + CAMLlocal1(r); + Z_DECL(arg); + mp_size_t i; + unsigned char* p; + Z_MARK_OP; + Z_MARK_SLOW; + Z_ARG(arg); + r = caml_alloc_string(size_arg * sizeof(mp_limb_t)); + Z_REFRESH(arg); + p = (unsigned char*) String_val(r); + memset(p, 0, size_arg * sizeof(mp_limb_t)); + for (i = 0; i < size_arg; i++) { + mp_limb_t x = ptr_arg[i]; + *(p++) = x; + *(p++) = x >> 8; + *(p++) = x >> 16; + *(p++) = x >> 24; +#ifdef ARCH_SIXTYFOUR + *(p++) = x >> 32; + *(p++) = x >> 40; + *(p++) = x >> 48; + *(p++) = x >> 56; +#endif + } + CAMLreturn(r); +} + +CAMLprim value ml_z_of_bits(value arg) +{ + CAMLparam1(arg); + CAMLlocal1(r); + mp_size_t sz, szw; + mp_size_t i = 0; + mp_limb_t x; + const unsigned char* p; + Z_MARK_OP; + Z_MARK_SLOW; + sz = caml_string_length(arg); + szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t); + r = ml_z_alloc(szw); + p = (const unsigned char*) String_val(arg); + /* all limbs but last */ + if (szw > 1) { + for (; i < szw - 1; i++) { + x = *(p++); + x |= ((mp_limb_t) *(p++)) << 8; + x |= ((mp_limb_t) *(p++)) << 16; + x |= ((mp_limb_t) *(p++)) << 24; +#ifdef ARCH_SIXTYFOUR + x |= ((mp_limb_t) *(p++)) << 32; + x |= ((mp_limb_t) *(p++)) << 40; + x |= ((mp_limb_t) *(p++)) << 48; + x |= ((mp_limb_t) *(p++)) << 56; +#endif + Z_LIMB(r)[i] = x; + } + sz -= i * sizeof(mp_limb_t); + } + /* last limb */ + if (sz > 0) { + x = *(p++); + if (sz > 1) x |= ((mp_limb_t) *(p++)) << 8; + if (sz > 2) x |= ((mp_limb_t) *(p++)) << 16; + if (sz > 3) x |= ((mp_limb_t) *(p++)) << 24; +#ifdef ARCH_SIXTYFOUR + if (sz > 4) x |= ((mp_limb_t) *(p++)) << 32; + if (sz > 5) x |= ((mp_limb_t) *(p++)) << 40; + if (sz > 6) x |= ((mp_limb_t) *(p++)) << 48; + if (sz > 7) x |= ((mp_limb_t) *(p++)) << 56; +#endif + Z_LIMB(r)[i] = x; + } + r = ml_z_reduce(r, szw, 0); + Z_CHECK(r); + CAMLreturn(r); +} + +/*--------------------------------------------------- + TESTS AND COMPARISONS + ---------------------------------------------------*/ + +CAMLprim value ml_z_compare(value arg1, value arg2) +{ + int r; + Z_DECL(arg1); Z_DECL(arg2); + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH + /* Value-equal small integers are equal. + Pointer-equal big integers are equal as well. */ + if (arg1 == arg2) return Val_long(0); + if (Is_long(arg2)) { + if (Is_long(arg1)) { + return arg1 > arg2 ? Val_long(1) : Val_long(-1); + } else { + /* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1 + or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */ + return Z_SIGN(arg1) ? Val_long(-1) : Val_long(1); + } + } + else if (Is_long(arg1)) { + /* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1 + or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */ + return Z_SIGN(arg2) ? Val_long(1) : Val_long(-1); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + Z_ARG(arg1); + Z_ARG(arg2); + r = 0; + if (sign_arg1 != sign_arg2) r = 1; + else if (size_arg1 > size_arg2) r = 1; + else if (size_arg1 < size_arg2) r = -1; + else { + mp_size_t i; + for (i = size_arg1 - 1; i >= 0; i--) { + if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; } + if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; } + } + } + if (sign_arg1) r = -r; + return Val_long(r); +} + +CAMLprim value ml_z_equal(value arg1, value arg2) +{ + mp_size_t i; + Z_DECL(arg1); Z_DECL(arg2); + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH + /* Value-equal small integers are equal. + Pointer-equal big integers are equal as well. */ + if (arg1 == arg2) return Val_true; + /* If both arg1 and arg2 are small integers but failed the equality + test above, they are different. + If one of arg1/arg2 is a small integer and the other is a big integer, + they are different: one is in the range [Z_MIN_INT,Z_MAX_INT] + and the other is outside this range. */ + if (Is_long(arg2) || Is_long(arg1)) return Val_false; +#endif + /* mpn_ version */ + Z_MARK_SLOW; + Z_ARG(arg1); + Z_ARG(arg2); + if (sign_arg1 != sign_arg2 || size_arg1 != size_arg2) return Val_false; + for (i = 0; i < size_arg1; i++) + if (ptr_arg1[i] != ptr_arg2[i]) return Val_false; + return Val_true; +} + +int ml_z_sgn(value arg) +{ + if (Is_long(arg)) { + if (arg > Val_long(0)) return 1; + else if (arg < Val_long(0)) return -1; + else return 0; + } + else { + Z_MARK_SLOW; +#if !Z_USE_NATINT + /* In "use natint" mode, zero is a small integer, treated above */ + if (!Z_SIZE(arg)) return 0; +#endif + if (Z_SIGN(arg)) return -1; else return 1; + } +} +CAMLprim value ml_z_sign(value arg) +{ + Z_MARK_OP; + Z_CHECK(arg); + return Val_long(ml_z_sgn(arg)); +} + +CAMLprim value ml_z_size(value v) +{ + Z_MARK_OP; + if (Is_long(v)) return Val_long(1); + else return Val_long(Z_SIZE(v)); +} + + +/*--------------------------------------------------- + ARITHMETIC OPERATORS + ---------------------------------------------------*/ + +CAMLprim value ml_z_neg(value arg) +{ + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg)) { + /* fast path */ + if (arg > Val_long(Z_MIN_INT)) return 2 - arg; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam1(arg); + value r; + Z_DECL(arg); + Z_ARG(arg); + r = ml_z_alloc(size_arg); + Z_REFRESH(arg); + ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg); + r = ml_z_reduce(r, size_arg, sign_arg ^ Z_SIGN_MASK); + Z_CHECK(r); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_abs(value arg) +{ + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg)) { + /* fast path */ + if (arg >= Val_long(0)) return arg; + if (arg > Val_long(Z_MIN_INT)) return 2 - arg; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam1(arg); + Z_DECL(arg); + value r; + Z_ARG(arg); + if (sign_arg) { + r = ml_z_alloc(size_arg); + Z_REFRESH(arg); + ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg); + r = ml_z_reduce(r, size_arg, 0); + Z_CHECK(r); + } + else r = arg; + CAMLreturn(r); + } +} + +/* helper function for add/sub */ +static value ml_z_addsub(value arg1, value arg2, intnat sign) +{ + CAMLparam2(arg1,arg2); + Z_DECL(arg1); Z_DECL(arg2); + value r; + mp_limb_t c; + Z_ARG(arg1); + Z_ARG(arg2); + sign_arg2 ^= sign; + if (!size_arg2) r = arg1; + else if (!size_arg1) { + if (sign) { + /* negation */ + r = ml_z_alloc(size_arg2); + Z_REFRESH(arg2); + ml_z_cpy_limb(Z_LIMB(r), ptr_arg2, size_arg2); + r = ml_z_reduce(r, size_arg2, sign_arg2); + } + else r = arg2; + } + else if (sign_arg1 == sign_arg2) { + /* addition */ + if (size_arg1 >= size_arg2) { + r = ml_z_alloc(size_arg1 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + c = mpn_add(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2); + Z_LIMB(r)[size_arg1] = c; + r = ml_z_reduce(r, size_arg1+1, sign_arg1); + } + else { + r = ml_z_alloc(size_arg2 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + c = mpn_add(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1); + Z_LIMB(r)[size_arg2] = c; + r = ml_z_reduce(r, size_arg2+1, sign_arg1); + } + } + else { + /* subtraction */ + if (size_arg1 > size_arg2) { + r = ml_z_alloc(size_arg1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2); + r = ml_z_reduce(r, size_arg1, sign_arg1); + } + else if (size_arg1 < size_arg2) { + r = ml_z_alloc(size_arg2); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1); + r = ml_z_reduce(r, size_arg2, sign_arg2); + } + else { + int cmp = mpn_cmp(ptr_arg1, ptr_arg2, size_arg1); + if (cmp > 0) { + r = ml_z_alloc(size_arg1+1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1); + r = ml_z_reduce(r, size_arg1, sign_arg1); + } + else if (cmp < 0) { + r = ml_z_alloc(size_arg1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_n(Z_LIMB(r), ptr_arg2, ptr_arg1, size_arg1); + r = ml_z_reduce(r, size_arg1, sign_arg2); + } + else r = Val_long(0); + } + } + Z_CHECK(r); + CAMLreturn(r); +} + +CAMLprim value ml_z_add(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat v = a1 + a2; + if (Z_FITS_INT(v)) return Val_long(v); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return ml_z_addsub(arg1, arg2, 0); +} + +CAMLprim value ml_z_sub(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat v = a1 - a2; + if (Z_FITS_INT(v)) return Val_long(v); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return ml_z_addsub(arg1, arg2, Z_SIGN_MASK); +} + +CAMLprim value ml_z_mul_overflows(value vx, value vy) +{ +#if HAS_BUILTIN(__builtin_mul_overflow) || __GNUC__ >= 5 + intnat z; + return Val_bool(__builtin_mul_overflow(vx - 1, vy >> 1, &z)); +#elif defined(__GNUC__) && defined(__x86_64__) + intnat z; + unsigned char o; + asm("imulq %1, %3; seto %0" + : "=q" (o), "=r" (z) + : "1" (vx - 1), "r" (vy >> 1) + : "cc"); + return Val_int(o); +#elif defined(_MSC_VER) && defined(_M_X64) + intnat hi, lo; + lo = _mul128(vx - 1, vy >> 1, &hi); + return Val_bool(hi != lo >> 63); +#else + /* Portable C code */ + intnat x = Long_val(vx); + intnat y = Long_val(vy); + /* Quick approximate check for small values of x and y. + Also catches the cases x = 0, x = 1, y = 0, y = 1. */ + if (Z_FITS_HINT(x)) { + if (Z_FITS_HINT(y)) return Val_false; + if ((uintnat) x <= 1) return Val_false; + } + if ((uintnat) y <= 1) return Val_false; +#if 1 + /* Give up at this point; we'll go through the general case in ml_z_mul */ + return Val_true; +#else + /* The product x*y is representable as an unboxed integer if + it is in [Z_MIN_INT, Z_MAX_INT]. + x >= 0 y >= 0: x*y >= 0 and x*y <= Z_MAX_INT <-> y <= Z_MAX_INT / x + x < 0 y >= 0: x*y <= 0 and x*y >= Z_MIN_INT <-> x >= Z_MIN_INT / y + x >= 0 y < 0 : x*y <= 0 and x*y >= Z_MIN_INT <-> y >= Z_MIN_INT / x + x < 0 y < 0 : x*y >= 0 and x*y <= Z_MAX_INT <-> x >= Z_MAX_INT / y */ + if (x >= 0) + if (y >= 0) + return Val_bool(y > Z_MAX_INT / x); + else + return Val_bool(y < Z_MIN_INT / x); + else + if (y >= 0) + return Val_bool(x < Z_MIN_INT / y); + else + return Val_bool(x < Z_MAX_INT / y); +#endif +#endif +} + +CAMLprim value ml_z_mul(value arg1, value arg2) +{ + Z_DECL(arg1); Z_DECL(arg2); + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2) && + ml_z_mul_overflows(arg1, arg2) == Val_false) { + return Val_long(Long_val(arg1) * Long_val(arg2)); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + Z_ARG(arg1); + Z_ARG(arg2); + if (!size_arg1 || !size_arg2) return Val_long(0); + { + CAMLparam2(arg1,arg2); + value r = ml_z_alloc(size_arg1 + size_arg2); + mp_limb_t c; + Z_REFRESH(arg1); + Z_REFRESH(arg2); + if (size_arg2 == 1) { + c = mpn_mul_1(Z_LIMB(r), ptr_arg1, size_arg1, *ptr_arg2); + Z_LIMB(r)[size_arg1] = c; + } + else if (size_arg1 == 1) { + c = mpn_mul_1(Z_LIMB(r), ptr_arg2, size_arg2, *ptr_arg1); + Z_LIMB(r)[size_arg2] = c; + } +#if HAVE_NATIVE_mpn_mul_2 /* untested */ + else if (size_arg2 == 2) { + c = mpn_mul_2(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2); + Z_LIMB(r)[size_arg1 + 1] = c; + } + else if (size_arg1 == 2) { + c = mpn_mul_2(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1); + Z_LIMB(r)[size_arg2 + 1] = c; + } +#endif + else if (size_arg1 > size_arg2) + mpn_mul(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2); + else if (size_arg1 < size_arg2) + mpn_mul(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1); +/* older GMP don't have mpn_sqr, so we make the optimisation optional */ +#ifdef mpn_sqr + else if (ptr_arg1 == ptr_arg2) + mpn_sqr(Z_LIMB(r), ptr_arg1, size_arg1); +#endif + else + mpn_mul_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1); + r = ml_z_reduce(r, size_arg1 + size_arg2, sign_arg1^sign_arg2); + Z_CHECK(r); + CAMLreturn(r); + } +} + +/* helper function for division: returns truncated quotient and remainder */ +static value ml_z_tdiv_qr(value arg1, value arg2) +{ + CAMLparam2(arg1, arg2); + CAMLlocal3(q, r, p); + Z_DECL(arg1); Z_DECL(arg2); + Z_ARG(arg1); Z_ARG(arg2); + if (!size_arg2) ml_z_raise_divide_by_zero(); + if (size_arg1 >= size_arg2) { + q = ml_z_alloc(size_arg1 - size_arg2 + 1); + r = ml_z_alloc(size_arg2); + Z_REFRESH(arg1); Z_REFRESH(arg2); + mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0, + ptr_arg1, size_arg1, ptr_arg2, size_arg2); + q = ml_z_reduce(q, size_arg1 - size_arg2 + 1, sign_arg1 ^ sign_arg2); + r = ml_z_reduce(r, size_arg2, sign_arg1); + } + else { + q = Val_long(0); + r = arg1; + } + Z_CHECK(q); + Z_CHECK(r); + p = caml_alloc_small(2, 0); + Field(p,0) = q; + Field(p,1) = r; + CAMLreturn(p); +} + +CAMLprim value ml_z_div_rem(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q, r; + if (!a2) ml_z_raise_divide_by_zero(); + q = a1 / a2; + r = a1 % a2; + if (Z_FITS_INT(q) && Z_FITS_INT(r)) { + value p = caml_alloc_small(2, 0); + Field(p,0) = Val_long(q); + Field(p,1) = Val_long(r); + return p; + } + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return ml_z_tdiv_qr(arg1, arg2); +} + +CAMLprim value ml_z_div(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q; + if (!a2) ml_z_raise_divide_by_zero(); + q = a1 / a2; + if (Z_FITS_INT(q)) return Val_long(q); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return Field(ml_z_tdiv_qr(arg1, arg2), 0); +} + +CAMLprim value ml_z_rem(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat r; + if (!a2) ml_z_raise_divide_by_zero(); + r = a1 % a2; + if (Z_FITS_INT(r)) return Val_long(r); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return Field(ml_z_tdiv_qr(arg1, arg2), 1); +} + +/* helper function for division with rounding towards +oo / -oo */ +static value ml_z_rdiv(value arg1, value arg2, intnat dir) +{ + CAMLparam2(arg1, arg2); + CAMLlocal2(q, r); + Z_DECL(arg1); Z_DECL(arg2); + Z_ARG(arg1); Z_ARG(arg2); + if (!size_arg2) ml_z_raise_divide_by_zero(); + if (size_arg1 >= size_arg2) { + mp_limb_t c = 0; + q = ml_z_alloc(size_arg1 - size_arg2 + 2); + r = ml_z_alloc(size_arg2); + Z_REFRESH(arg1); Z_REFRESH(arg2); + mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0, + ptr_arg1, size_arg1, ptr_arg2, size_arg2); + if ((sign_arg1 ^ sign_arg2) == dir) { + /* outward rounding */ + mp_size_t sz; + for (sz = size_arg2; sz > 0 && !Z_LIMB(r)[sz-1]; sz--); + if (sz) { + /* r != 0: needs adjustment */ + c = mpn_add_1(Z_LIMB(q), Z_LIMB(q), size_arg1 - size_arg2 + 1, 1); + } + } + Z_LIMB(q)[size_arg1 - size_arg2 + 1] = c; + q = ml_z_reduce(q, size_arg1 - size_arg2 + 2, sign_arg1 ^ sign_arg2); + } + else { + if (size_arg1 && (sign_arg1 ^ sign_arg2) == dir) { + if (dir) q = Val_long(-1); + else q = Val_long(1); + } + else q = Val_long(0); + } + Z_CHECK(q); + CAMLreturn(q); +} + +CAMLprim value ml_z_cdiv(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q; + if (!a2) ml_z_raise_divide_by_zero(); + /* adjust to round towards +oo */ + if (a1 > 0 && a2 > 0) a1 += a2-1; + else if (a1 < 0 && a2 < 0) a1 += a2+1; + q = a1 / a2; + if (Z_FITS_INT(q)) return Val_long(q); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return ml_z_rdiv(arg1, arg2, 0); +} + +CAMLprim value ml_z_fdiv(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q; + if (!a2) ml_z_raise_divide_by_zero(); + /* adjust to round towards -oo */ + if (a1 < 0 && a2 > 0) a1 -= a2-1; + else if (a1 > 0 && a2 < 0) a1 -= a2+1; + q = a1 / a2; + if (Z_FITS_INT(q)) return Val_long(q); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return ml_z_rdiv(arg1, arg2, Z_SIGN_MASK); +} + +/* helper function for succ / pred */ +static value ml_z_succpred(value arg, intnat sign) +{ + CAMLparam1(arg); + Z_DECL(arg); + value r; + Z_ARG(arg); + r = ml_z_alloc(size_arg + 1); + Z_REFRESH(arg); + if (!size_arg) { + Z_LIMB(r)[0] = 1; + r = ml_z_reduce(r, 1, sign); + } + else if (sign_arg == sign) { + /* add 1 */ + mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1); + Z_LIMB(r)[size_arg] = c; + r = ml_z_reduce(r, size_arg + 1, sign_arg); + } + else { + /* subtract 1 */ + mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1); + r = ml_z_reduce(r, size_arg, sign_arg); + } + Z_CHECK(r); + CAMLreturn(r); +} + +CAMLprim value ml_z_succ(value arg) +{ + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg)) { + /* fast path */ + if (arg < Val_long(Z_MAX_INT)) return arg + 2; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return ml_z_succpred(arg, 0); +} + +CAMLprim value ml_z_pred(value arg) +{ + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg)) { + /* fast path */ + if (arg > Val_long(Z_MIN_INT)) return arg - 2; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + return ml_z_succpred(arg, Z_SIGN_MASK); +} + +CAMLprim value ml_z_sqrt(value arg) +{ + /* XXX TODO: fast path */ + CAMLparam1(arg); + Z_DECL(arg); + value r; + Z_MARK_OP; + Z_MARK_SLOW; + Z_CHECK(arg); + Z_ARG(arg); + if (sign_arg) + caml_invalid_argument("Z.sqrt: square root of a negative number"); + if (size_arg) { + mp_size_t sz = (size_arg + 1) / 2; + r = ml_z_alloc(sz); + Z_REFRESH(arg); + mpn_sqrtrem(Z_LIMB(r), NULL, ptr_arg, size_arg); + r = ml_z_reduce(r, sz, 0); + } + else r = Val_long(0); + Z_CHECK(r); + CAMLreturn(r); +} + +CAMLprim value ml_z_sqrt_rem(value arg) +{ + CAMLparam1(arg); + CAMLlocal3(r, s, p); + Z_DECL(arg); + /* XXX TODO: fast path */ + Z_MARK_OP; + Z_MARK_SLOW; + Z_CHECK(arg); + Z_ARG(arg); + if (sign_arg) + caml_invalid_argument("Z.sqrt_rem: square root of a negative number"); + if (size_arg) { + mp_size_t sz = (size_arg + 1) / 2, sz2; + r = ml_z_alloc(sz); + s = ml_z_alloc(size_arg); + Z_REFRESH(arg); + sz2 = mpn_sqrtrem(Z_LIMB(r), Z_LIMB(s), ptr_arg, size_arg); + r = ml_z_reduce(r, sz, 0); + s = ml_z_reduce(s, sz2, 0); + } + else r = s = Val_long(0); + Z_CHECK(r); + Z_CHECK(s); + p = caml_alloc_small(2, 0); + Field(p,0) = r; + Field(p,1) = s; + CAMLreturn(p); +} + +CAMLprim value ml_z_gcd(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + if (a1 < 0) a1 = -a1; + if (a2 < 0) a2 = -a2; + if (a1 < a2) { intnat t = a1; a1 = a2; a2 = t; } + while (a2) { + intnat r = a1 % a2; + a1 = a2; a2 = r; + } + /* If arg1 = arg2 = min_int, the result a1 is -min_int, not representable + as a tagged integer; fall through the slow case, then. */ + if (a1 <= Z_MAX_INT) return Val_long(a1); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam2(arg1, arg2); + CAMLlocal3(r, tmp1, tmp2); + mp_size_t sz, pos1, pos2, limb1, limb2, bit1, bit2, pos, limb, bit, i; + Z_DECL(arg1); Z_DECL(arg2); + Z_ARG(arg1); Z_ARG(arg2); + if (!size_arg1) r = sign_arg2 ? ml_z_neg(arg2) : arg2; + else if (!size_arg2) r = sign_arg1 ? ml_z_neg(arg1) : arg1; + else { + /* copy args to tmp storage & remove lower 0 bits */ + pos1 = mpn_scan1(ptr_arg1, 0); + pos2 = mpn_scan1(ptr_arg2, 0); + limb1 = pos1 / Z_LIMB_BITS; + limb2 = pos2 / Z_LIMB_BITS; + bit1 = pos1 % Z_LIMB_BITS; + bit2 = pos2 % Z_LIMB_BITS; + size_arg1 -= limb1; + size_arg2 -= limb2; + tmp1 = ml_z_alloc(size_arg1 + 1); + tmp2 = ml_z_alloc(size_arg2 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + if (bit1) { + mpn_rshift(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1, bit1); + if (!Z_LIMB(tmp1)[size_arg1-1]) size_arg1--; + } + else ml_z_cpy_limb(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1); + if (bit2) { + mpn_rshift(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2, bit2); + if (!Z_LIMB(tmp2)[size_arg2-1]) size_arg2--; + } + else ml_z_cpy_limb(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2); + /* compute gcd of 2^pos1 & 2^pos2 */ + pos = (pos1 <= pos2) ? pos1 : pos2; + limb = pos / Z_LIMB_BITS; + bit = pos % Z_LIMB_BITS; + /* compute gcd of arg1 & arg2 without lower 0 bits */ + /* second argument must have less bits than first */ + if ((size_arg1 > size_arg2) || + ((size_arg1 == size_arg2) && + (Z_LIMB(tmp1)[size_arg1 - 1] >= Z_LIMB(tmp2)[size_arg1 - 1]))) { + r = ml_z_alloc(size_arg2 + limb + 1); + sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp1), size_arg1, Z_LIMB(tmp2), size_arg2); + } + else { + r = ml_z_alloc(size_arg1 + limb + 1); + sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp2), size_arg2, Z_LIMB(tmp1), size_arg1); + } + /* glue the two results */ + for (i = 0; i < limb; i++) + Z_LIMB(r)[i] = 0; + Z_LIMB(r)[sz + limb] = 0; + if (bit) mpn_lshift(Z_LIMB(r) + limb, Z_LIMB(r) + limb, sz + 1, bit); + r = ml_z_reduce(r, limb + sz + 1, 0); + } + Z_CHECK(r); + CAMLreturn(r); + } +} + +/* only computes one cofactor */ +CAMLprim value ml_z_gcdext_intern(value arg1, value arg2) +{ + /* XXX TODO: fast path */ + CAMLparam2(arg1, arg2); + CAMLlocal5(r, res_arg1, res_arg2, s, p); + Z_DECL(arg1); Z_DECL(arg2); + mp_size_t sz, sn; + Z_MARK_OP; + Z_MARK_SLOW; + Z_CHECK(arg1); Z_CHECK(arg2); + Z_ARG(arg1); Z_ARG(arg2); + if (!size_arg1 || !size_arg2) ml_z_raise_divide_by_zero(); + /* copy args to tmp storage */ + res_arg1 = ml_z_alloc(size_arg1 + 1); + res_arg2 = ml_z_alloc(size_arg2 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + ml_z_cpy_limb(Z_LIMB(res_arg1), ptr_arg1, size_arg1); + ml_z_cpy_limb(Z_LIMB(res_arg2), ptr_arg2, size_arg2); + /* must have arg1 >= arg2 */ + if ((size_arg1 > size_arg2) || + ((size_arg1 == size_arg2) && + (mpn_cmp(Z_LIMB(res_arg1), Z_LIMB(res_arg2), size_arg1) >= 0))) { + r = ml_z_alloc(size_arg1 + 1); + s = ml_z_alloc(size_arg1 + 1); + sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn, + Z_LIMB(res_arg1), size_arg1, Z_LIMB(res_arg2), size_arg2); + p = caml_alloc_small(3, 0); + Field(p,2) = Val_true; + } + else { + r = ml_z_alloc(size_arg2 + 1); + s = ml_z_alloc(size_arg2 + 1); + sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn, + Z_LIMB(res_arg2), size_arg2, Z_LIMB(res_arg1), size_arg1); + p = caml_alloc_small(3, 0); + Field(p,2) = Val_false; + sign_arg1 = sign_arg2; + } + /* pack result */ + r = ml_z_reduce(r, sz, 0); + if ((int)sn >= 0) s = ml_z_reduce(s, sn, sign_arg1); + else s = ml_z_reduce(s, -sn, sign_arg1 ^ Z_SIGN_MASK); + Z_CHECK(r); + Z_CHECK(s); + Field(p,0) = r; + Field(p,1) = s; + CAMLreturn(p); +} + + +/*--------------------------------------------------- + BITWISE OPERATORS + ---------------------------------------------------*/ + +CAMLprim value ml_z_logand(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + return arg1 & arg2; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam2(arg1,arg2); + value r; + mp_size_t i; + mp_limb_t c; + Z_DECL(arg1); Z_DECL(arg2); + Z_ARG(arg1); Z_ARG(arg2); + /* ensure size_arg1 >= size_arg2 */ + if (size_arg1 < size_arg2) { + mp_size_t sz; + mp_limb_t *p, s; + value a; + sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz; + p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p; + s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s; + a = arg1; arg1 = arg2; arg2 = a; + } + if (!size_arg2) r = arg2; + else if (sign_arg1 && sign_arg2) { + /* arg1 < 0, arg2 < 0 => r < 0 */ + r = ml_z_alloc(size_arg1 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); + c = 1; /* carry when decrementing arg2 */ + for (i = 0; i < size_arg2; i++) { + mp_limb_t v = ptr_arg2[i]; + Z_LIMB(r)[i] = Z_LIMB(r)[i] | (v - c); + c = c && !v; + } + c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); + Z_LIMB(r)[size_arg1] = c; + r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); + } + else if (sign_arg1) { + /* arg1 < 0, arg2 > 0 => r >= 0 */ + r = ml_z_alloc(size_arg2); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = (~Z_LIMB(r)[i]) & ptr_arg2[i]; + r = ml_z_reduce(r, size_arg2, 0); + } + else if (sign_arg2) { + /* arg1 > 0, arg2 < 0 => r >= 0 */ + r = ml_z_alloc(size_arg1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = ptr_arg1[i] & (~Z_LIMB(r)[i]); + for (; i < size_arg1; i++) + Z_LIMB(r)[i] = ptr_arg1[i]; + r = ml_z_reduce(r, size_arg1, 0); + } + else { + /* arg1, arg2 > 0 => r >= 0 */ + r = ml_z_alloc(size_arg2); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = ptr_arg1[i] & ptr_arg2[i]; + r = ml_z_reduce(r, size_arg2, 0); + } + Z_CHECK(r); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_logor(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + return arg1 | arg2; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam2(arg1,arg2); + Z_DECL(arg1); Z_DECL(arg2); + mp_size_t i; + mp_limb_t c; + value r; + Z_ARG(arg1); Z_ARG(arg2); + /* ensure size_arg1 >= size_arg2 */ + if (size_arg1 < size_arg2) { + mp_size_t sz; + mp_limb_t *p, s; + value a; + sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz; + p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p; + s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s; + a = arg1; arg1 = arg2; arg2 = a; + } + if (!size_arg2) r = arg1; + else if (sign_arg1 && sign_arg2) { + /* arg1 < 0, arg2 < 0 => r < 0 */ + r = ml_z_alloc(size_arg2 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1); + c = 1; /* carry when decrementing arg2 */ + for (i = 0; i < size_arg2; i++) { + mp_limb_t v = ptr_arg2[i]; + Z_LIMB(r)[i] = Z_LIMB(r)[i] & (v - c); + c = c && !v; + } + c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1); + Z_LIMB(r)[size_arg2] = c; + r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK); + } + else if (sign_arg1) { + /* arg1 < 0, arg2 > 0 => r < 0 */ + r = ml_z_alloc(size_arg1 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = Z_LIMB(r)[i] & (~ptr_arg2[i]); + c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); + Z_LIMB(r)[size_arg1] = c; + r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); + } + else if (sign_arg2) { + /* arg1 > 0, arg2 < 0 => r < 0*/ + r = ml_z_alloc(size_arg2 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = (~ptr_arg1[i]) & Z_LIMB(r)[i]; + c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1); + Z_LIMB(r)[size_arg2] = c; + r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK); + } + else { + /* arg1, arg2 > 0 => r > 0 */ + r = ml_z_alloc(size_arg1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = ptr_arg1[i] | ptr_arg2[i]; + for (; i < size_arg1; i++) + Z_LIMB(r)[i] = ptr_arg1[i]; + r = ml_z_reduce(r, size_arg1, 0); + } + Z_CHECK(r); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_logxor(value arg1, value arg2) +{ + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + return (arg1 ^ arg2) | 1; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam2(arg1,arg2); + Z_DECL(arg1); Z_DECL(arg2); + value r; + mp_size_t i; + mp_limb_t c; + Z_ARG(arg1); Z_ARG(arg2); + /* ensure size_arg1 >= size_arg2 */ + if (size_arg1 < size_arg2) { + mp_size_t sz; + mp_limb_t *p, s; + value a; + sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz; + p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p; + s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s; + a = arg1; arg1 = arg2; arg2 = a; + } + if (!size_arg2) r = arg1; + else if (sign_arg1 && sign_arg2) { + /* arg1 < 0, arg2 < 0 => r >=0 */ + r = ml_z_alloc(size_arg1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); + c = 1; /* carry when decrementing arg2 */ + for (i = 0; i < size_arg2; i++) { + mp_limb_t v = ptr_arg2[i]; + Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ (v - c); + c = c && !v; + } + r = ml_z_reduce(r, size_arg1, 0); + } + else if (sign_arg1) { + /* arg1 < 0, arg2 > 0 => r < 0 */ + r = ml_z_alloc(size_arg1 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ ptr_arg2[i]; + c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); + Z_LIMB(r)[size_arg1] = c; + r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); + } + else if (sign_arg2) { + /* arg1 > 0, arg2 < 0 => r < 0 */ + r = ml_z_alloc(size_arg1 + 1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = ptr_arg1[i] ^ Z_LIMB(r)[i]; + for (; i < size_arg1; i++) + Z_LIMB(r)[i] = ptr_arg1[i]; + c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); + Z_LIMB(r)[size_arg1] = c; + r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); + } + else { + /* arg1, arg2 > 0 => r >= 0 */ + r = ml_z_alloc(size_arg1); + Z_REFRESH(arg1); + Z_REFRESH(arg2); + for (i = 0; i < size_arg2; i++) + Z_LIMB(r)[i] = ptr_arg1[i] ^ ptr_arg2[i]; + for (; i < size_arg1; i++) + Z_LIMB(r)[i] = ptr_arg1[i]; + r = ml_z_reduce(r, size_arg1, 0); + } + Z_CHECK(r); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_lognot(value arg) +{ + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg)) { + /* fast path */ + return (~arg) | 1; + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam1(arg); + Z_DECL(arg); + value r; + Z_ARG(arg); + r = ml_z_alloc(size_arg + 1); + Z_REFRESH(arg); + /* compute r = -arg - 1 */ + if (!size_arg) { + /* arg = 0 => r = -1 */ + Z_LIMB(r)[0] = 1; + r = ml_z_reduce(r, 1, Z_SIGN_MASK); + } + else if (sign_arg) { + /* arg < 0, r > 0, |r| = |arg| - 1 */ + mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1); + r = ml_z_reduce(r, size_arg, 0); + } + else { + /* arg > 0, r < 0, |r| = |arg| + 1 */ + mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1); + Z_LIMB(r)[size_arg] = c; + r = ml_z_reduce(r, size_arg + 1, Z_SIGN_MASK); + } + Z_CHECK(r); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_shift_left(value arg, value count) +{ + Z_DECL(arg); + intnat c = Long_val(count); + intnat c1, c2; + Z_MARK_OP; + Z_CHECK(arg); + if (c < 0) + caml_invalid_argument("Z.shift_left: count argument must be positive"); + if (!c) return arg; + c1 = c / Z_LIMB_BITS; + c2 = c % Z_LIMB_BITS; +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg) && !c1) { + /* fast path */ + value a = arg - 1; + value r = arg << c2; + if (a == (r >> c2)) return r | 1; + } +#endif + Z_ARG(arg); + if (!size_arg) return Val_long(0); + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam1(arg); + value r; + mp_size_t i; + r = ml_z_alloc(size_arg + c1 + 1); + Z_REFRESH(arg); + /* 0-filled limbs */ + for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0; + if (c2) { + /* shifted bits */ + mp_limb_t x = mpn_lshift(Z_LIMB(r) + c1, ptr_arg, size_arg, c2); + Z_LIMB(r)[size_arg + c1] = x; + } + else { + /* unshifted copy */ + ml_z_cpy_limb(Z_LIMB(r) + c1, ptr_arg, size_arg); + Z_LIMB(r)[size_arg + c1] = 0; + } + r = ml_z_reduce(r, size_arg + c1 + 1, sign_arg); + Z_CHECK(r); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_shift_right(value arg, value count) +{ + Z_DECL(arg); + intnat c = Long_val(count); + intnat c1, c2; + value r; + Z_MARK_OP; + Z_CHECK(arg); + if (c < 0) + caml_invalid_argument("Z.shift_right: count argument must be positive"); + if (!c) return arg; + c1 = c / Z_LIMB_BITS; + c2 = c % Z_LIMB_BITS; +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg)) { + /* fast path */ + if (c1) { + if (arg < 0) return Val_long(-1); + else return Val_long(0); + } + return (arg >> c2) | 1; + } +#endif + Z_ARG(arg); + if (c1 >= size_arg) { + if (sign_arg) return Val_long(-1); + else return Val_long(0); + } + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam1(arg); + mp_limb_t cr; + r = ml_z_alloc(size_arg - c1 + 1); + Z_REFRESH(arg); + if (c2) + /* shifted bits */ + cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2); + else { + /* unshifted copy */ + ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1); + cr = 0; + } + if (sign_arg) { + /* round |arg| to +oo */ + mp_size_t i; + if (!cr) { + for (i = 0; i < c1; i++) + if (ptr_arg[i]) { cr = 1; break; } + } + if (cr) + cr = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg - c1, 1); + } + else cr = 0; + Z_LIMB(r)[size_arg - c1] = cr; + r = ml_z_reduce(r, size_arg - c1 + 1, sign_arg); + Z_CHECK(r); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_shift_right_trunc(value arg, value count) +{ + Z_DECL(arg); + intnat c = Long_val(count); + intnat c1, c2; + value r; + Z_MARK_OP; + Z_CHECK(arg); + if (c < 0) + caml_invalid_argument("Z.shift_right_trunc: count argument must be positive"); + if (!c) return arg; + c1 = c / Z_LIMB_BITS; + c2 = c % Z_LIMB_BITS; +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg)) { + /* fast path */ + if (c1) return Val_long(0); + if (arg >= 1) return (arg >> c2) | 1; + else return Val_long(- ((- Long_val(arg)) >> c2)); + } +#endif + Z_ARG(arg); + if (c1 >= size_arg) return Val_long(0); + /* mpn_ version */ + Z_MARK_SLOW; + { + CAMLparam1(arg); + r = ml_z_alloc(size_arg - c1); + Z_REFRESH(arg); + if (c2) + /* shifted bits */ + mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2); + else + /* unshifted copy */ + ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1); + r = ml_z_reduce(r, size_arg - c1, sign_arg); + Z_CHECK(r); + CAMLreturn(r); + } +} + +/* Helper function for numbits: number of leading 0 bits in x */ + +#ifdef _LONG_LONG_LIMB +#define BUILTIN_CLZ __builtin_clzll +#else +#define BUILTIN_CLZ __builtin_clzl +#endif + +/* Use GCC or Clang built-in if available. The argument must be != 0. */ +#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#define ml_z_clz BUILTIN_CLZ +#else +/* Portable C implementation - Hacker's Delight fig 5.12 */ +int ml_z_clz(mp_limb_t x) +{ + int n; + mp_limb_t y; +#ifdef ARCH_SIXTYFOUR + n = 64; + y = x >> 32; if (y != 0) { n = n - 32; x = y; } +#else + n = 32; +#endif + y = x >> 16; if (y != 0) { n = n - 16; x = y; } + y = x >> 8; if (y != 0) { n = n - 8; x = y; } + y = x >> 4; if (y != 0) { n = n - 4; x = y; } + y = x >> 2; if (y != 0) { n = n - 2; x = y; } + y = x >> 1; if (y != 0) return n - 2; + return n - x; +} +#endif + +CAMLprim value ml_z_numbits(value arg) +{ + Z_DECL(arg); + intnat r; + int n; + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH + if (Is_long(arg)) { + /* fast path */ + r = Long_val(arg); + if (r == 0) { + return Val_int(0); + } else { + n = ml_z_clz(r > 0 ? r : -r); + return Val_long(sizeof(intnat) * 8 - n); + } + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + Z_ARG(arg); + if (size_arg == 0) return Val_int(0); + n = ml_z_clz(ptr_arg[size_arg - 1]); + return Val_long(size_arg * Z_LIMB_BITS - n); +} + +/* Helper function for trailing_zeros: number of trailing 0 bits in x */ + +#ifdef _LONG_LONG_LIMB +#define BUILTIN_CTZ __builtin_ctzll +#else +#define BUILTIN_CTZ __builtin_ctzl +#endif + +/* Use GCC or Clang built-in if available. The argument must be != 0. */ +#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#define ml_z_ctz BUILTIN_CTZ +#else +/* Portable C implementation - Hacker's Delight fig 5.21 */ +int ml_z_ctz(mp_limb_t x) +{ + int n; + mp_limb_t y; + CAMLassert (x != 0); +#ifdef ARCH_SIXTYFOUR + n = 63; + y = x << 32; if (y != 0) { n = n - 32; x = y; } +#else + n = 31; +#endif + y = x << 16; if (y != 0) { n = n - 16; x = y; } + y = x << 8; if (y != 0) { n = n - 8; x = y; } + y = x << 4; if (y != 0) { n = n - 4; x = y; } + y = x << 2; if (y != 0) { n = n - 2; x = y; } + y = x << 1; if (y != 0) { n = n - 1; } + return n; +} +#endif + +CAMLprim value ml_z_trailing_zeros(value arg) +{ + Z_DECL(arg); + intnat r; + mp_size_t i; + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH + if (Is_long(arg)) { + /* fast path */ + r = Long_val(arg); + if (r == 0) { + return Val_long (Max_long); + } else { + /* No need to take absolute value of r, as ctz(-x) = ctz(x) */ + return Val_long (ml_z_ctz(r)); + } + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + Z_ARG(arg); + if (size_arg == 0) return Val_long (Max_long); + for (i = 0; ptr_arg[i] == 0; i++) /* skip */; + return Val_long(i * Z_LIMB_BITS + ml_z_ctz(ptr_arg[i])); +} + +/* helper function for popcount & hamdist: number of bits at 1 in x */ +/* maybe we should use the mpn_ function even for small arguments, in case + the CPU has a fast popcount opcode? + */ +uintnat ml_z_count(uintnat x) +{ +#ifdef ARCH_SIXTYFOUR + x = (x & 0x5555555555555555UL) + ((x >> 1) & 0x5555555555555555UL); + x = (x & 0x3333333333333333UL) + ((x >> 2) & 0x3333333333333333UL); + x = (x & 0x0f0f0f0f0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0f0f0f0f0fUL); + x = (x & 0x00ff00ff00ff00ffUL) + ((x >> 8) & 0x00ff00ff00ff00ffUL); + x = (x & 0x0000ffff0000ffffUL) + ((x >> 16) & 0x0000ffff0000ffffUL); + x = (x & 0x00000000ffffffffUL) + ((x >> 32) & 0x00000000ffffffffUL); +#else + x = (x & 0x55555555UL) + ((x >> 1) & 0x55555555UL); + x = (x & 0x33333333UL) + ((x >> 2) & 0x33333333UL); + x = (x & 0x0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0fUL); + x = (x & 0x00ff00ffUL) + ((x >> 8) & 0x00ff00ffUL); + x = (x & 0x0000ffffUL) + ((x >> 16) & 0x0000ffffUL); +#endif + return x; +} + +CAMLprim value ml_z_popcount(value arg) +{ + Z_DECL(arg); + intnat r; + Z_MARK_OP; + Z_CHECK(arg); +#if Z_FAST_PATH + if (Is_long(arg)) { + /* fast path */ + r = Long_val(arg); + if (r < 0) ml_z_raise_overflow(); + return Val_long(ml_z_count(r)); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + Z_ARG(arg); + if (sign_arg) ml_z_raise_overflow(); + if (!size_arg) return Val_long(0); + r = mpn_popcount(ptr_arg, size_arg); + if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); + return Val_long(r); +} + +CAMLprim value ml_z_hamdist(value arg1, value arg2) +{ + Z_DECL(arg1); Z_DECL(arg2); + intnat r; + mp_size_t sz; + Z_MARK_OP; + Z_CHECK(arg1); + Z_CHECK(arg2); +#if Z_FAST_PATH + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + r = Long_val(arg1) ^ Long_val(arg2); + if (r < 0) ml_z_raise_overflow(); + return Val_long(ml_z_count(r)); + } +#endif + /* mpn_ version */ + Z_MARK_SLOW; + Z_ARG(arg1); + Z_ARG(arg2); + if (sign_arg1 != sign_arg2) ml_z_raise_overflow(); + /* XXX TODO: case where arg1 & arg2 are both negative */ + if (sign_arg1 || sign_arg2) + caml_invalid_argument("Z.hamdist: negative arguments"); + /* distance on common size */ + sz = (size_arg1 <= size_arg2) ? size_arg1 : size_arg2; + if (sz) { + r = mpn_hamdist(ptr_arg1, ptr_arg2, sz); + if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); + } + else r = 0; + /* add stray bits */ + if (size_arg1 > size_arg2) { + r += mpn_popcount(ptr_arg1 + size_arg2, size_arg1 - size_arg2); + if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); + } + else if (size_arg2 > size_arg1) { + r += mpn_popcount(ptr_arg2 + size_arg1, size_arg2 - size_arg1); + if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); + } + return Val_long(r); +} + +CAMLprim value ml_z_testbit(value arg, value index) +{ + Z_DECL(arg); + uintnat b_idx; + mp_size_t l_idx, i; + mp_limb_t limb; + Z_MARK_OP; + Z_CHECK(arg); + b_idx = Long_val(index); /* Caml code checked index >= 0 */ +#if Z_FAST_PATH + if (Is_long(arg)) { + if (b_idx >= Z_LIMB_BITS) b_idx = Z_LIMB_BITS - 1; + return Val_int((Long_val(arg) >> b_idx) & 1); + } +#endif + Z_MARK_SLOW; + Z_ARG(arg); + l_idx = b_idx / Z_LIMB_BITS; + if (l_idx >= size_arg) return Val_bool(sign_arg); + limb = ptr_arg[l_idx]; + if (sign_arg != 0) { + /* If arg is negative, its 2-complement representation is + bitnot(abs(arg) - 1). + If any of the limbs of abs(arg) below l_idx is nonzero, + the carry from the decrement dies before reaching l_idx, + and we just test bitnot(limb). + If all the limbs below l_idx are zero, the carry from the + decrement propagates to l_idx, + and we test bitnot(limb - 1) = - limb. */ + for (i = 0; i < l_idx; i++) { + if (ptr_arg[i] != 0) { limb = ~limb; goto extract; } + } + limb = -limb; + } + extract: + return Val_int((limb >> (b_idx % Z_LIMB_BITS)) & 1); +} + +/*--------------------------------------------------- + FUNCTIONS BASED ON mpz_t + ---------------------------------------------------*/ + +/* sets rop to the value in op (limbs are copied) */ +void ml_z_mpz_set_z(mpz_t rop, value op) +{ + Z_DECL(op); + Z_CHECK(op); + Z_ARG(op); + if (size_op * Z_LIMB_BITS > INT_MAX) + caml_invalid_argument("Z: risk of overflow in mpz type"); + mpz_realloc2(rop, size_op * Z_LIMB_BITS); + rop->_mp_size = (sign_op >= 0) ? size_op : -size_op; + ml_z_cpy_limb(rop->_mp_d, ptr_op, size_op); +} + +/* inits and sets rop to the value in op (limbs are copied) */ +void ml_z_mpz_init_set_z(mpz_t rop, value op) +{ + mpz_init(rop); + ml_z_mpz_set_z(rop,op); +} + +/* returns a new z objects equal to op (limbs are copied) */ +value ml_z_from_mpz(mpz_t op) +{ + value r; + size_t sz = mpz_size(op); + r = ml_z_alloc(sz); + ml_z_cpy_limb(Z_LIMB(r), op->_mp_d, sz); + return ml_z_reduce(r, sz, (mpz_sgn(op) >= 0) ? 0 : Z_SIGN_MASK); +} + +#if __GNU_MP_VERSION >= 5 +/* not exported by gmp.h */ +extern void __gmpn_divexact (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t); +#endif + +CAMLprim value ml_z_divexact(value arg1, value arg2) +{ + Z_DECL(arg1); Z_DECL(arg2); + Z_MARK_OP; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q; + if (!a2) ml_z_raise_divide_by_zero(); + q = a1 / a2; + if (Z_FITS_INT(q)) return Val_long(q); + } +#endif + Z_MARK_SLOW; +#if __GNU_MP_VERSION >= 5 + { + /* mpn_ version */ + Z_ARG(arg1); + Z_ARG(arg2); + if (!size_arg2) + ml_z_raise_divide_by_zero(); + if (size_arg1 < size_arg2) + return Val_long(0); + { + CAMLparam2(arg1,arg2); + CAMLlocal1(q); + q = ml_z_alloc(size_arg1 - size_arg2 + 1); + Z_REFRESH(arg1); Z_REFRESH(arg2); + __gmpn_divexact(Z_LIMB(q), + ptr_arg1, size_arg1, ptr_arg2, size_arg2); + q = ml_z_reduce(q, size_arg1 - size_arg2 + 1, sign_arg1 ^ sign_arg2); + Z_CHECK(q); + CAMLreturn(q); + } + } +#else + { + /* mpz_ version */ + CAMLparam2(arg1,arg2); + CAMLlocal1(r); + mpz_t a,b; + if (!ml_z_sgn(arg2)) + ml_z_raise_divide_by_zero(); + ml_z_mpz_init_set_z(a, arg1); + ml_z_mpz_init_set_z(b, arg2); + mpz_divexact(a, a, b); + r = ml_z_from_mpz(a); + mpz_clear(a); + mpz_clear(b); + CAMLreturn(r); + } +#endif +} + +CAMLprim value ml_z_powm(value base, value exp, value mod) +{ + CAMLparam3(base,exp,mod); + CAMLlocal1(r); + Z_DECL(mod); + mpz_t mbase, mexp, mmod; + Z_ARG(mod); + if (!size_mod) + ml_z_raise_divide_by_zero(); + ml_z_mpz_init_set_z(mbase, base); + ml_z_mpz_init_set_z(mexp, exp); + ml_z_mpz_init_set_z(mmod, mod); + if (mpz_sgn(mexp) < 0) { + /* we need to check whether base is invertible to avoid a division by zero + in mpz_powm, so we can as well use the computed inverse + */ + if (!mpz_invert(mbase, mbase, mmod)) { + mpz_clear(mbase); + mpz_clear(mexp); + mpz_clear(mmod); + ml_z_raise_divide_by_zero(); + } + mpz_neg(mexp, mexp); + } + mpz_powm(mbase, mbase, mexp, mmod); + r = ml_z_from_mpz(mbase); + mpz_clear(mbase); + mpz_clear(mexp); + mpz_clear(mmod); + CAMLreturn(r); +} + +CAMLprim value ml_z_powm_sec(value base, value exp, value mod) +{ +#ifndef HAS_MPIR +#if __GNU_MP_VERSION >= 5 + CAMLparam3(base,exp,mod); + CAMLlocal1(r); + mpz_t mbase, mexp, mmod; + ml_z_mpz_init_set_z(mbase, base); + ml_z_mpz_init_set_z(mexp, exp); + ml_z_mpz_init_set_z(mmod, mod); + if (mpz_sgn(mexp) <= 0) { + mpz_clear(mbase); + mpz_clear(mexp); + mpz_clear(mmod); + caml_invalid_argument("Z.powm_sec: exponent must be positive"); + } + if (! mpz_odd_p(mmod)) { + mpz_clear(mbase); + mpz_clear(mexp); + mpz_clear(mmod); + caml_invalid_argument("Z.powm_sec: modulus must be odd"); + } + mpz_powm_sec(mbase, mbase, mexp, mmod); + r = ml_z_from_mpz(mbase); + mpz_clear(mbase); + mpz_clear(mexp); + mpz_clear(mmod); + CAMLreturn(r); +#else + MAYBE_UNUSED(base); + MAYBE_UNUSED(exp); + MAYBE_UNUSED(mod); + caml_invalid_argument("Z.powm_sec: not available, needs GMP version >= 5"); +#endif +#else + MAYBE_UNUSED(base); + MAYBE_UNUSED(exp); + MAYBE_UNUSED(mod); + caml_invalid_argument("Z.powm_sec: not available in MPIR, needs GMP version >= 5"); +#endif +} + +CAMLprim value ml_z_pow(value base, value exp) +{ + CAMLparam2(base,exp); + CAMLlocal1(r); + mpz_t mbase; + intnat e = Long_val(exp); + mp_size_t sz, ralloc; + int cnt; + if (e < 0) + caml_invalid_argument("Z.pow: exponent must be nonnegative"); + ml_z_mpz_init_set_z(mbase, base); + + /* Safe overapproximation of the size of the result. + In case this overflows an int, GMP may abort with a message + "gmp: overflow in mpz type". To avoid this, we test the size before + calling mpz_pow_ui and raise an OCaml exception. + Note: we lifted the computation from mpz_n_pow_ui. + */ + sz = mbase->_mp_size; + if (sz < 0) sz = -sz; + cnt = sz > 0 ? ml_z_clz(mbase->_mp_d[sz - 1]) : 0; + ralloc = (sz * GMP_NUMB_BITS - cnt + GMP_NAIL_BITS) * e / GMP_NUMB_BITS + 5; + if (ralloc > INT_MAX) { + mpz_clear(mbase); + caml_invalid_argument("Z.pow: risk of overflow in mpz type"); + } + mpz_pow_ui(mbase, mbase, e); + r = ml_z_from_mpz(mbase); + mpz_clear(mbase); + CAMLreturn(r); +} + +CAMLprim value ml_z_root(value a, value b) +{ + CAMLparam2(a,b); + CAMLlocal1(r); + Z_DECL(a); + mpz_t ma; + intnat mb = Long_val(b); + if (mb <= 0) + caml_invalid_argument("Z.root: exponent must be positive"); + Z_ARG(a); + if (!(mb & 1) && sign_a) + caml_invalid_argument("Z.root: even root of a negative number"); + ml_z_mpz_init_set_z(ma, a); + mpz_root(ma, ma, mb); + r = ml_z_from_mpz(ma); + mpz_clear(ma); + CAMLreturn(r); +} + +CAMLprim value ml_z_rootrem(value a, value b) +{ + CAMLparam2(a,b); + CAMLlocal3(r1,r2,r3); + Z_DECL(a); + mpz_t ma, mr1, mr2; + intnat mb = Long_val(b); + if (mb <= 0) + caml_invalid_argument("Z.rootrem: exponent must be positive"); + Z_ARG(a); + if (!(mb & 1) && sign_a) + caml_invalid_argument("Z.rootrem: even root of a negative number"); + ml_z_mpz_init_set_z(ma, a); + mpz_init(mr1); + mpz_init(mr2); + mpz_rootrem(mr1, mr2, ma, mb); + r1 = ml_z_from_mpz(mr1); + r2 = ml_z_from_mpz(mr2); + r3 = caml_alloc_small(2, 0); + Field(r3,0) = r1; + Field(r3,1) = r2; + mpz_clear(ma); + mpz_clear(mr1); + mpz_clear(mr2); + CAMLreturn(r3); +} + +CAMLprim value ml_z_perfect_power(value a) +{ + CAMLparam1(a); + int r; + mpz_t ma; + ml_z_mpz_init_set_z(ma, a); + r = mpz_perfect_power_p(ma); + mpz_clear(ma); + CAMLreturn(r ? Val_true : Val_false); +} + +CAMLprim value ml_z_perfect_square(value a) +{ + CAMLparam1(a); + int r; + mpz_t ma; + ml_z_mpz_init_set_z(ma, a); + r = mpz_perfect_square_p(ma); + mpz_clear(ma); + CAMLreturn(r ? Val_true : Val_false); +} + +CAMLprim value ml_z_probab_prime(value a, int b) +{ + CAMLparam1(a); + int r; + mpz_t ma; + ml_z_mpz_init_set_z(ma, a); + r = mpz_probab_prime_p(ma, Int_val(b)); + mpz_clear(ma); + CAMLreturn(Val_int(r)); +} + +CAMLprim value ml_z_nextprime(value a) +{ + CAMLparam1(a); + CAMLlocal1(r); + mpz_t ma; + ml_z_mpz_init_set_z(ma, a); + mpz_nextprime(ma, ma); + r = ml_z_from_mpz(ma); + mpz_clear(ma); + CAMLreturn(r); +} + +CAMLprim value ml_z_invert(value base, value mod) +{ + CAMLparam2(base,mod); + CAMLlocal1(r); + mpz_t mbase, mmod; + ml_z_mpz_init_set_z(mbase, base); + ml_z_mpz_init_set_z(mmod, mod); + if (!mpz_invert(mbase, mbase, mmod)) { + mpz_clear(mbase); + mpz_clear(mmod); + ml_z_raise_divide_by_zero(); + } + r = ml_z_from_mpz(mbase); + mpz_clear(mbase); + mpz_clear(mmod); + CAMLreturn(r); +} + +CAMLprim value ml_z_divisible(value a, value b) +{ + CAMLparam2(a,b); + mpz_t ma, mb; + int r; + ml_z_mpz_init_set_z(ma, a); + ml_z_mpz_init_set_z(mb, b); + r = mpz_divisible_p(ma, mb); + mpz_clear(ma); + mpz_clear(mb); + CAMLreturn(Val_bool(r)); +} + +CAMLprim value ml_z_congruent(value a, value b, value c) +{ + CAMLparam3(a,b,c); + mpz_t ma, mb, mc; + int r; + ml_z_mpz_init_set_z(ma, a); + ml_z_mpz_init_set_z(mb, b); + ml_z_mpz_init_set_z(mc, c); + r = mpz_congruent_p(ma, mb, mc); + mpz_clear(ma); + mpz_clear(mb); + mpz_clear(mc); + CAMLreturn(Val_bool(r)); +} + +CAMLprim value ml_z_jacobi(value a, value b) +{ + CAMLparam2(a,b); + mpz_t ma, mb; + int r; + ml_z_mpz_init_set_z(ma, a); + ml_z_mpz_init_set_z(mb, b); + r = mpz_jacobi(ma, mb); + mpz_clear(ma); + mpz_clear(mb); + CAMLreturn(Val_int(r)); +} + +CAMLprim value ml_z_legendre(value a, value b) +{ + CAMLparam2(a,b); + mpz_t ma, mb; + int r; + ml_z_mpz_init_set_z(ma, a); + ml_z_mpz_init_set_z(mb, b); + r = mpz_legendre(ma, mb); + mpz_clear(ma); + mpz_clear(mb); + CAMLreturn(Val_int(r)); +} + +CAMLprim value ml_z_kronecker(value a, value b) +{ + CAMLparam2(a,b); + mpz_t ma, mb; + int r; + ml_z_mpz_init_set_z(ma, a); + ml_z_mpz_init_set_z(mb, b); + r = mpz_kronecker(ma, mb); + mpz_clear(ma); + mpz_clear(mb); + CAMLreturn(Val_int(r)); +} + +CAMLprim value ml_z_remove(value a, value b) +{ + CAMLparam2(a,b); + CAMLlocal2(r,tmp); + mpz_t ma, mb, mr; + int i; + ml_z_mpz_init_set_z(ma, a); + ml_z_mpz_init_set_z(mb, b); + mpz_init(mr); + i = mpz_remove(mr, ma, mb); + tmp = ml_z_from_mpz(mr); + r = caml_alloc_small(2, 0); + Field(r,0) = tmp; + Field(r,1) = Val_int(i); + mpz_clear(ma); + mpz_clear(mb); + mpz_clear(mr); + CAMLreturn(r); +} + +CAMLprim value ml_z_fac(value a) +{ + CAMLparam1(a); + CAMLlocal1(r); + mpz_t mr; + intnat ma = Long_val(a); + if (ma < 0) + caml_invalid_argument("Z.fac: non-positive argument"); + mpz_init(mr); + mpz_fac_ui(mr, ma); + r = ml_z_from_mpz(mr); + mpz_clear(mr); + CAMLreturn(r); +} + +CAMLprim value ml_z_fac2(value a) +{ + CAMLparam1(a); + CAMLlocal1(r); + mpz_t mr; + intnat ma = Long_val(a); + if (ma < 0) + caml_invalid_argument("Z.fac2: non-positive argument"); + mpz_init(mr); + mpz_2fac_ui(mr, ma); + r = ml_z_from_mpz(mr); + mpz_clear(mr); + CAMLreturn(r); +} + +CAMLprim value ml_z_facM(value a, value b) +{ + CAMLparam2(a,b); + CAMLlocal1(r); + mpz_t mr; + intnat ma = Long_val(a), mb = Long_val(b); + if (ma < 0 || mb < 0) + caml_invalid_argument("Z.facM: non-positive argument"); + mpz_init(mr); + mpz_mfac_uiui(mr, ma, mb); + r = ml_z_from_mpz(mr); + mpz_clear(mr); + CAMLreturn(r); +} + +CAMLprim value ml_z_primorial(value a) +{ + CAMLparam1(a); + CAMLlocal1(r); + mpz_t mr; + intnat ma = Long_val(a); + if (ma < 0) + caml_invalid_argument("Z.primorial: non-positive argument"); + mpz_init(mr); + mpz_primorial_ui(mr, ma); + r = ml_z_from_mpz(mr); + mpz_clear(mr); + CAMLreturn(r); +} + +CAMLprim value ml_z_bin(value a, value b) +{ + CAMLparam2(a,b); + CAMLlocal1(r); + mpz_t ma; + intnat mb = Long_val(b); + if (mb < 0) + caml_invalid_argument("Z.bin: non-positive argument"); + ml_z_mpz_init_set_z(ma, a); + mpz_bin_ui(ma, ma, mb); + r = ml_z_from_mpz(ma); + mpz_clear(ma); + CAMLreturn(r); +} + +CAMLprim value ml_z_fib(value a) +{ + CAMLparam1(a); + CAMLlocal1(r); + mpz_t mr; + intnat ma = Long_val(a); + if (ma < 0) + caml_invalid_argument("Z.fib: non-positive argument"); + mpz_init(mr); + mpz_fib_ui(mr, ma); + r = ml_z_from_mpz(mr); + mpz_clear(mr); + CAMLreturn(r); +} + +CAMLprim value ml_z_lucnum(value a) +{ + CAMLparam1(a); + CAMLlocal1(r); + mpz_t mr; + intnat ma = Long_val(a); + if (ma < 0) + caml_invalid_argument("Z.lucnum: non-positive argument"); + mpz_init(mr); + mpz_lucnum_ui(mr, ma); + r = ml_z_from_mpz(mr); + mpz_clear(mr); + CAMLreturn(r); +} + + + +/* XXX should we support the following? + mpz_scan0, mpz_scan1 + mpz_setbit, mpz_clrbit, mpz_combit, mpz_tstbit + mpz_odd_p, mpz_even_p + random numbers +*/ + + + +/*--------------------------------------------------- + CUSTOMS BLOCKS + ---------------------------------------------------*/ + +/* With OCaml < 3.12.1, comparing a block an int with OCaml's + polymorphic compare will give erroneous results (int always + strictly smaller than block). OCaml 3.12.1 and above + give the correct result. +*/ +int ml_z_custom_compare(value arg1, value arg2) +{ + Z_DECL(arg1); Z_DECL(arg2); + int r; + Z_CHECK(arg1); Z_CHECK(arg2); +#if Z_FAST_PATH + /* Value-equal small integers are equal. + Pointer-equal big integers are equal as well. */ + if (arg1 == arg2) return 0; + if (Is_long(arg2)) { + if (Is_long(arg1)) { + return arg1 > arg2 ? 1 : -1; + } else { + /* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1 + or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */ + return Z_SIGN(arg1) ? -1 : 1; + } + } + else if (Is_long(arg1)) { + /* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1 + or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */ + return Z_SIGN(arg2) ? 1 : -1; + } +#endif + r = 0; + Z_ARG(arg1); + Z_ARG(arg2); + if (sign_arg1 != sign_arg2) r = 1; + else if (size_arg1 > size_arg2) r = 1; + else if (size_arg1 < size_arg2) r = -1; + else { + mp_size_t i; + for (i = size_arg1 - 1; i >= 0; i--) { + if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; } + if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; } + } + } + if (sign_arg1) r = -r; + return r; +} + +static intnat ml_z_custom_hash(value v) +{ + Z_DECL(v); + mp_size_t i; + uint32_t acc = 0; + Z_CHECK(v); + Z_ARG(v); + for (i = 0; i < size_v; i++) { + acc = caml_hash_mix_uint32(acc, (uint32_t)(ptr_v[i])); +#ifdef ARCH_SIXTYFOUR + acc = caml_hash_mix_uint32(acc, ptr_v[i] >> 32); +#endif + } +#ifndef ARCH_SIXTYFOUR + /* To obtain the same hash value on 32- and 64-bit platforms */ + if (size_v % 2 != 0) + acc = caml_hash_mix_uint32(acc, 0); +#endif + if (sign_v) acc++; + return acc; +} + +/* serialized format: + - 1-byte sign (1 for negative, 0 for positive) + - 4-byte size in bytes + - size-byte unsigned integer, in little endian order + */ +static void ml_z_custom_serialize(value v, + uintnat * wsize_32, + uintnat * wsize_64) +{ + mp_size_t i,nb; + Z_DECL(v); + Z_CHECK(v); + Z_ARG(v); + if ((mp_size_t)(uint32_t) size_v != size_v) + caml_failwith("Z.serialize: number is too large"); + nb = size_v * sizeof(mp_limb_t); + caml_serialize_int_1(sign_v ? 1 : 0); + caml_serialize_int_4(nb); + for (i = 0; i < size_v; i++) { + mp_limb_t x = ptr_v[i]; + caml_serialize_int_1(x); + caml_serialize_int_1(x >> 8); + caml_serialize_int_1(x >> 16); + caml_serialize_int_1(x >> 24); +#ifdef ARCH_SIXTYFOUR + caml_serialize_int_1(x >> 32); + caml_serialize_int_1(x >> 40); + caml_serialize_int_1(x >> 48); + caml_serialize_int_1(x >> 56); +#endif + } + *wsize_32 = 4 * (1 + (nb + 3) / 4); + *wsize_64 = 8 * (1 + (nb + 7) / 8); +#if Z_PERFORM_CHECK + /* Add space for canary */ + *wsize_32 += 4; + *wsize_64 += 8; +#endif +} + +/* There are two issues with integers that are tagged ints on a 64-bit + machine but boxed bigints on a 32-bit machine, namely integers in the + [2^30, 2^62) and [-2^62, -2^30) ranges: + - Serializing such an integer on a 64-bit machine and + deserializing on a 32-bit machine will fail in the generic unmarshaler. + The correct behavior would be to return a boxed integer. + - Serializing such an integer on a 32-bit machine and + deserializing on a 64-bit machine must fail. + The wrong behavior would be to return a block containing a + non-normalized, boxed integer (issue #148). +*/ +static uintnat ml_z_custom_deserialize(void * dst) +{ + mp_limb_t* d = ((mp_limb_t*)dst) + 1; + int sign = caml_deserialize_uint_1(); + uint32_t sz = caml_deserialize_uint_4(); + uint32_t szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t); + uint32_t i = 0; + mp_limb_t x; + /* all limbs but last */ + if (szw > 1) { + for (; i < szw - 1; i++) { + x = caml_deserialize_uint_1(); + x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8; + x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16; + x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24; +#ifdef ARCH_SIXTYFOUR + x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32; + x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40; + x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48; + x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56; +#endif + d[i] = x; + } + sz -= i * sizeof(mp_limb_t); + } + /* last limb */ + if (sz > 0) { + x = caml_deserialize_uint_1(); + if (sz > 1) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8; + if (sz > 2) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16; + if (sz > 3) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24; +#ifdef ARCH_SIXTYFOUR + if (sz > 4) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32; + if (sz > 5) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40; + if (sz > 6) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48; + if (sz > 7) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56; +#endif + d[i] = x; + i++; + } + while (i > 0 && !d[i-1]) i--; + d[-1] = i | (sign ? Z_SIGN_MASK : 0); +#if Z_PERFORM_CHECK + d[szw] = 0xDEADBEEF ^ szw; + szw++; +#endif +#if Z_USE_NATINT + if (i == 0 || + (i == 1 && (d[0] <= Z_MAX_INT || (d[0] == -Z_MIN_INT && sign)))) { + /* Issue #148: this is not a canonical representation, + so we raise a Failure */ + caml_deserialize_error("Z.t value produced on a 32-bit platform cannot be read on a 64-bit platform"); + } +#endif + return (szw+1) * sizeof(mp_limb_t); +} + +struct custom_operations ml_z_custom_ops = { + /* Identifiers starting with _ are normally reserved for the OCaml runtime + system, but we got authorization form Gallium to use "_z". + It is very compact and stays in the spirit of identifiers used for + int32 & co ("_i" & co.). + */ + "_z", + custom_finalize_default, + ml_z_custom_compare, + ml_z_custom_hash, + ml_z_custom_serialize, + ml_z_custom_deserialize, + ml_z_custom_compare, +#ifndef Z_OCAML_LEGACY_CUSTOM_OPERATIONS + custom_fixed_length_default +#endif +}; + + +/*--------------------------------------------------- + CONVERSION WITH MLGMPIDL + ---------------------------------------------------*/ + +CAMLprim value ml_z_mlgmpidl_of_mpz(value a) +{ + CAMLparam1(a); + mpz_ptr mpz = (mpz_ptr)(Data_custom_val(a)); + CAMLreturn(ml_z_from_mpz(mpz)); +} + +/* stores the Z.t object into an existing Mpz.t one; + as we never allocate Mpz.t objects, we don't need any pointer to + mlgmpidl's custom block ops, and so, can link the function even if + mlgmpidl is not installed + */ +CAMLprim value ml_z_mlgmpidl_set_mpz(value r, value a) +{ + CAMLparam2(r,a); + mpz_ptr mpz = (mpz_ptr)(Data_custom_val(r)); + ml_z_mpz_set_z(mpz,a); + CAMLreturn(Val_unit); +} + + + +/*--------------------------------------------------- + INIT / EXIT + ---------------------------------------------------*/ + +/* called at program exit to display performance information */ +#if Z_PERF_COUNTER +static void ml_z_dump_count() +{ + printf("Z: %lu asm operations, %lu C operations, %lu slow (%lu%%)\n", + ml_z_ops_as, ml_z_ops, ml_z_slow, + ml_z_ops ? (ml_z_slow*100/(ml_z_ops+ml_z_ops_as)) : 0); +} +#endif + +CAMLprim value ml_z_init() +{ + ml_z_2p32 = ldexp(1., 32); + /* run-time checks */ +#ifdef ARCH_SIXTYFOUR + if (sizeof(intnat) != 8 || sizeof(mp_limb_t) != 8) + caml_failwith("Z.init: invalid size of types, 8 expected"); +#else + if (sizeof(intnat) != 4 || sizeof(mp_limb_t) != 4) + caml_failwith("Z.init: invalid size of types, 4 expected"); +#endif + /* install functions */ +#if Z_PERF_COUNTER + atexit(ml_z_dump_count); +#endif +#if Z_CUSTOM_BLOCK + caml_register_custom_operations(&ml_z_custom_ops); +#endif + return Val_unit; +} + +#ifdef __cplusplus +} +#endif diff --git a/unikernel/duniverse/Zarith/configure b/unikernel/duniverse/Zarith/configure new file mode 100755 index 00000000..f3006c16 --- /dev/null +++ b/unikernel/duniverse/Zarith/configure @@ -0,0 +1,388 @@ +#! /bin/sh + +# configuration script + +# This file is part of the Zarith library +# http://forge.ocamlcore.org/projects/zarith . +# It is distributed under LGPL 2 licensing, with static linking exception. +# See the LICENSE file included in the distribution. +# +# Copyright (c) 2010-2011 Antoine Miné, Abstraction project. +# Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), +# a joint laboratory by: +# CNRS (Centre national de la recherche scientifique, France), +# ENS (École normale supérieure, Paris, France), +# INRIA Rocquencourt (Institut national de recherche en informatique, France). + + +# options +installdir='auto' +ocamllibdir='auto' +gmp='auto' +perf='no' + +ocaml='ocaml' +ocamlc='ocamlc' +ocamlopt='ocamlopt' +ocamlmklib='ocamlmklib' +ocamldep='ocamldep' +ocamldoc='ocamldoc' +ccinc="$CPPFLAGS" +ldflags="$LDFLAGS" +cclib='' +ccdef='' +mlflags="$OCAMLFLAGS" +mloptflags="$OCAMLOPTFLAGS" +mlinc="$OCAMLINC" +objsuffix="o" +ocamlfind="auto" + +# sanitize +LC_ALL=C +export LC_ALL +unset IFS + + +# help +help() +{ + cat <" > tmp.c + echo "int main() { return 1; }" >> tmp.c + r=1 + $CC $ccopt $ccinc -c tmp.c -o tmp.o >/dev/null 2>/dev/null || r=0 + if test ! -f tmp.o; then r=0; fi + rm -f tmp.c tmp.o + if test $r -eq 0; then echo "not found"; else echo "found"; fi + return $r +} + +checklib() +{ + echo_n "library $1: " + rm -f tmp.c tmp.out + echo "int main() { return 1; }" > tmp.c + r=1 + $CC $ccopt $ldflags $cclib tmp.c -l$1 -o tmp.out >/dev/null 2>/dev/null || r=0 + if test ! -x tmp.out; then r=0; fi + rm -f tmp.c tmp.o tmp.out + if test $r -eq 0; then echo "not found"; else echo "found"; fi + return $r +} + +checkcc() +{ + echo_n "checking compilation with $cc $ccopt: " + rm -f tmp.c tmp.out + echo "int main() { return 1; }" >> tmp.c + r=1 + $CC $ccopt tmp.c -o tmp.out >/dev/null 2>/dev/null || r=0 + if test ! -x tmp.out; then r=0; fi + rm -f tmp.c tmp.o tmp.out + if test $r -eq 0; then echo "not working"; else echo "working"; fi + return $r +} + +checkcmxalib() +{ + echo_n "library $1: " + $ocamlopt $mloptflags $1 -o tmp.out >/dev/null 2>/dev/null || r=0 + if test ! -x tmp.out; then r=0; fi + rm -f tmp.out + if test $r -eq 0; then echo "not found"; else echo "found"; fi + return $r +} + + +# check required programs + +searchbinreq $ocaml +searchbinreq $ocamlc +searchbinreq $ocamldep +searchbinreq $ocamlmklib +if searchbin $ocamldoc; then + ocamldoc='' +fi + +if test -n "$CC"; then + searchbinreq "$CC" + ccopt="$CFLAGS" +else + ccopt="-O3 -Wall -Wextra $CFLAGS" +fi + +# optional native-code generation + +hasocamlopt='no' + +searchbin $ocamlopt +if test $? -eq 1; then hasocamlopt='yes'; fi + + +# check C compiler + +checkcc +if test $? -eq 0; then + # try again with (almost) no options + ccopt='-O' + checkcc + if test $? -eq 0; then echo "cannot compile and link program"; exit 2; fi +fi + + +# directories + +if test "$ocamllibdir" = "auto" +then ocamllibdir=`ocamlc -where | sed 's/\r$//'` +fi + +if test ! -f "$ocamllibdir/caml/mlvalues.h" +then echo "cannot find OCaml libraries in $ocamllibdir"; exit 2; fi +ccinc="-I$ocamllibdir $ccinc" +checkinc "caml/mlvalues.h" +if test $? -eq 0; then echo "cannot include caml/mlvalues.h"; exit 2; fi + + +# optional dynamic linking + +hasdynlink='no' + +if test $hasocamlopt = yes +then + checkcmxalib dynlink.cmxa + if test $? -eq 1; then hasdynlink='yes'; fi +fi + + +# installation method + +searchbin ocamlfind +if test $? -eq 1 && test $ocamlfind != "no"; then + instmeth='findlib' + if test "$installdir" = "auto" + then installdir=`ocamlfind printconf destdir`; fi +else + searchbin install + if test $? -eq 1; then instmeth='install' + else echo "no installation method found"; exit 2; fi + if test "$installdir" = "auto"; then installdir="$ocamllibdir"; fi +fi + + +# detect OCaml's word-size + +echo "print_int (Sys.word_size);;" > tmp.ml +wordsize=`ocaml tmp.ml` +echo "OCaml's word size is $wordsize" +rm -f tmp.ml + + +# check GMP, MPIR + +if test "$gmp" = 'gmp' || test "$gmp" = 'auto'; then + if pkg-config gmp 2>/dev/null; then + echo 'package gmp: found' + gmp='OK' + cclib="$cclib $(pkg-config --libs gmp)" + ccinc="$ccinc $(pkg-config --cflags gmp)" + ccdef="-DHAS_GMP $ccdef" + else + checkinc gmp.h + if test $? -eq 1; then + checklib gmp + if test $? -eq 1; then + gmp='OK' + cclib="$cclib -lgmp" + ccdef="-DHAS_GMP $ccdef" + fi + fi + fi +fi +if test "$gmp" = 'mpir' || test "$gmp" = 'auto'; then + checkinc mpir.h + if test $? -eq 1; then + checklib mpir + if test $? -eq 1; then + gmp='OK' + cclib="$cclib -lmpir" + ccdef="-DHAS_MPIR $ccdef" + fi + fi +fi +if test "$gmp" != 'OK'; then echo "cannot find GMP nor MPIR"; exit 2; fi + + +# OCaml version + +ocamlver=`ocamlc -version` + +# OCaml version 4.04 or later is required + +case "$ocamlver" in + [123].* | 4.0[0123].*) + echo "OCaml version $ocamlver is no longer supported." + echo "OCaml version 4.04.0 or later is required." + exit 2 + ;; +esac + +# -bin-annot available since 4.00.0 +echo "OCaml supports -bin-annot to produce documentation" +hasbinannot='yes' + +# Changes to C API (the custom_operation struct) since 4.08.0 +case "$ocamlver" in + [123].* | 4.0[01234567].* ) + echo "Using OCaml legacy C API custom operations" + ccdef="-DZ_OCAML_LEGACY_CUSTOM_OPERATIONS $ccdef" + ;; + *) + ;; +esac + +# dump Makefile + +cat > Makefile <] is set (related to the [gmp] package), Zarith will be + * compile with the location of the [gmp] package. However, [gmp] can be + * located into an OPAM switch (if the is absolute) or a local + * directory. The second case appears when you use [opam monorepo] which pulls + * dependencies into a [duniverse] local directory. + * + * The second case appears for the MirageOS 4.0 support too when we want to use + * a cross-compiled version of `libgmp.a` which should be available into our + * source-tree (compiled by `dune`). + * + * This script wants to help us to compile Zarith in these contexts: + * - as a simple OPAM dependency (which will be installed into a switch) + * - as a dependency brought by [opam monorepo] + * - in the situation where we use [opam monorepo] and the cross-compilation + *) + +let always x _ = x + +let deadbeef = "\xde\xad\xbe\xef" +let cc = ref deadbeef +let gmp_path = ref deadbeef +let with_conf_gmp = ref false + +let dir_sep_char = '/' +let is_relative p = p.[0] <> dir_sep_char +let ( / ) = Filename.concat + +let split s = + let min = 0 and max = max_int and sat chr = chr <> dir_sep_char in + if min > max || max = 0 then (s, "") else + let len = String.length s in + let max_idx = len - 1 in + let min_idx = let k = len - max in (if k < 0 then 0 else k) in + let need_idx = max_idx - min in + let rec loop i = + if i >= min_idx && sat s.[i] then loop (i - 1) else + if i > need_idx || i = max_idx then (s, "") else + if i = -1 then ("", s) else + let cut = i + 1 in + String.sub s 0 cut, String.sub s cut (len - cut) + in + loop max_idx + +let is_prefix ~affix s = + let len_a = String.length affix in + let len_s = String.length s in + if len_a > len_s then false else + let max_idx_a = len_a - 1 in + let rec loop i = + if i > max_idx_a then true else + if affix.[i] <> s.[i] then false else loop (i + 1) + in + loop 0 + +let is_prefix ~prefix p = + if not (is_prefix ~affix:prefix p) then false else + let suff_start = String.length prefix in + if prefix.[suff_start - 1] = dir_sep_char then true else + if suff_start = String.length p then (* suffix empty *) true else + p.[suff_start] = dir_sep_char + +let spec = + [ "--with-gmp", Arg.Set_string gmp_path, "Location of libgmp.a" + ; "--with-conf-gmp", Arg.Set with_conf_gmp, "Use the host's libgmp.a" + ; "--cc", Arg.Set_string cc, "C compiler" ] + +let usage = Format.asprintf "%s --cc [--with-gmp=] [--with-conf-gmp]\n%!" Sys.argv.(0) + +let where () = match !gmp_path, !with_conf_gmp with + | gmp_path, _ when gmp_path <> deadbeef -> + let gmp_path, _libgmp_a = split gmp_path in + let cwd = Sys.getcwd () in + if is_relative gmp_path || is_prefix ~prefix:cwd gmp_path + then `Source (cwd / gmp_path) + else `Switch gmp_path + | _, true -> `Host + | _, false -> `Missing + +let env = function + | `Source gmp_path when is_relative gmp_path -> + let gmp_path = Sys.getcwd () / gmp_path in + Format.asprintf "CC=\"%s\" LDFLAGS=\"-L%s\" CFLAGS=\"-I%s\" CPPFLAGS=\"-I%s\"" + !cc gmp_path gmp_path gmp_path + | `Source gmp_path + | `Switch gmp_path -> + Format.asprintf "CC=\"%s\" LDFLAGS=\"-L%s\" CFLAGS=\"-I%s\" CPPFLAGS=\"-I%s\"" + !cc gmp_path gmp_path gmp_path + | `Host -> + Format.asprintf "CC=\"%s\"" !cc + | `Missing -> failwith "Zarith requires gmp." + +let () = + Arg.parse spec (always ()) usage ; + if !cc = deadbeef + then ( Format.eprintf "%s%!" usage ; exit 1 ) ; + let where = where () in + let env = env where in + Format.printf "%s%!" env + (* XXX(dinosaure): we must **not** append '\n'. Otherwise, + * we don't set the environment. *) diff --git a/unikernel/duniverse/Zarith/dune b/unikernel/duniverse/Zarith/dune new file mode 100644 index 00000000..f68c2463 --- /dev/null +++ b/unikernel/duniverse/Zarith/dune @@ -0,0 +1,99 @@ +(env + (dev + (flags + (:standard -w -6-32-39)))) + +(library + (name zarith) + (public_name zarith) + (modules z q big_int_Z zarith_version) + (wrapped false) + (foreign_stubs + (language c) + (names caml_z) + (flags + :standard + (:include cflags.sexp))) + (c_library_flags + (:include libs.sexp))) + +(executable + (name configure_env) + (modules configure_env)) + +(rule + (target Makefile) + (deps configure env) + (action + (bash + "env %{read:env} ./configure --ocamllibdir %{ocaml-config:standard_library}"))) + +(rule + (target env) + (action + (copy gmp.%{lib-available:gmp} env))) + +(rule + (target gmp.true) + (deps + (:exe configure_env.exe) + %{lib:gmp:libgmp.a} + %{lib:gmp:libgmp.so} + %{lib:gmp:gmp.h}) + (action + (with-stdout-to + %{target} + (run %{exe} --cc "%{cc}" --with-gmp=%{lib:gmp:libgmp.a})))) + +(rule + (target gmp.false) + (deps + (:exe configure_env.exe)) + (action + (with-stdout-to + %{target} + (run %{exe} --cc "%{cc}" --with-conf-gmp)))) + +(rule + (target cflags.sexp) + (deps Makefile) + (action + (with-stdout-to + %{target} + (progn + (bash "echo -n '('") + (bash "cat Makefile | sed -n -e 's/CFLAGS=//p'") + (bash "echo -n ')'"))))) + +; Note that the order (LDFLAGS, then LIBS) is important below since +; zarith uses pkg-config to detect gmp, and adds the output to LIBS +; but we like -L ..._build/solo5/duniverse/Zarith/../../../install/solo5/lib/gmp +; first, followed by -L/usr/local/lib -lgmp (from pkg-config) + +(rule + (target libs.sexp) + (deps Makefile) + (action + (with-stdout-to + %{target} + (progn + (bash "echo -n '('") + (bash "cat Makefile | sed -n -e 's/LDFLAGS=//p'") + (bash "cat Makefile | sed -n -e 's/LIBS=//p'") + (bash "echo -n ')'"))))) + +(rule + (deps META) + (action + (with-stdout-to + zarith_version.ml + (progn + (run echo "let") + (bash "grep \"version\" META | head -1"))))) + +(library + (name zarith_top) + (optional) + (public_name zarith.top) + (modules zarith_top) + (libraries zarith compiler-libs.toplevel)) diff --git a/unikernel/duniverse/Zarith/dune-project b/unikernel/duniverse/Zarith/dune-project new file mode 100644 index 00000000..2c07b359 --- /dev/null +++ b/unikernel/duniverse/Zarith/dune-project @@ -0,0 +1,3 @@ +(lang dune 2.8) +(name zarith) +(version df8969d) diff --git a/unikernel/duniverse/Zarith/project.mak b/unikernel/duniverse/Zarith/project.mak new file mode 100644 index 00000000..34b219f8 --- /dev/null +++ b/unikernel/duniverse/Zarith/project.mak @@ -0,0 +1,158 @@ +# This file is part of the Zarith library +# http://forge.ocamlcore.org/projects/zarith . +# It is distributed under LGPL 2 licensing, with static linking exception. +# See the LICENSE file included in the distribution. +# +# Copyright (c) 2010-2011 Antoine Miné, Abstraction project. +# Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), +# a joint laboratory by: +# CNRS (Centre national de la recherche scientifique, France), +# ENS (École normale supérieure, Paris, France), +# INRIA Rocquencourt (Institut national de recherche en informatique, France). + +ifeq "$(shell $(OCAMLC) -config |grep ccomp_type)" "ccomp_type: msvc" +OBJSUFFIX := obj +LIBSUFFIX := lib +DLLSUFFIX := dll +EXE := .exe +else +OBJSUFFIX := o +LIBSUFFIX := a +ifeq "$(findstring mingw,$(shell $(OCAMLC) -config |grep system))" "mingw" +DLLSUFFIX := dll +EXE := .exe +else +DLLSUFFIX := so +EXE := +endif +endif + + +# project files +############### + +CSRC = caml_z.c +MLSRC = zarith_version.ml z.ml q.ml big_int_Z.ml +MLISRC = z.mli q.mli big_int_Z.mli + +AUTOGEN = zarith_version.ml + +CMIOBJ = $(MLISRC:%.mli=%.cmi) +CMXOBJ = $(MLSRC:%.ml=%.cmx) +CMIDOC = $(MLISRC:%.mli=%.cmti) + +TOBUILD = zarith.cma libzarith.$(LIBSUFFIX) $(CMIOBJ) zarith_top.cma z.mli + +TOINSTALL = $(TOBUILD) zarith.h q.mli big_int_Z.mli + +ifeq ($(HASOCAMLOPT),yes) +TOBUILD += zarith.cmxa $(CMXOBJ) +TOINSTALL += zarith.$(LIBSUFFIX) +endif +OCAMLFLAGS += -I +compiler-libs +OCAMLOPTFLAGS += -I +compiler-libs + +ifeq ($(HASDYNLINK),yes) +TOBUILD += zarith.cmxs +endif + +ifeq ($(HASBINANNOT),yes) +TOINSTALL += $(CMIDOC) +OCAMLFLAGS += -bin-annot +endif + +# build targets +############### + +all: $(TOBUILD) + +tests: + make -C tests test + +zarith.cma: $(MLSRC:%.ml=%.cmo) + $(OCAMLMKLIB) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS) + +zarith.cmxa: $(MLSRC:%.ml=%.cmx) + $(OCAMLMKLIB) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS) + +zarith.cmxs: zarith.cmxa libzarith.$(LIBSUFFIX) + $(OCAMLOPT) -shared -o $@ -I . zarith.cmxa -linkall + +libzarith.$(LIBSUFFIX): $(CSRC:%.c=%.$(OBJSUFFIX)) + $(OCAMLMKLIB) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS) + +zarith_top.cma: zarith_top.cmo + $(OCAMLC) -o $@ -a $< + +doc: $(MLISRC) +ifneq ($(OCAMLDOC),) + mkdir -p html + $(OCAMLDOC) -html -d html -charset utf8 $+ +else + $(error ocamldoc is required to build the documentation) +endif + +zarith_version.ml: META + (echo "let"; grep "version" META | head -1) > zarith_version.ml + +# install targets +################# + +ifeq ($(INSTMETH),install) +install: + install -d $(INSTALLDIR) $(INSTALLDIR)/zarith $(INSTALLDIR)/stublibs + for i in $(TOINSTALL); do \ + if test -f $$i; then $(INSTALL) -m 0644 $$i $(INSTALLDIR)/zarith/$$i; fi; \ + done + if test -f dllzarith.$(DLLSUFFIX); then $(INSTALL) -m 0755 dllzarith.$(DLLSUFFIX) $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); fi + +uninstall: + for i in $(TOINSTALL); do \ + rm -f $(INSTALLDIR)/zarith/$$i; \ + done + if test -f $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); then rm -f $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); fi +endif + +ifeq ($(INSTMETH),findlib) +install: + $(OCAMLFIND) install -destdir "$(INSTALLDIR)" zarith META $(TOINSTALL) -optional dllzarith.$(DLLSUFFIX) + +uninstall: + $(OCAMLFIND) remove -destdir "$(INSTALLDIR)" zarith +endif + + +# rules +####### + +%.cmi: %.mli + $(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $< + +%.cmo: %.ml %.cmi + $(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $< + +%.cmx: %.ml %.cmi + $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $< + +%.cmo: %.ml + $(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $< + +%.cmx: %.ml + $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $< + +%.$(OBJSUFFIX): %.c + $(OCAMLC) -ccopt "$(CFLAGS)" -c $< + +clean: + /bin/rm -rf *.$(OBJSUFFIX) *.$(LIBSUFFIX) *.$(DLLSUFFIX) *.cmi *.cmo *.cmx *.cmxa *.cmxs *.cma *.cmt *.cmti *~ \#* depend test $(AUTOGEN) tmp.c depend + make -C tests clean + +depend: $(AUTOGEN) + $(OCAMLDEP) $(OCAMLINC) $(MLSRC) $(MLISRC) > depend + +include depend + +$(CSRC:%.c=%.$(OBJSUFFIX)): zarith.h + +.PHONY: clean +.PHONY: tests diff --git a/unikernel/duniverse/Zarith/q.ml b/unikernel/duniverse/Zarith/q.ml new file mode 100644 index 00000000..8abfc08a --- /dev/null +++ b/unikernel/duniverse/Zarith/q.ml @@ -0,0 +1,574 @@ +(** + Rationals. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + +type t = { + num: Z.t; (** Numerator. *) + den: Z.t; (** Denominator, >= 0 *) + } +(* Type of rationals. + Invariants: + - den is always >= 0; + - num and den have no common factor; + - if den=0, then num is -1, 0 or 1. + - if num=0, then den is -1, 0 or 1. + *) + + + +(* creation *) +(* -------- *) + +(* make *) +let mk n d = + { num = n; den = d; } + +(* make and normalize n/d, assuming d > 0 *) +let make_real n d = + if n == Z.zero || d == Z.one then mk n Z.one + else + let g = Z.gcd n d in + if g == Z.one + then mk n d + else mk (Z.divexact n g) (Z.divexact d g) + +(* make and normalize any fraction *) +let make n d = + let sd = Z.sign d in + if sd = 0 then mk (Z.of_int (Z.sign n)) Z.zero else + if sd > 0 then make_real n d else + make_real (Z.neg n) (Z.neg d) + +let of_bigint n = mk n Z.one +(* n/1 *) + +let of_int n = of_bigint (Z.of_int n) + +let of_int32 n = of_bigint (Z.of_int32 n) + +let of_int64 n = of_bigint (Z.of_int64 n) + +let of_nativeint n = of_bigint (Z.of_nativeint n) + +let of_ints n d = make (Z.of_int n) (Z.of_int d) + +let zero = of_bigint Z.zero +(* 0/1 *) + +let one = of_bigint Z.one +(* 1/1 *) + +let minus_one = of_bigint Z.minus_one +(* -1/1 *) + +let inf = mk Z.one Z.zero +(* 1/0 *) + +let minus_inf = mk Z.minus_one Z.zero +(* -1/0 *) + +let undef = mk Z.zero Z.zero +(* 0/0 *) + +let of_float d = + if d = infinity then inf else + if d = neg_infinity then minus_inf else + if classify_float d = FP_nan then undef else + let m,e = frexp d in + (* put into the form m * 2^e, where m is an integer *) + let m,e = Z.of_float (ldexp m 53), e-53 in + if e >= 0 then of_bigint (Z.shift_left m e) + else make_real m (Z.shift_left Z.one (-e)) + +(* queries *) +(* ------- *) + +type kind = + | ZERO (* 0 *) + | INF (* 1/0 *) + | MINF (* -1/0 *) + | UNDEF (* 0/0 *) + | NZERO (* non-special, non-0 *) + +let classify n = + if n.den == Z.zero then + match Z.sign n.num with + | 1 -> INF + | -1 -> MINF + | _ -> UNDEF + else + if n.num == Z.zero + then ZERO + else NZERO + +let is_real n = (n.den != Z.zero) + +let num x = x.num + +let den x = x.den + +let sign x = Z.sign x.num +(* sign undef = 0 + sign inf = 1 + sign -inf = -1 +*) + +let equal x y = + (Z.equal x.num y.num) && (Z.equal x.den y.den) && (classify x <> UNDEF) + +let compare x y = + match classify x, classify y with + | UNDEF,UNDEF | INF,INF | MINF,MINF -> 0 + | UNDEF,_ -> -1 + | _,UNDEF -> 1 + | MINF,_ | _,INF -> -1 + | INF,_ | _,MINF -> 1 + | _ -> + if x.den = y.den (* implies equality, + especially if immediate value and not a pointer, + in particular in the case den = 1 *) + then Z.compare x.num y.num + else + Z.compare + (Z.mul x.num y.den) + (Z.mul y.num x.den) + +let min a b = if compare a b <= 0 then a else b +let max a b = if compare a b >= 0 then a else b + + +let leq x y = + match classify x, classify y with + | UNDEF,_ | _,UNDEF -> false + | MINF,_ | _,INF -> true + | INF,_ | _,MINF -> false + | _ -> + if x.den = y.den + then Z.leq x.num y.num + else + Z.leq + (Z.mul x.num y.den) + (Z.mul y.num x.den) + +let lt x y = + match classify x, classify y with + | UNDEF,_ | _,UNDEF -> false + | INF,_ | _,MINF -> false + | MINF,_ | _,INF -> true + | _ -> + if x.den = y.den + then Z.lt x.num y.num + else + Z.lt + (Z.mul x.num y.den) + (Z.mul y.num x.den) + +let geq x y = leq y x +let gt x y = lt y x + +let to_string n = + match classify n with + | UNDEF -> "undef" + | INF -> "+inf" + | MINF -> "-inf" + | ZERO -> "0" + | NZERO -> + if Z.equal n.den Z.one then Z.to_string n.num + else (Z.to_string n.num) ^ "/" ^ (Z.to_string n.den) + +let to_bigint x = Z.div x.num x.den +(* raises a Division by zero in case x is undefined or infinity *) + +let to_int x = Z.to_int (to_bigint x) + +let to_int32 x = Z.to_int32 (to_bigint x) + +let to_int64 x = Z.to_int64 (to_bigint x) + +let to_nativeint x = Z.to_nativeint (to_bigint x) + +let to_float x = + match classify x with + | ZERO -> 0.0 + | INF -> infinity + | MINF -> neg_infinity + | UNDEF -> nan + | NZERO -> + let p = x.num and q = x.den in + let np = Z.numbits p and nq = Z.numbits q in + if np <= 53 && nq <= 53 then + (* p and q convert to floats exactly; use FP division to get the + correctly-rounded result. *) + Int64.to_float (Z.to_int64 p) /. Int64.to_float (Z.to_int64 q) + else begin + let negat = + if Z.sign p < 0 then -1 else 1 + in + (* p is in [2^(np-1), 2^np) + q is in [2^(nq-1), 2^nq) + We define n,p',q' such that p'/q'*2^n=p/q and |p'/q'| is in [1, 2). *) + let n = np - nq in + (* Scaling p/q by 2^n *) + let (p', q') = + if n >= 0 + then (p, Z.shift_left q n) + else (Z.shift_left p (-n), q) + in + let (p', n) = + if Z.geq (Z.abs p') q' + then (p', n) + else (Z.shift_left p' 1, pred n) + in + (* If we divided p' by q' now, the resulting quotient would + have one significant digit. *) + let p' = Z.shift_left p' 54 in + (* When we divide p' by q' next, the resulting quotient will + have 55 significant digits. The strategy is: + - First, compute the quotient with 55 significant digits in + round-to-odd, and + - Second, round that number to the number of effective + significant digits we desire for the result, which is 53 + for a normal result and less than 53 for a subnormal result. + We cannot afford an intermediate rounding at 53 significant digits + if the end-result is subnormal. See + https://github.com/ocaml/Zarith/issues/29 *) + (* Euclidean division of p' by q' *) + let (quo, rem) = Z.ediv_rem p' q' in + if n <= -1080 + then + (* The end result is +0.0 or -0.0 (depending on negat) + or perhaps the next floating-point number of the same + sign (depending on the current rounding mode. *) + ldexp (float_of_int negat) (-1080) + else + let offset = + if n <= -1023 + then + (* The end result will be subnormal, add an offset + to make the rounding happen directly at the place + where it should happend. + quo has the form: 1xxxx... + we add: 1000000... + so as to end up with: 101xxxx... *) + Z.shift_left (Z.of_int negat) (55 + (-1023 - n)) + else + Z.zero + in + let quo = Z.add offset quo in + let quo = + if Z.sign rem = 0 + then quo + else Z.logor Z.one quo (* round to odd *) + in + (* The FPU rounding mode affects the Z.to_float that comes next, + making the rounding computed according to the current FPU rounding + mode. *) + let f = Z.to_float quo in + (* The subtraction that comes next is exact, so that the rounding + mode does not change what it does. *) + let f = f -. (Z.to_float offset) + in + (* ldexp is also exact and unaffected by the rounding mode. + We have made sure that if the end result is going to be subnormal, + then f has exactly the correct number of significant digits for + no rounding to happen here. *) + ldexp f (n - 54) + end + +(* operations *) +(* ---------- *) + +let neg x = + mk (Z.neg x.num) x.den +(* neg undef = undef + neg inf = -inf + neg -inf = inf + *) + +let abs x = + mk (Z.abs x.num) x.den +(* abs undef = undef + abs inf = abs -inf = inf + *) + +(* addition or substraction (zaors) of finite numbers *) +let aors zaors x y = + if x.den == y.den then (* implies equality, + especially if immediate value and not a pointer, + in particular in the case den = 1 *) + make_real (zaors x.num y.num) x.den + else + make_real + (zaors + (Z.mul x.num y.den) + (Z.mul y.num x.den)) + (Z.mul x.den y.den) + +let add x y = + if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with + | ZERO,_ -> y + | _,ZERO -> x + | UNDEF,_ | _,UNDEF -> undef + | INF,MINF | MINF,INF -> undef + | INF,_ | _,INF -> inf + | MINF,_ | _,MINF -> minus_inf + | NZERO,NZERO -> failwith "impossible case" + else + aors Z.add x y +(* undef + x = x + undef = undef + inf + -inf = -inf + inf = undef + inf + x = x + inf = inf + -inf + x = x + -inf = -inf + *) + +let sub x y = + if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with + | ZERO,_ -> neg y + | _,ZERO -> x + | UNDEF,_ | _,UNDEF -> undef + | INF,INF | MINF,MINF -> undef + | INF,_ | _,MINF -> inf + | MINF,_ | _,INF -> minus_inf + | NZERO,NZERO -> failwith "impossible case" + else + aors Z.sub x y +(* sub x y = add x (neg y) *) + +let mul x y = + if x.den == Z.zero || y.den == Z.zero then + mk + (Z.of_int ((Z.sign x.num) * (Z.sign y.num))) + Z.zero + else + make_real (Z.mul x.num y.num) (Z.mul x.den y.den) + +(* undef * x = x * undef = undef + 0 * inf = inf * 0 = 0 * -inf = -inf * 0 = undef + inf * x = x * inf = sign x * inf + -inf * x = x * -inf = - sign x * inf +*) + +let inv x = + match Z.sign x.num with + | 1 -> mk x.den x.num + | -1 -> mk (Z.neg x.den) (Z.neg x.num) + | _ -> if x.den == Z.zero then undef else inf +(* 1 / undef = undef + 1 / inf = 1 / -inf = 0 + 1 / 0 = inf + + note that: inv (inv -inf) = inf <> -inf + *) + +let div x y = + if Z.sign y.num >= 0 + then mul x (mk y.den y.num) + else mul x (mk (Z.neg y.den) (Z.neg y.num)) +(* undef / x = x / undef = undef + 0 / 0 = undef + inf / inf = inf / -inf = -inf / inf = -inf / -inf = undef + 0 / inf = 0 / -inf = x / inf = x / -inf = 0 + inf / x = sign x * inf + -inf / x = - sign x * inf + inf / 0 = inf + -inf / 0 = -inf + x / 0 = sign x * inf + + we have div x y = mul x (inv y) +*) + +let mul_2exp x n = + if x.den == Z.zero then x + else make_real (Z.shift_left x.num n) x.den + +let div_2exp x n = + if x.den == Z.zero then x + else make_real x.num (Z.shift_left x.den n) + + +type supported_base = + | B2 | B8 | B10 | B16 + +let int_of_base = function + | B2 -> 2 + | B8 -> 8 + | B10 -> 10 + | B16 -> 16 + +(* [find_in_string s ~pos ~last pred] find the first index in the string between [pos] + (inclusive) and [last] (exclusive) that satisfy the predicate [pred] *) +let rec find_in_string s ~pos ~last p = + if pos >= last + then None + else if p s.[pos] + then Some pos + else find_in_string s ~pos:(pos + 1) ~last p + +(* The current implementation supports plain decimals, decimal points, + scientific notation ('e' or 'E' for base 10 litteral and 'p' or 'P' + for base 16), and fraction of integers (eg. 1/2). In particular it + accepts any numeric literal accepted by OCaml's lexer. + Restrictions: + - exponents in scientific notation should fit on an integer + - scientific notation only available in hexa and decimal (as in OCaml) *) +let of_string = + (* return a boolean (true for negative) and the next offset to read *) + let parse_sign s i j = + if j < i + 1 + then false, i + else + match s.[i] with + | '-' -> true , i + 1 + | '+' -> false, i + 1 + | _ -> false ,i + in + (* return the base and the next offset to read *) + let parse_base s i j = + if j < i + 2 + then B10, i + else + match s.[i],s.[i+1] with + | '0',('x'|'X') -> B16, i + 2 + | '0',('o'|'O') -> B8, i + 2 + | '0',('b'|'B') -> B2, i + 2 + | _ -> B10, i + in + let find_exponent_mark = function + | B10 -> (function 'e' | 'E' -> true | _ -> false) + | B16 -> (function 'p' | 'P' -> true | _ -> false) + | B8 | B2 -> (fun _ -> false) + in + let of_scientific_notation s = + let i = 0 in + let j = String.length s in + let sign,i = parse_sign s i j in + let base,i = parse_base s i j in + (* shift left due to the exponent *) + let shift_left, j = + match find_in_string s ~pos:i ~last:j (find_exponent_mark base) with + | None -> 0, j + | Some ei -> + let pos = ei + 1 in + let ez = Z.of_substring_base 10 s ~pos ~len:(j - pos) in + Z.to_int ez, ei + in + (* shift right due to the radix *) + let z, shift_right = + match base with + | B2 | B8 -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0 + | B10 | B16 -> + match find_in_string s ~pos:i ~last:j ((=) '.') with + | None -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0 + | Some k -> + (* shift_right_factor correspond to the shift to apply when we move the decimal + point one position to the left. + + 0x1.1p1 = 0x11p-3 = 0x0.11p5 + 1.1e1 = 11e0 = 0.11e2 *) + let shift_right_factor = + match base with + | B10 -> 1 + | B16 -> 4 + | B2 | B8 -> assert false + in + (* We should only consider actual digits to perform the shift. *) + let num_digits = ref 0 in + for h = k + 1 to j - 1 do + match s.[h] with + | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> + incr num_digits + | '_' -> () + | _ -> + (* '-' and '+' could wrongly be accepted by Z.of_string_base *) + invalid_arg "Q.of_string: invalid digit" + done; + let first_digit_after_dot = + match find_in_string s ~pos:(k+1) ~last:j ((<>) '_') with + | None -> j + | Some x -> x + in + let shift = !num_digits * shift_right_factor in + let without_dot = + String.sub s i (k-i) + ^ (String.sub s first_digit_after_dot (j - first_digit_after_dot)) + in + Z.of_string_base (int_of_base base) without_dot, shift + in + let shift = shift_left - shift_right in + let exponent_pow = + match base with + | B10 -> 10 + | B16 -> 2 + | B8 | B2 -> 1 + in + let abs = + if shift < 0 then + make z (Z.pow (Z.of_int exponent_pow) (~- shift)) + else + of_bigint (Z.mul z (Z.pow (Z.of_int exponent_pow) shift)) + in + if sign + then neg abs + else abs + in + function + | "" -> zero + | "inf" | "+inf" -> inf + | "-inf" -> minus_inf + | "undef" -> undef + | s -> + try + let i = String.index s '/' in + make + (Z.of_substring s ~pos:0 ~len:i) + (Z.of_substring s ~pos:(i+1) ~len:(String.length s-i-1)) + with Not_found -> + of_scientific_notation s + + + +(* printing *) +(* -------- *) + +let print x = print_string (to_string x) +let output chan x = output_string chan (to_string x) +let sprint () x = to_string x +let bprint b x = Buffer.add_string b (to_string x) +let pp_print f x = Format.pp_print_string f (to_string x) + + +(* prefix and infix *) +(* ---------------- *) + +let (~-) = neg +let (~+) x = x +let (+) = add +let (-) = sub +let ( * ) = mul +let (/) = div +let (lsl) = mul_2exp +let (asr) = div_2exp +let (~$) = of_int +let (//) = of_ints +let (~$$) = of_bigint +let (///) = make +let (=) = equal +let (<) = lt +let (>) = gt +let (<=) = leq +let (>=) = geq +let (<>) a b = not (equal a b) diff --git a/unikernel/duniverse/Zarith/q.mli b/unikernel/duniverse/Zarith/q.mli new file mode 100644 index 00000000..c3ee8f0f --- /dev/null +++ b/unikernel/duniverse/Zarith/q.mli @@ -0,0 +1,298 @@ +(** + Rationals. + + This modules builds arbitrary precision rationals on top of arbitrary + integers from module Z. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + +(** {1 Types} *) + +type t = { + num: Z.t; (** Numerator. *) + den: Z.t; (** Denominator, >= 0 *) + } +(** A rational is represented as a pair numerator/denominator, reduced to + have a non-negative denominator and no common factor. + This form is canonical (enabling polymorphic equality and hashing). + The representation allows three special numbers: [inf] (1/0), [-inf] (-1/0) + and [undef] (0/0). + *) + +(** {1 Construction} *) + +val make: Z.t -> Z.t -> t +(** [make num den] constructs a new rational equal to [num]/[den]. + It takes care of putting the rational in canonical form. + *) + +val zero: t +val one: t +val minus_one:t +(** 0, 1, -1. *) + +val inf: t +(** 1/0. *) + +val minus_inf: t +(** -1/0. *) + +val undef: t +(** 0/0. *) + +val of_bigint: Z.t -> t +val of_int: int -> t +val of_int32: int32 -> t +val of_int64: int64 -> t +val of_nativeint: nativeint -> t +(** Conversions from various integer types. *) + +val of_ints: int -> int -> t +(** Conversion from an [int] numerator and an [int] denominator. *) + +val of_float: float -> t +(** Conversion from a [float]. + The conversion is exact, and maps NaN to [undef]. + *) + + +val of_string: string -> t +(** Converts a string to a rational. Plain integers, [/] separated + integer ratios (with optional sign), decimal point and scientific + notations are understood. + Additionally, the special [inf], [-inf], and [undef] are + recognized (they can also be typeset respectively as [1/0], [-1/0], + [0/0]). *) + + +(** {1 Inspection} *) + +val num: t -> Z.t +(** Get the numerator. *) + +val den: t -> Z.t +(** Get the denominator. *) + + +(** {1 Testing} *) + +type kind = + | ZERO (** 0 *) + | INF (** infinity, i.e. 1/0 *) + | MINF (** minus infinity, i.e. -1/0 *) + | UNDEF (** undefined, i.e., 0/0 *) + | NZERO (** well-defined, non-infinity, non-zero number *) +(** Rationals can be categorized into different kinds, depending mainly on + whether the numerator and/or denominator is null. + *) + +val classify: t -> kind +(** Determines the kind of a rational. *) + +val is_real: t -> bool +(** Whether the argument is non-infinity and non-undefined. *) + +val sign: t -> int +(** Returns 1 if the argument is positive (including inf), -1 if it is + negative (including -inf), and 0 if it is null or undefined. + *) + +val compare: t -> t -> int +(** [compare x y] compares [x] to [y] and returns 1 if [x] is strictly + greater that [y], -1 if it is strictly smaller, and 0 if they are + equal. + This is a total ordering. + Infinities are ordered in the natural way, while undefined is considered + the smallest of all: undef = undef < -inf <= -inf < x < inf <= inf. + This is consistent with OCaml's handling of floating-point infinities + and NaN. + + OCaml's polymorphic comparison will NOT return a result consistent with + the ordering of rationals. + *) + +val equal: t -> t -> bool +(** Equality testing. + Unlike [compare], this follows IEEE semantics: [undef] <> [undef]. + *) + +val min: t -> t -> t +(** Returns the smallest of its arguments. *) + +val max: t -> t -> t +(** Returns the largest of its arguments. *) + +val leq: t -> t -> bool +(** Less than or equal. [leq undef undef] returns false. *) + +val geq: t -> t -> bool +(** Greater than or equal. [leq undef undef] returns false. *) + +val lt: t -> t -> bool +(** Less than (not equal). *) + +val gt: t -> t -> bool +(** Greater than (not equal). *) + + +(** {1 Conversions} *) + +val to_bigint: t -> Z.t +val to_int: t -> int +val to_int32: t -> int32 +val to_int64: t -> int64 +val to_nativeint: t -> nativeint +(** Convert to integer by truncation. + Raises a [Divide_by_zero] if the argument is an infinity or undefined. + Raises a [Z.Overflow] if the result does not fit in the destination + type. +*) + +val to_string: t -> string +(** Converts to human-readable, base-10, [/]-separated rational. *) + +val to_float: t -> float +(** Converts to a floating-point number, using the current + floating-point rounding mode. With the default rounding mode, + the result is the floating-point number closest to the given + rational; ties break to even mantissa. *) + +(** {1 Arithmetic operations} *) + +(** + In all operations, the result is [undef] if one argument is [undef]. + Other operations can return [undef]: such as [inf]-[inf], [inf]*0, 0/0. + *) + +val neg: t -> t +(** Negation. *) + +val abs: t -> t +(** Absolute value. *) + +val add: t -> t -> t +(** Addition. *) + +val sub: t -> t -> t +(** Subtraction. We have [sub x y] = [add x (neg y)]. *) + +val mul: t -> t -> t +(** Multiplication. *) + +val inv: t -> t +(** Inverse. + Note that [inv 0] is defined, and equals [inf]. + *) + +val div: t -> t -> t +(** Division. + We have [div x y] = [mul x (inv y)], and [inv x] = [div one x]. + *) + +val mul_2exp: t -> int -> t +(** [mul_2exp x n] multiplies [x] by 2 to the power of [n]. *) + +val div_2exp: t -> int -> t +(** [div_2exp x n] divides [x] by 2 to the power of [n]. *) + + +(** {1 Printing} *) + +val print: t -> unit +(** Prints the argument on the standard output. *) + +val output: out_channel -> t -> unit +(** Prints the argument on the specified channel. + Also intended to be used as [%a] format printer in [Printf.printf]. + *) + +val sprint: unit -> t -> string +(** To be used as [%a] format printer in [Printf.sprintf]. *) + +val bprint: Buffer.t -> t -> unit +(** To be used as [%a] format printer in [Printf.bprintf]. *) + +val pp_print: Format.formatter -> t -> unit +(** Prints the argument on the specified formatter. + Also intended to be used as [%a] format printer in [Format.printf]. + *) + + +(** {1 Prefix and infix operators} *) + +(** + Classic prefix and infix [int] operators are redefined on [t]. +*) + +val (~-): t -> t +(** Negation [neg]. *) + +val (~+): t -> t +(** Identity. *) + +val (+): t -> t -> t +(** Addition [add]. *) + +val (-): t -> t -> t +(** Subtraction [sub]. *) + +val ( * ): t -> t -> t +(** Multiplication [mul]. *) + +val (/): t -> t -> t +(** Division [div]. *) + +val (lsl): t -> int -> t +(** Multiplication by a power of two [mul_2exp]. *) + +val (asr): t -> int -> t +(** Division by a power of two [shift_right]. *) + +val (~$): int -> t +(** Conversion from [int]. *) + +val (//): int -> int -> t +(** Creates a rational from two [int]s. *) + +val (~$$): Z.t -> t +(** Conversion from [Z.t]. *) + +val (///): Z.t -> Z.t -> t +(** Creates a rational from two [Z.t]. *) + +val (=): t -> t -> bool +(** Same as [equal]. + @since 1.8 *) + +val (<): t -> t -> bool +(** Same as [lt]. + @since 1.8 *) + +val (>): t -> t -> bool +(** Same as [gt]. + @since 1.8 *) + +val (<=): t -> t -> bool +(** Same as [leq]. + @since 1.8 *) + +val (>=): t -> t -> bool +(** Same as [geq]. + @since 1.8 *) + +val (<>): t -> t -> bool +(** [a <> b] is equivalent to [not (equal a b)]. + @since 1.8 *) diff --git a/unikernel/duniverse/Zarith/tests/bi.ml b/unikernel/duniverse/Zarith/tests/bi.ml new file mode 100644 index 00000000..1c3a0d6e --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/bi.ml @@ -0,0 +1,198 @@ +(* stress test, using random and corner cases + compares Big_int_Z, a Big_int compatible interface for Z, to OCaml's + reference Big_int library + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + +*) + + +module B = Big_int (* reference library *) + +module T = Big_int_Z (* tested library *) + + +(* randomness *) + +let _ = Random.init 42 + +let random_int64 () = + let a,b,c = Random.bits(), Random.bits(), Random.bits () in + let a,b,c = Int64.of_int a, Int64.of_int b, Int64.of_int c in + let a,b,c = Int64.shift_left a 60, Int64.shift_left b 30, c in + Int64.logor a (Int64.logor b c) + +let random_int () = Int64.to_int (random_int64 ()) + +let random_string () = + let l = 1 + Random.int 200 in + let s = Buffer.create l in + let st = if l > 1 && Random.bool () then begin + Buffer.add_char s '-'; + 1 + end else 0 in + for i = st to l - 1 do + Buffer.add_char s (Char.chr (48 + Random.int 10)) + done; + Buffer.contents s + + +(* list utility *) + +let list_make n f = + let rec doit i acc = if i < 0 then acc else doit (i-1) ((f i)::acc) in + doit (n-1) [] + + +(* interesting numbers, as big_int *) + +let p = (list_make 128 (B.shift_left_big_int B.unit_big_int)) +let pn = p @ (List.map B.minus_big_int p) +let g_list = + [B.zero_big_int] @ + pn @ (List.map B.succ_big_int pn) @ (List.map B.pred_big_int pn) @ + (list_make 128 (fun _ -> B.big_int_of_int (random_int ()))) @ + (list_make 128 (fun _ -> B.big_int_of_string (random_string()))) + +let sh_list = list_make 256 (fun x -> x) +let pow_list = [1;2;3;4;5;6;7;8;9;10;20;55] + +(* conversion to Z *) + +let g_t_list = + Printf.printf "converting %i numbers\n%!" (List.length g_list); + List.map + (fun g -> + let t = T.big_int_of_string (B.string_of_big_int g) in + let g' = B.big_int_of_string (T.string_of_big_int t) in + if B.compare_big_int g g' <> 0 then failwith (Printf.sprintf "string_of_big_int failure: %s" (B.string_of_big_int g)); + g, t + ) + g_list + +let rec cut_list n l = + if n <= 0 then [] else match l with [] -> [] | h :: t -> h :: cut_list (n-1) t + +let small_g_t_list = cut_list 256 g_t_list + +(* operator tests *) + +let test_un msg filt gf tf = + Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list); + List.iter + (fun (g,t) -> + try + if filt g then ( + let g' = gf g and t' = tf t in + if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g) (B.string_of_big_int g') (T.string_of_big_int t')) + ) + with Failure _ -> () + ) g_t_list + +let test_bin_gen msg filt gf tf l = + Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l); + List.iter + (fun (g1,t1) -> + List.iter + (fun (g2,t2) -> + if filt (g1,g2) then ( + let g' = gf g1 g2 and t' = tf t1 t2 in + if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g1) (B.string_of_big_int g2) (B.string_of_big_int g') (T.string_of_big_int t')) + ) + ) l + ) l + +let test_bin msg filt gf tf = test_bin_gen msg filt gf tf g_t_list +let test_bin_small msg filt gf tf = test_bin_gen msg filt gf tf small_g_t_list + +let test_shift msg gf tf = + Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list); + List.iter + (fun s -> + List.iter + (fun (g,t) -> + let g' = gf g s and t' = tf t s in + if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%i Bresult=%s Tresult=%s" msg (B.string_of_big_int g) s (B.string_of_big_int g') (T.string_of_big_int t')) + ) g_t_list + ) sh_list + +let test_pow msg gf tf = + Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list); + List.iter + (fun s -> + List.iter + (fun (g,t) -> + let g' = gf g s and t' = tf t s in + if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%i Bresult=%s Tresult=%s" msg (B.string_of_big_int g) s (B.string_of_big_int g') (T.string_of_big_int t')) + ) g_t_list + ) pow_list + +let test_comparison msg gf tf l = + Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l); + List.iter + (fun (g1,t1) -> + List.iter + (fun (g2,t2) -> + let g' = gf g1 g2 and t' = tf t1 t2 in + if g' <> t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%s" msg (B.string_of_big_int g1) (B.string_of_big_int g2)) + ) l + ) l + +let filt_none _ = true +let filt_pos x = B.sign_big_int x >= 0 +let filt_nonzero2 (_,d) = B.sign_big_int d <> 0 +let filt_pos2 (x,y) = B.sign_big_int x >= 0 && B.sign_big_int y >= 0 +let filt_nonzero22 (x,y) = B.sign_big_int x <> 0 && B.sign_big_int y <> 0 + +let ffst f x = fst (f x) +let fsnd f x = snd (f x) +let ffst2 f x y = fst (f x y) +let fsnd2 f x y = snd (f x y) + +let _ = test_un "int_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int (T.int_of_big_int x)) +let _ = test_un "int32_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int32 (T.int32_of_big_int x)) +let _ = test_un "int64_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int64 (T.int64_of_big_int x)) +let _ = test_un "nativeint_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_nativeint (T.nativeint_of_big_int x)) +let _ = test_un "string_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_string (T.string_of_big_int x)) + +let _ = test_un "minus_big_int" filt_none B.minus_big_int T.minus_big_int +let _ = test_un "abs_big_int" filt_none B.abs_big_int T.abs_big_int +let _ = test_un "succ_big_int"filt_none B.succ_big_int T.succ_big_int +let _ = test_un "pred_big_int" filt_none B.pred_big_int T.pred_big_int +let _ = test_un "sqrt_big_int" filt_pos B.sqrt_big_int T.sqrt_big_int + +let _ = test_bin "add_big_int" filt_none B.add_big_int T.add_big_int +let _ = test_bin "sub_big_int" filt_none B.sub_big_int T.sub_big_int +let _ = test_bin "mult_big_int" filt_none B.mult_big_int T.mult_big_int +let _ = test_bin_small "div_big_int" filt_nonzero2 B.div_big_int T.div_big_int +let _ = test_bin_small "quomod_big_int #1" filt_nonzero2 (ffst2 B.quomod_big_int) (ffst2 T.quomod_big_int) +let _ = test_bin_small "quomod_big_int #2" filt_nonzero2 (fsnd2 B.quomod_big_int) (fsnd2 T.quomod_big_int) +let _ = test_bin_small "mod_big_int" filt_nonzero2 B.mod_big_int T.mod_big_int +let _ = test_bin_small "gcd_big_int" filt_nonzero22 B.gcd_big_int T.gcd_big_int + +let _ = test_bin "and_big_int" filt_pos2 B.and_big_int T.and_big_int +let _ = test_bin "or_big_int" filt_pos2 B.or_big_int T.or_big_int +let _ = test_bin "xor_big_int" filt_pos2 B.xor_big_int T.xor_big_int + +let _ = test_shift "shift_left_big_int" B.shift_left_big_int T.shift_left_big_int +let _ = test_shift "shift_right_big_int" B.shift_right_big_int T.shift_right_big_int +let _ = test_shift "shift_right_towards_zero_big_int" B.shift_right_towards_zero_big_int T.shift_right_towards_zero_big_int + +let _ = test_pow "power_big_int_positive_int" B.power_big_int_positive_int T.power_big_int_positive_int + +let _ = test_comparison "compare" B.compare_big_int Z.compare g_t_list +let _ = test_comparison "equal" B.eq_big_int Z.equal g_t_list +let _ = test_comparison "lt" B.lt_big_int (fun x y -> x < y) g_t_list +let _ = test_comparison "ge" B.ge_big_int (fun x y -> x >= y) g_t_list + +let _ = Printf.printf "All tests passed!\n" diff --git a/unikernel/duniverse/Zarith/tests/chi2.ml b/unikernel/duniverse/Zarith/tests/chi2.ml new file mode 100644 index 00000000..86a57381 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/chi2.ml @@ -0,0 +1,60 @@ +(* Accumulate [n] samples from function [f] and check the chi-square. + Assumes [f] returns integers in the [0..255] range. *) + +let chisquare n f = + let r = 256 in + let freq = Array.make r 0 in + for i = 0 to n - 1 do + let t = f () in freq.(t) <- freq.(t) + 1 + done; + let expected = float n /. float r in + let t = + Array.fold_left + (fun s x -> let d = float x -. expected in d *. d +. s) + 0.0 freq in + let chi2 = t /. expected in + let degfree = float r -. 1.0 in + (* The degree of freedom is high, so we approximate as a normal + distribution with mean equal to degfree and variance 2 * degfree. + Four sigmas correspond to a 99.9968% confidence interval. + (Without the approximation, the confidence interval seems to be 99.986%.) + *) + chi2 <= degfree +. 4.0 *. sqrt (2.0 *. degfree) + +let failed = ref false + +let test_base name f = + if not (chisquare 100_000 f) then begin + Printf.printf "%s: suspicious result\n%!" name; + failed := true + end + +let test name f = + (* Test the low 8 bits of the result of f *) + test_base name (fun () -> Z.to_int (Z.logand (f ()) (Z.of_int 0xFF))) + +let p = Z.of_string "35742549198872617291353508656626642567" + +let _ = + test "random_bits 15 (bits 0-7)" + (fun () -> Z.random_bits 15); + test "random_bits 32 (bits 12-19)" + (fun () -> Z.(shift_right (random_bits 32) 12)); + test "random_bits 31 (bits 23-30)" + (fun () -> Z.(shift_right (random_bits 31) 23)); + test "random_int 2^30 (bits 0-7)" + (fun () -> Z.(random_int (shift_left one 30))); + test "random_int 2^30 (bits 21-28)" + (fun () -> Z.(shift_right (random_int (shift_left one 30)) 21)); + test "random_int (256 * p) / p" + (let bound = Z.shift_left p 8 in + fun () -> Z.(div (random_int bound) p)); + (* Also test our hash function, why not? *) + test_base "hash (random_int p) (bits 0-7)" + (fun () -> Z.(hash (random_int p)) land 0xFF); + test_base "hash (random_int p) (bits 16-23)" + (fun () -> (Z.(hash (random_int p)) lsr 16) land 0xFF); + exit (if !failed then 2 else 0) + + + diff --git a/unikernel/duniverse/Zarith/tests/extern.data32 b/unikernel/duniverse/Zarith/tests/extern.data32 new file mode 100644 index 00000000..00316438 Binary files /dev/null and b/unikernel/duniverse/Zarith/tests/extern.data32 differ diff --git a/unikernel/duniverse/Zarith/tests/extern.data64 b/unikernel/duniverse/Zarith/tests/extern.data64 new file mode 100644 index 00000000..6d0c104c Binary files /dev/null and b/unikernel/duniverse/Zarith/tests/extern.data64 differ diff --git a/unikernel/duniverse/Zarith/tests/extern.ml b/unikernel/duniverse/Zarith/tests/extern.ml new file mode 100644 index 00000000..247677b5 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/extern.ml @@ -0,0 +1,14 @@ +(* Marshal some interesting big integers to the given file *) + +let _ = + let file = Sys.argv.(1) in + let oc = open_out_bin file in + for nbits = 16 to 128 do + let x = Z.shift_left Z.one nbits in + output_value oc (Z.pred (Z.neg x)); + output_value oc (Z.neg x); + output_value oc (Z.pred x); + output_value oc x + done; + close_out oc + diff --git a/unikernel/duniverse/Zarith/tests/intern.ml b/unikernel/duniverse/Zarith/tests/intern.ml new file mode 100644 index 00000000..c7940ae0 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/intern.ml @@ -0,0 +1,24 @@ +(* Unmarshal big integers from the given file, and report errors *) + +open Printf + +let expect ic n = + try + let m = (input_value ic : Z.t) in + if Z.equal m n then printf " OK" else printf " Wrong" + with Failure _ -> + printf " Fail" + +let _ = + let file = Sys.argv.(1) in + let ic = open_in_bin file in + for nbits = 16 to 128 do + printf "%d:" nbits; + let x = Z.shift_left Z.one nbits in + expect ic (Z.pred (Z.neg x)); + expect ic (Z.neg x); + expect ic (Z.pred x); + expect ic x; + print_newline() + done; + close_in ic diff --git a/unikernel/duniverse/Zarith/tests/intern.output3232 b/unikernel/duniverse/Zarith/tests/intern.output3232 new file mode 100644 index 00000000..9029dd27 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/intern.output3232 @@ -0,0 +1,113 @@ +16: OK OK OK OK +17: OK OK OK OK +18: OK OK OK OK +19: OK OK OK OK +20: OK OK OK OK +21: OK OK OK OK +22: OK OK OK OK +23: OK OK OK OK +24: OK OK OK OK +25: OK OK OK OK +26: OK OK OK OK +27: OK OK OK OK +28: OK OK OK OK +29: OK OK OK OK +30: OK OK OK OK +31: OK OK OK OK +32: OK OK OK OK +33: OK OK OK OK +34: OK OK OK OK +35: OK OK OK OK +36: OK OK OK OK +37: OK OK OK OK +38: OK OK OK OK +39: OK OK OK OK +40: OK OK OK OK +41: OK OK OK OK +42: OK OK OK OK +43: OK OK OK OK +44: OK OK OK OK +45: OK OK OK OK +46: OK OK OK OK +47: OK OK OK OK +48: OK OK OK OK +49: OK OK OK OK +50: OK OK OK OK +51: OK OK OK OK +52: OK OK OK OK +53: OK OK OK OK +54: OK OK OK OK +55: OK OK OK OK +56: OK OK OK OK +57: OK OK OK OK +58: OK OK OK OK +59: OK OK OK OK +60: OK OK OK OK +61: OK OK OK OK +62: OK OK OK OK +63: OK OK OK OK +64: OK OK OK OK +65: OK OK OK OK +66: OK OK OK OK +67: OK OK OK OK +68: OK OK OK OK +69: OK OK OK OK +70: OK OK OK OK +71: OK OK OK OK +72: OK OK OK OK +73: OK OK OK OK +74: OK OK OK OK +75: OK OK OK OK +76: OK OK OK OK +77: OK OK OK OK +78: OK OK OK OK +79: OK OK OK OK +80: OK OK OK OK +81: OK OK OK OK +82: OK OK OK OK +83: OK OK OK OK +84: OK OK OK OK +85: OK OK OK OK +86: OK OK OK OK +87: OK OK OK OK +88: OK OK OK OK +89: OK OK OK OK +90: OK OK OK OK +91: OK OK OK OK +92: OK OK OK OK +93: OK OK OK OK +94: OK OK OK OK +95: OK OK OK OK +96: OK OK OK OK +97: OK OK OK OK +98: OK OK OK OK +99: OK OK OK OK +100: OK OK OK OK +101: OK OK OK OK +102: OK OK OK OK +103: OK OK OK OK +104: OK OK OK OK +105: OK OK OK OK +106: OK OK OK OK +107: OK OK OK OK +108: OK OK OK OK +109: OK OK OK OK +110: OK OK OK OK +111: OK OK OK OK +112: OK OK OK OK +113: OK OK OK OK +114: OK OK OK OK +115: OK OK OK OK +116: OK OK OK OK +117: OK OK OK OK +118: OK OK OK OK +119: OK OK OK OK +120: OK OK OK OK +121: OK OK OK OK +122: OK OK OK OK +123: OK OK OK OK +124: OK OK OK OK +125: OK OK OK OK +126: OK OK OK OK +127: OK OK OK OK +128: OK OK OK OK diff --git a/unikernel/duniverse/Zarith/tests/intern.output3264 b/unikernel/duniverse/Zarith/tests/intern.output3264 new file mode 100644 index 00000000..bcacdfbe --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/intern.output3264 @@ -0,0 +1,113 @@ +16: OK OK OK OK +17: OK OK OK OK +18: OK OK OK OK +19: OK OK OK OK +20: OK OK OK OK +21: OK OK OK OK +22: OK OK OK OK +23: OK OK OK OK +24: OK OK OK OK +25: OK OK OK OK +26: OK OK OK OK +27: OK OK OK OK +28: OK OK OK OK +29: OK OK OK OK +30: Fail OK OK Fail +31: Fail Fail Fail Fail +32: Fail Fail Fail Fail +33: Fail Fail Fail Fail +34: Fail Fail Fail Fail +35: Fail Fail Fail Fail +36: Fail Fail Fail Fail +37: Fail Fail Fail Fail +38: Fail Fail Fail Fail +39: Fail Fail Fail Fail +40: Fail Fail Fail Fail +41: Fail Fail Fail Fail +42: Fail Fail Fail Fail +43: Fail Fail Fail Fail +44: Fail Fail Fail Fail +45: Fail Fail Fail Fail +46: Fail Fail Fail Fail +47: Fail Fail Fail Fail +48: Fail Fail Fail Fail +49: Fail Fail Fail Fail +50: Fail Fail Fail Fail +51: Fail Fail Fail Fail +52: Fail Fail Fail Fail +53: Fail Fail Fail Fail +54: Fail Fail Fail Fail +55: Fail Fail Fail Fail +56: Fail Fail Fail Fail +57: Fail Fail Fail Fail +58: Fail Fail Fail Fail +59: Fail Fail Fail Fail +60: Fail Fail Fail Fail +61: Fail Fail Fail Fail +62: OK Fail Fail OK +63: OK OK OK OK +64: OK OK OK OK +65: OK OK OK OK +66: OK OK OK OK +67: OK OK OK OK +68: OK OK OK OK +69: OK OK OK OK +70: OK OK OK OK +71: OK OK OK OK +72: OK OK OK OK +73: OK OK OK OK +74: OK OK OK OK +75: OK OK OK OK +76: OK OK OK OK +77: OK OK OK OK +78: OK OK OK OK +79: OK OK OK OK +80: OK OK OK OK +81: OK OK OK OK +82: OK OK OK OK +83: OK OK OK OK +84: OK OK OK OK +85: OK OK OK OK +86: OK OK OK OK +87: OK OK OK OK +88: OK OK OK OK +89: OK OK OK OK +90: OK OK OK OK +91: OK OK OK OK +92: OK OK OK OK +93: OK OK OK OK +94: OK OK OK OK +95: OK OK OK OK +96: OK OK OK OK +97: OK OK OK OK +98: OK OK OK OK +99: OK OK OK OK +100: OK OK OK OK +101: OK OK OK OK +102: OK OK OK OK +103: OK OK OK OK +104: OK OK OK OK +105: OK OK OK OK +106: OK OK OK OK +107: OK OK OK OK +108: OK OK OK OK +109: OK OK OK OK +110: OK OK OK OK +111: OK OK OK OK +112: OK OK OK OK +113: OK OK OK OK +114: OK OK OK OK +115: OK OK OK OK +116: OK OK OK OK +117: OK OK OK OK +118: OK OK OK OK +119: OK OK OK OK +120: OK OK OK OK +121: OK OK OK OK +122: OK OK OK OK +123: OK OK OK OK +124: OK OK OK OK +125: OK OK OK OK +126: OK OK OK OK +127: OK OK OK OK +128: OK OK OK OK diff --git a/unikernel/duniverse/Zarith/tests/intern.output6432 b/unikernel/duniverse/Zarith/tests/intern.output6432 new file mode 100644 index 00000000..bcacdfbe --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/intern.output6432 @@ -0,0 +1,113 @@ +16: OK OK OK OK +17: OK OK OK OK +18: OK OK OK OK +19: OK OK OK OK +20: OK OK OK OK +21: OK OK OK OK +22: OK OK OK OK +23: OK OK OK OK +24: OK OK OK OK +25: OK OK OK OK +26: OK OK OK OK +27: OK OK OK OK +28: OK OK OK OK +29: OK OK OK OK +30: Fail OK OK Fail +31: Fail Fail Fail Fail +32: Fail Fail Fail Fail +33: Fail Fail Fail Fail +34: Fail Fail Fail Fail +35: Fail Fail Fail Fail +36: Fail Fail Fail Fail +37: Fail Fail Fail Fail +38: Fail Fail Fail Fail +39: Fail Fail Fail Fail +40: Fail Fail Fail Fail +41: Fail Fail Fail Fail +42: Fail Fail Fail Fail +43: Fail Fail Fail Fail +44: Fail Fail Fail Fail +45: Fail Fail Fail Fail +46: Fail Fail Fail Fail +47: Fail Fail Fail Fail +48: Fail Fail Fail Fail +49: Fail Fail Fail Fail +50: Fail Fail Fail Fail +51: Fail Fail Fail Fail +52: Fail Fail Fail Fail +53: Fail Fail Fail Fail +54: Fail Fail Fail Fail +55: Fail Fail Fail Fail +56: Fail Fail Fail Fail +57: Fail Fail Fail Fail +58: Fail Fail Fail Fail +59: Fail Fail Fail Fail +60: Fail Fail Fail Fail +61: Fail Fail Fail Fail +62: OK Fail Fail OK +63: OK OK OK OK +64: OK OK OK OK +65: OK OK OK OK +66: OK OK OK OK +67: OK OK OK OK +68: OK OK OK OK +69: OK OK OK OK +70: OK OK OK OK +71: OK OK OK OK +72: OK OK OK OK +73: OK OK OK OK +74: OK OK OK OK +75: OK OK OK OK +76: OK OK OK OK +77: OK OK OK OK +78: OK OK OK OK +79: OK OK OK OK +80: OK OK OK OK +81: OK OK OK OK +82: OK OK OK OK +83: OK OK OK OK +84: OK OK OK OK +85: OK OK OK OK +86: OK OK OK OK +87: OK OK OK OK +88: OK OK OK OK +89: OK OK OK OK +90: OK OK OK OK +91: OK OK OK OK +92: OK OK OK OK +93: OK OK OK OK +94: OK OK OK OK +95: OK OK OK OK +96: OK OK OK OK +97: OK OK OK OK +98: OK OK OK OK +99: OK OK OK OK +100: OK OK OK OK +101: OK OK OK OK +102: OK OK OK OK +103: OK OK OK OK +104: OK OK OK OK +105: OK OK OK OK +106: OK OK OK OK +107: OK OK OK OK +108: OK OK OK OK +109: OK OK OK OK +110: OK OK OK OK +111: OK OK OK OK +112: OK OK OK OK +113: OK OK OK OK +114: OK OK OK OK +115: OK OK OK OK +116: OK OK OK OK +117: OK OK OK OK +118: OK OK OK OK +119: OK OK OK OK +120: OK OK OK OK +121: OK OK OK OK +122: OK OK OK OK +123: OK OK OK OK +124: OK OK OK OK +125: OK OK OK OK +126: OK OK OK OK +127: OK OK OK OK +128: OK OK OK OK diff --git a/unikernel/duniverse/Zarith/tests/intern.output6464 b/unikernel/duniverse/Zarith/tests/intern.output6464 new file mode 100644 index 00000000..9029dd27 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/intern.output6464 @@ -0,0 +1,113 @@ +16: OK OK OK OK +17: OK OK OK OK +18: OK OK OK OK +19: OK OK OK OK +20: OK OK OK OK +21: OK OK OK OK +22: OK OK OK OK +23: OK OK OK OK +24: OK OK OK OK +25: OK OK OK OK +26: OK OK OK OK +27: OK OK OK OK +28: OK OK OK OK +29: OK OK OK OK +30: OK OK OK OK +31: OK OK OK OK +32: OK OK OK OK +33: OK OK OK OK +34: OK OK OK OK +35: OK OK OK OK +36: OK OK OK OK +37: OK OK OK OK +38: OK OK OK OK +39: OK OK OK OK +40: OK OK OK OK +41: OK OK OK OK +42: OK OK OK OK +43: OK OK OK OK +44: OK OK OK OK +45: OK OK OK OK +46: OK OK OK OK +47: OK OK OK OK +48: OK OK OK OK +49: OK OK OK OK +50: OK OK OK OK +51: OK OK OK OK +52: OK OK OK OK +53: OK OK OK OK +54: OK OK OK OK +55: OK OK OK OK +56: OK OK OK OK +57: OK OK OK OK +58: OK OK OK OK +59: OK OK OK OK +60: OK OK OK OK +61: OK OK OK OK +62: OK OK OK OK +63: OK OK OK OK +64: OK OK OK OK +65: OK OK OK OK +66: OK OK OK OK +67: OK OK OK OK +68: OK OK OK OK +69: OK OK OK OK +70: OK OK OK OK +71: OK OK OK OK +72: OK OK OK OK +73: OK OK OK OK +74: OK OK OK OK +75: OK OK OK OK +76: OK OK OK OK +77: OK OK OK OK +78: OK OK OK OK +79: OK OK OK OK +80: OK OK OK OK +81: OK OK OK OK +82: OK OK OK OK +83: OK OK OK OK +84: OK OK OK OK +85: OK OK OK OK +86: OK OK OK OK +87: OK OK OK OK +88: OK OK OK OK +89: OK OK OK OK +90: OK OK OK OK +91: OK OK OK OK +92: OK OK OK OK +93: OK OK OK OK +94: OK OK OK OK +95: OK OK OK OK +96: OK OK OK OK +97: OK OK OK OK +98: OK OK OK OK +99: OK OK OK OK +100: OK OK OK OK +101: OK OK OK OK +102: OK OK OK OK +103: OK OK OK OK +104: OK OK OK OK +105: OK OK OK OK +106: OK OK OK OK +107: OK OK OK OK +108: OK OK OK OK +109: OK OK OK OK +110: OK OK OK OK +111: OK OK OK OK +112: OK OK OK OK +113: OK OK OK OK +114: OK OK OK OK +115: OK OK OK OK +116: OK OK OK OK +117: OK OK OK OK +118: OK OK OK OK +119: OK OK OK OK +120: OK OK OK OK +121: OK OK OK OK +122: OK OK OK OK +123: OK OK OK OK +124: OK OK OK OK +125: OK OK OK OK +126: OK OK OK OK +127: OK OK OK OK +128: OK OK OK OK diff --git a/unikernel/duniverse/Zarith/tests/ofstring.ml b/unikernel/duniverse/Zarith/tests/ofstring.ml new file mode 100644 index 00000000..bf8684b2 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/ofstring.ml @@ -0,0 +1,292 @@ +let pow2 n = + let rec doit acc n = + if n<=0 then acc else doit (Z.add acc acc) (n-1) + in + doit Z.one n + +let p30 = pow2 30 +let p62 = pow2 62 +let p300 = pow2 300 +let p120 = pow2 120 +let p121 = pow2 121 + +let test_of_string_Z () = + let round_trip_Z () = + let round_trip fmt x= + (Z.equal (Z.of_string (Z.format fmt x)) x) + in + let formats = [ + "%i"; "%#b"; "%#o"; "%#x"; "%#X"; + "%+i"; "%#+b"; "%#+o"; "%#+x"; "%#+X"; + "%+0i"; "%#+0b"; "%#+0o"; "%#+0x"; "%#+0X"; + ] in + let numbers = + let (+) = Z.add in + let l = [p30; p62; p30 + p62; p300; p120; p121] in + l @ (List.map Z.neg l) + in + List.iter + (fun fmt -> + assert + ( + List.for_all + (fun x -> round_trip fmt x) + numbers + ) + ) + formats + in + let fail d f x = + try + ignore (f x); + Printf.printf "%s should fail on %s\n" d x + with _ -> () + in + let succ d f x y = + try + let z = f x in + if Z.equal z y + then () + else + Printf.printf + "%s(%s) returned %s, expected %s\n" + d + x + (Z.to_string z) + (Z.to_string y) + with _ -> + Printf.printf "%s failed. Expected %s\n" d (Z.to_string y) + in + let z_and_int_agree s = + let f = try Some (int_of_string s) with _ -> None in + let z = try Some (Z.of_string s) with _ -> None in + match f,z with + | None, None -> () + | Some i, Some z -> + if not (Z.equal (Z.of_int i) z) + then + Printf.printf + "Z.of_string (%s) returned %s, expected %s\n" + s + (Z.to_string z) + (string_of_int i) + | Some i, None -> + Printf.printf + "Z.of_string (%s) failed, expected %s\n" + s + (string_of_int i) + | None, Some z -> + Printf.printf + "Z.of_string (%s) returned %s, failure expected" + s + (Z.to_string z) + in + + round_trip_Z (); + + fail "Z.of_string" Z.of_string "0b2"; + fail "Z.of_string" Z.of_string "0o8"; + fail "Z.of_string" Z.of_string "0xg"; + fail "Z.of_string" Z.of_string "0xG"; + fail "Z.of_string" Z.of_string "0A"; + succ "Z.of_string" Z.of_string "" Z.zero; + succ "Z.of_string" Z.of_string "+" Z.zero; + succ "Z.of_string" Z.of_string "-" Z.zero; + succ "Z.of_string" Z.of_string "0x" Z.zero; + succ "Z.of_string" Z.of_string "0b" Z.zero; + + fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0b2"; + fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0o8"; + fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0xg"; + fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0xG"; + fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:1) "0A"; + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:0) "+" Z.zero; + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:1) "-+" Z.zero; + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"--1-" (Z.minus_one); + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"--1\000" (Z.minus_one); + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"\000-1\000" (Z.minus_one); + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:1)"00b1" Z.zero; + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"00b1" Z.zero; + succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:3)"00b1" Z.one; + + z_and_int_agree "_123"; + z_and_int_agree "1_23"; + z_and_int_agree "12_3"; + z_and_int_agree "123_"; + z_and_int_agree "0x_123"; + z_and_int_agree "0_123"; + + let s = Z.format "%#b" p120 in + let n = String.length s in + for i = 0 to n - 3 do + succ "Z.of_substring" + (Z.of_substring ~pos:0 ~len:(n - i)) + s + (Z.shift_right p120 i) + done + +let _ = test_of_string_Z () + +let test_of_string_Q () = + let round_trip_Q () = + let round_trip fmt x= + let os = Q.of_string (Z.to_string x) in + let ob = Q.of_bigint x in + if Q.equal os ob then + true + else begin + Format.printf "%a not equal to %a\n" Q.pp_print os Q.pp_print ob; + false + end + in + let formats = [ + "%i"; "%#b"; "%#o"; "%#x"; "%#X"; + "%+i"; "%#+b"; "%#+o"; "%#+x"; "%#+X"; + "%+0i"; "%#+0b"; "%#+0o"; "%#+0x"; "%#+0X"; + ] in + let numbers = + let (+) = Z.add in + let l = [p30; p62; p30 + p62; p300; p120; p121] in + (l @ (List.map Z.neg l)) + in + List.iter + (fun fmt -> + assert + ( + List.for_all + (fun x -> round_trip fmt x) + numbers + ) + ) + formats + in + let fail d f x = + try + let s = f x in + Printf.printf "%s should fail on %s. Got %s\n" d x (Q.to_string s) + with _ -> () + in + let succ d f x y = + try + let z = f x in + if Q.equal z y + then () + else + Printf.printf + "%s(%s) returned %s, expected %s\n" + d + x + (Q.to_string z) + (Q.to_string y) + with exc -> + Printf.printf "%s failed. Expected %s. Got %s\n" d (Q.to_string y) + (Printexc.to_string exc) + in + let q_and_float_agree s = + let f = try Some (float_of_string s) with _ -> None in + let q = try Some (Q.of_string s) with _ -> None in + match f,q with + | None, None -> () + | Some f, Some q -> + if not ((Q.to_float q) = f) + then + Printf.printf + "Q.of_string (%s) returned %s, expected %s\n" + s + (Q.to_string q) + (string_of_float f) + | Some f, None -> + Printf.printf + "Q.of_string (%s) failed, expected %s\n" + s + (string_of_float f) + | None, Some q -> + Printf.printf + "Q.of_string (%s) returned %s, failure expected" + s + (Q.to_string q) + in + + + round_trip_Q (); + + fail "Q.of_string" Q.of_string "0b2"; + fail "Q.of_string" Q.of_string "0o8"; + fail "Q.of_string" Q.of_string "0xg"; + fail "Q.of_string" Q.of_string "0xG"; + fail "Q.of_string" Q.of_string "0A"; + succ "Q.of_string" Q.of_string "" Q.zero; + succ "Q.of_string" Q.of_string "+" Q.zero; + succ "Q.of_string" Q.of_string "-" Q.zero; + succ "Q.of_string" Q.of_string "0x" Q.zero; + succ "Q.of_string" Q.of_string "0X" Q.zero; + succ "Q.of_string" Q.of_string "0o" Q.zero; + succ "Q.of_string" Q.of_string "0O" Q.zero; + succ "Q.of_string" Q.of_string "0b" Q.zero; + succ "Q.of_string" Q.of_string "0B" Q.zero; + succ "Q.of_string" Q.of_string "0b101" (Q.of_string "5"); + succ "Q.of_string" Q.of_string "0B101" (Q.of_string "5"); + succ "Q.of_string" Q.of_string "0o101" (Q.of_string "65"); + succ "Q.of_string" Q.of_string "0O101" (Q.of_string "65"); + + fail "Q.of_string" Q.of_string "0b2"; + fail "Q.of_string" Q.of_string "0o8"; + fail "Q.of_string" Q.of_string "0xg"; + fail "Q.of_string" Q.of_string "0xG"; + fail "Q.of_string" Q.of_string "0A"; + fail "Q.of_string" Q.of_string "-0b0.1e1"; + fail "Q.of_string" Q.of_string "-0o0.1E1"; + fail "Q.of_string" Q.of_string "-0b0.1P1"; + fail "Q.of_string" Q.of_string "-0o0.1p1"; + fail "Q.of_string" Q.of_string "-0.1P1"; + fail "Q.of_string" Q.of_string "-0.1p1"; + succ "Q.of_string" Q.of_string "0x1e2" (Q.of_int 482); + succ "Q.of_string" Q.of_string "1e2" (Q.of_int 100); + succ "Q.of_string" Q.of_string "+" Q.zero; + succ "Q.of_string" Q.of_string "-+" Q.zero; + succ "Q.of_string" Q.of_string "-1" Q.minus_one; + succ "Q.of_string" Q.of_string "+0xFF.8" (Q.of_float 255.5); + succ "Q.of_string" Q.of_string "+0xff.8" (Q.of_float 255.5); + succ "Q.of_string" Q.of_string "-0xFF.8" (Q.of_float (-255.5)); + succ "Q.of_string" Q.of_string "-0xff.8" (Q.of_float (-255.5)); + succ "Q.of_string" Q.of_string "-0.1e1" (Q.of_float (float_of_string "-0.1e1")) ; + succ "Q.of_string" Q.of_string "-0.1E1" (Q.of_float (float_of_string "-0.1E1")) ; + succ "Q.of_string" Q.of_string "-0x0.1P1" (Q.of_float (float_of_string "-0x0.1P1")) ; + succ "Q.of_string" Q.of_string "-0x0.1p1" (Q.of_float (float_of_string "-0x0.1p1")) ; + succ "Q.of_string" Q.of_string "6.674e-11" (Q.of_string "0.00000000006674") ; + + q_and_float_agree "-0x0.1p1" ; + q_and_float_agree "-0x0.1P1" ; + q_and_float_agree "-0x0.1p10" ; + q_and_float_agree "-0x0.1p10" ; + + q_and_float_agree "1_2.34e03"; + q_and_float_agree "12_.34e03"; + q_and_float_agree "12._34e03"; + q_and_float_agree "12.3_4e03"; + q_and_float_agree "12.34_e03"; + (* float_of_string accept leading underscores after ( 'e' | 'E'), Q does not. *) + (* q_and_float_agree "12.34e_03"; *) + q_and_float_agree "12.34e0_3"; + q_and_float_agree "12.34e03_"; + + q_and_float_agree "000_001"; + q_and_float_agree "001_000"; + + q_and_float_agree "123."; + + (* underscores right after dot are accepted. *) + q_and_float_agree "1._001"; + q_and_float_agree "._001"; + (* float_of_string doesn't accept strings without digits, Q and Z do (e.g. "+", "-", "0x", "." *) + (* q_and_float_agree "."; *) + (* q_and_float_agree "._"; *) + + + q_and_float_agree "0.x00a"; + q_and_float_agree ".-001"; + + () + + +let _ = test_of_string_Q () diff --git a/unikernel/duniverse/Zarith/tests/pi.ml b/unikernel/duniverse/Zarith/tests/pi.ml new file mode 100644 index 00000000..376932ff --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/pi.ml @@ -0,0 +1,65 @@ +(* Pi digits computed with the streaming algorithm given on pages 4, 6 + & 7 of "Unbounded Spigot Algorithms for the Digits of Pi", Jeremy + Gibbons, August 2004. *) + +open Printf + +let zero = Z.zero +and one = Z.one +and three = Z.of_int 3 +and four = Z.of_int 4 +and ten = Z.of_int 10 +and neg_ten = Z.of_int (-10) +;; + +(* Linear Fractional (aka M=F6bius) Transformations *) +module LFT = struct + + let floor_ev (q, r, s, t) x = + Z.((q * x + r) / (s * x + t)) + + let unit = (one, zero, zero, one) + + let comp (q, r, s, t) (q', r', s', t') = + Z.(q * q' + r * s', q * r' + r * t', + s * q' + t * s', s * r' + t * t') + +end + +let next z = LFT.floor_ev z three + +let safe z n = (n = LFT.floor_ev z four) + +let prod z n = LFT.comp (ten, Z.(neg_ten * n), zero, one) z + +let cons z k = + let den = 2 * k + 1 in + LFT.comp z (Z.of_int k, Z.of_int (2 * den), zero, Z.of_int den) + +let rec digit k z n row col = + if n > 0 then + let y = next z in + if safe z y then + if col = 10 then ( + let row = row + 10 in + printf "\t:%i\n%a" row Z.output y; + digit k (prod z y) (n - 1) row 1 + ) + else ( + printf "%a" Z.output y; + digit k (prod z y) (n - 1) row (col + 1) + ) + else digit (k + 1) (cons z k) n row col + else + printf "%*s\t:%i\n" (10 - col) "" (row + col) + +let digits n = digit 1 LFT.unit n 0 0 + +let usage () = + prerr_endline "Usage: pi "; + exit 2 + +let _ = + let args = Sys.argv in + if Array.length args <> 2 then usage () else + digits (int_of_string Sys.argv.(1)) diff --git a/unikernel/duniverse/Zarith/tests/pi.output b/unikernel/duniverse/Zarith/tests/pi.output new file mode 100644 index 00000000..de12c0ec --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/pi.output @@ -0,0 +1,50 @@ +3141592653 :10 +5897932384 :20 +6264338327 :30 +9502884197 :40 +1693993751 :50 +0582097494 :60 +4592307816 :70 +4062862089 :80 +9862803482 :90 +5342117067 :100 +9821480865 :110 +1328230664 :120 +7093844609 :130 +5505822317 :140 +2535940812 :150 +8481117450 :160 +2841027019 :170 +3852110555 :180 +9644622948 :190 +9549303819 :200 +6442881097 :210 +5665933446 :220 +1284756482 :230 +3378678316 :240 +5271201909 :250 +1456485669 :260 +2346034861 :270 +0454326648 :280 +2133936072 :290 +6024914127 :300 +3724587006 :310 +6063155881 :320 +7488152092 :330 +0962829254 :340 +0917153643 :350 +6789259036 :360 +0011330530 :370 +5488204665 :380 +2138414695 :390 +1941511609 :400 +4330572703 :410 +6575959195 :420 +3092186117 :430 +3819326117 :440 +9310511854 :450 +8074462379 :460 +9627495673 :470 +5188575272 :480 +4891227938 :490 +1830119491 :500 diff --git a/unikernel/duniverse/Zarith/tests/setround.c b/unikernel/duniverse/Zarith/tests/setround.c new file mode 100644 index 00000000..2898545e --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/setround.c @@ -0,0 +1,27 @@ +/* Auxiliary function to control FP rounding mode. Assumes ISO C99. */ + +#include +#include + +#ifndef FE_DOWNWARD +#define FE_DOWNWARD (-1) +#endif +#ifndef FE_TONEAREST +#define FE_TONEAREST (-1) +#endif +#ifndef FE_TOWARDZERO +#define FE_TOWARDZERO (-1) +#endif +#ifndef FE_UPWARD +#define FE_UPWARD (-1) +#endif + +static int modes[4] = { + FE_DOWNWARD, FE_TONEAREST, FE_TOWARDZERO, FE_UPWARD +}; + +CAMLprim value caml_ztest_setround(value vmode) +{ + int rc = fesetround(modes[Int_val(vmode)]); + return Val_bool(rc == 0); +} diff --git a/unikernel/duniverse/Zarith/tests/timings.ml b/unikernel/duniverse/Zarith/tests/timings.ml new file mode 100644 index 00000000..eb2ac617 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/timings.ml @@ -0,0 +1,154 @@ +open Printf + +(* Timing harness harness *) + +let time fn arg = + let start = Sys.time() in + let rec time accu = + let qty = fn arg in + let duration = Sys.time() -. start in + let qty = float qty in + if duration >= 1.0 + then duration /. (accu +. qty) + else time (accu +. qty) + in time 0.0 + +let time_repeat rep fn arg = + time (fun () -> for i = 1 to rep do ignore (fn arg) done; rep) () + +(* Basic arithmetic operations *) + +let add (x, y) = + for i = 1 to 50_000_000 do + ignore (Sys.opaque_identity (Z.add x y)) + done; + 50_000_000 + +let sub (x, y) = + for i = 1 to 50_000_000 do + ignore (Sys.opaque_identity (Z.sub x y)) + done; + 50_000_000 + +let mul (x, y) = + for i = 1 to 50_000_000 do + ignore (Sys.opaque_identity (Z.mul x y)) + done; + 50_000_000 + +let div (x, y) = + for i = 1 to 10_000_000 do + ignore (Sys.opaque_identity (Z.div x y)) + done; + 1_000_000 + +let shl (x, y) = + for i = 1 to 50_000_000 do + ignore (Sys.opaque_identity (Z.shift_left x y)) + done; + 50_000_000 + +let big = Z.pow (Z.of_int 17) 150 +let med = Z.pow (Z.of_int 3) 150 + +let _ = + printf "%.2e add (small, no overflow)\n%!" + (time add (Z.of_int 1, Z.of_int 2)); + printf "%.2e add (small, overflow)\n%!" + (time add (Z.of_int max_int, Z.of_int 2)); + printf "%.2e add (small, big)\n%!" + (time add (Z.of_int 1, big)); + printf "%.2e add (big, big)\n%!" + (time add (big, big)); + printf "%.2e sub (small, no overflow)\n%!" + (time sub (Z.of_int 1, Z.of_int 2)); + printf "%.2e sub (small, overflow)\n%!" + (time sub (Z.of_int max_int, Z.of_int (-2))); + printf "%.2e sub (big, small)\n%!" + (time sub (big, Z.of_int 1)); + printf "%.2e sub (big, big)\n%!" + (time sub (big, big)); + printf "%.2e mul (small, no overflow)\n%!" + (time mul (Z.of_int 42, Z.of_int 74)); + printf "%.2e mul (small, overflow)\n%!" + (time mul (Z.of_int max_int, Z.of_int 3)); + printf "%.2e mul (small, big)\n%!" + (time mul (Z.of_int 3, big)); + printf "%.2e mul (medium, medium)\n%!" + (time mul (med, med)); + printf "%.2e mul (big, big)\n%!" + (time mul (big, big)); + printf "%.2e div (small, small)\n%!" + (time div (Z.of_int 12345678, Z.of_int 443)); + printf "%.2e div (big, small)\n%!" + (time div (big, Z.of_int 443)); + printf "%.2e div (big, medium)\n%!" + (time div (big, med)); + printf "%.2e shl (small, no overflow)\n%!" + (time shl (Z.of_int 3, 10)); + printf "%.2e shl (small, overflow)\n%!" + (time shl (Z.of_int max_int, 2)); + printf "%.2e shl (big)\n%!" + (time shl (big, 42)) +(* Factorial *) + +let rec fact_z n = + if n <= 0 then Z.one else Z.mul (Z.of_int n) (fact_z (n-1)) + +let _ = + printf "%.2e fact 10\n%!" + (time_repeat 1_000_000 fact_z 10); + printf "%.2e fact 40\n%!" + (time_repeat 10_000 fact_z 40); + printf "%.2e fact 200\n%!" + (time_repeat 10_000 fact_z 200) + +(* Fibonacci *) + +let rec fib_int n = + if n < 2 then 1 else fib_int(n-1) + fib_int(n-2) + +let rec fib_natint n = + if n < 2 then 1n else Nativeint.add (fib_natint(n-1)) (fib_natint(n-2)) + +let rec fib_z n = + if n < 2 then Z.one else Z.add (fib_z(n-1)) (fib_z(n-2)) + +let fib_arg = 32 + +let _ = + printf "%.2e fib (int)\n%!" + (time_repeat 100 fib_int fib_arg); + printf "%.2e fib (nativeint)\n%!" + (time_repeat 100 fib_natint fib_arg); + printf "%.2e fib (Z)\n%!" + (time_repeat 100 fib_z fib_arg) + +(* Takeushi *) + +let rec tak_int (x, y, z) = + if x > y + then tak_int(tak_int (x-1, y, z), tak_int (y-1, z, x), tak_int (z-1, x, y)) + else z + +let rec tak_natint (x, y, z) = + if x > y + then tak_natint(tak_natint (Nativeint.sub x 1n, y, z), + tak_natint (Nativeint.sub y 1n, z, x), + tak_natint (Nativeint.sub z 1n, x, y)) + else z + +let rec tak_z (x, y, z) = + if Z.compare x y > 0 + then tak_z(tak_z (Z.pred x, y, z), + tak_z (Z.pred y, z, x), + tak_z (Z.pred z, x, y)) + else z + +let _ = + printf "%.2e tak (int)\n%!" + (time_repeat 1000 tak_int (18,12,6)); + printf "%.2e tak (nativeint)\n%!" + (time_repeat 1000 tak_natint (18n,12n,6n)); + printf "%.2e tak (Z)\n%!" + (time_repeat 1000 tak_z (Z.of_int 18, Z.of_int 12, Z.of_int 6)) diff --git a/unikernel/duniverse/Zarith/tests/tofloat.ml b/unikernel/duniverse/Zarith/tests/tofloat.ml new file mode 100644 index 00000000..511daa1d --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/tofloat.ml @@ -0,0 +1,134 @@ +(* Testing Z.to_float *) + +open Printf + +type rounding_mode = + FE_DOWNWARD | FE_TONEAREST | FE_TOWARDZERO | FE_UPWARD + +external setround: rounding_mode -> bool = "caml_ztest_setround" + +external format_float: string -> float -> string = "caml_format_float" + +let hex_of_float f = format_float "%a" f + +(* For testing, we use randomly-generated integers of the form + * 2^ + We can predict their FP value by converting the integer part to FP, + then scale by the exponent using ldexp. *) + +let test1 (mant: int64) (exp: int) = + let expected = ldexp (Int64.to_float mant) exp in + let actual = Z.to_float (Z.shift_left (Z.of_int64 mant) exp) in + if actual = expected then true else begin + printf "%Ld * 2^%d: expected %s, got %s\n" + mant exp (hex_of_float expected) (hex_of_float actual); + false + end + +let rnd64 () = + let m1 = Random.bits() in (* 30 bits *) + let m2 = Random.bits() in (* 30 bits *) + let m3 = Random.bits() in + Int64.(logor (of_int m1) + (logor (shift_left (of_int m2) 30) + (shift_left (of_int m3) 60))) + +let testN numrounds = + printf " (%d tests)... %!" numrounds; + let errors = ref 0 in + (* Some random int64 values *) + for i = 1 to numrounds do + let m = Random.int64 Int64.max_int in + if not (test1 m 0) then incr errors; + if not (test1 (Int64.neg m) 0) then incr errors + done; + (* Some random int64 values scaled by some random power of 2 *) + for i = 1 to numrounds do + let m = rnd64() in + let exp = Random.int 1100 in (* sometimes +inf will result *) + if not (test1 m exp) then incr errors + done; + (* Special test close to a rounding point *) + for i = 0 to 15 do + let m = Int64.(add 0xfffffffffffff0L (of_int i)) in + if not (test1 m 32) then incr errors; + if not (test1 (Int64.neg m) 32) then incr errors + done; + if !errors = 0 + then printf "passed\n%!" + else printf "FAILED (%d errors)\n%!" !errors + +let testQ1 (mant1: int64) (exp1: int) (mant2: int64) (exp2: int) = + let expected = + ldexp (Int64.to_float mant1) exp1 /. ldexp (Int64.to_float mant2) exp2 in + let actual = + Q.to_float (Q.make (Z.shift_left (Z.of_int64 mant1) exp1) + (Z.shift_left (Z.of_int64 mant2) exp2)) in + if compare actual expected = 0 then true else begin + printf "%Ld * 2^%d / %Ld * 2^%d : expected %s, got %s\n" + mant1 exp1 mant2 exp2 (hex_of_float expected) (hex_of_float actual); + false + end + +let testQN numrounds = + printf " (%d tests)... %!" numrounds; + let errors = ref 0 in + (* Some special values *) + if not (testQ1 0L 0 1L 0) then incr errors; + if not (testQ1 1L 0 0L 0) then incr errors; + if not (testQ1 (-1L) 0 0L 0) then incr errors; + if not (testQ1 0L 0 0L 0) then incr errors; + (* Some random fractions *) + for i = 1 to numrounds do + let m1 = Random.int64 0x20000000000000L in + let m1 = if Random.bool() then m1 else Int64.neg m1 in + let exp1 = Random.int 500 in + let m2 = Random.int64 0x20000000000000L in + let exp2 = Random.int 500 in + if not (testQ1 m1 exp1 m2 exp2) then incr errors + done; + if !errors = 0 + then printf "passed\n%!" + else printf "FAILED (%d errors)\n%!" !errors + +let _ = + let numrounds = + if Array.length Sys.argv >= 2 + then int_of_string Sys.argv.(1) + else 100_000 in + printf "Default rounding mode (Z)"; + testN numrounds; + printf "Default rounding mode (Q)"; + testQN numrounds; + if setround FE_TOWARDZERO then begin + printf "Round toward zero (Z)"; + testN numrounds; + printf "Round toward zero (Q)"; + testQN numrounds + end else begin + printf "Round toward zero not supported, skipping\n" + end; + if setround FE_DOWNWARD then begin + printf "Round downward (Z)"; + testN numrounds; + printf "Round downward (Q)"; + testQN numrounds + end else begin + printf "Round downward not supported, skipping\n" + end; + if setround FE_UPWARD then begin + printf "Round upward (Z)"; + testN numrounds; + printf "Round upward (Q)"; + testQN numrounds + end else begin + printf "Round upward not supported, skipping\n" + end; + if setround FE_TONEAREST then begin + printf "Round to nearest (Z)"; + testN numrounds; + printf "Round to nearest (Q)"; + testQN numrounds + end else begin + printf "Round to nearest not supported, skipping\n" + end diff --git a/unikernel/duniverse/Zarith/tests/tst_extract.ml b/unikernel/duniverse/Zarith/tests/tst_extract.ml new file mode 100644 index 00000000..a687f6c9 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/tst_extract.ml @@ -0,0 +1,35 @@ +module I = Z + +let pr ch x = + output_string ch (I.to_string x); + flush ch + +let chk_extract x o l = + let expected = + I.logand (I.shift_right x o) (I.pred (I.shift_left (I.of_int 1) l)) + and actual = + I.extract x o l in + if actual <> expected then (Printf.printf "extract %a %d %d = %a found %a\n" pr x o l pr expected pr actual; failwith "test failed") + +let doit () = + let max = 128 in + for l = 1 to max do + if l mod 16 == 0 then Printf.printf "%i/%i\n%!" l max; + for o = 0 to 256 do + for n = 0 to 256 do + let x = I.shift_left I.one n in + chk_extract x o l; + chk_extract (I.mul x x) o l; + chk_extract (I.mul x (I.mul x x)) o l; + chk_extract (I.succ x) o l; + chk_extract (I.pred x) o l; + chk_extract (I.neg (I.mul x x)) o l; + chk_extract (I.neg (I.mul x (I.mul x x))) o l; + chk_extract (I.neg x) o l; + chk_extract (I.neg (I.succ x)) o l; + chk_extract (I.neg (I.pred x)) o l; + done + done + done + +let _ = doit () diff --git a/unikernel/duniverse/Zarith/tests/zq.ml b/unikernel/duniverse/Zarith/tests/zq.ml new file mode 100644 index 00000000..fb007ca6 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/zq.ml @@ -0,0 +1,920 @@ +(* Simple tests for the Z and Q modules. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + +*) + + +(* testing Z *) + +module I = Z + +let pr ch x = + output_string ch (I.to_string x); + flush ch + +let pr2 ch (x,y) = + Printf.fprintf ch "%s, %s" (I.to_string x) (I.to_string y); + flush ch + +let pr3 ch (x,y,z) = + Printf.fprintf ch "%s, %s, %s" + (I.to_string x) (I.to_string y) (I.to_string z); + flush ch + +let prfloat ch (x,y : float * float) = + if x = y then + Printf.fprintf ch "OK" + else + Printf.fprintf ch "WRONG! (expected %g, got %g)" y x + +let prmarshal ch (x,y : I.t * I.t) = + (if I.equal x y then + Printf.fprintf ch "OK" + else + Printf.fprintf ch "WRONG! (expected %a, got %a)" pr y pr x); + flush ch + +let pow2 n = + let rec doit acc n = + if n<=0 then acc else doit (I.add acc acc) (n-1) + in + doit I.one n + +let fact n = + let rec doit acc n = + if n<=1 then acc + else doit (I.mul acc (I.of_int n)) (n-1) + in + doit I.one n + +let pow a b = + let rec doit b = + if b <= 0 then I.one else + let acc = doit (b lsr 1) in + if b land 1 = 1 then I.mul (I.mul acc acc) (I.of_int a) + else I.mul acc acc + in + doit b + +let cvt_int x = + (string_of_bool (I.fits_int x)) + ^","^ + (try string_of_int (I.to_int x) with I.Overflow -> "ovf") + +let cvt_int32 x = + (string_of_bool (I.fits_int32 x)) + ^","^ + (try Int32.to_string (I.to_int32 x) with I.Overflow -> "ovf") + +let cvt_int64 x = + (string_of_bool (I.fits_int64 x)) + ^","^ + (try Int64.to_string (I.to_int64 x) with I.Overflow -> "ovf") + +let cvt_nativeint x = + (string_of_bool (I.fits_nativeint x)) + ^","^ + (try Nativeint.to_string (I.to_nativeint x) with I.Overflow -> "ovf") + +let cvt_int32_unsigned x = + (string_of_bool (I.fits_int32_unsigned x)) + ^","^ + (try Int32.to_string (I.to_int32_unsigned x) with I.Overflow -> "ovf") + +let cvt_int64_unsigned x = + (string_of_bool (I.fits_int64_unsigned x)) + ^","^ + (try Int64.to_string (I.to_int64_unsigned x) with I.Overflow -> "ovf") + +let cvt_nativeint_unsigned x = + (string_of_bool (I.fits_nativeint_unsigned x)) + ^","^ + (try Nativeint.to_string (I.to_nativeint_unsigned x) with I.Overflow -> "ovf") + +let p2 = I.of_int 2 +let p3 = I.of_int 3 +let p30 = pow2 30 +let p62 = pow2 62 +let p300 = pow2 300 +let p120 = pow2 120 +let p121 = pow2 121 +let maxi = I.of_int max_int +let mini = I.of_int min_int +let maxi32 = I.of_int32 Int32.max_int +let mini32 = I.of_int32 Int32.min_int +let maxi64 = I.of_int64 Int64.max_int +let mini64 = I.of_int64 Int64.min_int +let maxni = I.of_nativeint Nativeint.max_int +let minni = I.of_nativeint Nativeint.min_int + +let chk_bits x = + Printf.printf "to_bits %a\n =" pr x; + String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x); + Printf.printf "\n"; + assert(I.equal (I.abs x) (I.of_bits (I.to_bits x))); + assert((I.to_bits x) = (I.to_bits (I.neg x))); + Printf.printf "marshal round trip %a\n =" pr x; + let y = Marshal.(from_string (to_string x []) 0) in + Printf.printf " %a\n" prmarshal (y, x) + +let chk_extract (x, o, l) = + let expected = + I.logand (I.shift_right x o) (I.pred (I.shift_left (I.of_int 1) l)) + and actual = + I.extract x o l in + Printf.printf "extract %a %d %d = %a " pr x o l pr actual; + if I.equal actual expected + then Printf.printf "(passed)\n" + else Printf.printf "(FAILED, expected %a)\n" pr expected + +let chk_signed_extract (x, o, l) = + let uns_res = I.extract x o l in + let expected = + if I.compare uns_res (I.shift_left (I.of_int 1) (l-1)) >= 0 + then I.sub uns_res (I.shift_left (I.of_int 1) l) + else uns_res in + let actual = + I.signed_extract x o l in + Printf.printf "signed_extract %a %d %d = %a " pr x o l pr actual; + if I.equal actual expected + then Printf.printf "(passed)\n" + else Printf.printf "(FAILED, expected %a)\n" pr expected + +let chk_numbits_tz x = + Printf.printf "numbits / trailing_zeros %a " pr x; + let n = I.numbits x and z = I.trailing_zeros x in + if + if I.equal x I.zero then + n = 0 && z = max_int + else + n > 0 && z >= 0 && z < n + && I.leq (I.shift_left I.one (n-1)) (I.abs x) + && I.lt (I.abs x) (I.shift_left I.one n) + && (z = 0 || I.equal (I.extract x 0 z) I.zero) + && I.testbit x z + then Printf.printf "(passed)\n" + else Printf.printf "(FAILED)\n" + +let chk_testbit x = + Printf.printf "testbit %a " pr x; + let n = I.numbits x in + let ok = ref true in + for i = 0 to n + 64 do + let actual = I.testbit x i + and expected = I.extract x i 1 in + if not (I.equal expected (if actual then I.one else I.zero)) + then begin Printf.printf "(error on %d) " i; ok := false end + done; + if !ok + then Printf.printf "(passed)\n" + else Printf.printf "(FAILED)\n" + +let pr_byte = + let state = ref 0 in + fun () -> + state := (!state * 65793 + 4282663) land 0xFF_FF_FF; + !state lsr 16 + +let pr_bytes buf pos len = + for i = pos to pos + len - 1 do + Bytes.set_uint8 buf i (pr_byte ()) + done + +let test_Z() = + Printf.printf "0\n = %a\n" pr I.zero; + Printf.printf "1\n = %a\n" pr I.one; + Printf.printf "-1\n = %a\n" pr I.minus_one; + Printf.printf "42\n = %a\n" pr (I.of_int 42); + Printf.printf "1+1\n = %a\n" pr (I.add I.one I.one); + Printf.printf "1-1\n = %a\n" pr (I.sub I.one I.one); + Printf.printf "- 1\n = %a\n" pr (I.neg I.one); + Printf.printf "0-1\n = %a\n" pr (I.sub I.zero I.one); + Printf.printf "max_int\n = %a\n" pr maxi; + Printf.printf "min_int\n = %a\n" pr mini; + Printf.printf "-max_int\n = %a\n" pr (I.neg maxi); + Printf.printf "-min_int\n = %a\n" pr (I.neg mini); + Printf.printf "2^300\n = %a\n" pr p300; + Printf.printf "2^120\n = %a\n" pr p120; + Printf.printf "2^300+2^120\n = %a\n" pr (I.add p300 p120); + Printf.printf "2^300-2^120\n = %a\n" pr (I.sub p300 p120); + Printf.printf "2^300+(-(2^120))\n = %a\n" pr (I.add p300 (I.neg p120)); + Printf.printf "2^120-2^300\n = %a\n" pr (I.sub p120 p300); + Printf.printf "2^120+(-(2^300))\n = %a\n" pr (I.add p120 (I.neg p300)); + Printf.printf "-(2^120)+(-(2^300))\n = %a\n" pr (I.add (I.neg p120) (I.neg p300)); + Printf.printf "-(2^120)-2^300\n = %a\n" pr (I.sub (I.neg p120) p300); + Printf.printf "2^300-2^300\n = %a\n" pr (I.sub p300 p300); + Printf.printf "2^121\n = %a\n" pr p121; + Printf.printf "2^121+2^120\n = %a\n" pr (I.add p121 p120); + Printf.printf "2^121-2^120\n = %a\n" pr (I.sub p121 p120); + Printf.printf "2^121+(-(2^120))\n = %a\n" pr (I.add p121 (I.neg p120)); + Printf.printf "2^120-2^121\n = %a\n" pr (I.sub p120 p121); + Printf.printf "2^120+(-(2^121))\n = %a\n" pr (I.add p120 (I.neg p121)); + Printf.printf "-(2^120)+(-(2^121))\n = %a\n" pr (I.add (I.neg p120) (I.neg p121)); + Printf.printf "-(2^120)-2^121\n = %a\n" pr (I.sub (I.neg p120) p121); + Printf.printf "2^121+0\n = %a\n" pr (I.add p121 I.zero); + Printf.printf "2^121-0\n = %a\n" pr (I.sub p121 I.zero); + Printf.printf "0+2^121\n = %a\n" pr (I.add I.zero p121); + Printf.printf "0-2^121\n = %a\n" pr (I.sub I.zero p121); + Printf.printf "2^300+1\n = %a\n" pr (I.add p300 I.one); + Printf.printf "2^300-1\n = %a\n" pr (I.sub p300 I.one); + Printf.printf "1+2^300\n = %a\n" pr (I.add I.one p300); + Printf.printf "1-2^300\n = %a\n" pr (I.sub I.one p300); + Printf.printf "2^300+(-1)\n = %a\n" pr (I.add p300 I.minus_one); + Printf.printf "2^300-(-1)\n = %a\n" pr (I.sub p300 I.minus_one); + Printf.printf "(-1)+2^300\n = %a\n" pr (I.add I.minus_one p300); + Printf.printf "(-1)-2^300\n = %a\n" pr (I.sub I.minus_one p300); + Printf.printf "-(2^300)+1\n = %a\n" pr (I.add (I.neg p300) I.one); + Printf.printf "-(2^300)-1\n = %a\n" pr (I.sub (I.neg p300) I.one); + Printf.printf "1+(-(2^300))\n = %a\n" pr (I.add I.one (I.neg p300)); + Printf.printf "1-(-(2^300))\n = %a\n" pr (I.sub I.one (I.neg p300)); + Printf.printf "-(2^300)+(-1)\n = %a\n" pr (I.add (I.neg p300) I.minus_one); + Printf.printf "-(2^300)-(-1)\n = %a\n" pr (I.sub (I.neg p300) I.minus_one); + Printf.printf "(-1)+(-(2^300))\n = %a\n" pr (I.add I.minus_one (I.neg p300)); + Printf.printf "(-1)-(-(2^300))\n = %a\n" pr (I.sub I.minus_one (I.neg p300)); + Printf.printf "max_int+1\n = %a\n" pr (I.add maxi I.one); + Printf.printf "min_int-1\n = %a\n" pr (I.sub mini I.one); + Printf.printf "-max_int-1\n = %a\n" pr (I.sub (I.neg maxi) I.one); + Printf.printf "-min_int-1\n = %a\n" pr (I.sub (I.neg mini) I.one); + Printf.printf "5! = %a\n" pr (fact 5); + Printf.printf "12! = %a\n" pr (fact 12); + Printf.printf "15! = %a\n" pr (fact 15); + Printf.printf "20! = %a\n" pr (fact 20); + Printf.printf "25! = %a\n" pr (fact 25); + Printf.printf "50! = %a\n" pr (fact 50); + Printf.printf "2^300*2^120\n = %a\n" pr (I.mul p300 p120); + Printf.printf "2^120*2^300\n = %a\n" pr (I.mul p120 p300); + Printf.printf "2^300*(-(2^120))\n = %a\n" pr (I.mul p300 (I.neg p120)); + Printf.printf "2^120*(-(2^300))\n = %a\n" pr (I.mul p120 (I.neg p300)); + Printf.printf "-(2^120)*(-(2^300))\n = %a\n" pr (I.mul (I.neg p120) (I.neg p300)); + Printf.printf "2^121*2^120\n = %a\n" pr (I.mul p121 p120); + Printf.printf "2^120*2^121\n = %a\n" pr (I.mul p120 p121); + Printf.printf "2^121*0\n = %a\n" pr (I.mul p121 I.zero); + Printf.printf "0*2^121\n = %a\n" pr (I.mul I.zero p121); + Printf.printf "2^300*1\n = %a\n" pr (I.mul p300 I.one); + Printf.printf "1*2^300\n = %a\n" pr (I.mul I.one p300); + Printf.printf "2^300*(-1)\n = %a\n" pr (I.mul p300 I.minus_one); + Printf.printf "(-1)*2^300\n = %a\n" pr (I.mul I.minus_one p300); + Printf.printf "-(2^300)*1\n = %a\n" pr (I.mul (I.neg p300) I.one); + Printf.printf "1*(-(2^300))\n = %a\n" pr (I.mul I.one (I.neg p300)); + Printf.printf "-(2^300)*(-1)\n = %a\n" pr (I.mul (I.neg p300) I.minus_one); + Printf.printf "(-1)*(-(2^300))\n = %a\n" pr (I.mul I.minus_one (I.neg p300)); + Printf.printf "1*(2^30)\n = %a\n" pr (I.mul I.one p30); + Printf.printf "1*(2^62)\n = %a\n" pr (I.mul I.one p62); + Printf.printf "(2^30)*(2^30)\n = %a\n" pr (I.mul p30 p30); + Printf.printf "(2^62)*(2^62)\n = %a\n" pr (I.mul p62 p62); + Printf.printf "0+1\n = %a\n" pr (I.succ I.zero); + Printf.printf "1+1\n = %a\n" pr (I.succ I.one); + Printf.printf "-1+1\n = %a\n" pr (I.succ I.minus_one); + Printf.printf "2+1\n = %a\n" pr (I.succ p2); + Printf.printf "-2+1\n = %a\n" pr (I.succ (I.neg p2)); + Printf.printf "(2^300)+1\n = %a\n" pr (I.succ p300); + Printf.printf "-(2^300)+1\n = %a\n" pr (I.succ (I.neg p300)); + Printf.printf "0-1\n = %a\n" pr (I.pred I.zero); + Printf.printf "1-1\n = %a\n" pr (I.pred I.one); + Printf.printf "-1-1\n = %a\n" pr (I.pred I.minus_one); + Printf.printf "2-1\n = %a\n" pr (I.pred p2); + Printf.printf "-2-1\n = %a\n" pr (I.pred (I.neg p2)); + Printf.printf "(2^300)-1\n = %a\n" pr (I.pred p300); + Printf.printf "-(2^300)-1\n = %a\n" pr (I.pred (I.neg p300)); + Printf.printf "max_int+1\n = %a\n" pr (I.succ maxi); + Printf.printf "min_int-1\n = %a\n" pr (I.pred mini); + Printf.printf "-max_int-1\n = %a\n" pr (I.pred (I.neg maxi)); + Printf.printf "-min_int-1\n = %a\n" pr (I.pred (I.neg mini)); + Printf.printf "abs(0)\n = %a\n" pr (I.abs I.zero); + Printf.printf "abs(1)\n = %a\n" pr (I.abs I.one); + Printf.printf "abs(-1)\n = %a\n" pr (I.abs I.minus_one); + Printf.printf "abs(min_int)\n = %a\n" pr (I.abs mini); + Printf.printf "abs(2^300)\n = %a\n" pr (I.abs p300); + Printf.printf "abs(-(2^300))\n = %a\n" pr (I.abs (I.neg p300)); + Printf.printf "max_nativeint\n = %a\n" pr maxni; + Printf.printf "max_int32\n = %a\n" pr maxi32; + Printf.printf "max_int64\n = %a\n" pr maxi64; + Printf.printf "to_int 1\n = %s\n" (cvt_int I.one); + Printf.printf "to_int max_int\n = %s\n" (cvt_int maxi); + Printf.printf "to_int max_nativeint\n = %s\n" (cvt_int maxni); + Printf.printf "to_int max_int32\n = %s\n" (cvt_int maxi32); + Printf.printf "to_int max_int64\n = %s\n" (cvt_int maxi64); + Printf.printf "to_int32 1\n = %s\n" (cvt_int32 I.one); + Printf.printf "to_int32 max_int\n = %s\n" (cvt_int32 maxi); + Printf.printf "to_int32 max_nativeint\n = %s\n" (cvt_int32 maxni); + Printf.printf "to_int32 max_int32\n = %s\n" (cvt_int32 maxi32); + Printf.printf "to_int32 max_int64\n = %s\n" (cvt_int32 maxi64); + Printf.printf "to_int64 1\n = %s\n" (cvt_int64 I.one); + Printf.printf "to_int64 max_int\n = %s\n" (cvt_int64 maxi); + Printf.printf "to_int64 max_nativeint\n = %s\n" (cvt_int64 maxni); + Printf.printf "to_int64 max_int32\n = %s\n" (cvt_int64 maxi32); + Printf.printf "to_int64 max_int64\n = %s\n" (cvt_int64 maxi64); + Printf.printf "to_nativeint 1\n = %s\n" (cvt_nativeint I.one); + Printf.printf "to_nativeint max_int\n = %s\n" (cvt_nativeint maxi); + Printf.printf "to_nativeint max_nativeint\n = %s\n" (cvt_nativeint maxni); + Printf.printf "to_nativeint max_int32\n = %s\n" (cvt_nativeint maxi32); + Printf.printf "to_nativeint max_int64\n = %s\n" (cvt_nativeint maxi64); + Printf.printf "to_int -min_int\n = %s\n" (cvt_int (I.neg mini)); + Printf.printf "to_int -min_nativeint\n = %s\n" (cvt_int (I.neg minni)); + Printf.printf "to_int -min_int32\n = %s\n" (cvt_int (I.neg mini32)); + Printf.printf "to_int -min_int64\n = %s\n" (cvt_int (I.neg mini64)); + Printf.printf "to_int32 -min_int\n = %s\n" (cvt_int32 (I.neg mini)); + Printf.printf "to_int32 -min_nativeint\n = %s\n" (cvt_int32 (I.neg minni)); + Printf.printf "to_int32 -min_int32\n = %s\n" (cvt_int32 (I.neg mini32)); + Printf.printf "to_int32 -min_int64\n = %s\n" (cvt_int32(I.neg mini64)); + Printf.printf "to_int64 -min_int\n = %s\n" (cvt_int64 (I.neg mini)); + Printf.printf "to_int64 -min_nativeint\n = %s\n" (cvt_int64 (I.neg minni)); + Printf.printf "to_int64 -min_int32\n = %s\n" (cvt_int64 (I.neg mini32)); + Printf.printf "to_int64 -min_int64\n = %s\n" (cvt_int64 (I.neg mini64)); + Printf.printf "to_nativeint -min_int\n = %s\n" (cvt_nativeint (I.neg mini)); + Printf.printf "to_nativeint -min_nativeint\n = %s\n" (cvt_nativeint (I.neg minni)); + Printf.printf "to_nativeint -min_int32\n = %s\n" (cvt_nativeint (I.neg mini32)); + Printf.printf "to_nativeint -min_int64\n = %s\n" (cvt_nativeint (I.neg mini64)); + Printf.printf "to_int32_unsigned 1\n = %s\n" (cvt_int32_unsigned I.one); + Printf.printf "to_int32_unsigned -1\n = %s\n" (cvt_int32_unsigned I.minus_one); + Printf.printf "to_int32_unsigned max_int\n = %s\n" (cvt_int32_unsigned maxi); + Printf.printf "to_int32_unsigned max_nativeint\n = %s\n" (cvt_int32_unsigned maxni); + Printf.printf "to_int32_unsigned max_int32\n = %s\n" (cvt_int32_unsigned maxi32); + Printf.printf "to_int32_unsigned 2max_int32\n = %s\n" (cvt_int32_unsigned (I.mul p2 maxi32)); + Printf.printf "to_int32_unsigned 3max_int32\n = %s\n" (cvt_int32_unsigned (I.mul p3 maxi32)); + Printf.printf "to_int32_unsigned max_int64\n = %s\n" (cvt_int32_unsigned maxi64); + Printf.printf "to_int64_unsigned 1\n = %s\n" (cvt_int64_unsigned I.one); + Printf.printf "to_int64_unsigned -1\n = %s\n" (cvt_int64_unsigned I.minus_one); + Printf.printf "to_int64_unsigned max_int\n = %s\n" (cvt_int64_unsigned maxi); + Printf.printf "to_int64_unsigned max_nativeint\n = %s\n" (cvt_int64_unsigned maxni); + Printf.printf "to_int64_unsigned max_int32\n = %s\n" (cvt_int64_unsigned maxi32); + Printf.printf "to_int64_unsigned max_int64\n = %s\n" (cvt_int64_unsigned maxi64); + Printf.printf "to_int64_unsigned 2max_int64\n = %s\n" (cvt_int64_unsigned (I.mul p2 maxi64)); + Printf.printf "to_int64_unsigned 3max_int64\n = %s\n" (cvt_int64_unsigned (I.mul p3 maxi64)); + Printf.printf "to_nativeint_unsigned 1\n = %s\n" (cvt_nativeint_unsigned I.one); + Printf.printf "to_nativeint_unsigned -1\n = %s\n" (cvt_nativeint_unsigned I.minus_one); + Printf.printf "to_nativeint_unsigned max_int\n = %s\n" (cvt_nativeint_unsigned maxi); + Printf.printf "to_nativeint_unsigned max_nativeint\n = %s\n" (cvt_nativeint_unsigned maxni); + Printf.printf "to_nativeint_unsigned 2max_nativeint\n = %s\n" (cvt_nativeint_unsigned (I.mul p2 maxni)); + Printf.printf "to_nativeint_unsigned max_int32\n = %s\n" (cvt_nativeint_unsigned maxi32); + Printf.printf "to_nativeint_unsigned max_int64\n = %s\n" (cvt_nativeint_unsigned maxi64); + Printf.printf "to_nativeint_unsigned 2max_int64\n = %s\n" (cvt_nativeint_unsigned (I.mul p2 maxi64)); + Printf.printf "to_nativeint_unsigned 3max_int64\n = %s\n" (cvt_nativeint_unsigned (I.mul p3 maxi64)); + Printf.printf "of_int32_unsigned -1\n = %a\n" pr (I.of_int32_unsigned (-1l)); + Printf.printf "of_int64_unsigned -1\n = %a\n" pr (I.of_int64_unsigned (-1L)); + Printf.printf "of_nativeint_unsigned -1\n = %a\n" pr (I.of_nativeint_unsigned (-1n)); + + Printf.printf "of_float 1.\n = %a\n" pr (I.of_float 1.); + Printf.printf "of_float -1.\n = %a\n" pr (I.of_float (-. 1.)); + Printf.printf "of_float pi\n = %a\n" pr (I.of_float (2. *. acos 0.)); + Printf.printf "of_float 2^30\n = %a\n" pr (I.of_float (ldexp 1. 30)); + Printf.printf "of_float 2^31\n = %a\n" pr (I.of_float (ldexp 1. 31)); + Printf.printf "of_float 2^32\n = %a\n" pr (I.of_float (ldexp 1. 32)); + Printf.printf "of_float 2^33\n = %a\n" pr (I.of_float (ldexp 1. 33)); + Printf.printf "of_float -2^30\n = %a\n" pr (I.of_float (-.(ldexp 1. 30))); + Printf.printf "of_float -2^31\n = %a\n" pr (I.of_float (-.(ldexp 1. 31))); + Printf.printf "of_float -2^32\n = %a\n" pr (I.of_float (-.(ldexp 1. 32))); + Printf.printf "of_float -2^33\n = %a\n" pr (I.of_float (-.(ldexp 1. 33))); + Printf.printf "of_float 2^61\n = %a\n" pr (I.of_float (ldexp 1. 61)); + Printf.printf "of_float 2^62\n = %a\n" pr (I.of_float (ldexp 1. 62)); + Printf.printf "of_float 2^63\n = %a\n" pr (I.of_float (ldexp 1. 63)); + Printf.printf "of_float 2^64\n = %a\n" pr (I.of_float (ldexp 1. 64)); + Printf.printf "of_float 2^65\n = %a\n" pr (I.of_float (ldexp 1. 65)); + Printf.printf "of_float -2^61\n = %a\n" pr (I.of_float (-.(ldexp 1. 61))); + Printf.printf "of_float -2^62\n = %a\n" pr (I.of_float (-.(ldexp 1. 62))); + Printf.printf "of_float -2^63\n = %a\n" pr (I.of_float (-.(ldexp 1. 63))); + Printf.printf "of_float -2^64\n = %a\n" pr (I.of_float (-.(ldexp 1. 64))); + Printf.printf "of_float -2^65\n = %a\n" pr (I.of_float (-.(ldexp 1. 65))); + Printf.printf "of_float 2^120\n = %a\n" pr (I.of_float (ldexp 1. 120)); + Printf.printf "of_float 2^300\n = %a\n" pr (I.of_float (ldexp 1. 300)); + Printf.printf "of_float -2^120\n = %a\n" pr (I.of_float (-.(ldexp 1. 120))); + Printf.printf "of_float -2^300\n = %a\n" pr (I.of_float (-.(ldexp 1. 300))); + Printf.printf "of_float 0.5\n = %a\n" pr (I.of_float 0.5); + Printf.printf "of_float -0.5\n = %a\n" pr (I.of_float (-. 0.5)); + Printf.printf "of_float 200.5\n = %a\n" pr (I.of_float 200.5); + Printf.printf "of_float -200.5\n = %a\n" pr (I.of_float (-. 200.5)); + Printf.printf "to_float 0\n = %a\n" prfloat (I.to_float I.zero, 0.0); + Printf.printf "to_float 1\n = %a\n" prfloat (I.to_float I.one, 1.0); + Printf.printf "to_float -1\n = %a\n" prfloat (I.to_float I.minus_one, -1.0); + Printf.printf "to_float 2^120\n = %a\n" prfloat (I.to_float p120, ldexp 1.0 120); + Printf.printf "to_float -2^120\n = %a\n" prfloat (I.to_float (I.neg p120), -. (ldexp 1.0 120)); + Printf.printf "to_float (2^120-1)\n = %a\n" prfloat (I.to_float (I.pred p120), ldexp 1.0 120); + Printf.printf "to_float (-2^120+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg p120)), -. (ldexp 1.0 120)); + Printf.printf "to_float 2^63\n = %a\n" prfloat (I.to_float (pow2 63), ldexp 1.0 63); + Printf.printf "to_float -2^63\n = %a\n" prfloat (I.to_float (I.neg (pow2 63)), -. (ldexp 1.0 63)); + Printf.printf "to_float (2^63-1)\n = %a\n" prfloat (I.to_float (I.pred (pow2 63)), ldexp 1.0 63); + Printf.printf "to_float (-2^63-1)\n = %a\n" prfloat (I.to_float (I.pred (I.neg (pow2 63))), -. (ldexp 1.0 63)); + Printf.printf "to_float (-2^63+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg (pow2 63))), -. (ldexp 1.0 63)); + Printf.printf "to_float 2^300\n = %a\n" prfloat (I.to_float p300, ldexp 1.0 300); + Printf.printf "to_float -2^300\n = %a\n" prfloat (I.to_float (I.neg p300), -. (ldexp 1.0 300)); + Printf.printf "to_float (2^300-1)\n = %a\n" prfloat (I.to_float (I.pred p300), ldexp 1.0 300); + Printf.printf "to_float (-2^300+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg p300)), -. (ldexp 1.0 300)); + Printf.printf "of_string 12\n = %a\n" pr (I.of_string "12"); + Printf.printf "of_string 0x12\n = %a\n" pr (I.of_string "0x12"); + Printf.printf "of_string 0b10\n = %a\n" pr (I.of_string "0b10"); + Printf.printf "of_string 0o12\n = %a\n" pr (I.of_string "0o12"); + Printf.printf "of_string -12\n = %a\n" pr (I.of_string "-12"); + Printf.printf "of_string -0x12\n = %a\n" pr (I.of_string "-0x12"); + Printf.printf "of_string -0b10\n = %a\n" pr (I.of_string "-0b10"); + Printf.printf "of_string -0o12\n = %a\n" pr (I.of_string "-0o12"); + Printf.printf "of_string 000123456789012345678901234567890\n = %a\n" pr (I.of_string "000123456789012345678901234567890"); + Printf.printf "2^120 / 2^300 (trunc)\n = %a\n" pr (I.div p120 p300); + Printf.printf "max_int / 2 (trunc)\n = %a\n" pr (I.div maxi p2); + Printf.printf "(2^300+1) / 2^120 (trunc)\n = %a\n" pr (I.div (I.succ p300) p120); + Printf.printf "(-(2^300+1)) / 2^120 (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) p120); + Printf.printf "(2^300+1) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.succ p300) (I.neg p120)); + Printf.printf "(-(2^300+1)) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) (I.neg p120)); + Printf.printf "2^120 / 2^300 (ceil)\n = %a\n" pr (I.cdiv p120 p300); + Printf.printf "max_int / 2 (ceil)\n = %a\n" pr (I.cdiv maxi p2); + Printf.printf "(2^300+1) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) p120); + Printf.printf "(-(2^300+1)) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) p120); + Printf.printf "(2^300+1) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) (I.neg p120)); + Printf.printf "(-(2^300+1)) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) (I.neg p120)); + Printf.printf "2^120 / 2^300 (floor)\n = %a\n" pr (I.fdiv p120 p300); + Printf.printf "max_int / 2 (floor)\n = %a\n" pr (I.fdiv maxi p2); + Printf.printf "(2^300+1) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.succ p300) p120); + Printf.printf "(-(2^300+1)) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) p120); + Printf.printf "(2^300+1) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.succ p300) (I.neg p120)); + Printf.printf "(-(2^300+1)) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) (I.neg p120)); + Printf.printf "2^120 %% 2^300\n = %a\n" pr (I.rem p120 p300); + Printf.printf "max_int %% 2\n = %a\n" pr (I.rem maxi p2); + Printf.printf "(2^300+1) %% 2^120\n = %a\n" pr (I.rem (I.succ p300) p120); + Printf.printf "(-(2^300+1)) %% 2^120\n = %a\n" pr (I.rem (I.neg (I.succ p300)) p120); + Printf.printf "(2^300+1) %% (-(2^120))\n = %a\n" pr (I.rem (I.succ p300) (I.neg p120)); + Printf.printf "(-(2^300+1)) %% (-(2^120))\n = %a\n" pr (I.rem (I.neg (I.succ p300)) (I.neg p120)); + Printf.printf "2^120 /,%% 2^300\n = %a\n" pr2 (I.div_rem p120 p300); + Printf.printf "max_int /,%% 2\n = %a\n" pr2 (I.div_rem maxi p2); + Printf.printf "(2^300+1) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.succ p300) p120); + Printf.printf "(-(2^300+1)) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) p120); + Printf.printf "(2^300+1) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.succ p300) (I.neg p120)); + Printf.printf "(-(2^300+1)) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) (I.neg p120)); + Printf.printf "1 & 2\n = %a\n" pr (I.logand I.one p2); + Printf.printf "1 & 2^300\n = %a\n" pr (I.logand I.one p300); + Printf.printf "2^120 & 2^300\n = %a\n" pr (I.logand p120 p300); + Printf.printf "2^300 & 2^120\n = %a\n" pr (I.logand p300 p120); + Printf.printf "2^300 & 2^300\n = %a\n" pr (I.logand p300 p300); + Printf.printf "2^300 & 0\n = %a\n" pr (I.logand p300 I.zero); + Printf.printf "-2^120 & 2^300\n = %a\n" pr (I.logand (I.neg p120) p300); + Printf.printf " 2^120 & -2^300\n = %a\n" pr (I.logand p120 (I.neg p300)); + Printf.printf "-2^120 & -2^300\n = %a\n" pr (I.logand (I.neg p120) (I.neg p300)); + Printf.printf "-2^300 & 2^120\n = %a\n" pr (I.logand (I.neg p300) p120); + Printf.printf " 2^300 & -2^120\n = %a\n" pr (I.logand p300 (I.neg p120)); + Printf.printf "-2^300 & -2^120\n = %a\n" pr (I.logand (I.neg p300) (I.neg p120)); + Printf.printf "1 | 2\n = %a\n" pr (I.logor I.one p2); + Printf.printf "1 | 2^300\n = %a\n" pr (I.logor I.one p300); + Printf.printf "2^120 | 2^300\n = %a\n" pr (I.logor p120 p300); + Printf.printf "2^300 | 2^120\n = %a\n" pr (I.logor p300 p120); + Printf.printf "2^300 | 2^300\n = %a\n" pr (I.logor p300 p300); + Printf.printf "2^300 | 0\n = %a\n" pr (I.logor p300 I.zero); + Printf.printf "-2^120 | 2^300\n = %a\n" pr (I.logor (I.neg p120) p300); + Printf.printf " 2^120 | -2^300\n = %a\n" pr (I.logor p120 (I.neg p300)); + Printf.printf "-2^120 | -2^300\n = %a\n" pr (I.logor (I.neg p120) (I.neg p300)); + Printf.printf "-2^300 | 2^120\n = %a\n" pr (I.logor (I.neg p300) p120); + Printf.printf " 2^300 | -2^120\n = %a\n" pr (I.logor p300 (I.neg p120)); + Printf.printf "-2^300 | -2^120\n = %a\n" pr (I.logor (I.neg p300) (I.neg p120)); + Printf.printf "1 ^ 2\n = %a\n" pr (I.logxor I.one p2); + Printf.printf "1 ^ 2^300\n = %a\n" pr (I.logxor I.one p300); + Printf.printf "2^120 ^ 2^300\n = %a\n" pr (I.logxor p120 p300); + Printf.printf "2^300 ^ 2^120\n = %a\n" pr (I.logxor p300 p120); + Printf.printf "2^300 ^ 2^300\n = %a\n" pr (I.logxor p300 p300); + Printf.printf "2^300 ^ 0\n = %a\n" pr (I.logxor p300 I.zero); + Printf.printf "-2^120 ^ 2^300\n = %a\n" pr (I.logxor (I.neg p120) p300); + Printf.printf " 2^120 ^ -2^300\n = %a\n" pr (I.logxor p120 (I.neg p300)); + Printf.printf "-2^120 ^ -2^300\n = %a\n" pr (I.logxor (I.neg p120) (I.neg p300)); + Printf.printf "-2^300 ^ 2^120\n = %a\n" pr (I.logxor (I.neg p300) p120); + Printf.printf " 2^300 ^ -2^120\n = %a\n" pr (I.logxor p300 (I.neg p120)); + Printf.printf "-2^300 ^ -2^120\n = %a\n" pr (I.logxor (I.neg p300) (I.neg p120)); + Printf.printf "~0\n = %a\n" pr (I.lognot I.zero); + Printf.printf "~1\n = %a\n" pr (I.lognot I.one); + Printf.printf "~2\n = %a\n" pr (I.lognot p2); + Printf.printf "~2^300\n = %a\n" pr (I.lognot p300); + Printf.printf "~(-1)\n = %a\n" pr (I.lognot I.minus_one); + Printf.printf "~(-2)\n = %a\n" pr (I.lognot (I.neg p2)); + Printf.printf "~(-(2^300))\n = %a\n" pr (I.lognot (I.neg p300)); + Printf.printf "0 >> 1\n = %a\n" pr (I.shift_right I.zero 1); + Printf.printf "0 >> 100\n = %a\n" pr (I.shift_right I.zero 100); + Printf.printf "2 >> 1\n = %a\n" pr (I.shift_right p2 1); + Printf.printf "2 >> 2\n = %a\n" pr (I.shift_right p2 2); + Printf.printf "2 >> 100\n = %a\n" pr (I.shift_right p2 100); + Printf.printf "2^300 >> 1\n = %a\n" pr (I.shift_right p300 1); + Printf.printf "2^300 >> 2\n = %a\n" pr (I.shift_right p300 2); + Printf.printf "2^300 >> 100\n = %a\n" pr (I.shift_right p300 100); + Printf.printf "2^300 >> 200\n = %a\n" pr (I.shift_right p300 200); + Printf.printf "2^300 >> 300\n = %a\n" pr (I.shift_right p300 300); + Printf.printf "2^300 >> 400\n = %a\n" pr (I.shift_right p300 400); + Printf.printf "-1 >> 1\n = %a\n" pr (I.shift_right I.minus_one 1); + Printf.printf "-2 >> 1\n = %a\n" pr (I.shift_right (I.neg p2) 1); + Printf.printf "-2 >> 2\n = %a\n" pr (I.shift_right (I.neg p2) 2); + Printf.printf "-2 >> 100\n = %a\n" pr (I.shift_right (I.neg p2) 100); + Printf.printf "-2^300 >> 1\n = %a\n" pr (I.shift_right (I.neg p300) 1); + Printf.printf "-2^300 >> 2\n = %a\n" pr (I.shift_right (I.neg p300) 2); + Printf.printf "-2^300 >> 100\n = %a\n" pr (I.shift_right (I.neg p300) 100); + Printf.printf "-2^300 >> 200\n = %a\n" pr (I.shift_right (I.neg p300) 200); + Printf.printf "-2^300 >> 300\n = %a\n" pr (I.shift_right (I.neg p300) 300); + Printf.printf "-2^300 >> 400\n = %a\n" pr (I.shift_right (I.neg p300) 400); + Printf.printf "0 >>0 1\n = %a\n" pr (I.shift_right_trunc I.zero 1); + Printf.printf "0 >>0 100\n = %a\n" pr (I.shift_right_trunc I.zero 100); + Printf.printf "2 >>0 1\n = %a\n" pr (I.shift_right_trunc p2 1); + Printf.printf "2 >>0 2\n = %a\n" pr (I.shift_right_trunc p2 2); + Printf.printf "2 >>0 100\n = %a\n" pr (I.shift_right_trunc p2 100); + Printf.printf "2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc p300 1); + Printf.printf "2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc p300 2); + Printf.printf "2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc p300 100); + Printf.printf "2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc p300 200); + Printf.printf "2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc p300 300); + Printf.printf "2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc p300 400); + Printf.printf "-1 >>0 1\n = %a\n" pr (I.shift_right_trunc I.minus_one 1); + Printf.printf "-2 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 1); + Printf.printf "-2 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 2); + Printf.printf "-2 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 100); + Printf.printf "-2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 1); + Printf.printf "-2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 2); + Printf.printf "-2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 100); + Printf.printf "-2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 200); + Printf.printf "-2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 300); + Printf.printf "-2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 400); + Printf.printf "0 << 1\n = %a\n" pr (I.shift_left I.zero 1); + Printf.printf "0 << 100\n = %a\n" pr (I.shift_left I.zero 100); + Printf.printf "2 << 1\n = %a\n" pr (I.shift_left p2 1); + Printf.printf "2 << 32\n = %a\n" pr (I.shift_left p2 32); + Printf.printf "2 << 64\n = %a\n" pr (I.shift_left p2 64); + Printf.printf "2 << 299\n = %a\n" pr (I.shift_left p2 299); + Printf.printf "2^120 << 1\n = %a\n" pr (I.shift_left p120 1); + Printf.printf "2^120 << 180\n = %a\n" pr (I.shift_left p120 180); + Printf.printf "compare 1 2\n = %i\n" (I.compare I.one p2); + Printf.printf "compare 1 1\n = %i\n" (I.compare I.one I.one); + Printf.printf "compare 2 1\n = %i\n" (I.compare p2 I.one); + Printf.printf "compare 2^300 2^120\n = %i\n" (I.compare p300 p120); + Printf.printf "compare 2^120 2^120\n = %i\n" (I.compare p120 p120); + Printf.printf "compare 2^120 2^300\n = %i\n" (I.compare p120 p300); + Printf.printf "compare 2^121 2^120\n = %i\n" (I.compare p121 p120); + Printf.printf "compare 2^120 2^121\n = %i\n" (I.compare p120 p121); + Printf.printf "compare 2^300 -2^120\n = %i\n" (I.compare p300 (I.neg p120)); + Printf.printf "compare 2^120 -2^120\n = %i\n" (I.compare p120 (I.neg p120)); + Printf.printf "compare 2^120 -2^300\n = %i\n" (I.compare p120 (I.neg p300)); + Printf.printf "compare -2^300 2^120\n = %i\n" (I.compare (I.neg p300) p120); + Printf.printf "compare -2^120 2^120\n = %i\n" (I.compare (I.neg p120) p120); + Printf.printf "compare -2^120 2^300\n = %i\n" (I.compare (I.neg p120) p300); + Printf.printf "compare -2^300 -2^120\n = %i\n" (I.compare (I.neg p300) (I.neg p120)); + Printf.printf "compare -2^120 -2^120\n = %i\n" (I.compare (I.neg p120) (I.neg p120)); + Printf.printf "compare -2^120 -2^300\n = %i\n" (I.compare (I.neg p120) (I.neg p300)); + Printf.printf "equal 1 2\n = %B\n" (I.equal I.one p2); + Printf.printf "equal 1 1\n = %B\n" (I.equal I.one I.one); + Printf.printf "equal 2 1\n = %B\n" (I.equal p2 I.one); + Printf.printf "equal 2^300 2^120\n = %B\n" (I.equal p300 p120); + Printf.printf "equal 2^120 2^120\n = %B\n" (I.equal p120 p120); + Printf.printf "equal 2^120 2^300\n = %B\n" (I.equal p120 p300); + Printf.printf "equal 2^121 2^120\n = %B\n" (I.equal p121 p120); + Printf.printf "equal 2^120 2^121\n = %B\n" (I.equal p120 p121); + Printf.printf "equal 2^120 -2^120\n = %B\n" (I.equal p120 (I.neg p120)); + Printf.printf "equal -2^120 2^120\n = %B\n" (I.equal (I.neg p120) p120); + Printf.printf "equal -2^120 -2^120\n = %B\n" (I.equal (I.neg p120) (I.neg p120)); + Printf.printf "sign 0\n = %i\n" (I.sign I.zero); + Printf.printf "sign 1\n = %i\n" (I.sign I.one); + Printf.printf "sign -1\n = %i\n" (I.sign I.minus_one); + Printf.printf "sign 2^300\n = %i\n" (I.sign p300); + Printf.printf "sign -2^300\n = %i\n" (I.sign (I.neg p300)); + Printf.printf "gcd 0 0\n = %a\n" pr (I.gcd I.zero I.zero); + Printf.printf "gcd 0 -137\n = %a\n" pr (I.gcd (I.of_int 0) (I.of_int (-137))); + Printf.printf "gcd 12 27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int 27)); + Printf.printf "gcd 27 12\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 12)); + Printf.printf "gcd 27 27\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 27)); + Printf.printf "gcd -12 27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int 27)); + Printf.printf "gcd 12 -27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int (-27))); + Printf.printf "gcd -12 -27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int (-27))); + Printf.printf "gcd 0 2^300\n = %a\n" pr (I.gcd (I.of_int 0) p300); + Printf.printf "gcd 2^120 2^300\n = %a\n" pr (I.gcd p120 p300); + Printf.printf "gcd 2^300 2^120\n = %a\n" pr (I.gcd p300 p120); + Printf.printf "gcd 0 -2^300\n = %a\n" pr (I.gcd (I.of_int 0) (I.neg p300)); + Printf.printf "gcd 2^120 -2^300\n = %a\n" pr (I.gcd p120 (I.neg p300)); + Printf.printf "gcd 2^300 -2^120\n = %a\n" pr (I.gcd p300 (I.neg p120)); + Printf.printf "gcd -2^120 2^300\n = %a\n" pr (I.gcd (I.neg p120) p300); + Printf.printf "gcd -2^300 2^120\n = %a\n" pr (I.gcd (I.neg p300) p120); + Printf.printf "gcd -2^120 -2^300\n = %a\n" pr (I.gcd (I.neg p120) (I.neg p300)); + Printf.printf "gcd -2^300 -2^120\n = %a\n" pr (I.gcd (I.neg p300) (I.neg p120)); + Printf.printf "gcdext 12 27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int 27)); + Printf.printf "gcdext 27 12\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 12)); + Printf.printf "gcdext 27 27\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 27)); + Printf.printf "gcdext -12 27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int 27)); + Printf.printf "gcdext 12 -27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int (-27))); + Printf.printf "gcdext -12 -27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int (-27))); + Printf.printf "gcdext 2^120 2^300\n = %a\n" pr3 (I.gcdext p120 p300); + Printf.printf "gcdext 2^300 2^120\n = %a\n" pr3 (I.gcdext p300 p120); + Printf.printf "gcdext 12 0\n = %a\n" pr3 (I.gcdext (I.of_int 12) I.zero); + Printf.printf "gcdext 0 27\n = %a\n" pr3 (I.gcdext I.zero (I.of_int 27)); + Printf.printf "gcdext -12 0\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) I.zero); + Printf.printf "gcdext 0 -27\n = %a\n" pr3 (I.gcdext I.zero (I.of_int (-27))); + Printf.printf "gcdext 2^120 0\n = %a\n" pr3 (I.gcdext p120 I.zero); + Printf.printf "gcdext 0 2^300\n = %a\n" pr3 (I.gcdext I.zero p300); + Printf.printf "gcdext -2^120 0\n = %a\n" pr3 (I.gcdext (I.neg p120) I.zero); + Printf.printf "gcdext 0 -2^300\n = %a\n" pr3 (I.gcdext I.zero (I.neg p300)); + Printf.printf "gcdext 0 0\n = %a\n" pr3 (I.gcdext I.zero I.zero); + Printf.printf "lcm 0 0 = %a\n" pr (I.lcm I.zero I.zero); + Printf.printf "lcm 10 12 = %a\n" pr (I.lcm (I.of_int 10) (I.of_int 12)); + Printf.printf "lcm -10 12 = %a\n" pr (I.lcm (I.of_int (-10)) (I.of_int 12)); + Printf.printf "lcm 10 -12 = %a\n" pr (I.lcm (I.of_int 10) (I.of_int (-12))); + Printf.printf "lcm -10 -12 = %a\n" pr (I.lcm (I.of_int (-10)) (I.of_int (-12))); + Printf.printf "lcm 0 12 = %a\n" pr (I.lcm I.zero (I.of_int 12)); + Printf.printf "lcm 0 -12 = %a\n" pr (I.lcm I.zero (I.of_int (-12))); + Printf.printf "lcm 10 0 = %a\n" pr (I.lcm (I.of_int 10) I.zero); + Printf.printf "lcm -10 0 = %a\n" pr (I.lcm (I.of_int (-10)) I.zero); + Printf.printf "lcm 2^120 2^300 = %a\n" pr (I.lcm p120 p300); + Printf.printf "lcm 2^120 -2^300 = %a\n" pr (I.lcm p120 (I.neg p300)); + Printf.printf "lcm -2^120 2^300 = %a\n" pr (I.lcm (I.neg p120) p300); + Printf.printf "lcm -2^120 -2^300 = %a\n" pr (I.lcm (I.neg p120) (I.neg p300)); + Printf.printf "lcm 2^120 0 = %a\n" pr (I.lcm p120 I.zero); + Printf.printf "lcm -2^120 0 = %a\n" pr (I.lcm (I.neg p120) I.zero); + Printf.printf "is_odd 0\n = %b\n" (I.is_odd (Z.of_int 0)); + Printf.printf "is_odd 1\n = %b\n" (I.is_odd (Z.of_int 1)); + Printf.printf "is_odd 2\n = %b\n" (I.is_odd (Z.of_int 2)); + Printf.printf "is_odd 3\n = %b\n" (I.is_odd (Z.of_int 3)); + Printf.printf "is_odd 2^120\n = %b\n" (I.is_odd p120); + Printf.printf "is_odd 2^120+1\n = %b\n" (I.is_odd (Z.succ p120)); + Printf.printf "is_odd 2^300\n = %b\n" (I.is_odd p300); + Printf.printf "is_odd 2^300+1\n = %b\n" (I.is_odd (Z.succ p300)); + Printf.printf "sqrt 0\n = %a\n" pr (I.sqrt I.zero); + Printf.printf "sqrt 1\n = %a\n" pr (I.sqrt I.one); + Printf.printf "sqrt 2\n = %a\n" pr (I.sqrt p2); + Printf.printf "sqrt 2^120\n = %a\n" pr (I.sqrt p120); + Printf.printf "sqrt 2^121\n = %a\n" pr (I.sqrt p121); + Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero); + Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one); + Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2); + Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120); + Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121); + Printf.printf "popcount 0\n = %i\n" (I.popcount I.zero); + Printf.printf "popcount 1\n = %i\n" (I.popcount I.one); + Printf.printf "popcount 2\n = %i\n" (I.popcount p2); + Printf.printf "popcount max_int32\n = %i\n" (I.popcount maxi32); + Printf.printf "popcount 2^120\n = %i\n" (I.popcount p120); + Printf.printf "popcount (2^120-1)\n = %i\n" (I.popcount (I.pred p120)); + Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero); + Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one); + Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300); + Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120); + Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120)); + Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300); + Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300)); + Printf.printf "divisible 42 7\n = %B\n" (I.divisible (I.of_int 42) (I.of_int 7)); + Printf.printf "divisible 43 7\n = %B\n" (I.divisible (I.of_int 43) (I.of_int 7)); + Printf.printf "divisible 0 0\n = %B\n" (I.divisible I.zero I.zero); + Printf.printf "divisible 0 2^120\n = %B\n" (I.divisible I.zero p120); + Printf.printf "divisible 2 2^120\n = %B\n" (I.divisible (I.of_int 2) p120); + Printf.printf "divisible 2^300 2^120\n = %B\n" (I.divisible p300 p120); + Printf.printf "divisible (2^300-1) 32\n = %B\n" (I.divisible (I.pred p300) (I.of_int 32)); + Printf.printf "divisible min_int (max_int+1)\n = %B\n" (I.divisible (I.of_int min_int) (I.succ (I.of_int max_int))); + Printf.printf "divisible (max_int+1) min_int\n = %B\n" (I.divisible (I.succ (I.of_int max_int)) (I.of_int min_int)); + + (* always 0 when not using custom blocks *) + Printf.printf "hash(2^120)\n = %i\n" (Hashtbl.hash p120); + Printf.printf "hash(2^121)\n = %i\n" (Hashtbl.hash p121); + Printf.printf "hash(2^300)\n = %i\n" (Hashtbl.hash p300); + (* fails if not using custom blocks *) + Printf.printf "2^120 = 2^300\n = %B\n" (p120 = p300); + Printf.printf "2^120 = 2^120\n = %B\n" (p120 = p120); + Printf.printf "2^120 = 2^120\n = %B\n" (p120 = (pow2 120)); + Printf.printf "2^120 > 2^300\n = %B\n" (p120 > p300); + Printf.printf "2^120 < 2^300\n = %B\n" (p120 < p300); + Printf.printf "2^120 = 1\n = %B\n" (p120 = I.one); + (* In OCaml < 3.12.1, the order is not consistent with integers when + comparing mpn_ and ints with OCaml's polymorphic compare operator. + In OCaml >= 3.12.1, the results are consistent. + *) + Printf.printf "2^120 > 1\n = %B\n" (p120 > I.one); + Printf.printf "2^120 < 1\n = %B\n" (p120 < I.one); + Printf.printf "-2^120 > 1\n = %B\n" ((I.neg p120) > I.one); + Printf.printf "-2^120 < 1\n = %B\n" ((I.neg p120) < I.one); + Printf.printf "demarshal 2^120, 2^300, 1\n = %a\n" pr3 + (Marshal.from_string (Marshal.to_string (p120,p300,I.one) []) 0); + Printf.printf "demarshal -2^120, -2^300, -1\n = %a\n" pr3 + (Marshal.from_string (Marshal.to_string (I.neg p120,I.neg p300,I.minus_one) []) 0); + Printf.printf "format %%i 0 = /%s/\n" (I.format "%i" I.zero); + Printf.printf "format %%i 1 = /%s/\n" (I.format "%i" I.one); + Printf.printf "format %%i -1 = /%s/\n" (I.format "%i" I.minus_one); + Printf.printf "format %%i 2^30 = /%s/\n" (I.format "%i" p30); + Printf.printf "format %%i -2^30 = /%s/\n" (I.format "%i" (I.neg p30)); + Printf.printf "format %% i 1 = /%s/\n" (I.format "% i" I.one); + Printf.printf "format %%+i 1 = /%s/\n" (I.format "%+i" I.one); + Printf.printf "format %%x 0 = /%s/\n" (I.format "%x" I.zero); + Printf.printf "format %%x 1 = /%s/\n" (I.format "%x" I.one); + Printf.printf "format %%x -1 = /%s/\n" (I.format "%x" I.minus_one); + Printf.printf "format %%x 2^30 = /%s/\n" (I.format "%x" p30); + Printf.printf "format %%x -2^30 = /%s/\n" (I.format "%x" (I.neg p30)); + Printf.printf "format %%X 0 = /%s/\n" (I.format "%X" I.zero); + Printf.printf "format %%X 1 = /%s/\n" (I.format "%X" I.one); + Printf.printf "format %%X -1 = /%s/\n" (I.format "%X" I.minus_one); + Printf.printf "format %%X 2^30 = /%s/\n" (I.format "%X" p30); + Printf.printf "format %%X -2^30 = /%s/\n" (I.format "%X" (I.neg p30)); + Printf.printf "format %%o 0 = /%s/\n" (I.format "%o" I.zero); + Printf.printf "format %%o 1 = /%s/\n" (I.format "%o" I.one); + Printf.printf "format %%o -1 = /%s/\n" (I.format "%o" I.minus_one); + Printf.printf "format %%o 2^30 = /%s/\n" (I.format "%o" p30); + Printf.printf "format %%o -2^30 = /%s/\n" (I.format "%o" (I.neg p30)); + Printf.printf "format %%10i 0 = /%s/\n" (I.format "%10i" I.zero); + Printf.printf "format %%10i 1 = /%s/\n" (I.format "%10i" I.one); + Printf.printf "format %%10i -1 = /%s/\n" (I.format "%10i" I.minus_one); + Printf.printf "format %%10i 2^30 = /%s/\n" (I.format "%10i" p30); + Printf.printf "format %%10i -2^30 = /%s/\n" (I.format "%10i" (I.neg p30)); + Printf.printf "format %%-10i 0 = /%s/\n" (I.format "%-10i" I.zero); + Printf.printf "format %%-10i 1 = /%s/\n" (I.format "%-10i" I.one); + Printf.printf "format %%-10i -1 = /%s/\n" (I.format "%-10i" I.minus_one); + Printf.printf "format %%-10i 2^30 = /%s/\n" (I.format "%-10i" p30); + Printf.printf "format %%-10i -2^30 = /%s/\n" (I.format "%-10i" (I.neg p30)); + Printf.printf "format %%+10i 0 = /%s/\n" (I.format "%+10i" I.zero); + Printf.printf "format %%+10i 1 = /%s/\n" (I.format "%+10i" I.one); + Printf.printf "format %%+10i -1 = /%s/\n" (I.format "%+10i" I.minus_one); + Printf.printf "format %%+10i 2^30 = /%s/\n" (I.format "%+10i" p30); + Printf.printf "format %%+10i -2^30 = /%s/\n" (I.format "%+10i" (I.neg p30)); + Printf.printf "format %% 10i 0 = /%s/\n" (I.format "% 10i" I.zero); + Printf.printf "format %% 10i 1 = /%s/\n" (I.format "% 10i" I.one); + Printf.printf "format %% 10i -1 = /%s/\n" (I.format "% 10i" I.minus_one); + Printf.printf "format %% 10i 2^30 = /%s/\n" (I.format "% 10i" p30); + Printf.printf "format %% 10i -2^30 = /%s/\n" (I.format "% 10i" (I.neg p30)); + Printf.printf "format %%010i 0 = /%s/\n" (I.format "%010i" I.zero); + Printf.printf "format %%010i 1 = /%s/\n" (I.format "%010i" I.one); + Printf.printf "format %%010i -1 = /%s/\n" (I.format "%010i" I.minus_one); + Printf.printf "format %%010i 2^30 = /%s/\n" (I.format "%010i" p30); + Printf.printf "format %%010i -2^30 = /%s/\n" (I.format "%010i" (I.neg p30)); + Printf.printf "format %%#x 0 = /%s/\n" (I.format "%#x" I.zero); + Printf.printf "format %%#x 1 = /%s/\n" (I.format "%#x" I.one); + Printf.printf "format %%#x -1 = /%s/\n" (I.format "%#x" I.minus_one); + Printf.printf "format %%#x 2^30 = /%s/\n" (I.format "%#x" p30); + Printf.printf "format %%#x -2^30 = /%s/\n" (I.format "%#x" (I.neg p30)); + Printf.printf "format %%#X 0 = /%s/\n" (I.format "%#X" I.zero); + Printf.printf "format %%#X 1 = /%s/\n" (I.format "%#X" I.one); + Printf.printf "format %%#X -1 = /%s/\n" (I.format "%#X" I.minus_one); + Printf.printf "format %%#X 2^30 = /%s/\n" (I.format "%#X" p30); + Printf.printf "format %%#X -2^30 = /%s/\n" (I.format "%#X" (I.neg p30)); + Printf.printf "format %%#o 0 = /%s/\n" (I.format "%#o" I.zero); + Printf.printf "format %%#o 1 = /%s/\n" (I.format "%#o" I.one); + Printf.printf "format %%#o -1 = /%s/\n" (I.format "%#o" I.minus_one); + Printf.printf "format %%#o 2^30 = /%s/\n" (I.format "%#o" p30); + Printf.printf "format %%#o -2^30 = /%s/\n" (I.format "%#o" (I.neg p30)); + Printf.printf "format %%#10x 0 = /%s/\n" (I.format "%#10x" I.zero); + Printf.printf "format %%#10x 1 = /%s/\n" (I.format "%#10x" I.one); + Printf.printf "format %%#10x -1 = /%s/\n" (I.format "%#10x" I.minus_one); + Printf.printf "format %%#10x 2^30 = /%s/\n" (I.format "%#10x" p30); + Printf.printf "format %%#10x -2^30 = /%s/\n" (I.format "%#10x" (I.neg p30)); + Printf.printf "format %%#10X 0 = /%s/\n" (I.format "%#10X" I.zero); + Printf.printf "format %%#10X 1 = /%s/\n" (I.format "%#10X" I.one); + Printf.printf "format %%#10X -1 = /%s/\n" (I.format "%#10X" I.minus_one); + Printf.printf "format %%#10X 2^30 = /%s/\n" (I.format "%#10X" p30); + Printf.printf "format %%#10X -2^30 = /%s/\n" (I.format "%#10X" (I.neg p30)); + Printf.printf "format %%#10o 0 = /%s/\n" (I.format "%#10o" I.zero); + Printf.printf "format %%#10o 1 = /%s/\n" (I.format "%#10o" I.one); + Printf.printf "format %%#10o -1 = /%s/\n" (I.format "%#10o" I.minus_one); + Printf.printf "format %%#10o 2^30 = /%s/\n" (I.format "%#10o" p30); + Printf.printf "format %%#10o -2^30 = /%s/\n" (I.format "%#10o" (I.neg p30)); + Printf.printf "format %%#-10x 0 = /%s/\n" (I.format "%#-10x" I.zero); + Printf.printf "format %%#-10x 1 = /%s/\n" (I.format "%#-10x" I.one); + Printf.printf "format %%#-10x -1 = /%s/\n" (I.format "%#-10x" I.minus_one); + Printf.printf "format %%#-10x 2^30 = /%s/\n" (I.format "%#-10x" p30); + Printf.printf "format %%#-10x -2^30 = /%s/\n" (I.format "%#-10x" (I.neg p30)); + Printf.printf "format %%#-10X 0 = /%s/\n" (I.format "%#-10X" I.zero); + Printf.printf "format %%#-10X 1 = /%s/\n" (I.format "%#-10X" I.one); + Printf.printf "format %%#-10X -1 = /%s/\n" (I.format "%#-10X" I.minus_one); + Printf.printf "format %%#-10X 2^30 = /%s/\n" (I.format "%#-10X" p30); + Printf.printf "format %%#-10X -2^30 = /%s/\n" (I.format "%#-10X" (I.neg p30)); + Printf.printf "format %%#-10o 0 = /%s/\n" (I.format "%#-10o" I.zero); + Printf.printf "format %%#-10o 1 = /%s/\n" (I.format "%#-10o" I.one); + Printf.printf "format %%#-10o -1 = /%s/\n" (I.format "%#-10o" I.minus_one); + Printf.printf "format %%#-10o 2^30 = /%s/\n" (I.format "%#-10o" p30); + Printf.printf "format %%#-10o -2^30 = /%s/\n" (I.format "%#-10o" (I.neg p30)); + + let extract_testdata = + let a = I.of_int 42 + and b = I.of_int (-42) + and c = I.of_string "3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701" in + [a,0,1; a,0,5; a,0,32; a,0,64; + a,1,1; a,1,5; a,1,32; a,1,63; a,1,64; a,1,127; a,1,128; + a,69,12; + b,0,1; b,0,5; b,0,32; b,0,64; + b,1,1; b,1,5; b,1,32; b,1,63; b,1,64; b,1,127; b,1,128; + b,69,12; + c,0,1; c,0,64; c,128,1; c,128,5; c,131,32; c,175,63; c,277,123] in + List.iter chk_extract extract_testdata; + List.iter chk_signed_extract extract_testdata; + + chk_bits I.zero; + chk_bits p2; + chk_bits (I.neg p2); + chk_bits p30; + chk_bits (I.neg p30); + chk_bits p62; + chk_bits (I.neg p62); + chk_bits p300; + chk_bits p120; + chk_bits p121; + chk_bits maxi; + chk_bits mini; + chk_bits maxi32; + chk_bits mini32; + chk_bits maxi64; + chk_bits mini64; + chk_bits maxni; + chk_bits minni; + + List.iter chk_testbit [ + I.zero; I.one; I.of_int (-42); + I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986"; + I.neg (I.shift_left (I.of_int 123456) 64); + ]; + + List.iter chk_numbits_tz [ + I.zero; I.one; I.of_int (-42); + I.shift_left (I.of_int 9999) 77; + I.neg (I.shift_left (I.of_int 123456) 64); + ]; + + Printf.printf "random_bits 45 = %a\n" + pr (I.random_bits_gen ~fill:pr_bytes 45); + Printf.printf "random_bits 45 = %a\n" + pr (I.random_bits_gen ~fill:pr_bytes 45); + Printf.printf "random_bits 12 = %a\n" + pr (I.random_bits_gen ~fill:pr_bytes 12); + Printf.printf "random_int 123456 = %a\n" + pr (I.random_int_gen ~fill:pr_bytes (I.of_int 123456)); + Printf.printf "random_int 9999999 = %a\n" + pr (I.random_int_gen ~fill:pr_bytes (I.of_int 9999999)); + + () + + +(* testing Q *) + +(* gcd extended to: gcd x 0 = gcd 0 x = 0 *) +let gcd2 a b = + if Z.sign a = 0 then b + else if Z.sign b = 0 then a + else Z.gcd a b + +(* check invariant *) +let check x = + assert (Z.sign x.Q.den >= 0); + assert (Z.compare (gcd2 x.Q.num x.Q.den) Z.one <= 0) + + +let t_list = [Q.zero;Q.one;Q.minus_one;Q.inf;Q.minus_inf;Q.undef] + +let test1 msg op = + List.iter + (fun x -> + let r = op x in + check r; + Printf.printf "%s %s = %s\n" msg (Q.to_string x) (Q.to_string r) + ) t_list + +let test2 msg op = + List.iter + (fun x -> + List.iter + (fun y -> + let r = op x y in + check r; + Printf.printf "%s %s %s = %s\n" (Q.to_string x) msg (Q.to_string y) (Q.to_string r) + ) t_list + ) t_list + +let test_Q () = + let _ = List.iter check t_list in + let _ = test1 "-" Q.neg in + let _ = test1 "1/" Q.inv in + let _ = test1 "abs" Q.abs in + let _ = test2 "+" Q.add in + let _ = test2 "-" Q.sub in + let _ = test2 "*" Q.mul in + let _ = test2 "/" Q.div in + let _ = test2 "* 1/" (fun a b -> Q.mul a (Q.inv b)) in + let _ = test1 "mul_2exp (1) " (fun a -> Q.mul_2exp a 1) in + let _ = test1 "mul_2exp (2) " (fun a -> Q.mul_2exp a 2) in + let _ = test1 "div_2exp (1) " (fun a -> Q.div_2exp a 1) in + let _ = test1 "div_2exp (2) " (fun a -> Q.div_2exp a 2) in + (* check simple identitites *) + List.iter + (fun x -> + assert (0 = Q.compare x (Q.div_2exp (Q.mul_2exp x 2) 2)); + assert (0 = Q.compare x (Q.mul_2exp (Q.div_2exp x 2) 2)); + List.iter + (fun y -> + Printf.printf "identity checking %s %s\n" (Q.to_string x) (Q.to_string y); + assert (0 = Q.compare (Q.add x y) (Q.add y x)); + assert (0 = Q.compare (Q.sub x y) (Q.neg (Q.sub y x))); + assert (0 = Q.compare (Q.sub x y) (Q.add x (Q.neg y))); + assert (0 = Q.compare (Q.mul x y) (Q.mul y x)); + assert (0 = Q.compare (Q.div x y) (Q.mul x (Q.inv y))); + ) t_list + ) t_list; + assert (Q.compare Q.undef Q.undef = 0); + assert (not (Q.equal Q.undef Q.undef)); + assert (not (Q.lt Q.undef Q.undef)); + assert (not (Q.leq Q.undef Q.undef)); + assert (not (Q.gt Q.undef Q.undef)); + assert (not (Q.geq Q.undef Q.undef)) + + +(* main *) + +let _ = test_Z() +let _ = test_Q() diff --git a/unikernel/duniverse/Zarith/tests/zq.output32 b/unikernel/duniverse/Zarith/tests/zq.output32 new file mode 100644 index 00000000..d0912dd6 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/zq.output32 @@ -0,0 +1,1452 @@ +0 + = 0 +1 + = 1 +-1 + = -1 +42 + = 42 +1+1 + = 2 +1-1 + = 0 +- 1 + = -1 +0-1 + = -1 +max_int + = 1073741823 +min_int + = -1073741824 +-max_int + = -1073741823 +-min_int + = 1073741824 +2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 + = 1329227995784915872903807060280344576 +2^300+2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^300+(-(2^120)) + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120-2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-(2^120)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-(2^120)-2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^300 + = 0 +2^121 + = 2658455991569831745807614120560689152 +2^121+2^120 + = 3987683987354747618711421180841033728 +2^121-2^120 + = 1329227995784915872903807060280344576 +2^121+(-(2^120)) + = 1329227995784915872903807060280344576 +2^120-2^121 + = -1329227995784915872903807060280344576 +2^120+(-(2^121)) + = -1329227995784915872903807060280344576 +-(2^120)+(-(2^121)) + = -3987683987354747618711421180841033728 +-(2^120)-2^121 + = -3987683987354747618711421180841033728 +2^121+0 + = 2658455991569831745807614120560689152 +2^121-0 + = 2658455991569831745807614120560689152 +0+2^121 + = 2658455991569831745807614120560689152 +0-2^121 + = -2658455991569831745807614120560689152 +2^300+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^300-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300+(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300-(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)-(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +max_int+1 + = 1073741824 +min_int-1 + = -1073741825 +-max_int-1 + = -1073741824 +-min_int-1 + = 1073741823 +5! = 120 +12! = 479001600 +15! = 1307674368000 +20! = 2432902008176640000 +25! = 15511210043330985984000000 +50! = 30414093201713378043612608166064768844377641568960512000000000000 +2^300*2^120 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*2^300 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^300*(-(2^120)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*(-(2^300)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +-(2^120)*(-(2^300)) + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^121*2^120 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^120*2^121 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^121*0 + = 0 +0*2^121 + = 0 +2^300*1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300*(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(2^30) + = 1073741824 +1*(2^62) + = 4611686018427387904 +(2^30)*(2^30) + = 1152921504606846976 +(2^62)*(2^62) + = 21267647932558653966460912964485513216 +0+1 + = 1 +1+1 + = 2 +-1+1 + = 0 +2+1 + = 3 +-2+1 + = -1 +(2^300)+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0-1 + = -1 +1-1 + = 0 +-1-1 + = -2 +2-1 + = 1 +-2-1 + = -3 +(2^300)-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +max_int+1 + = 1073741824 +min_int-1 + = -1073741825 +-max_int-1 + = -1073741824 +-min_int-1 + = 1073741823 +abs(0) + = 0 +abs(1) + = 1 +abs(-1) + = 1 +abs(min_int) + = 1073741824 +abs(2^300) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +abs(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +max_nativeint + = 2147483647 +max_int32 + = 2147483647 +max_int64 + = 9223372036854775807 +to_int 1 + = true,1 +to_int max_int + = true,1073741823 +to_int max_nativeint + = false,ovf +to_int max_int32 + = false,ovf +to_int max_int64 + = false,ovf +to_int32 1 + = true,1 +to_int32 max_int + = true,1073741823 +to_int32 max_nativeint + = true,2147483647 +to_int32 max_int32 + = true,2147483647 +to_int32 max_int64 + = false,ovf +to_int64 1 + = true,1 +to_int64 max_int + = true,1073741823 +to_int64 max_nativeint + = true,2147483647 +to_int64 max_int32 + = true,2147483647 +to_int64 max_int64 + = true,9223372036854775807 +to_nativeint 1 + = true,1 +to_nativeint max_int + = true,1073741823 +to_nativeint max_nativeint + = true,2147483647 +to_nativeint max_int32 + = true,2147483647 +to_nativeint max_int64 + = false,ovf +to_int -min_int + = false,ovf +to_int -min_nativeint + = false,ovf +to_int -min_int32 + = false,ovf +to_int -min_int64 + = false,ovf +to_int32 -min_int + = true,1073741824 +to_int32 -min_nativeint + = false,ovf +to_int32 -min_int32 + = false,ovf +to_int32 -min_int64 + = false,ovf +to_int64 -min_int + = true,1073741824 +to_int64 -min_nativeint + = true,2147483648 +to_int64 -min_int32 + = true,2147483648 +to_int64 -min_int64 + = false,ovf +to_nativeint -min_int + = true,1073741824 +to_nativeint -min_nativeint + = false,ovf +to_nativeint -min_int32 + = false,ovf +to_nativeint -min_int64 + = false,ovf +to_int32_unsigned 1 + = true,1 +to_int32_unsigned -1 + = false,ovf +to_int32_unsigned max_int + = true,1073741823 +to_int32_unsigned max_nativeint + = true,2147483647 +to_int32_unsigned max_int32 + = true,2147483647 +to_int32_unsigned 2max_int32 + = true,-2 +to_int32_unsigned 3max_int32 + = false,ovf +to_int32_unsigned max_int64 + = false,ovf +to_int64_unsigned 1 + = true,1 +to_int64_unsigned -1 + = false,ovf +to_int64_unsigned max_int + = true,1073741823 +to_int64_unsigned max_nativeint + = true,2147483647 +to_int64_unsigned max_int32 + = true,2147483647 +to_int64_unsigned max_int64 + = true,9223372036854775807 +to_int64_unsigned 2max_int64 + = true,-2 +to_int64_unsigned 3max_int64 + = false,ovf +to_nativeint_unsigned 1 + = true,1 +to_nativeint_unsigned -1 + = false,ovf +to_nativeint_unsigned max_int + = true,1073741823 +to_nativeint_unsigned max_nativeint + = true,2147483647 +to_nativeint_unsigned 2max_nativeint + = true,-2 +to_nativeint_unsigned max_int32 + = true,2147483647 +to_nativeint_unsigned max_int64 + = false,ovf +to_nativeint_unsigned 2max_int64 + = false,ovf +to_nativeint_unsigned 3max_int64 + = false,ovf +of_int32_unsigned -1 + = 4294967295 +of_int64_unsigned -1 + = 18446744073709551615 +of_nativeint_unsigned -1 + = 4294967295 +of_float 1. + = 1 +of_float -1. + = -1 +of_float pi + = 3 +of_float 2^30 + = 1073741824 +of_float 2^31 + = 2147483648 +of_float 2^32 + = 4294967296 +of_float 2^33 + = 8589934592 +of_float -2^30 + = -1073741824 +of_float -2^31 + = -2147483648 +of_float -2^32 + = -4294967296 +of_float -2^33 + = -8589934592 +of_float 2^61 + = 2305843009213693952 +of_float 2^62 + = 4611686018427387904 +of_float 2^63 + = 9223372036854775808 +of_float 2^64 + = 18446744073709551616 +of_float 2^65 + = 36893488147419103232 +of_float -2^61 + = -2305843009213693952 +of_float -2^62 + = -4611686018427387904 +of_float -2^63 + = -9223372036854775808 +of_float -2^64 + = -18446744073709551616 +of_float -2^65 + = -36893488147419103232 +of_float 2^120 + = 1329227995784915872903807060280344576 +of_float 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float -2^120 + = -1329227995784915872903807060280344576 +of_float -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float 0.5 + = 0 +of_float -0.5 + = 0 +of_float 200.5 + = 200 +of_float -200.5 + = -200 +to_float 0 + = OK +to_float 1 + = OK +to_float -1 + = OK +to_float 2^120 + = OK +to_float -2^120 + = OK +to_float (2^120-1) + = OK +to_float (-2^120+1) + = OK +to_float 2^63 + = OK +to_float -2^63 + = OK +to_float (2^63-1) + = OK +to_float (-2^63-1) + = OK +to_float (-2^63+1) + = OK +to_float 2^300 + = OK +to_float -2^300 + = OK +to_float (2^300-1) + = OK +to_float (-2^300+1) + = OK +of_string 12 + = 12 +of_string 0x12 + = 18 +of_string 0b10 + = 2 +of_string 0o12 + = 10 +of_string -12 + = -12 +of_string -0x12 + = -18 +of_string -0b10 + = -2 +of_string -0o12 + = -10 +of_string 000123456789012345678901234567890 + = 123456789012345678901234567890 +2^120 / 2^300 (trunc) + = 0 +max_int / 2 (trunc) + = 536870911 +(2^300+1) / 2^120 (trunc) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (trunc) + = 1532495540865888858358347027150309183618739122183602176 +2^120 / 2^300 (ceil) + = 1 +max_int / 2 (ceil) + = 536870912 +(2^300+1) / 2^120 (ceil) + = 1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / 2^120 (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (ceil) + = 1532495540865888858358347027150309183618739122183602177 +2^120 / 2^300 (floor) + = 0 +max_int / 2 (floor) + = 536870911 +(2^300+1) / 2^120 (floor) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (floor) + = -1532495540865888858358347027150309183618739122183602177 +(2^300+1) / (-(2^120)) (floor) + = -1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / (-(2^120)) (floor) + = 1532495540865888858358347027150309183618739122183602176 +2^120 % 2^300 + = 1329227995784915872903807060280344576 +max_int % 2 + = 1 +(2^300+1) % 2^120 + = 1 +(-(2^300+1)) % 2^120 + = -1 +(2^300+1) % (-(2^120)) + = 1 +(-(2^300+1)) % (-(2^120)) + = -1 +2^120 /,% 2^300 + = 0, 1329227995784915872903807060280344576 +max_int /,% 2 + = 536870911, 1 +(2^300+1) /,% 2^120 + = 1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% 2^120 + = -1532495540865888858358347027150309183618739122183602176, -1 +(2^300+1) /,% (-(2^120)) + = -1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% (-(2^120)) + = 1532495540865888858358347027150309183618739122183602176, -1 +1 & 2 + = 0 +1 & 2^300 + = 0 +2^120 & 2^300 + = 0 +2^300 & 2^120 + = 0 +2^300 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 & 0 + = 0 +-2^120 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + 2^120 & -2^300 + = 0 +-2^120 & -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & 2^120 + = 0 + 2^300 & -2^120 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & -2^120 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1 | 2 + = 3 +1 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 | 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 | 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 | 2^300 + = -1329227995784915872903807060280344576 + 2^120 | -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 | -2^300 + = -1329227995784915872903807060280344576 +-2^300 | 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 | -2^120 + = -1329227995784915872903807060280344576 +-2^300 | -2^120 + = -1329227995784915872903807060280344576 +1 ^ 2 + = 3 +1 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^300 + = 0 +2^300 ^ 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 ^ 2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 + 2^120 ^ -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 ^ -2^300 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^300 ^ 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 ^ -2^120 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-2^300 ^ -2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +~0 + = -1 +~1 + = -2 +~2 + = -3 +~2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +~(-1) + = 0 +~(-2) + = 1 +~(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0 >> 1 + = 0 +0 >> 100 + = 0 +2 >> 1 + = 1 +2 >> 2 + = 0 +2 >> 100 + = 0 +2^300 >> 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >> 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >> 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >> 200 + = 1267650600228229401496703205376 +2^300 >> 300 + = 1 +2^300 >> 400 + = 0 +-1 >> 1 + = -1 +-2 >> 1 + = -1 +-2 >> 2 + = -1 +-2 >> 100 + = -1 +-2^300 >> 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >> 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >> 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >> 200 + = -1267650600228229401496703205376 +-2^300 >> 300 + = -1 +-2^300 >> 400 + = -1 +0 >>0 1 + = 0 +0 >>0 100 + = 0 +2 >>0 1 + = 1 +2 >>0 2 + = 0 +2 >>0 100 + = 0 +2^300 >>0 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >>0 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >>0 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >>0 200 + = 1267650600228229401496703205376 +2^300 >>0 300 + = 1 +2^300 >>0 400 + = 0 +-1 >>0 1 + = 0 +-2 >>0 1 + = -1 +-2 >>0 2 + = 0 +-2 >>0 100 + = 0 +-2^300 >>0 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >>0 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >>0 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >>0 200 + = -1267650600228229401496703205376 +-2^300 >>0 300 + = -1 +-2^300 >>0 400 + = 0 +0 << 1 + = 0 +0 << 100 + = 0 +2 << 1 + = 4 +2 << 32 + = 8589934592 +2 << 64 + = 36893488147419103232 +2 << 299 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 << 1 + = 2658455991569831745807614120560689152 +2^120 << 180 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +compare 1 2 + = -1 +compare 1 1 + = 0 +compare 2 1 + = 1 +compare 2^300 2^120 + = 1 +compare 2^120 2^120 + = 0 +compare 2^120 2^300 + = -1 +compare 2^121 2^120 + = 1 +compare 2^120 2^121 + = -1 +compare 2^300 -2^120 + = 1 +compare 2^120 -2^120 + = 1 +compare 2^120 -2^300 + = 1 +compare -2^300 2^120 + = -1 +compare -2^120 2^120 + = -1 +compare -2^120 2^300 + = -1 +compare -2^300 -2^120 + = -1 +compare -2^120 -2^120 + = 0 +compare -2^120 -2^300 + = 1 +equal 1 2 + = false +equal 1 1 + = true +equal 2 1 + = false +equal 2^300 2^120 + = false +equal 2^120 2^120 + = true +equal 2^120 2^300 + = false +equal 2^121 2^120 + = false +equal 2^120 2^121 + = false +equal 2^120 -2^120 + = false +equal -2^120 2^120 + = false +equal -2^120 -2^120 + = true +sign 0 + = 0 +sign 1 + = 1 +sign -1 + = -1 +sign 2^300 + = 1 +sign -2^300 + = -1 +gcd 0 0 + = 0 +gcd 0 -137 + = 137 +gcd 12 27 + = 3 +gcd 27 12 + = 3 +gcd 27 27 + = 27 +gcd -12 27 + = 3 +gcd 12 -27 + = 3 +gcd -12 -27 + = 3 +gcd 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 2^120 + = 1329227995784915872903807060280344576 +gcd 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 -2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 -2^120 + = 1329227995784915872903807060280344576 +gcdext 12 27 + = 3, -2, 1 +gcdext 27 12 + = 3, 1, -2 +gcdext 27 27 + = 27, 0, 1 +gcdext -12 27 + = 3, 2, 1 +gcdext 12 -27 + = 3, -2, -1 +gcdext -12 -27 + = 3, 2, -1 +gcdext 2^120 2^300 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 2^300 2^120 + = 1329227995784915872903807060280344576, 0, 1 +gcdext 12 0 + = 12, 1, 0 +gcdext 0 27 + = 27, 0, 1 +gcdext -12 0 + = 12, -1, 0 +gcdext 0 -27 + = 27, 0, -1 +gcdext 2^120 0 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1 +gcdext -2^120 0 + = 1329227995784915872903807060280344576, -1, 0 +gcdext 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1 +gcdext 0 0 + = 0, 0, 0 +lcm 0 0 = 0 +lcm 10 12 = 60 +lcm -10 12 = 60 +lcm 10 -12 = 60 +lcm -10 -12 = 60 +lcm 0 12 = 0 +lcm 0 -12 = 0 +lcm 10 0 = 0 +lcm -10 0 = 0 +lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 0 = 0 +lcm -2^120 0 = 0 +is_odd 0 + = false +is_odd 1 + = true +is_odd 2 + = false +is_odd 3 + = true +is_odd 2^120 + = false +is_odd 2^120+1 + = true +is_odd 2^300 + = false +is_odd 2^300+1 + = true +sqrt 0 + = 0 +sqrt 1 + = 1 +sqrt 2 + = 1 +sqrt 2^120 + = 1152921504606846976 +sqrt 2^121 + = 1630477228166597776 +sqrt_rem 0 + = 0, 0 +sqrt_rem 1 + = 1, 0 +sqrt_rem 2 + = 1, 1 +sqrt_rem 2^120 + = 1152921504606846976, 0 +sqrt_rem 2^121 + = 1630477228166597776, 1772969445592542976 +popcount 0 + = 0 +popcount 1 + = 1 +popcount 2 + = 1 +popcount max_int32 + = 31 +popcount 2^120 + = 1 +popcount (2^120-1) + = 120 +hamdist 0 0 + = 0 +hamdist 0 1 + = 1 +hamdist 0 2^300 + = 1 +hamdist 2^120 2^120 + = 0 +hamdist 2^120 (2^120-1) + = 121 +hamdist 2^120 2^300 + = 2 +hamdist (2^120-1) (2^300-1) + = 180 +divisible 42 7 + = true +divisible 43 7 + = false +divisible 0 0 + = true +divisible 0 2^120 + = true +divisible 2 2^120 + = false +divisible 2^300 2^120 + = true +divisible (2^300-1) 32 + = false +divisible min_int (max_int+1) + = true +divisible (max_int+1) min_int + = true +hash(2^120) + = 691199303 +hash(2^121) + = 382412560 +hash(2^300) + = 61759632 +2^120 = 2^300 + = false +2^120 = 2^120 + = true +2^120 = 2^120 + = true +2^120 > 2^300 + = false +2^120 < 2^300 + = true +2^120 = 1 + = false +2^120 > 1 + = true +2^120 < 1 + = false +-2^120 > 1 + = false +-2^120 < 1 + = true +demarshal 2^120, 2^300, 1 + = 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1 +demarshal -2^120, -2^300, -1 + = -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1 +format %i 0 = /0/ +format %i 1 = /1/ +format %i -1 = /-1/ +format %i 2^30 = /1073741824/ +format %i -2^30 = /-1073741824/ +format % i 1 = / 1/ +format %+i 1 = /+1/ +format %x 0 = /0/ +format %x 1 = /1/ +format %x -1 = /-1/ +format %x 2^30 = /40000000/ +format %x -2^30 = /-40000000/ +format %X 0 = /0/ +format %X 1 = /1/ +format %X -1 = /-1/ +format %X 2^30 = /40000000/ +format %X -2^30 = /-40000000/ +format %o 0 = /0/ +format %o 1 = /1/ +format %o -1 = /-1/ +format %o 2^30 = /10000000000/ +format %o -2^30 = /-10000000000/ +format %10i 0 = / 0/ +format %10i 1 = / 1/ +format %10i -1 = / -1/ +format %10i 2^30 = /1073741824/ +format %10i -2^30 = /-1073741824/ +format %-10i 0 = /0 / +format %-10i 1 = /1 / +format %-10i -1 = /-1 / +format %-10i 2^30 = /1073741824/ +format %-10i -2^30 = /-1073741824/ +format %+10i 0 = / +0/ +format %+10i 1 = / +1/ +format %+10i -1 = / -1/ +format %+10i 2^30 = /+1073741824/ +format %+10i -2^30 = /-1073741824/ +format % 10i 0 = / 0/ +format % 10i 1 = / 1/ +format % 10i -1 = / -1/ +format % 10i 2^30 = / 1073741824/ +format % 10i -2^30 = /-1073741824/ +format %010i 0 = /0000000000/ +format %010i 1 = /0000000001/ +format %010i -1 = /-000000001/ +format %010i 2^30 = /1073741824/ +format %010i -2^30 = /-1073741824/ +format %#x 0 = /0x0/ +format %#x 1 = /0x1/ +format %#x -1 = /-0x1/ +format %#x 2^30 = /0x40000000/ +format %#x -2^30 = /-0x40000000/ +format %#X 0 = /0X0/ +format %#X 1 = /0X1/ +format %#X -1 = /-0X1/ +format %#X 2^30 = /0X40000000/ +format %#X -2^30 = /-0X40000000/ +format %#o 0 = /0o0/ +format %#o 1 = /0o1/ +format %#o -1 = /-0o1/ +format %#o 2^30 = /0o10000000000/ +format %#o -2^30 = /-0o10000000000/ +format %#10x 0 = / 0x0/ +format %#10x 1 = / 0x1/ +format %#10x -1 = / -0x1/ +format %#10x 2^30 = /0x40000000/ +format %#10x -2^30 = /-0x40000000/ +format %#10X 0 = / 0X0/ +format %#10X 1 = / 0X1/ +format %#10X -1 = / -0X1/ +format %#10X 2^30 = /0X40000000/ +format %#10X -2^30 = /-0X40000000/ +format %#10o 0 = / 0o0/ +format %#10o 1 = / 0o1/ +format %#10o -1 = / -0o1/ +format %#10o 2^30 = /0o10000000000/ +format %#10o -2^30 = /-0o10000000000/ +format %#-10x 0 = /0x0 / +format %#-10x 1 = /0x1 / +format %#-10x -1 = /-0x1 / +format %#-10x 2^30 = /0x40000000/ +format %#-10x -2^30 = /-0x40000000/ +format %#-10X 0 = /0X0 / +format %#-10X 1 = /0X1 / +format %#-10X -1 = /-0X1 / +format %#-10X 2^30 = /0X40000000/ +format %#-10X -2^30 = /-0X40000000/ +format %#-10o 0 = /0o0 / +format %#-10o 1 = /0o1 / +format %#-10o -1 = /-0o1 / +format %#-10o 2^30 = /0o10000000000/ +format %#-10o -2^30 = /-0o10000000000/ +extract 42 0 1 = 0 (passed) +extract 42 0 5 = 10 (passed) +extract 42 0 32 = 42 (passed) +extract 42 0 64 = 42 (passed) +extract 42 1 1 = 1 (passed) +extract 42 1 5 = 21 (passed) +extract 42 1 32 = 21 (passed) +extract 42 1 63 = 21 (passed) +extract 42 1 64 = 21 (passed) +extract 42 1 127 = 21 (passed) +extract 42 1 128 = 21 (passed) +extract 42 69 12 = 0 (passed) +extract -42 0 1 = 0 (passed) +extract -42 0 5 = 22 (passed) +extract -42 0 32 = 4294967254 (passed) +extract -42 0 64 = 18446744073709551574 (passed) +extract -42 1 1 = 1 (passed) +extract -42 1 5 = 11 (passed) +extract -42 1 32 = 4294967275 (passed) +extract -42 1 63 = 9223372036854775787 (passed) +extract -42 1 64 = 18446744073709551595 (passed) +extract -42 1 127 = 170141183460469231731687303715884105707 (passed) +extract -42 1 128 = 340282366920938463463374607431768211435 (passed) +extract -42 69 12 = 4095 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = 15536040655639606317 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = 19 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = 2516587394 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = 7690089207107781587 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = 9888429935207999867003931753264634841 (passed) +signed_extract 42 0 1 = 0 (passed) +signed_extract 42 0 5 = 10 (passed) +signed_extract 42 0 32 = 42 (passed) +signed_extract 42 0 64 = 42 (passed) +signed_extract 42 1 1 = -1 (passed) +signed_extract 42 1 5 = -11 (passed) +signed_extract 42 1 32 = 21 (passed) +signed_extract 42 1 63 = 21 (passed) +signed_extract 42 1 64 = 21 (passed) +signed_extract 42 1 127 = 21 (passed) +signed_extract 42 1 128 = 21 (passed) +signed_extract 42 69 12 = 0 (passed) +signed_extract -42 0 1 = 0 (passed) +signed_extract -42 0 5 = -10 (passed) +signed_extract -42 0 32 = -42 (passed) +signed_extract -42 0 64 = -42 (passed) +signed_extract -42 1 1 = -1 (passed) +signed_extract -42 1 5 = 11 (passed) +signed_extract -42 1 32 = -21 (passed) +signed_extract -42 1 63 = -21 (passed) +signed_extract -42 1 64 = -21 (passed) +signed_extract -42 1 127 = -21 (passed) +signed_extract -42 1 128 = -21 (passed) +signed_extract -42 69 12 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = -2910703418069945299 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = -13 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = -1778379902 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = -1533282829746994221 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = -745394031071327116226524728978121767 (passed) +to_bits 0 + = +marshal round trip 0 + = OK +to_bits 2 + = 02 00 00 00 +marshal round trip 2 + = OK +to_bits -2 + = 02 00 00 00 +marshal round trip -2 + = OK +to_bits 1073741824 + = 00 00 00 40 +marshal round trip 1073741824 + = OK +to_bits -1073741824 + = 00 00 00 40 +marshal round trip -1073741824 + = OK +to_bits 4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip 4611686018427387904 + = OK +to_bits -4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip -4611686018427387904 + = OK +to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 10 00 00 +marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = OK +to_bits 1329227995784915872903807060280344576 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 +marshal round trip 1329227995784915872903807060280344576 + = OK +to_bits 2658455991569831745807614120560689152 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 +marshal round trip 2658455991569831745807614120560689152 + = OK +to_bits 1073741823 + = ff ff ff 3f +marshal round trip 1073741823 + = OK +to_bits -1073741824 + = 00 00 00 40 +marshal round trip -1073741824 + = OK +to_bits 2147483647 + = ff ff ff 7f +marshal round trip 2147483647 + = OK +to_bits -2147483648 + = 00 00 00 80 +marshal round trip -2147483648 + = OK +to_bits 9223372036854775807 + = ff ff ff ff ff ff ff 7f +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + = 00 00 00 00 00 00 00 80 +marshal round trip -9223372036854775808 + = OK +to_bits 2147483647 + = ff ff ff 7f +marshal round trip 2147483647 + = OK +to_bits -2147483648 + = 00 00 00 80 +marshal round trip -2147483648 + = OK +testbit 0 (passed) +testbit 1 (passed) +testbit -42 (passed) +testbit 31415926535897932384626433832795028841971693993751058209749445923078164062862089986 (passed) +testbit -2277361236363886404304896 (passed) +numbits / trailing_zeros 0 (passed) +numbits / trailing_zeros 1 (passed) +numbits / trailing_zeros -42 (passed) +numbits / trailing_zeros 1511006158790834639735881728 (passed) +numbits / trailing_zeros -2277361236363886404304896 (passed) +random_bits 45 = 25076743995969 +random_bits 45 = 33510880286625 +random_bits 12 = 1263 +random_int 123456 = 103797 +random_int 9999999 = 1089068 +- 0 = 0 +- 1 = -1 +- -1 = 1 +- +inf = -inf +- -inf = +inf +- undef = undef +1/ 0 = +inf +1/ 1 = 1 +1/ -1 = -1 +1/ +inf = 0 +1/ -inf = 0 +1/ undef = undef +abs 0 = 0 +abs 1 = 1 +abs -1 = 1 +abs +inf = +inf +abs -inf = +inf +abs undef = undef +0 + 0 = 0 +0 + 1 = 1 +0 + -1 = -1 +0 + +inf = +inf +0 + -inf = -inf +0 + undef = undef +1 + 0 = 1 +1 + 1 = 2 +1 + -1 = 0 +1 + +inf = +inf +1 + -inf = -inf +1 + undef = undef +-1 + 0 = -1 +-1 + 1 = 0 +-1 + -1 = -2 +-1 + +inf = +inf +-1 + -inf = -inf +-1 + undef = undef ++inf + 0 = +inf ++inf + 1 = +inf ++inf + -1 = +inf ++inf + +inf = +inf ++inf + -inf = undef ++inf + undef = undef +-inf + 0 = -inf +-inf + 1 = -inf +-inf + -1 = -inf +-inf + +inf = undef +-inf + -inf = -inf +-inf + undef = undef +undef + 0 = undef +undef + 1 = undef +undef + -1 = undef +undef + +inf = undef +undef + -inf = undef +undef + undef = undef +0 - 0 = 0 +0 - 1 = -1 +0 - -1 = 1 +0 - +inf = -inf +0 - -inf = +inf +0 - undef = undef +1 - 0 = 1 +1 - 1 = 0 +1 - -1 = 2 +1 - +inf = -inf +1 - -inf = +inf +1 - undef = undef +-1 - 0 = -1 +-1 - 1 = -2 +-1 - -1 = 0 +-1 - +inf = -inf +-1 - -inf = +inf +-1 - undef = undef ++inf - 0 = +inf ++inf - 1 = +inf ++inf - -1 = +inf ++inf - +inf = undef ++inf - -inf = +inf ++inf - undef = undef +-inf - 0 = -inf +-inf - 1 = -inf +-inf - -1 = -inf +-inf - +inf = -inf +-inf - -inf = undef +-inf - undef = undef +undef - 0 = undef +undef - 1 = undef +undef - -1 = undef +undef - +inf = undef +undef - -inf = undef +undef - undef = undef +0 * 0 = 0 +0 * 1 = 0 +0 * -1 = 0 +0 * +inf = undef +0 * -inf = undef +0 * undef = undef +1 * 0 = 0 +1 * 1 = 1 +1 * -1 = -1 +1 * +inf = +inf +1 * -inf = -inf +1 * undef = undef +-1 * 0 = 0 +-1 * 1 = -1 +-1 * -1 = 1 +-1 * +inf = -inf +-1 * -inf = +inf +-1 * undef = undef ++inf * 0 = undef ++inf * 1 = +inf ++inf * -1 = -inf ++inf * +inf = +inf ++inf * -inf = -inf ++inf * undef = undef +-inf * 0 = undef +-inf * 1 = -inf +-inf * -1 = +inf +-inf * +inf = -inf +-inf * -inf = +inf +-inf * undef = undef +undef * 0 = undef +undef * 1 = undef +undef * -1 = undef +undef * +inf = undef +undef * -inf = undef +undef * undef = undef +0 / 0 = undef +0 / 1 = 0 +0 / -1 = 0 +0 / +inf = 0 +0 / -inf = 0 +0 / undef = undef +1 / 0 = +inf +1 / 1 = 1 +1 / -1 = -1 +1 / +inf = 0 +1 / -inf = 0 +1 / undef = undef +-1 / 0 = -inf +-1 / 1 = -1 +-1 / -1 = 1 +-1 / +inf = 0 +-1 / -inf = 0 +-1 / undef = undef ++inf / 0 = +inf ++inf / 1 = +inf ++inf / -1 = -inf ++inf / +inf = undef ++inf / -inf = undef ++inf / undef = undef +-inf / 0 = -inf +-inf / 1 = -inf +-inf / -1 = +inf +-inf / +inf = undef +-inf / -inf = undef +-inf / undef = undef +undef / 0 = undef +undef / 1 = undef +undef / -1 = undef +undef / +inf = undef +undef / -inf = undef +undef / undef = undef +0 * 1/ 0 = undef +0 * 1/ 1 = 0 +0 * 1/ -1 = 0 +0 * 1/ +inf = 0 +0 * 1/ -inf = 0 +0 * 1/ undef = undef +1 * 1/ 0 = +inf +1 * 1/ 1 = 1 +1 * 1/ -1 = -1 +1 * 1/ +inf = 0 +1 * 1/ -inf = 0 +1 * 1/ undef = undef +-1 * 1/ 0 = -inf +-1 * 1/ 1 = -1 +-1 * 1/ -1 = 1 +-1 * 1/ +inf = 0 +-1 * 1/ -inf = 0 +-1 * 1/ undef = undef ++inf * 1/ 0 = +inf ++inf * 1/ 1 = +inf ++inf * 1/ -1 = -inf ++inf * 1/ +inf = undef ++inf * 1/ -inf = undef ++inf * 1/ undef = undef +-inf * 1/ 0 = -inf +-inf * 1/ 1 = -inf +-inf * 1/ -1 = +inf +-inf * 1/ +inf = undef +-inf * 1/ -inf = undef +-inf * 1/ undef = undef +undef * 1/ 0 = undef +undef * 1/ 1 = undef +undef * 1/ -1 = undef +undef * 1/ +inf = undef +undef * 1/ -inf = undef +undef * 1/ undef = undef +mul_2exp (1) 0 = 0 +mul_2exp (1) 1 = 2 +mul_2exp (1) -1 = -2 +mul_2exp (1) +inf = +inf +mul_2exp (1) -inf = -inf +mul_2exp (1) undef = undef +mul_2exp (2) 0 = 0 +mul_2exp (2) 1 = 4 +mul_2exp (2) -1 = -4 +mul_2exp (2) +inf = +inf +mul_2exp (2) -inf = -inf +mul_2exp (2) undef = undef +div_2exp (1) 0 = 0 +div_2exp (1) 1 = 1/2 +div_2exp (1) -1 = -1/2 +div_2exp (1) +inf = +inf +div_2exp (1) -inf = -inf +div_2exp (1) undef = undef +div_2exp (2) 0 = 0 +div_2exp (2) 1 = 1/4 +div_2exp (2) -1 = -1/4 +div_2exp (2) +inf = +inf +div_2exp (2) -inf = -inf +div_2exp (2) undef = undef +identity checking 0 0 +identity checking 0 1 +identity checking 0 -1 +identity checking 0 +inf +identity checking 0 -inf +identity checking 0 undef +identity checking 1 0 +identity checking 1 1 +identity checking 1 -1 +identity checking 1 +inf +identity checking 1 -inf +identity checking 1 undef +identity checking -1 0 +identity checking -1 1 +identity checking -1 -1 +identity checking -1 +inf +identity checking -1 -inf +identity checking -1 undef +identity checking +inf 0 +identity checking +inf 1 +identity checking +inf -1 +identity checking +inf +inf +identity checking +inf -inf +identity checking +inf undef +identity checking -inf 0 +identity checking -inf 1 +identity checking -inf -1 +identity checking -inf +inf +identity checking -inf -inf +identity checking -inf undef +identity checking undef 0 +identity checking undef 1 +identity checking undef -1 +identity checking undef +inf +identity checking undef -inf +identity checking undef undef diff --git a/unikernel/duniverse/Zarith/tests/zq.output64 b/unikernel/duniverse/Zarith/tests/zq.output64 new file mode 100644 index 00000000..a49ec069 --- /dev/null +++ b/unikernel/duniverse/Zarith/tests/zq.output64 @@ -0,0 +1,1452 @@ +0 + = 0 +1 + = 1 +-1 + = -1 +42 + = 42 +1+1 + = 2 +1-1 + = 0 +- 1 + = -1 +0-1 + = -1 +max_int + = 4611686018427387903 +min_int + = -4611686018427387904 +-max_int + = -4611686018427387903 +-min_int + = 4611686018427387904 +2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 + = 1329227995784915872903807060280344576 +2^300+2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^300+(-(2^120)) + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120-2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-(2^120)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-(2^120)-2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^300 + = 0 +2^121 + = 2658455991569831745807614120560689152 +2^121+2^120 + = 3987683987354747618711421180841033728 +2^121-2^120 + = 1329227995784915872903807060280344576 +2^121+(-(2^120)) + = 1329227995784915872903807060280344576 +2^120-2^121 + = -1329227995784915872903807060280344576 +2^120+(-(2^121)) + = -1329227995784915872903807060280344576 +-(2^120)+(-(2^121)) + = -3987683987354747618711421180841033728 +-(2^120)-2^121 + = -3987683987354747618711421180841033728 +2^121+0 + = 2658455991569831745807614120560689152 +2^121-0 + = 2658455991569831745807614120560689152 +0+2^121 + = 2658455991569831745807614120560689152 +0-2^121 + = -2658455991569831745807614120560689152 +2^300+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^300-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300+(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300-(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)-(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +5! = 120 +12! = 479001600 +15! = 1307674368000 +20! = 2432902008176640000 +25! = 15511210043330985984000000 +50! = 30414093201713378043612608166064768844377641568960512000000000000 +2^300*2^120 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*2^300 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^300*(-(2^120)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*(-(2^300)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +-(2^120)*(-(2^300)) + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^121*2^120 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^120*2^121 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^121*0 + = 0 +0*2^121 + = 0 +2^300*1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300*(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(2^30) + = 1073741824 +1*(2^62) + = 4611686018427387904 +(2^30)*(2^30) + = 1152921504606846976 +(2^62)*(2^62) + = 21267647932558653966460912964485513216 +0+1 + = 1 +1+1 + = 2 +-1+1 + = 0 +2+1 + = 3 +-2+1 + = -1 +(2^300)+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0-1 + = -1 +1-1 + = 0 +-1-1 + = -2 +2-1 + = 1 +-2-1 + = -3 +(2^300)-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +abs(0) + = 0 +abs(1) + = 1 +abs(-1) + = 1 +abs(min_int) + = 4611686018427387904 +abs(2^300) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +abs(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +max_nativeint + = 9223372036854775807 +max_int32 + = 2147483647 +max_int64 + = 9223372036854775807 +to_int 1 + = true,1 +to_int max_int + = true,4611686018427387903 +to_int max_nativeint + = false,ovf +to_int max_int32 + = true,2147483647 +to_int max_int64 + = false,ovf +to_int32 1 + = true,1 +to_int32 max_int + = false,ovf +to_int32 max_nativeint + = false,ovf +to_int32 max_int32 + = true,2147483647 +to_int32 max_int64 + = false,ovf +to_int64 1 + = true,1 +to_int64 max_int + = true,4611686018427387903 +to_int64 max_nativeint + = true,9223372036854775807 +to_int64 max_int32 + = true,2147483647 +to_int64 max_int64 + = true,9223372036854775807 +to_nativeint 1 + = true,1 +to_nativeint max_int + = true,4611686018427387903 +to_nativeint max_nativeint + = true,9223372036854775807 +to_nativeint max_int32 + = true,2147483647 +to_nativeint max_int64 + = true,9223372036854775807 +to_int -min_int + = false,ovf +to_int -min_nativeint + = false,ovf +to_int -min_int32 + = true,2147483648 +to_int -min_int64 + = false,ovf +to_int32 -min_int + = false,ovf +to_int32 -min_nativeint + = false,ovf +to_int32 -min_int32 + = false,ovf +to_int32 -min_int64 + = false,ovf +to_int64 -min_int + = true,4611686018427387904 +to_int64 -min_nativeint + = false,ovf +to_int64 -min_int32 + = true,2147483648 +to_int64 -min_int64 + = false,ovf +to_nativeint -min_int + = true,4611686018427387904 +to_nativeint -min_nativeint + = false,ovf +to_nativeint -min_int32 + = true,2147483648 +to_nativeint -min_int64 + = false,ovf +to_int32_unsigned 1 + = true,1 +to_int32_unsigned -1 + = false,ovf +to_int32_unsigned max_int + = false,ovf +to_int32_unsigned max_nativeint + = false,ovf +to_int32_unsigned max_int32 + = true,2147483647 +to_int32_unsigned 2max_int32 + = true,-2 +to_int32_unsigned 3max_int32 + = false,ovf +to_int32_unsigned max_int64 + = false,ovf +to_int64_unsigned 1 + = true,1 +to_int64_unsigned -1 + = false,ovf +to_int64_unsigned max_int + = true,4611686018427387903 +to_int64_unsigned max_nativeint + = true,9223372036854775807 +to_int64_unsigned max_int32 + = true,2147483647 +to_int64_unsigned max_int64 + = true,9223372036854775807 +to_int64_unsigned 2max_int64 + = true,-2 +to_int64_unsigned 3max_int64 + = false,ovf +to_nativeint_unsigned 1 + = true,1 +to_nativeint_unsigned -1 + = false,ovf +to_nativeint_unsigned max_int + = true,4611686018427387903 +to_nativeint_unsigned max_nativeint + = true,9223372036854775807 +to_nativeint_unsigned 2max_nativeint + = true,-2 +to_nativeint_unsigned max_int32 + = true,2147483647 +to_nativeint_unsigned max_int64 + = true,9223372036854775807 +to_nativeint_unsigned 2max_int64 + = true,-2 +to_nativeint_unsigned 3max_int64 + = false,ovf +of_int32_unsigned -1 + = 4294967295 +of_int64_unsigned -1 + = 18446744073709551615 +of_nativeint_unsigned -1 + = 18446744073709551615 +of_float 1. + = 1 +of_float -1. + = -1 +of_float pi + = 3 +of_float 2^30 + = 1073741824 +of_float 2^31 + = 2147483648 +of_float 2^32 + = 4294967296 +of_float 2^33 + = 8589934592 +of_float -2^30 + = -1073741824 +of_float -2^31 + = -2147483648 +of_float -2^32 + = -4294967296 +of_float -2^33 + = -8589934592 +of_float 2^61 + = 2305843009213693952 +of_float 2^62 + = 4611686018427387904 +of_float 2^63 + = 9223372036854775808 +of_float 2^64 + = 18446744073709551616 +of_float 2^65 + = 36893488147419103232 +of_float -2^61 + = -2305843009213693952 +of_float -2^62 + = -4611686018427387904 +of_float -2^63 + = -9223372036854775808 +of_float -2^64 + = -18446744073709551616 +of_float -2^65 + = -36893488147419103232 +of_float 2^120 + = 1329227995784915872903807060280344576 +of_float 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float -2^120 + = -1329227995784915872903807060280344576 +of_float -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float 0.5 + = 0 +of_float -0.5 + = 0 +of_float 200.5 + = 200 +of_float -200.5 + = -200 +to_float 0 + = OK +to_float 1 + = OK +to_float -1 + = OK +to_float 2^120 + = OK +to_float -2^120 + = OK +to_float (2^120-1) + = OK +to_float (-2^120+1) + = OK +to_float 2^63 + = OK +to_float -2^63 + = OK +to_float (2^63-1) + = OK +to_float (-2^63-1) + = OK +to_float (-2^63+1) + = OK +to_float 2^300 + = OK +to_float -2^300 + = OK +to_float (2^300-1) + = OK +to_float (-2^300+1) + = OK +of_string 12 + = 12 +of_string 0x12 + = 18 +of_string 0b10 + = 2 +of_string 0o12 + = 10 +of_string -12 + = -12 +of_string -0x12 + = -18 +of_string -0b10 + = -2 +of_string -0o12 + = -10 +of_string 000123456789012345678901234567890 + = 123456789012345678901234567890 +2^120 / 2^300 (trunc) + = 0 +max_int / 2 (trunc) + = 2305843009213693951 +(2^300+1) / 2^120 (trunc) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (trunc) + = 1532495540865888858358347027150309183618739122183602176 +2^120 / 2^300 (ceil) + = 1 +max_int / 2 (ceil) + = 2305843009213693952 +(2^300+1) / 2^120 (ceil) + = 1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / 2^120 (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (ceil) + = 1532495540865888858358347027150309183618739122183602177 +2^120 / 2^300 (floor) + = 0 +max_int / 2 (floor) + = 2305843009213693951 +(2^300+1) / 2^120 (floor) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (floor) + = -1532495540865888858358347027150309183618739122183602177 +(2^300+1) / (-(2^120)) (floor) + = -1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / (-(2^120)) (floor) + = 1532495540865888858358347027150309183618739122183602176 +2^120 % 2^300 + = 1329227995784915872903807060280344576 +max_int % 2 + = 1 +(2^300+1) % 2^120 + = 1 +(-(2^300+1)) % 2^120 + = -1 +(2^300+1) % (-(2^120)) + = 1 +(-(2^300+1)) % (-(2^120)) + = -1 +2^120 /,% 2^300 + = 0, 1329227995784915872903807060280344576 +max_int /,% 2 + = 2305843009213693951, 1 +(2^300+1) /,% 2^120 + = 1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% 2^120 + = -1532495540865888858358347027150309183618739122183602176, -1 +(2^300+1) /,% (-(2^120)) + = -1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% (-(2^120)) + = 1532495540865888858358347027150309183618739122183602176, -1 +1 & 2 + = 0 +1 & 2^300 + = 0 +2^120 & 2^300 + = 0 +2^300 & 2^120 + = 0 +2^300 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 & 0 + = 0 +-2^120 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + 2^120 & -2^300 + = 0 +-2^120 & -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & 2^120 + = 0 + 2^300 & -2^120 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & -2^120 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1 | 2 + = 3 +1 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 | 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 | 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 | 2^300 + = -1329227995784915872903807060280344576 + 2^120 | -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 | -2^300 + = -1329227995784915872903807060280344576 +-2^300 | 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 | -2^120 + = -1329227995784915872903807060280344576 +-2^300 | -2^120 + = -1329227995784915872903807060280344576 +1 ^ 2 + = 3 +1 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^300 + = 0 +2^300 ^ 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 ^ 2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 + 2^120 ^ -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 ^ -2^300 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^300 ^ 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 ^ -2^120 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-2^300 ^ -2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +~0 + = -1 +~1 + = -2 +~2 + = -3 +~2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +~(-1) + = 0 +~(-2) + = 1 +~(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0 >> 1 + = 0 +0 >> 100 + = 0 +2 >> 1 + = 1 +2 >> 2 + = 0 +2 >> 100 + = 0 +2^300 >> 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >> 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >> 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >> 200 + = 1267650600228229401496703205376 +2^300 >> 300 + = 1 +2^300 >> 400 + = 0 +-1 >> 1 + = -1 +-2 >> 1 + = -1 +-2 >> 2 + = -1 +-2 >> 100 + = -1 +-2^300 >> 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >> 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >> 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >> 200 + = -1267650600228229401496703205376 +-2^300 >> 300 + = -1 +-2^300 >> 400 + = -1 +0 >>0 1 + = 0 +0 >>0 100 + = 0 +2 >>0 1 + = 1 +2 >>0 2 + = 0 +2 >>0 100 + = 0 +2^300 >>0 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >>0 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >>0 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >>0 200 + = 1267650600228229401496703205376 +2^300 >>0 300 + = 1 +2^300 >>0 400 + = 0 +-1 >>0 1 + = 0 +-2 >>0 1 + = -1 +-2 >>0 2 + = 0 +-2 >>0 100 + = 0 +-2^300 >>0 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >>0 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >>0 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >>0 200 + = -1267650600228229401496703205376 +-2^300 >>0 300 + = -1 +-2^300 >>0 400 + = 0 +0 << 1 + = 0 +0 << 100 + = 0 +2 << 1 + = 4 +2 << 32 + = 8589934592 +2 << 64 + = 36893488147419103232 +2 << 299 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 << 1 + = 2658455991569831745807614120560689152 +2^120 << 180 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +compare 1 2 + = -1 +compare 1 1 + = 0 +compare 2 1 + = 1 +compare 2^300 2^120 + = 1 +compare 2^120 2^120 + = 0 +compare 2^120 2^300 + = -1 +compare 2^121 2^120 + = 1 +compare 2^120 2^121 + = -1 +compare 2^300 -2^120 + = 1 +compare 2^120 -2^120 + = 1 +compare 2^120 -2^300 + = 1 +compare -2^300 2^120 + = -1 +compare -2^120 2^120 + = -1 +compare -2^120 2^300 + = -1 +compare -2^300 -2^120 + = -1 +compare -2^120 -2^120 + = 0 +compare -2^120 -2^300 + = 1 +equal 1 2 + = false +equal 1 1 + = true +equal 2 1 + = false +equal 2^300 2^120 + = false +equal 2^120 2^120 + = true +equal 2^120 2^300 + = false +equal 2^121 2^120 + = false +equal 2^120 2^121 + = false +equal 2^120 -2^120 + = false +equal -2^120 2^120 + = false +equal -2^120 -2^120 + = true +sign 0 + = 0 +sign 1 + = 1 +sign -1 + = -1 +sign 2^300 + = 1 +sign -2^300 + = -1 +gcd 0 0 + = 0 +gcd 0 -137 + = 137 +gcd 12 27 + = 3 +gcd 27 12 + = 3 +gcd 27 27 + = 27 +gcd -12 27 + = 3 +gcd 12 -27 + = 3 +gcd -12 -27 + = 3 +gcd 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 2^120 + = 1329227995784915872903807060280344576 +gcd 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 -2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 -2^120 + = 1329227995784915872903807060280344576 +gcdext 12 27 + = 3, -2, 1 +gcdext 27 12 + = 3, 1, -2 +gcdext 27 27 + = 27, 0, 1 +gcdext -12 27 + = 3, 2, 1 +gcdext 12 -27 + = 3, -2, -1 +gcdext -12 -27 + = 3, 2, -1 +gcdext 2^120 2^300 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 2^300 2^120 + = 1329227995784915872903807060280344576, 0, 1 +gcdext 12 0 + = 12, 1, 0 +gcdext 0 27 + = 27, 0, 1 +gcdext -12 0 + = 12, -1, 0 +gcdext 0 -27 + = 27, 0, -1 +gcdext 2^120 0 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1 +gcdext -2^120 0 + = 1329227995784915872903807060280344576, -1, 0 +gcdext 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1 +gcdext 0 0 + = 0, 0, 0 +lcm 0 0 = 0 +lcm 10 12 = 60 +lcm -10 12 = 60 +lcm 10 -12 = 60 +lcm -10 -12 = 60 +lcm 0 12 = 0 +lcm 0 -12 = 0 +lcm 10 0 = 0 +lcm -10 0 = 0 +lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 0 = 0 +lcm -2^120 0 = 0 +is_odd 0 + = false +is_odd 1 + = true +is_odd 2 + = false +is_odd 3 + = true +is_odd 2^120 + = false +is_odd 2^120+1 + = true +is_odd 2^300 + = false +is_odd 2^300+1 + = true +sqrt 0 + = 0 +sqrt 1 + = 1 +sqrt 2 + = 1 +sqrt 2^120 + = 1152921504606846976 +sqrt 2^121 + = 1630477228166597776 +sqrt_rem 0 + = 0, 0 +sqrt_rem 1 + = 1, 0 +sqrt_rem 2 + = 1, 1 +sqrt_rem 2^120 + = 1152921504606846976, 0 +sqrt_rem 2^121 + = 1630477228166597776, 1772969445592542976 +popcount 0 + = 0 +popcount 1 + = 1 +popcount 2 + = 1 +popcount max_int32 + = 31 +popcount 2^120 + = 1 +popcount (2^120-1) + = 120 +hamdist 0 0 + = 0 +hamdist 0 1 + = 1 +hamdist 0 2^300 + = 1 +hamdist 2^120 2^120 + = 0 +hamdist 2^120 (2^120-1) + = 121 +hamdist 2^120 2^300 + = 2 +hamdist (2^120-1) (2^300-1) + = 180 +divisible 42 7 + = true +divisible 43 7 + = false +divisible 0 0 + = true +divisible 0 2^120 + = true +divisible 2 2^120 + = false +divisible 2^300 2^120 + = true +divisible (2^300-1) 32 + = false +divisible min_int (max_int+1) + = true +divisible (max_int+1) min_int + = true +hash(2^120) + = 691199303 +hash(2^121) + = 382412560 +hash(2^300) + = 61759632 +2^120 = 2^300 + = false +2^120 = 2^120 + = true +2^120 = 2^120 + = true +2^120 > 2^300 + = false +2^120 < 2^300 + = true +2^120 = 1 + = false +2^120 > 1 + = true +2^120 < 1 + = false +-2^120 > 1 + = false +-2^120 < 1 + = true +demarshal 2^120, 2^300, 1 + = 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1 +demarshal -2^120, -2^300, -1 + = -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1 +format %i 0 = /0/ +format %i 1 = /1/ +format %i -1 = /-1/ +format %i 2^30 = /1073741824/ +format %i -2^30 = /-1073741824/ +format % i 1 = / 1/ +format %+i 1 = /+1/ +format %x 0 = /0/ +format %x 1 = /1/ +format %x -1 = /-1/ +format %x 2^30 = /40000000/ +format %x -2^30 = /-40000000/ +format %X 0 = /0/ +format %X 1 = /1/ +format %X -1 = /-1/ +format %X 2^30 = /40000000/ +format %X -2^30 = /-40000000/ +format %o 0 = /0/ +format %o 1 = /1/ +format %o -1 = /-1/ +format %o 2^30 = /10000000000/ +format %o -2^30 = /-10000000000/ +format %10i 0 = / 0/ +format %10i 1 = / 1/ +format %10i -1 = / -1/ +format %10i 2^30 = /1073741824/ +format %10i -2^30 = /-1073741824/ +format %-10i 0 = /0 / +format %-10i 1 = /1 / +format %-10i -1 = /-1 / +format %-10i 2^30 = /1073741824/ +format %-10i -2^30 = /-1073741824/ +format %+10i 0 = / +0/ +format %+10i 1 = / +1/ +format %+10i -1 = / -1/ +format %+10i 2^30 = /+1073741824/ +format %+10i -2^30 = /-1073741824/ +format % 10i 0 = / 0/ +format % 10i 1 = / 1/ +format % 10i -1 = / -1/ +format % 10i 2^30 = / 1073741824/ +format % 10i -2^30 = /-1073741824/ +format %010i 0 = /0000000000/ +format %010i 1 = /0000000001/ +format %010i -1 = /-000000001/ +format %010i 2^30 = /1073741824/ +format %010i -2^30 = /-1073741824/ +format %#x 0 = /0x0/ +format %#x 1 = /0x1/ +format %#x -1 = /-0x1/ +format %#x 2^30 = /0x40000000/ +format %#x -2^30 = /-0x40000000/ +format %#X 0 = /0X0/ +format %#X 1 = /0X1/ +format %#X -1 = /-0X1/ +format %#X 2^30 = /0X40000000/ +format %#X -2^30 = /-0X40000000/ +format %#o 0 = /0o0/ +format %#o 1 = /0o1/ +format %#o -1 = /-0o1/ +format %#o 2^30 = /0o10000000000/ +format %#o -2^30 = /-0o10000000000/ +format %#10x 0 = / 0x0/ +format %#10x 1 = / 0x1/ +format %#10x -1 = / -0x1/ +format %#10x 2^30 = /0x40000000/ +format %#10x -2^30 = /-0x40000000/ +format %#10X 0 = / 0X0/ +format %#10X 1 = / 0X1/ +format %#10X -1 = / -0X1/ +format %#10X 2^30 = /0X40000000/ +format %#10X -2^30 = /-0X40000000/ +format %#10o 0 = / 0o0/ +format %#10o 1 = / 0o1/ +format %#10o -1 = / -0o1/ +format %#10o 2^30 = /0o10000000000/ +format %#10o -2^30 = /-0o10000000000/ +format %#-10x 0 = /0x0 / +format %#-10x 1 = /0x1 / +format %#-10x -1 = /-0x1 / +format %#-10x 2^30 = /0x40000000/ +format %#-10x -2^30 = /-0x40000000/ +format %#-10X 0 = /0X0 / +format %#-10X 1 = /0X1 / +format %#-10X -1 = /-0X1 / +format %#-10X 2^30 = /0X40000000/ +format %#-10X -2^30 = /-0X40000000/ +format %#-10o 0 = /0o0 / +format %#-10o 1 = /0o1 / +format %#-10o -1 = /-0o1 / +format %#-10o 2^30 = /0o10000000000/ +format %#-10o -2^30 = /-0o10000000000/ +extract 42 0 1 = 0 (passed) +extract 42 0 5 = 10 (passed) +extract 42 0 32 = 42 (passed) +extract 42 0 64 = 42 (passed) +extract 42 1 1 = 1 (passed) +extract 42 1 5 = 21 (passed) +extract 42 1 32 = 21 (passed) +extract 42 1 63 = 21 (passed) +extract 42 1 64 = 21 (passed) +extract 42 1 127 = 21 (passed) +extract 42 1 128 = 21 (passed) +extract 42 69 12 = 0 (passed) +extract -42 0 1 = 0 (passed) +extract -42 0 5 = 22 (passed) +extract -42 0 32 = 4294967254 (passed) +extract -42 0 64 = 18446744073709551574 (passed) +extract -42 1 1 = 1 (passed) +extract -42 1 5 = 11 (passed) +extract -42 1 32 = 4294967275 (passed) +extract -42 1 63 = 9223372036854775787 (passed) +extract -42 1 64 = 18446744073709551595 (passed) +extract -42 1 127 = 170141183460469231731687303715884105707 (passed) +extract -42 1 128 = 340282366920938463463374607431768211435 (passed) +extract -42 69 12 = 4095 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = 15536040655639606317 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = 19 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = 2516587394 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = 7690089207107781587 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = 9888429935207999867003931753264634841 (passed) +signed_extract 42 0 1 = 0 (passed) +signed_extract 42 0 5 = 10 (passed) +signed_extract 42 0 32 = 42 (passed) +signed_extract 42 0 64 = 42 (passed) +signed_extract 42 1 1 = -1 (passed) +signed_extract 42 1 5 = -11 (passed) +signed_extract 42 1 32 = 21 (passed) +signed_extract 42 1 63 = 21 (passed) +signed_extract 42 1 64 = 21 (passed) +signed_extract 42 1 127 = 21 (passed) +signed_extract 42 1 128 = 21 (passed) +signed_extract 42 69 12 = 0 (passed) +signed_extract -42 0 1 = 0 (passed) +signed_extract -42 0 5 = -10 (passed) +signed_extract -42 0 32 = -42 (passed) +signed_extract -42 0 64 = -42 (passed) +signed_extract -42 1 1 = -1 (passed) +signed_extract -42 1 5 = 11 (passed) +signed_extract -42 1 32 = -21 (passed) +signed_extract -42 1 63 = -21 (passed) +signed_extract -42 1 64 = -21 (passed) +signed_extract -42 1 127 = -21 (passed) +signed_extract -42 1 128 = -21 (passed) +signed_extract -42 69 12 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = -2910703418069945299 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = -13 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = -1778379902 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = -1533282829746994221 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = -745394031071327116226524728978121767 (passed) +to_bits 0 + = +marshal round trip 0 + = OK +to_bits 2 + = 02 00 00 00 00 00 00 00 +marshal round trip 2 + = OK +to_bits -2 + = 02 00 00 00 00 00 00 00 +marshal round trip -2 + = OK +to_bits 1073741824 + = 00 00 00 40 00 00 00 00 +marshal round trip 1073741824 + = OK +to_bits -1073741824 + = 00 00 00 40 00 00 00 00 +marshal round trip -1073741824 + = OK +to_bits 4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip 4611686018427387904 + = OK +to_bits -4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip -4611686018427387904 + = OK +to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 10 00 00 +marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = OK +to_bits 1329227995784915872903807060280344576 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 +marshal round trip 1329227995784915872903807060280344576 + = OK +to_bits 2658455991569831745807614120560689152 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 +marshal round trip 2658455991569831745807614120560689152 + = OK +to_bits 4611686018427387903 + = ff ff ff ff ff ff ff 3f +marshal round trip 4611686018427387903 + = OK +to_bits -4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip -4611686018427387904 + = OK +to_bits 2147483647 + = ff ff ff 7f 00 00 00 00 +marshal round trip 2147483647 + = OK +to_bits -2147483648 + = 00 00 00 80 00 00 00 00 +marshal round trip -2147483648 + = OK +to_bits 9223372036854775807 + = ff ff ff ff ff ff ff 7f +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + = 00 00 00 00 00 00 00 80 +marshal round trip -9223372036854775808 + = OK +to_bits 9223372036854775807 + = ff ff ff ff ff ff ff 7f +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + = 00 00 00 00 00 00 00 80 +marshal round trip -9223372036854775808 + = OK +testbit 0 (passed) +testbit 1 (passed) +testbit -42 (passed) +testbit 31415926535897932384626433832795028841971693993751058209749445923078164062862089986 (passed) +testbit -2277361236363886404304896 (passed) +numbits / trailing_zeros 0 (passed) +numbits / trailing_zeros 1 (passed) +numbits / trailing_zeros -42 (passed) +numbits / trailing_zeros 1511006158790834639735881728 (passed) +numbits / trailing_zeros -2277361236363886404304896 (passed) +random_bits 45 = 25076743995969 +random_bits 45 = 33510880286625 +random_bits 12 = 1263 +random_int 123456 = 103797 +random_int 9999999 = 1089068 +- 0 = 0 +- 1 = -1 +- -1 = 1 +- +inf = -inf +- -inf = +inf +- undef = undef +1/ 0 = +inf +1/ 1 = 1 +1/ -1 = -1 +1/ +inf = 0 +1/ -inf = 0 +1/ undef = undef +abs 0 = 0 +abs 1 = 1 +abs -1 = 1 +abs +inf = +inf +abs -inf = +inf +abs undef = undef +0 + 0 = 0 +0 + 1 = 1 +0 + -1 = -1 +0 + +inf = +inf +0 + -inf = -inf +0 + undef = undef +1 + 0 = 1 +1 + 1 = 2 +1 + -1 = 0 +1 + +inf = +inf +1 + -inf = -inf +1 + undef = undef +-1 + 0 = -1 +-1 + 1 = 0 +-1 + -1 = -2 +-1 + +inf = +inf +-1 + -inf = -inf +-1 + undef = undef ++inf + 0 = +inf ++inf + 1 = +inf ++inf + -1 = +inf ++inf + +inf = +inf ++inf + -inf = undef ++inf + undef = undef +-inf + 0 = -inf +-inf + 1 = -inf +-inf + -1 = -inf +-inf + +inf = undef +-inf + -inf = -inf +-inf + undef = undef +undef + 0 = undef +undef + 1 = undef +undef + -1 = undef +undef + +inf = undef +undef + -inf = undef +undef + undef = undef +0 - 0 = 0 +0 - 1 = -1 +0 - -1 = 1 +0 - +inf = -inf +0 - -inf = +inf +0 - undef = undef +1 - 0 = 1 +1 - 1 = 0 +1 - -1 = 2 +1 - +inf = -inf +1 - -inf = +inf +1 - undef = undef +-1 - 0 = -1 +-1 - 1 = -2 +-1 - -1 = 0 +-1 - +inf = -inf +-1 - -inf = +inf +-1 - undef = undef ++inf - 0 = +inf ++inf - 1 = +inf ++inf - -1 = +inf ++inf - +inf = undef ++inf - -inf = +inf ++inf - undef = undef +-inf - 0 = -inf +-inf - 1 = -inf +-inf - -1 = -inf +-inf - +inf = -inf +-inf - -inf = undef +-inf - undef = undef +undef - 0 = undef +undef - 1 = undef +undef - -1 = undef +undef - +inf = undef +undef - -inf = undef +undef - undef = undef +0 * 0 = 0 +0 * 1 = 0 +0 * -1 = 0 +0 * +inf = undef +0 * -inf = undef +0 * undef = undef +1 * 0 = 0 +1 * 1 = 1 +1 * -1 = -1 +1 * +inf = +inf +1 * -inf = -inf +1 * undef = undef +-1 * 0 = 0 +-1 * 1 = -1 +-1 * -1 = 1 +-1 * +inf = -inf +-1 * -inf = +inf +-1 * undef = undef ++inf * 0 = undef ++inf * 1 = +inf ++inf * -1 = -inf ++inf * +inf = +inf ++inf * -inf = -inf ++inf * undef = undef +-inf * 0 = undef +-inf * 1 = -inf +-inf * -1 = +inf +-inf * +inf = -inf +-inf * -inf = +inf +-inf * undef = undef +undef * 0 = undef +undef * 1 = undef +undef * -1 = undef +undef * +inf = undef +undef * -inf = undef +undef * undef = undef +0 / 0 = undef +0 / 1 = 0 +0 / -1 = 0 +0 / +inf = 0 +0 / -inf = 0 +0 / undef = undef +1 / 0 = +inf +1 / 1 = 1 +1 / -1 = -1 +1 / +inf = 0 +1 / -inf = 0 +1 / undef = undef +-1 / 0 = -inf +-1 / 1 = -1 +-1 / -1 = 1 +-1 / +inf = 0 +-1 / -inf = 0 +-1 / undef = undef ++inf / 0 = +inf ++inf / 1 = +inf ++inf / -1 = -inf ++inf / +inf = undef ++inf / -inf = undef ++inf / undef = undef +-inf / 0 = -inf +-inf / 1 = -inf +-inf / -1 = +inf +-inf / +inf = undef +-inf / -inf = undef +-inf / undef = undef +undef / 0 = undef +undef / 1 = undef +undef / -1 = undef +undef / +inf = undef +undef / -inf = undef +undef / undef = undef +0 * 1/ 0 = undef +0 * 1/ 1 = 0 +0 * 1/ -1 = 0 +0 * 1/ +inf = 0 +0 * 1/ -inf = 0 +0 * 1/ undef = undef +1 * 1/ 0 = +inf +1 * 1/ 1 = 1 +1 * 1/ -1 = -1 +1 * 1/ +inf = 0 +1 * 1/ -inf = 0 +1 * 1/ undef = undef +-1 * 1/ 0 = -inf +-1 * 1/ 1 = -1 +-1 * 1/ -1 = 1 +-1 * 1/ +inf = 0 +-1 * 1/ -inf = 0 +-1 * 1/ undef = undef ++inf * 1/ 0 = +inf ++inf * 1/ 1 = +inf ++inf * 1/ -1 = -inf ++inf * 1/ +inf = undef ++inf * 1/ -inf = undef ++inf * 1/ undef = undef +-inf * 1/ 0 = -inf +-inf * 1/ 1 = -inf +-inf * 1/ -1 = +inf +-inf * 1/ +inf = undef +-inf * 1/ -inf = undef +-inf * 1/ undef = undef +undef * 1/ 0 = undef +undef * 1/ 1 = undef +undef * 1/ -1 = undef +undef * 1/ +inf = undef +undef * 1/ -inf = undef +undef * 1/ undef = undef +mul_2exp (1) 0 = 0 +mul_2exp (1) 1 = 2 +mul_2exp (1) -1 = -2 +mul_2exp (1) +inf = +inf +mul_2exp (1) -inf = -inf +mul_2exp (1) undef = undef +mul_2exp (2) 0 = 0 +mul_2exp (2) 1 = 4 +mul_2exp (2) -1 = -4 +mul_2exp (2) +inf = +inf +mul_2exp (2) -inf = -inf +mul_2exp (2) undef = undef +div_2exp (1) 0 = 0 +div_2exp (1) 1 = 1/2 +div_2exp (1) -1 = -1/2 +div_2exp (1) +inf = +inf +div_2exp (1) -inf = -inf +div_2exp (1) undef = undef +div_2exp (2) 0 = 0 +div_2exp (2) 1 = 1/4 +div_2exp (2) -1 = -1/4 +div_2exp (2) +inf = +inf +div_2exp (2) -inf = -inf +div_2exp (2) undef = undef +identity checking 0 0 +identity checking 0 1 +identity checking 0 -1 +identity checking 0 +inf +identity checking 0 -inf +identity checking 0 undef +identity checking 1 0 +identity checking 1 1 +identity checking 1 -1 +identity checking 1 +inf +identity checking 1 -inf +identity checking 1 undef +identity checking -1 0 +identity checking -1 1 +identity checking -1 -1 +identity checking -1 +inf +identity checking -1 -inf +identity checking -1 undef +identity checking +inf 0 +identity checking +inf 1 +identity checking +inf -1 +identity checking +inf +inf +identity checking +inf -inf +identity checking +inf undef +identity checking -inf 0 +identity checking -inf 1 +identity checking -inf -1 +identity checking -inf +inf +identity checking -inf -inf +identity checking -inf undef +identity checking undef 0 +identity checking undef 1 +identity checking undef -1 +identity checking undef +inf +identity checking undef -inf +identity checking undef undef diff --git a/unikernel/duniverse/Zarith/z.ml b/unikernel/duniverse/Zarith/z.ml new file mode 100644 index 00000000..58faadbc --- /dev/null +++ b/unikernel/duniverse/Zarith/z.ml @@ -0,0 +1,555 @@ +(** + Integers. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + +type t + +exception Overflow + +external init: unit -> unit = "ml_z_init" +let _ = init () + +let _ = Callback.register_exception "ml_z_overflow" Overflow + +external is_small_int: t -> bool = "%obj_is_int" +external unsafe_to_int: t -> int = "%identity" +external of_int: int -> t = "%identity" + +external c_neg: t -> t = "ml_z_neg" + +let neg x = + if is_small_int x && unsafe_to_int x <> min_int + then of_int (- unsafe_to_int x) + else c_neg x + +external c_add: t -> t -> t = "ml_z_add" + +let add x y = + if is_small_int x && is_small_int y then begin + let z = unsafe_to_int x + unsafe_to_int y in + (* Overflow check -- Hacker's Delight, section 2.12 *) + if (z lxor unsafe_to_int x) land (z lxor unsafe_to_int y) >= 0 + then of_int z + else c_add x y + end else + c_add x y + +external c_sub: t -> t -> t = "ml_z_sub" + +let sub x y = + if is_small_int x && is_small_int y then begin + let z = unsafe_to_int x - unsafe_to_int y in + (* Overflow check -- Hacker's Delight, section 2.12 *) + if (unsafe_to_int x lxor unsafe_to_int y) + land (z lxor unsafe_to_int x) >= 0 + then of_int z + else c_sub x y + end else + c_sub x y + +external mul_overflows: int -> int -> bool = "ml_z_mul_overflows" [@@noalloc] +external c_mul: t -> t -> t = "ml_z_mul" + +let mul x y = + if is_small_int x && is_small_int y + && not (mul_overflows (unsafe_to_int x) (unsafe_to_int y)) + then of_int (unsafe_to_int x * unsafe_to_int y) + else c_mul x y + +external c_div: t -> t -> t = "ml_z_div" + +let div x y = + if is_small_int y then + if unsafe_to_int y = -1 then + neg x + else if is_small_int x then + of_int (unsafe_to_int x / unsafe_to_int y) + else + c_div x y + else + c_div x y + +external cdiv: t -> t -> t = "ml_z_cdiv" +external fdiv: t -> t -> t = "ml_z_fdiv" + +external c_rem: t -> t -> t = "ml_z_rem" + +let rem x y = + if is_small_int y then + if unsafe_to_int y = -1 then + of_int 0 + else if is_small_int x then + of_int (unsafe_to_int x mod unsafe_to_int y) + else + c_rem x y + else + c_rem x y + +external div_rem: t -> t -> (t * t) = "ml_z_div_rem" + +external c_divexact: t -> t -> t = "ml_z_divexact" + +let divexact x y = + if is_small_int y then + if unsafe_to_int y = -1 then + neg x + else if is_small_int x then + of_int (unsafe_to_int x / unsafe_to_int y) + else + c_divexact x y + else + c_divexact x y + +external c_succ: t -> t = "ml_z_succ" + +let succ x = + if is_small_int x && unsafe_to_int x <> max_int + then of_int (unsafe_to_int x + 1) + else c_succ x + +external c_pred: t -> t = "ml_z_pred" + +let pred x = + if is_small_int x && unsafe_to_int x <> min_int + then of_int (unsafe_to_int x - 1) + else c_pred x + +external c_abs: t -> t = "ml_z_abs" + +let abs x = + if is_small_int x then + if unsafe_to_int x >= 0 then x + else if unsafe_to_int x <> min_int then + of_int (- unsafe_to_int x) + else + c_abs x + else + c_abs x + +external c_logand: t -> t -> t = "ml_z_logand" + +let logand x y = + if is_small_int x && is_small_int y + then of_int (unsafe_to_int x land unsafe_to_int y) + else c_logand x y + +external c_logor: t -> t -> t = "ml_z_logor" + +let logor x y = + if is_small_int x && is_small_int y + then of_int (unsafe_to_int x lor unsafe_to_int y) + else c_logor x y + +external c_logxor: t -> t -> t = "ml_z_logxor" + +let logxor x y = + if is_small_int x && is_small_int y + then of_int (unsafe_to_int x lxor unsafe_to_int y) + else c_logxor x y + +external c_lognot: t -> t = "ml_z_lognot" + +let lognot x = + if is_small_int x + then of_int (unsafe_to_int x lxor (-1)) + else c_lognot x + +external c_shift_left: t -> int -> t = "ml_z_shift_left" + +let shift_left x y = + if is_small_int x && y >= 0 && y < Sys.word_size then begin + let z = unsafe_to_int x lsl y in + if z asr y = unsafe_to_int x + then of_int z + else c_shift_left x y + end else + c_shift_left x y + +external c_shift_right: t -> int -> t = "ml_z_shift_right" + +let shift_right x y = + if is_small_int x && y >= 0 then + of_int + (unsafe_to_int x asr (if y < Sys.word_size then y else Sys.word_size - 1)) + else + c_shift_right x y + +external c_shift_right_trunc: t -> int -> t = "ml_z_shift_right_trunc" + +let shift_right_trunc x y = + if is_small_int x && y >= 0 then + if y >= Sys.word_size then + of_int 0 + else if unsafe_to_int x >= 0 then + of_int (unsafe_to_int x lsr y) + else + of_int (- ((- unsafe_to_int x) lsr y)) + else + c_shift_right_trunc x y + +external of_int32: int32 -> t = "ml_z_of_int32" +external of_int64: int64 -> t = "ml_z_of_int64" +external of_nativeint: nativeint -> t = "ml_z_of_nativeint" +external of_float: float -> t = "ml_z_of_float" + +let uint32_mask = pred (shift_left (of_int 1) 32) +let of_int32_unsigned x = logand (of_int32 x) uint32_mask + +let uint64_mask = pred (shift_left (of_int 1) 64) +let of_int64_unsigned x = logand (of_int64 x) uint64_mask + +let uintnat_mask = pred (shift_left (of_int 1) Nativeint.size) +let of_nativeint_unsigned x = logand (of_nativeint x) uintnat_mask + +external c_to_int: t -> int = "ml_z_to_int" + +let to_int x = + if is_small_int x then unsafe_to_int x else c_to_int x + +external to_int32: t -> int32 = "ml_z_to_int32" +external to_int64: t -> int64 = "ml_z_to_int64" +external to_nativeint: t -> nativeint = "ml_z_to_nativeint" +external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned" +external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned" +external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned" +external format: string -> t -> string = "ml_z_format" +external of_substring_base: int -> string -> pos:int -> len:int -> t = "ml_z_of_substring_base" +external compare: t -> t -> int = "ml_z_compare" [@@noalloc] +external equal: t -> t -> bool = "ml_z_equal" [@@noalloc] +external sign: t -> int = "ml_z_sign" [@@noalloc] +external gcd: t -> t -> t = "ml_z_gcd" +external gcdext_intern: t -> t -> (t * t * bool) = "ml_z_gcdext_intern" +external sqrt: t -> t = "ml_z_sqrt" +external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem" +external numbits: t -> int = "ml_z_numbits" [@@noalloc] +external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc] +external popcount: t -> int = "ml_z_popcount" +external hamdist: t -> t -> int = "ml_z_hamdist" +external size: t -> int = "ml_z_size" [@@noalloc] +external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc] +external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc] +external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc] +external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc] +external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc] +external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc] +external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc] +external extract: t -> int -> int -> t = "ml_z_extract" +external powm: t -> t -> t -> t = "ml_z_powm" +external pow: t -> int -> t = "ml_z_pow" +external powm_sec: t -> t -> t -> t = "ml_z_powm_sec" +external root: t -> int -> t = "ml_z_root" +external rootrem: t -> int -> t * t = "ml_z_rootrem" +external invert: t -> t -> t = "ml_z_invert" +external perfect_power: t -> bool = "ml_z_perfect_power" +external perfect_square: t -> bool = "ml_z_perfect_square" +external probab_prime: t -> int -> int = "ml_z_probab_prime" +external nextprime: t -> t = "ml_z_nextprime" +let hash: t -> int = Stdlib.Hashtbl.hash +let seeded_hash: int -> t -> int = Stdlib.Hashtbl.seeded_hash +external to_bits: t -> string = "ml_z_to_bits" +external of_bits: string -> t = "ml_z_of_bits" + +external c_divisible: t -> t -> bool = "ml_z_divisible" + +let divisible x y = + if is_small_int x then + if is_small_int y then + if unsafe_to_int y = 0 + then unsafe_to_int x = 0 + else (unsafe_to_int x) mod (unsafe_to_int y) = 0 + else + (* If y divides x, we have |y| <= |x| or x = 0. + Here, x is small: min_int <= x <= max_int + and y is not small: y < min_int \/ y > max_int. + |y| <= |x| is possible only if + x = min_int and y = -min_int = max_int+1 . + So, the only two cases where y divides x are + x = 0 or x = min_int /\ y = -min_int. *) + unsafe_to_int x = 0 || (unsafe_to_int x = min_int && y = c_neg x) + else + c_divisible x y + +external congruent: t -> t -> t -> bool = "ml_z_congruent" +external jacobi: t -> t -> int = "ml_z_jacobi" +external legendre: t -> t -> int = "ml_z_legendre" +external kronecker: t -> t -> int = "ml_z_kronecker" +external remove: t -> t -> t * int = "ml_z_remove" +external fac: int -> t = "ml_z_fac" +external fac2: int -> t = "ml_z_fac2" +external facM: int -> int -> t = "ml_z_facM" +external primorial: int -> t = "ml_z_primorial" +external bin: t -> int -> t = "ml_z_bin" +external fib: int -> t = "ml_z_fib" +external lucnum: int -> t = "ml_z_lucnum" + +let zero = of_int 0 +let one = of_int 1 +let minus_one = of_int (-1) + +let min a b = if compare a b <= 0 then a else b +let max a b = if compare a b >= 0 then a else b + +let leq a b = compare a b <= 0 +let geq a b = compare a b >= 0 +let lt a b = compare a b < 0 +let gt a b = compare a b > 0 + +let to_string = format "%d" + +let of_string s = of_substring_base 0 s ~pos:0 ~len:(String.length s) +let of_substring = of_substring_base 0 +let of_string_base base s = of_substring_base base s ~pos:0 ~len:(String.length s) + +let ediv_rem a b = + (* we have a = q * b + r, but [Big_int]'s remainder satisfies 0 <= r < |b|, + while [Z]'s remainder satisfies -|b| < r < |b| and sign(r) = sign(a) + *) + let q,r = div_rem a b in + if sign r >= 0 then (q,r) else + if sign b >= 0 then (pred q, add r b) + else (succ q, sub r b) + +let ediv a b = + if sign b >= 0 then fdiv a b else cdiv a b + +let erem a b = + let r = rem a b in + if sign r >= 0 then r else add r (abs b) + +let gcdext u v = + match sign u, sign v with + (* special cases: one argument is null *) + | 0, 0 -> zero, zero, zero + | 0, 1 -> v, zero, one + | 0, -1 -> neg v, zero, minus_one + | 1, 0 -> u, one, zero + | -1, 0 -> neg u, minus_one, zero + | _ -> + (* general case *) + let g,s,z = gcdext_intern u v in + if z then g, s, div (sub g (mul u s)) v + else g, div (sub g (mul v s)) u, s + +let lcm u v = + if u = zero || v = zero then zero + else + let g = gcd u v in + abs (mul (divexact u g) v) + +external testbit_internal: t -> int -> bool = "ml_z_testbit" [@@noalloc] +let testbit x n = + if n >= 0 then testbit_internal x n else invalid_arg "Z.testbit" +(* The test [n >= 0] is done in Caml rather than in the C stub code + so that the latter raises no exceptions and can be declared [@@noalloc]. *) + +let is_odd x = testbit_internal x 0 +let is_even x = not (testbit_internal x 0) + +external c_extract_small: t -> int -> int -> t + = "ml_z_extract_small" [@@noalloc] +external c_extract: t -> int -> int -> t = "ml_z_extract" + +let extract_internal x o l = + if is_small_int x then + (* Fast path *) + let o = if o >= Sys.int_size then Sys.int_size - 1 else o in + (* Shift away low "o" bits. If "o" too big, just replicate sign bit. *) + let z = unsafe_to_int x asr o in + if l < Sys.int_size then + (* Extract "l" low bits, if "l" is small enough *) + of_int (z land ((1 lsl l) - 1)) + else if z >= 0 then + (* If x >= 0, the extraction of "l" low bits keeps x unchanged. *) + of_int z + else + (* If x < 0, fall through slow path *) + c_extract x o l + else if l < Sys.int_size then + (* Alternative fast path since no allocation is required *) + c_extract_small x o l + else + c_extract x o l + +let extract x o l = + if o < 0 then invalid_arg "Z.extract: negative bit offset"; + if l < 1 then invalid_arg "Z.extract: nonpositive bit length"; + extract_internal x o l + +let signed_extract x o l = + if o < 0 then invalid_arg "Z.signed_extract: negative bit offset"; + if l < 1 then invalid_arg "Z.signed_extract: nonpositive bit length"; + if testbit x (o + l - 1) + then lognot (extract (lognot x) o l) + else extract x o l + +let log2 x = + if sign x > 0 then (numbits x) - 1 else invalid_arg "Z.log2" +let log2up x = + if sign x > 0 then numbits (pred x) else invalid_arg "Z.log2up" + +(* Consider a real number [r] such that + - the integral part of [r] is the bigint [x] + - 2^54 <= |x| < 2^63 + - the fractional part of [r] is 0 if [exact = true], + nonzero if [exact = false]. + Then, the following function returns [r] correctly rounded + according to the current rounding mode of the processor. + This is an instance of the "round to odd" technique formalized in + "When double rounding is odd" by S. Boldo and G. Melquiond. + The claim above is lemma Fappli_IEEE_extra.round_odd_fix + from the CompCert Coq development. *) + +let round_to_float x exact = + let m = to_int64 x in + (* Unless the fractional part is exactly 0, round m to an odd integer *) + let m = if exact then m else Int64.logor m 1L in + (* Then convert m to float, with the current rounding mode. *) + Int64.to_float m + +let to_float x = + if Obj.is_int (Obj.repr x) then + (* Fast path *) + float_of_int (Obj.magic x : int) + else begin + let n = numbits x in + if n <= 63 then + Int64.to_float (to_int64 x) + else begin + let n = n - 55 in + (* Extract top 55 bits of x *) + let top = shift_right x n in + (* Check if the other bits are all zero *) + let exact = equal x (shift_left top n) in + (* Round to float and apply exponent *) + ldexp (round_to_float top exact) n + end + end + +(* Formatting *) + +let print x = print_string (to_string x) +let output chan x = output_string chan (to_string x) +let sprint () x = to_string x +let bprint b x = Buffer.add_string b (to_string x) +let pp_print f x = Format.pp_print_string f (to_string x) + +(* Pseudo-random generation *) + +let rec raw_bits_random ?(rng: Random.State.t option) nbits = + let rec raw_bits accu n = + if n >= nbits then (accu, n) else begin + let i = + match rng with + | None -> Random.bits () + | Some r -> Random.State.bits r in + raw_bits (logxor (shift_left accu 30) (of_int i)) (n + 30) + end in + raw_bits zero 0 + +let raw_bits_from_bytes ~(fill: bytes -> int -> int -> unit) nbits = + let nbytes = (nbits + 7) / 8 in + let buf = Bytes.create nbytes in + fill buf 0 nbytes; + (of_bits (Bytes.to_string buf), nbytes * 8) + +let random_bits_aux (f: int -> t * int) nbits = + if nbits < 0 then invalid_arg "random_bits: number of bits must be >= 0"; + let (x, _) = f nbits in + extract x 0 nbits + +let random_int_aux (f: int -> t * int) bound = + if sign bound <= 0 then invalid_arg "random_int: bound must be > 0"; + let nbits1 = log2up bound in + let rec draw () = + (* The minimal number of random bits we need to draw is nbits1. + However, in the worst case, rejection (as described below) + will occur with probability almost 1/2. So, we draw more bits + than strictly necessary to make rejection much less likely. + With 4 extra bits, the probability of rejection is less than + 1/32. *) + let (x, nbits) = f (nbits1 + 4) in + let y = rem x bound in + (* We divide the range of x, namely [0 .. 2^nbits), into + - k intervals of width bound : + [0 .. bound) [bound.. 2*bound) .. [(k-1) * bound.. k * bound) + - the remaining numbers: [k * bound .. 2^nbits) + + k is chosen as large as possible: k = floor (2^nbits / bound). + + If x falls within the k intervals of width bound, + y = x mod bound is evenly distributed in [0 .. bound) + and we can use it as the pseudo-random number. + If x falls within the [k * bound .. 2^nbits) interval, + y = x mod bound may not be evenly distributed; + we reject and draw again. + + We can decide efficiently whether to reject, as follows. + Write 2^nbits = k * bound + r and x = q * bound + y, + with r and y in [0 .. bound). + If x - y <= 2^nbits - bound, then + q * bound = x - y <= 2^nbits - bound < 2^nbits - r = k * bound, + hence q < k and we can accept x. + Otherwise, + q * bound = x - y > 2^nbits - bound = (k - 1) * bound + r + hence q >= k and we must reject x. + *) + if leq (sub x y) (sub (shift_left one nbits) bound) + then y + else draw () in + draw () + +let random_int ?rng bound = + random_int_aux (raw_bits_random ?rng) bound +let random_bits ?rng nbits = + random_bits_aux (raw_bits_random ?rng) nbits + +let random_int_gen ~fill bound = + random_int_aux (raw_bits_from_bytes ~fill) bound +let random_bits_gen ~fill nbits = + random_bits_aux (raw_bits_from_bytes ~fill) nbits + +(* Infix notations *) + +let (~-) = neg +let (~+) x = x +let (+) = add +let (-) = sub +let ( * ) = mul +let (/) = div +external (/>): t -> t -> t = "ml_z_cdiv" +external (/<): t -> t -> t = "ml_z_fdiv" +let (/|) = divexact +let (mod) = rem +let (land) = logand +let (lor) = logor +let (lxor) = logxor +let (~!) = lognot +let (lsl) = shift_left +let (asr) = shift_right +external (~$): int -> t = "%identity" +external ( ** ): t -> int -> t = "ml_z_pow" + +module Compare = struct + let (=) = equal + let (<) = lt + let (>) = gt + let (<=) = leq + let (>=) = geq + let (<>) a b = not (equal a b) +end + +let version = Zarith_version.version diff --git a/unikernel/duniverse/Zarith/z.mli b/unikernel/duniverse/Zarith/z.mli new file mode 100644 index 00000000..17949426 --- /dev/null +++ b/unikernel/duniverse/Zarith/z.mli @@ -0,0 +1,880 @@ +(** + Integers. + + This modules provides arbitrary-precision integers. + Small integers internally use a regular OCaml [int]. + When numbers grow too large, we switch transparently to GMP numbers + ([mpn] numbers fully allocated on the OCaml heap). + + This interface is rather similar to that of [Int32] and [Int64], + with some additional functions provided natively by GMP + (GCD, square root, pop-count, etc.). + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + + +(** {1 Toplevel} *) + +(** For an optimal experience with the [ocaml] interactive toplevel, + the magic commands are: + + {[ + #load "zarith.cma";; + #install_printer Z.pp_print;; + ]} + + Alternatively, using the new [Zarith_top] toplevel module, simply: + {[ + #require "zarith.top";; + ]} +*) + + + +(** {1 Types} *) + +type t +(** Type of integers of arbitrary length. *) + +exception Overflow +(** Raised by conversion functions when the value cannot be represented in + the destination type. + *) + +(** {1 Construction} *) + +val zero: t +(** The number 0. *) + +val one: t +(** The number 1. *) + +val minus_one: t +(** The number -1. *) + +external of_int: int -> t = "%identity" +(** Converts from a base integer. *) + +external of_int32: int32 -> t = "ml_z_of_int32" +(** Converts from a 32-bit (signed) integer. *) + +external of_int64: int64 -> t = "ml_z_of_int64" +(** Converts from a 64-bit (signed) integer. *) + +external of_nativeint: nativeint -> t = "ml_z_of_nativeint" +(** Converts from a native (signed) integer. *) + +val of_int32_unsigned: int32 -> t +(** Converts from a 32-bit integer, interpreted as an unsigned integer. + @since 1.13 + *) + +val of_int64_unsigned: int64 -> t +(** Converts from a 64-bit integer, interpreted as an unsigned integer. + @since 1.13 + *) + +val of_nativeint_unsigned: nativeint -> t +(** Converts from a native integer, interpreted as an unsigned integer.. + @since 1.13 + *) + +external of_float: float -> t = "ml_z_of_float" +(** Converts from a floating-point value. + The value is truncated (rounded towards zero). + Raises [Overflow] on infinity and NaN arguments. + *) + +val of_string: string -> t +(** Converts a string to an integer. + An optional [-] prefix indicates a negative number, while a [+] + prefix is ignored. + An optional prefix [0x], [0o], or [0b] (following the optional [-] + or [+] prefix) indicates that the number is, + represented, in hexadecimal, octal, or binary, respectively. + Otherwise, base 10 is assumed. + (Unlike C, a lone [0] prefix does not denote octal.) + Raises an [Invalid_argument] exception if the string is not a + syntactically correct representation of an integer. + *) + +val of_substring : string -> pos:int -> len:int -> t +(** [of_substring s ~pos ~len] is the same as [of_string (String.sub s + pos len)] + @since 1.4 +*) + +val of_string_base: int -> string -> t +(** Parses a number represented as a string in the specified base, + with optional [-] or [+] prefix. + The base must be between 2 and 16. + *) + +external of_substring_base + : int -> string -> pos:int -> len:int -> t + = "ml_z_of_substring_base" +(** [of_substring_base base s ~pos ~len] is the same as [of_string_base + base (String.sub s pos len)] + @since 1.4 +*) + + +(** {1 Basic arithmetic operations} *) + +val succ: t -> t +(** Returns its argument plus one. *) + +val pred: t -> t +(** Returns its argument minus one. *) + +val abs: t -> t +(** Absolute value. *) + +val neg: t -> t +(** Unary negation. *) + +val add: t -> t -> t +(** Addition. *) + +val sub: t -> t -> t +(** Subtraction. *) + +val mul: t -> t -> t +(** Multiplication. *) + +val div: t -> t -> t +(** Integer division. The result is truncated towards zero + and obeys the rule of signs. + Raises [Division_by_zero] if the divisor (second argument) is 0. + *) + +val rem: t -> t -> t +(** Integer remainder. Can raise a [Division_by_zero]. + The result of [rem a b] has the sign of [a], and its absolute value is + strictly smaller than the absolute value of [b]. + The result satisfies the equality [a = b * div a b + rem a b]. + *) + +external div_rem: t -> t -> (t * t) = "ml_z_div_rem" +(** Computes both the integer quotient and the remainder. + [div_rem a b] is equal to [(div a b, rem a b)]. + Raises [Division_by_zero] if [b = 0]. + *) + +external cdiv: t -> t -> t = "ml_z_cdiv" +(** Integer division with rounding towards +oo (ceiling). + Can raise a [Division_by_zero]. + *) + +external fdiv: t -> t -> t = "ml_z_fdiv" +(** Integer division with rounding towards -oo (floor). + Can raise a [Division_by_zero]. + *) + +val ediv_rem: t -> t -> (t * t) +(** Euclidean division and remainder. [ediv_rem a b] returns a pair [(q, r)] + such that [a = b * q + r] and [0 <= r < |b|]. + Raises [Division_by_zero] if [b = 0]. + *) + +val ediv: t -> t -> t +(** Euclidean division. [ediv a b] is equal to [fst (ediv_rem a b)]. + The result satisfies [0 <= a - b * ediv a b < |b|]. + Raises [Division_by_zero] if [b = 0]. + *) + +val erem: t -> t -> t +(** Euclidean remainder. [erem a b] is equal to [snd (ediv_rem a b)]. + The result satisfies [0 <= erem a b < |b|] and + [a = b * ediv a b + erem a b]. Raises [Division_by_zero] if [b = 0]. + *) + +val divexact: t -> t -> t +(** [divexact a b] divides [a] by [b], only producing correct result when the + division is exact, i.e., when [b] evenly divides [a]. + It should be faster than general division. + Can raise a [Division_by_zero]. +*) + +val divisible: t -> t -> bool +(** [divisible a b] returns [true] if [a] is exactly divisible by [b]. + Unlike the other division functions, [b = 0] is accepted + (only 0 is considered divisible by 0). + @since 1.10 +*) + +external congruent: t -> t -> t -> bool = "ml_z_congruent" +(** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c]. + Unlike the other division functions, [c = 0] is accepted + (only equal numbers are considered equal congruent 0). + @since 1.10 +*) + + + + +(** {1 Bit-level operations} *) + +(** For all bit-level operations, negative numbers are considered in 2's + complement representation, starting with a virtual infinite number of + 1s. + *) + +val logand: t -> t -> t +(** Bitwise logical and. *) + +val logor: t -> t -> t +(** Bitwise logical or. *) + +val logxor: t -> t -> t +(** Bitwise logical exclusive or. *) + +val lognot: t -> t +(** Bitwise logical negation. + The identity [lognot a]=[-a-1] always hold. + *) + +val shift_left: t -> int -> t +(** Shifts to the left. + Equivalent to a multiplication by a power of 2. + The second argument must be nonnegative. + *) + +val shift_right: t -> int -> t +(** Shifts to the right. + This is an arithmetic shift, + equivalent to a division by a power of 2 with rounding towards -oo. + The second argument must be nonnegative. + *) + +val shift_right_trunc: t -> int -> t +(** Shifts to the right, rounding towards 0. + This is equivalent to a division by a power of 2, with truncation. + The second argument must be nonnegative. + *) + +external numbits: t -> int = "ml_z_numbits" [@@noalloc] +(** Returns the number of significant bits in the given number. + If [x] is zero, [numbits x] returns 0. Otherwise, + [numbits x] returns a positive integer [n] such that + [2^{n-1} <= |x| < 2^n]. Note that [numbits] is defined + for negative arguments, and that [numbits (-x) = numbits x]. + @since 1.4 +*) + +external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc] +(** Returns the number of trailing 0 bits in the given number. + If [x] is zero, [trailing_zeros x] returns [max_int]. + Otherwise, [trailing_zeros x] returns a nonnegative integer [n] + which is the largest [n] such that [2^n] divides [x] evenly. + Note that [trailing_zeros] is defined for negative arguments, + and that [trailing_zeros (-x) = trailing_zeros x]. + @since 1.4 +*) + +val testbit: t -> int -> bool +(** [testbit x n] return the value of bit number [n] in [x]: + [true] if the bit is 1, [false] if the bit is 0. + Bits are numbered from 0. Raise [Invalid_argument] if [n] + is negative. + @since 1.4 +*) + +external popcount: t -> int = "ml_z_popcount" +(** Counts the number of bits set. + Raises [Overflow] for negative arguments, as those have an infinite + number of bits set. + *) + +external hamdist: t -> t -> int = "ml_z_hamdist" +(** Counts the number of different bits. + Raises [Overflow] if the arguments have different signs + (in which case the distance is infinite). + *) + +(** {1 Conversions} *) + +(** Note that, when converting to an integer type that cannot represent the + converted value, an [Overflow] exception is raised. + *) + +val to_int: t -> int +(** Converts to a signed OCaml [int]. + Raises an [Overflow] if the value does not fit in a signed OCaml [int]. *) + +external to_int32: t -> int32 = "ml_z_to_int32" +(** Converts to a signed 32-bit integer [int32]. + Raises an [Overflow] if the value does not fit in a signed [int32]. *) + +external to_int64: t -> int64 = "ml_z_to_int64" +(** Converts to a signed 64-bit integer [int64]. + Raises an [Overflow] if the value does not fit in a signed [int64]. *) + +external to_nativeint: t -> nativeint = "ml_z_to_nativeint" +(** Converts to a native signed integer [nativeint]. + Raises an [Overflow] if the value does not fit in a signed [nativeint]. *) + +external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned" +(** Converts to an unsigned 32-bit integer. + The result is stored into an OCaml [int32]. + Beware that most [Int32] operations consider [int32] to a signed type, not unsigned. + Raises an [Overflow] if the value is negative or does not fit in an unsigned 32-bit integer. + @since 1.13 +*) + +external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned" +(** Converts to an unsigned 64-bit integer. + The result is stored into an OCaml [int64]. + Beware that most [Int64] operations consider [int64] to a signed type, not unsigned. + Raises an [Overflow] if the value is negative or does not fit in an unsigned 64-bit integer. + @since 1.13 + *) + +external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned" +(** Converts to a native unsigned integer. + The result is stored into an OCaml [nativeint]. + Beware that most [Nativeint] operations consider [nativeint] to a signed type, not unsigned. + Raises an [Overflow] if the value is negative or does not fit in an unsigned native integer. + @since 1.13 + *) + +val to_float: t -> float +(** Converts to a floating-point value. + This function rounds the given integer according to the current + rounding mode of the processor. In default mode, it returns + the floating-point number nearest to the given integer, + breaking ties by rounding to even. *) + +val to_string: t -> string +(** Gives a human-readable, decimal string representation of the argument. *) + +external format: string -> t -> string = "ml_z_format" +(** Gives a string representation of the argument in the specified + printf-like format. + The general specification has the following form: + + [% \[flags\] \[width\] type] + + Where the type actually indicates the base: + + - [i], [d], [u]: decimal + - [b]: binary + - [o]: octal + - [x]: lowercase hexadecimal + - [X]: uppercase hexadecimal + + Supported flags are: + + - [+]: prefix positive numbers with a [+] sign + - space: prefix positive numbers with a space + - [-]: left-justify (default is right justification) + - [0]: pad with zeroes (instead of spaces) + - [#]: alternate formatting (actually, simply output a literal-like prefix: [0x], [0b], [0o]) + + Unlike the classic [printf], all numbers are signed (even hexadecimal ones), + there is no precision field, and characters that are not part of the format + are simply ignored (and not copied in the output). + *) + +external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc] +(** Whether the argument fits in an OCaml signed [int]. *) + +external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc] +(** Whether the argument fits in a signed [int32]. *) + +external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc] +(** Whether the argument fits in a signed [int64]. *) + +external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc] +(** Whether the argument fits in a signed [nativeint]. *) + +external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc] +(** Whether the argument is non-negative and fits in an unsigned [int32]. + @since 1.13 + *) + +external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc] +(** Whether the argument is non-negative and fits in an unsigned [int64]. + @since 1.13 +*) + +external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc] +(** Whether the argument is non-negative fits in an unsigned [nativeint]. + @since 1.13 + *) + + +(** {1 Printing} *) + +val print: t -> unit +(** Prints the argument on the standard output. *) + +val output: out_channel -> t -> unit +(** Prints the argument on the specified channel. + Also intended to be used as [%a] format printer in [Printf.printf]. + *) + +val sprint: unit -> t -> string +(** To be used as [%a] format printer in [Printf.sprintf]. *) + +val bprint: Buffer.t -> t -> unit +(** To be used as [%a] format printer in [Printf.bprintf]. *) + +val pp_print: Format.formatter -> t -> unit +(** Prints the argument on the specified formatter. + Can be used as [%a] format printer in [Format.printf] and as + argument to [#install_printer] in the top-level. + *) + + +(** {1 Ordering} *) + +external compare: t -> t -> int = "ml_z_compare" [@@noalloc] +(** Comparison. [compare x y] returns 0 if [x] equals [y], + -1 if [x] is smaller than [y], and 1 if [x] is greater than [y]. + + Note that Pervasive.compare can be used to compare reliably two integers + only on OCaml 3.12.1 and later versions. + *) + +external equal: t -> t -> bool = "ml_z_equal" [@@noalloc] +(** Equality test. *) + +val leq: t -> t -> bool +(** Less than or equal. *) + +val geq: t -> t -> bool +(** Greater than or equal. *) + +val lt: t -> t -> bool +(** Less than (and not equal). *) + +val gt: t -> t -> bool +(** Greater than (and not equal). *) + +external sign: t -> int = "ml_z_sign" [@@noalloc] +(** Returns -1, 0, or 1 when the argument is respectively negative, null, or + positive. + *) + +val min: t -> t -> t +(** Returns the minimum of its arguments. *) + +val max: t -> t -> t +(** Returns the maximum of its arguments. *) + +val is_even: t -> bool +(** Returns true if the argument is even (divisible by 2), false if odd. + @since 1.4 +*) + +val is_odd: t -> bool +(** Returns true if the argument is odd, false if even. + @since 1.4 +*) + +val hash: t -> int +(** Hashes a number, producing a small integer. + The result is consistent with equality: + if [a] = [b], then [hash a] = [hash b]. + The result is the same as produced by OCaml's generic hash function, + {!Hashtbl.hash}. + Together with type {!Z.t}, the function {!Z.hash} makes it possible + to pass module {!Z} as argument to the functor {!Hashtbl.Make}. + @before 1.14 a different hash algorithm was used. +*) + +val seeded_hash: int -> t -> int +(** Like {!Z.hash}, but takes a seed as extra argument for diversification. + The result is the same as produced by OCaml's generic seeded hash function, + {!Hashtbl.seeded_hash}. + Together with type {!Z.t}, the function {!Z.hash} makes it possible + to pass module {!Z} as argument to the functor {!Hashtbl.MakeSeeded}. + @since 1.14 +*) + +(** {1 Elementary number theory} *) + +external gcd: t -> t -> t = "ml_z_gcd" +(** Greatest common divisor. + The result is always nonnegative. + We have [gcd(a,0) = gcd(0,a) = abs(a)], including [gcd(0,0) = 0]. +*) + +val gcdext: t -> t -> (t * t * t) +(** [gcdext u v] returns [(g,s,t)] where [g] is the greatest common divisor + and [g=us+vt]. + [g] is always nonnegative. + + Note: the function is based on the GMP [mpn_gcdext] function. The exact choice of [s] and [t] such that [g=us+vt] is not specified, as it may vary from a version of GMP to another (it has changed notably in GMP 4.3.0 and 4.3.1). + *) + +val lcm: t -> t -> t +(** + Least common multiple. + The result is always nonnegative. + We have [lcm(a,0) = lcm(0,a) = 0]. + *) + +external powm: t -> t -> t -> t = "ml_z_powm" +(** [powm base exp mod] computes [base]^[exp] modulo [mod]. + Negative [exp] are supported, in which case ([base]^-1)^(-[exp]) modulo + [mod] is computed. + However, if [exp] is negative but [base] has no inverse modulo [mod], then + a [Division_by_zero] is raised. + *) + +external powm_sec: t -> t -> t -> t = "ml_z_powm_sec" +(** [powm_sec base exp mod] computes [base]^[exp] modulo [mod]. + Unlike [Z.powm], this function is designed to take the same time + and have the same cache access patterns for any two same-size + arguments. Used in cryptographic applications, it provides better + resistance to side-channel attacks than [Z.powm]. + The exponent [exp] must be positive, and the modulus [mod] + must be odd. Otherwise, [Invalid_arg] is raised. + @since 1.4 +*) + +external invert: t -> t -> t = "ml_z_invert" +(** [invert base mod] returns the inverse of [base] modulo [mod]. + Raises a [Division_by_zero] if [base] is not invertible modulo [mod]. + *) + +external probab_prime: t -> int -> int = "ml_z_probab_prime" +(** [probab_prime x r] returns 0 if [x] is definitely composite, + 1 if [x] is probably prime, and 2 if [x] is definitely prime. + The [r] argument controls how many Miller-Rabin probabilistic + primality tests are performed (5 to 10 is a reasonable value). + *) + +external nextprime: t -> t = "ml_z_nextprime" +(** Returns the next prime greater than the argument. + The result is only prime with very high probability. + *) + +external jacobi: t -> t -> int = "ml_z_jacobi" +(** [jacobi a b] returns the Jacobi symbol [(a/b)]. + @since 1.10 *) + +external legendre: t -> t -> int = "ml_z_legendre" +(** [legendre a b] returns the Legendre symbol [(a/b)]. + @since 1.10 *) + +external kronecker: t -> t -> int = "ml_z_kronecker" +(** [kronecker a b] returns the Kronecker symbol [(a/b)]. + @since 1.10 *) + +external remove: t -> t -> t * int = "ml_z_remove" +(** [remove a b] returns [a] after removing all the occurences of the + factor [b]. + Also returns how many occurrences were removed. + @since 1.10 *) + +external fac: int -> t = "ml_z_fac" +(** [fac n] returns the factorial of [n] ([n!]). + Raises an [Invaid_argument] if [n] is non-positive. + @since 1.10 *) + +external fac2: int -> t = "ml_z_fac2" +(** [fac2 n] returns the double factorial of [n] ([n!!]). + Raises an [Invaid_argument] if [n] is non-positive. + @since 1.10 *) + + external facM: int -> int -> t = "ml_z_facM" +(** [facM n m] returns the [m]-th factorial of [n]. + Raises an [Invaid_argument] if [n] or [m] is non-positive. + @since 1.10 *) + +external primorial: int -> t = "ml_z_primorial" +(** [primorial n] returns the product of all positive prime numbers less + than or equal to [n]. + Raises an [Invaid_argument] if [n] is non-positive. + @since 1.10 *) + +external bin: t -> int -> t = "ml_z_bin" +(** [bin n k] returns the binomial coefficient [n] over [k]. + Raises an [Invaid_argument] if [k] is non-positive. + @since 1.10 *) + +external fib: int -> t = "ml_z_fib" +(** [fib n] returns the [n]-th Fibonacci number. + Raises an [Invaid_argument] if [n] is non-positive. + @since 1.10 *) + +external lucnum: int -> t = "ml_z_lucnum" +(** [lucnum n] returns the [n]-th Lucas number. + Raises an [Invaid_argument] if [n] is non-positive. + @since 1.10 *) + + +(** {1 Powers} *) + +external pow: t -> int -> t = "ml_z_pow" +(** [pow base exp] raises [base] to the [exp] power. + [exp] must be nonnegative. + Note that only exponents fitting in a machine integer are supported, as + larger exponents would surely make the result's size overflow the + address space. + *) + +external sqrt: t -> t = "ml_z_sqrt" +(** Returns the square root. The result is truncated (rounded down + to an integer). + Raises an [Invalid_argument] on negative arguments. + *) + +external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem" +(** Returns the square root truncated, and the remainder. + Raises an [Invalid_argument] on negative arguments. + *) + +external root: t -> int -> t = "ml_z_root" +(** [root x n] computes the [n]-th root of [x]. + [n] must be positive and, if [n] is even, then [x] must be nonnegative. + Otherwise, an [Invalid_argument] is raised. + *) + +external rootrem: t -> int -> t * t = "ml_z_rootrem" +(** [rootrem x n] computes the [n]-th root of [x] and the remainder + [x-root**n]. + [n] must be positive and, if [n] is even, then [x] must be nonnegative. + Otherwise, an [Invalid_argument] is raised. + @since 1.10 *) + +external perfect_power: t -> bool = "ml_z_perfect_power" +(** True if the argument has the form [a^b], with [b>1] *) + +external perfect_square: t -> bool = "ml_z_perfect_square" +(** True if the argument has the form [a^2]. *) + +val log2: t -> int +(** Returns the base-2 logarithm of its argument, rounded down to + an integer. If [x] is positive, [log2 x] returns the largest [n] + such that [2^n <= x]. If [x] is negative or zero, [log2 x] raise + the [Invalid_argument] exception. + @since 1.4 +*) + +val log2up: t -> int +(** Returns the base-2 logarithm of its argument, rounded up to + an integer. If [x] is positive, [log2up x] returns the smallest [n] + such that [x <= 2^n]. If [x] is negative or zero, [log2up x] raise + the [Invalid_argument] exception. + @since 1.4 +*) + +(** {1 Representation} *) + +external size: t -> int = "ml_z_size" [@@noalloc] +(** Returns the number of machine words used to represent the number. *) + +val extract: t -> int -> int -> t +(** [extract a off len] returns a nonnegative number corresponding to bits + [off] to [off]+[len]-1 of [a]. + Negative [a] are considered in infinite-length 2's complement + representation. + Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null. + *) + +val signed_extract: t -> int -> int -> t +(** [signed_extract a off len] extracts bits [off] to [off]+[len]-1 of [b], + as [extract] does, then sign-extends bit [len-1] of the result + (that is, bit [off + len - 1] of [a]). The result is between + [- 2{^[len]-1}] (included) and [2{^[len]-1}] (excluded), + and equal to [extract a off len] modulo [2{^len}]. + Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null. + *) + +external to_bits: t -> string = "ml_z_to_bits" +(** Returns a binary representation of the argument. + The string result should be interpreted as a sequence of bytes, + corresponding to the binary representation of the absolute value of + the argument in little endian ordering. + The sign is not stored in the string. + *) + +external of_bits: string -> t = "ml_z_of_bits" +(** Constructs a number from a binary string representation. + The string is interpreted as a sequence of bytes in little endian order, + and the result is always positive. + We have the identity: [of_bits (to_bits x) = abs x]. + However, we can have [to_bits (of_bits s) <> s] due to the presence of + trailing zeros in s. + *) + +(** {1 Pseudo-random number generation} *) + +val random_int: ?rng: Random.State.t -> t -> t +(** [random_int bound] returns a random integer between 0 (inclusive) + and [bound] (exclusive). [bound] must be greater than 0. + + The source of randomness is the {!Random} module from the OCaml + standard library. The optional [rng] argument specifies which + random state to use. If omitted, the default random state for the + {!Random} module is used. + + Random numbers produced by this function are not cryptographically + strong and must not be used in cryptographic or high-security + contexts. See {!Z.random_int_gen} for an alternative. + + @since 1.13 +*) + +val random_bits: ?rng: Random.State.t -> int -> t +(** [random_bits nbits] returns a random integer between 0 (inclusive) + and [2{^nbits}] (exclusive). [nbits] must be nonnegative. + This is a more efficient special case of {!Z.random_int} when the + bound is a power of two. + + The source of randomness and the [rng] optional argument are as + described in {!Z.random_int}. + + Random numbers produced by this function are not cryptographically + strong and must not be used in cryptographic or high-security + contexts. See {!Z.random_bits_gen} for an alternative. + + @since 1.13 +*) + +val random_int_gen: fill: (bytes -> int -> int -> unit) -> t -> t +(** [random_int_gen ~fill bound] returns a random integer between 0 (inclusive) + and [bound] (exclusive). [bound] must be greater than 0. + + The [fill] parameter is the source of randomness. It is called + as [fill buf pos len], and is responsible for drawing [len] random + bytes and writing them to offsets [pos] to [pos + len - 1] of + the byte array [buf]. + + Example of use where [/dev/random] provides the random bytes: +<< + In_channel.with_open_bin "/dev/random" + (fun ic -> Z.random_int_gen ~fill:(really_input ic) bound) +>> + Example of use where the Cryptokit library provides the random bytes: +<< + Z.random_int_gen ~fill:Cryptokit.Random.secure_rng#bytes bound +>> + @since 1.13 +*) + +val random_bits_gen: fill: (bytes -> int -> int -> unit) -> int -> t +(** [random_bits_gen ~fill nbits] returns a random integer between 0 (inclusive) + and [2{^nbits}] (exclusive). [nbits] must be nonnegative. + This is a more efficient special case of {!Z.random_int_gen} when the + bound is a power of two. The [fill] parameter is as described in + {!Z.random_int_gen}. + @since 1.13 +*) + +(** {1 Prefix and infix operators} *) + +(** + Classic (and less classic) prefix and infix [int] operators are + redefined on [t]. + + This makes it easy to typeset expressions. + Using OCaml 3.12's local open, you can simply write + [Z.(~$2 + ~$5 * ~$10)]. + *) + +val (~-): t -> t +(** Negation [neg]. *) + +val (~+): t -> t +(** Identity. *) + +val (+): t -> t -> t +(** Addition [add]. *) + +val (-): t -> t -> t +(** Subtraction [sub]. *) + +val ( * ): t -> t -> t +(** Multiplication [mul]. *) + +val (/): t -> t -> t +(** Truncated division [div]. *) + +external (/>): t -> t -> t = "ml_z_cdiv" +(** Ceiling division [cdiv]. *) + +external (/<): t -> t -> t = "ml_z_fdiv" +(** Flooring division [fdiv]. *) + +val (/|): t -> t -> t +(** Exact division [divexact]. *) + +val (mod): t -> t -> t +(** Remainder [rem]. *) + +val (land): t -> t -> t +(** Bit-wise logical and [logand]. *) + +val (lor): t -> t -> t +(** Bit-wise logical inclusive or [logor]. *) + +val (lxor): t -> t -> t +(** Bit-wise logical exclusive or [logxor]. *) + +val (~!): t -> t +(** Bit-wise logical negation [lognot]. *) + +val (lsl): t -> int -> t +(** Bit-wise shift to the left [shift_left]. *) + +val (asr): t -> int -> t +(** Bit-wise shift to the right [shift_right]. *) + +external (~$): int -> t = "%identity" + +(** Conversion from [int] [of_int]. *) + +external ( ** ): t -> int -> t = "ml_z_pow" +(** Power [pow]. *) + +module Compare : sig + + val (=): t -> t -> bool + (** Same as [equal]. *) + + val (<): t -> t -> bool + (** Same as [lt]. *) + + val (>): t -> t -> bool + (** Same as [gt]. *) + + val (<=): t -> t -> bool + (** Same as [leq]. *) + + val (>=): t -> t -> bool + (** Same as [geq]. *) + + val (<>): t -> t -> bool + (** [a <> b] is equivalent to [not (equal a b)]. *) + +end + +(** {1 Miscellaneous} *) + +val version: string +(** Library version. + @since 1.1 +*) + +(**/**) + +(** For internal use in module [Q]. *) +val round_to_float: t -> bool -> float diff --git a/unikernel/duniverse/Zarith/z_mlgmpidl.ml b/unikernel/duniverse/Zarith/z_mlgmpidl.ml new file mode 100644 index 00000000..429426c6 --- /dev/null +++ b/unikernel/duniverse/Zarith/z_mlgmpidl.ml @@ -0,0 +1,49 @@ +(** + Conversion between Zarith and MLGmpIDL integers and rationals. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + +external mlgmpidl_of_mpz: Mpz.t -> Z.t = "ml_z_mlgmpidl_of_mpz" +external mlgmpidl_set_mpz: Mpz.t -> Z.t -> unit = "ml_z_mlgmpidl_set_mpz" + +let z_of_mpz x = + mlgmpidl_of_mpz x + +let mpz_of_z x = + let r = Mpz.init () in + mlgmpidl_set_mpz r x; + r + +let z_of_mpzf x = + z_of_mpz (Mpzf._mpz x) + +let mpzf_of_z x = + Mpzf._mpzf (mpz_of_z x) + +let q_of_mpq x = + let n,d = Mpz.init (), Mpz.init () in + Mpq.get_num n x; + Mpq.get_den d x; + Q.make (z_of_mpz n) (z_of_mpz d) + +let mpq_of_q x = + Mpq.of_mpz2 (mpz_of_z x.Q.num) (mpz_of_z x.Q.den) + +let q_of_mpqf x = + q_of_mpq (Mpqf._mpq x) + +let mpqf_of_q x = + Mpqf._mpqf (mpq_of_q x) diff --git a/unikernel/duniverse/Zarith/z_mlgmpidl.mli b/unikernel/duniverse/Zarith/z_mlgmpidl.mli new file mode 100644 index 00000000..d6be0762 --- /dev/null +++ b/unikernel/duniverse/Zarith/z_mlgmpidl.mli @@ -0,0 +1,26 @@ +(** + Conversion between Zarith and MLGmpIDL integers and rationals. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + + *) + +val z_of_mpz: Mpz.t -> Z.t +val mpz_of_z: Z.t -> Mpz.t +val z_of_mpzf: Mpzf.t -> Z.t +val mpzf_of_z: Z.t -> Mpzf.t +val q_of_mpq: Mpq.t -> Q.t +val mpq_of_q: Q.t -> Mpq.t +val q_of_mpqf: Mpqf.t -> Q.t +val mpqf_of_q: Q.t -> Mpqf.t diff --git a/unikernel/duniverse/Zarith/zarith.h b/unikernel/duniverse/Zarith/zarith.h new file mode 100644 index 00000000..1e97f792 --- /dev/null +++ b/unikernel/duniverse/Zarith/zarith.h @@ -0,0 +1,42 @@ +/** + Public C interface for Zarith. + + This is intended for C libraries that wish to convert between mpz_t and + Z.t objects. + + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + +*/ + + +/* gmp.h or mpir.h must be included manually before zarith.h */ + +#ifdef __cplusplus +extern "C" { +#endif + +#include + +/* sets rop to the value in op (limbs are copied) */ +void ml_z_mpz_set_z(mpz_t rop, value op); + +/* inits and sets rop to the value in op (limbs are copied) */ +void ml_z_mpz_init_set_z(mpz_t rop, value op); + +/* returns a new z objects equal to op (limbs are copied) */ +value ml_z_from_mpz(mpz_t op); + +#ifdef __cplusplus +} +#endif diff --git a/unikernel/duniverse/Zarith/zarith.opam b/unikernel/duniverse/Zarith/zarith.opam new file mode 100644 index 00000000..8c4c60f4 --- /dev/null +++ b/unikernel/duniverse/Zarith/zarith.opam @@ -0,0 +1,29 @@ +version: "release-1.14-1-gdf8969d" +opam-version: "2.0" +maintainer: "Xavier Leroy " +authors: [ + "Antoine Miné" + "Xavier Leroy" + "Pascal Cuoq" +] +homepage: "https://github.com/mirage/Zarith" +bug-reports: "https://github.com/mirage/Zarith/issues" +dev-repo: "git+https://github.com/mirage/Zarith.git" +license: "LGPL-2.0-only WITH OCaml-LGPL-linking-exception" +build: [ + ["dune" "build" "-p" "zarith" ] +] +depends: [ + "ocaml" {>= "4.07.0"} + "dune" {>= "2.8"} + ("gmp" | "conf-gmp" ) +] +conflicts: [ "gmp" {< "6.2.1-5"} ] +synopsis: + "Implements arithmetic and logical operations over arbitrary-precision integers" +description: """ +The Zarith library implements arithmetic and logical operations over +arbitrary-precision integers. It uses GMP to efficiently implement +arithmetic over big integers. Small integers are represented as Caml +unboxed integers, for speed and space economy.""" +tags: ["cross-compile"] \ No newline at end of file diff --git a/unikernel/duniverse/Zarith/zarith_top.ml b/unikernel/duniverse/Zarith/zarith_top.ml new file mode 100644 index 00000000..371c6f16 --- /dev/null +++ b/unikernel/duniverse/Zarith/zarith_top.ml @@ -0,0 +1,23 @@ +(* + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Contributed by Christophe Troestler. +*) + +open Printf + +let eval_string + ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str = + let lexbuf = Lexing.from_string str in + let phrase = !Toploop.parse_toplevel_phrase lexbuf in + Toploop.execute_phrase print_outcome err_formatter phrase + +let () = + let printers = ["Z.pp_print"; "Q.pp_print"] in + let ok = List.fold_left (fun b p -> + b && eval_string(sprintf "#install_printer %s;;" p)) + true printers in + if not ok then Format.eprintf "Problem installing ZArith-printers@." diff --git a/unikernel/duniverse/angstrom/.github/workflows/test.yml b/unikernel/duniverse/angstrom/.github/workflows/test.yml new file mode 100644 index 00000000..70a9f524 --- /dev/null +++ b/unikernel/duniverse/angstrom/.github/workflows/test.yml @@ -0,0 +1,77 @@ +name: build + +on: + - push + - pull_request + +jobs: + builds: + name: Earliest Supported Version + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + ocaml-version: + - 4.04.0 + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v2 + + - name: Use OCaml ${{ matrix.ocaml-version }} + uses: avsm/setup-ocaml@v1 + with: + ocaml-version: ${{ matrix.ocaml-version }} + + - name: Deps + run: | + opam pin add -n angstrom . + opam install --deps-only angstrom + + - name: Build + run: opam exec -- dune build -p angstrom + + tests: + name: Tests + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + ocaml-version: + - 4.08.1 + - 4.10.2 + - 4.11.2 + - 4.12.0 + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v2 + + - name: Use OCaml ${{ matrix.ocaml-version }} + uses: avsm/setup-ocaml@v1 + with: + ocaml-version: ${{ matrix.ocaml-version }} + + - name: Deps + run: | + opam pin add -n angstrom . + opam pin add -n angstrom-async . + opam pin add -n angstrom-lwt-unix . + opam install -t --deps-only . + + - name: Build + run: opam exec -- dune build + + - name: Test + run: opam exec -- dune runtest + + - name: Examples + run: | + opam install -t angstrom-async angstrom-lwt-unix + opam exec -- make examples diff --git a/unikernel/duniverse/angstrom/.gitignore b/unikernel/duniverse/angstrom/.gitignore new file mode 100644 index 00000000..098c4818 --- /dev/null +++ b/unikernel/duniverse/angstrom/.gitignore @@ -0,0 +1,12 @@ +.*.sw[a-z] +*~ +_build/ +_tests/ +lib_test/tests_ +setup.log +setup.data +*.native +*.byte +*.docdir +*.install +.merlin \ No newline at end of file diff --git a/unikernel/duniverse/angstrom/LICENSE b/unikernel/duniverse/angstrom/LICENSE new file mode 100644 index 00000000..680d9127 --- /dev/null +++ b/unikernel/duniverse/angstrom/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Inhabited Type LLC + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/unikernel/duniverse/angstrom/META.angstrom.template b/unikernel/duniverse/angstrom/META.angstrom.template new file mode 100644 index 00000000..e8f92b97 --- /dev/null +++ b/unikernel/duniverse/angstrom/META.angstrom.template @@ -0,0 +1,16 @@ +# JBUILDER_GEN + +package "unix" ( + description = "Deprecated. Use angstrom-unix directly" + requires = "angstrom-unix" +) + +package "lwt-unix" ( + description = "Deprecated. Use angstrom-lwt-unix directly" + requires = "angstrom-lwt-unix" +) + +package "async" ( + description = "Deprecated. Use angstrom-async directly" + requires = "angstrom-async" +) \ No newline at end of file diff --git a/unikernel/duniverse/angstrom/Makefile b/unikernel/duniverse/angstrom/Makefile new file mode 100644 index 00000000..699eaa37 --- /dev/null +++ b/unikernel/duniverse/angstrom/Makefile @@ -0,0 +1,24 @@ +.PHONY: all build clean test install uninstall doc examples + +build: + dune build + +all: build + +test: + dune runtest + +examples: + dune build @examples + +install: + dune install + +uninstall: + dune uninstall + +doc: + dune build @doc + +clean: + rm -rf _build *.install diff --git a/unikernel/duniverse/angstrom/README.md b/unikernel/duniverse/angstrom/README.md new file mode 100644 index 00000000..612fff43 --- /dev/null +++ b/unikernel/duniverse/angstrom/README.md @@ -0,0 +1,152 @@ +# Angstrom + +Angstrom is a parser-combinator library that makes it easy to write efficient, +expressive, and reusable parsers suitable for high-performance applications. It +exposes monadic and applicative interfaces for composition, and supports +incremental input through buffered and unbuffered interfaces. Both interfaces +give the user total control over the blocking behavior of their application, +with the unbuffered interface enabling zero-copy IO. Parsers are backtracking +by default and support unbounded lookahead. + +[![Build Status](https://github.com/inhabitedtype/angstrom/workflows/build/badge.svg)](https://github.com/inhabitedtype/angstrom/actions?query=workflow%3A%22build%22) + + +## Installation + +Install the library and its dependencies via [OPAM][opam]: + +[opam]: http://opam.ocaml.org/ + +```bash +opam install angstrom +``` + +## Usage + +Angstrom is written with network protocols and serialization formats in mind. +As such, its source distribution includes implementations of various RFCs that +are illustrative of real-world applications of the library. These include an +[HTTP parser][http] and a [JSON parser][json]. + +[http]: https://github.com/inhabitedtype/angstrom/blob/master/examples/rFC2616.ml +[json]: https://github.com/inhabitedtype/angstrom/blob/master/examples/rFC7159.ml + +In addition, it is an informal tradition for OCaml parser-combinator libraries +to include in their READMEs a parser for a simple arithmetic expression +language. The code below implements a parser for such a language and computes +the numerical result of the expression as it is being parsed. Because Angstrom +is written with network protocols and serialization libraries in mind, it does +not include combinators for creating infix expression parsers. Such +combinators, e.g., `chainl1`, are nevertheless simple to define. + +```ocaml +open Angstrom + +let parens p = char '(' *> p <* char ')' +let add = char '+' *> return (+) +let sub = char '-' *> return (-) +let mul = char '*' *> return ( * ) +let div = char '/' *> return (/) +let integer = + take_while1 (function '0' .. '9' -> true | _ -> false) >>| int_of_string + +let chainl1 e op = + let rec go acc = + (lift2 (fun f x -> f acc x) op e >>= go) <|> return acc in + e >>= fun init -> go init + +let expr : int t = + fix (fun expr -> + let factor = parens expr <|> integer in + let term = chainl1 factor (mul <|> div) in + chainl1 term (add <|> sub)) + +let eval (str:string) : int = + match parse_string ~consume:All expr str with + | Ok v -> v + | Error msg -> failwith msg +``` + +For an explanation of the infix operators and other combinators used in the +implementation of this example, see the documentation in the [`mli`][mli]. + +[mli]: https://github.com/inhabitedtype/angstrom/blob/master/lib/angstrom.mli + + +## Comparison to Other Libraries + +There are several other parser-combinator libraries available for OCaml that +may suit your needs, and are worth considering. Most of them are derivatives of +or inspired by [Parsec][]. As such, they require the use of a `try` combinator +to achieve backtracking, rather than providing it by default. They also all use +something akin to a lazy character stream as the underlying input abstraction. +While this suits Haskell quite nicely, it requires blocking read calls when the +entire input is not immediately available—an approach that is inherently +incompatible with monadic concurrency libraries such as [Async] and [Lwt], and +writing high-performance, concurrent applications in general. Another +consequence of this approach to modeling and retrieving input is that the +parsers cannot iterate over sections of input in a tight loop, which adversely +affects performance. + +Below is a table that compares the features of Angstrom against the those of +other parser-combinator libraries. + +[parsec]: https://hackage.haskell.org/package/parsec +[async]: https://github.com/janestreet/async +[lwt]: https://ocsigen.org/lwt/ + + +Feature \ Library | Angstrom | [mparser] | [planck] | [opal] | +------------------------------------|:--------:|:---------:|:--------:|:------:| +Monadic interface | ✅ | ✅ | ✅ | ✅ | +Backtracking by default | ✅ | ❌ | ❌ | ❌ | +Unbounded lookahead | ✅ | ✅ | ✅ | ❌ | +Reports line numbers in errors | ❌ | ✅ | ❌ | ❌ | +Efficient `take_while`/`skip_while` | ✅ | ❌ | ❌ | ❌ | +Unbuffered (zero-copy) interface | ✅ | ❌ | ❌ | ❌ | +Non-blocking incremental interface | ✅ | ❌ | ❌ | ❌ | +Async Support | ✅ | ❌ | ❌ | ❌ | +Lwt Support | ✅ | ❌ | ❌ | ❌ | + +[mparser]: https://github.com/cakeplus/mparser +[opal]: https://github.com/pyrocat101/opal +[planck]: https://bitbucket.org/camlspotter/planck + + +## Development + +To install development dependencies, pin the package from the root of the +repository: + +```bash +opam pin add -n angstrom . +opam install --deps-only angstrom +``` + +After this, you may install a development version of the library using the +install command as usual. + +For building and running the tests during development, you will need to install +the `alcotest` package: + +```bash +opam install alcotest +make test +``` + +## Acknowledgements + +This library started off as a direct port of the inimitable [attoparsec][] +library. While the original approach of continuation-passing still survives in +the source code, several modifications have been made in order to adapt the +ideas to OCaml, and in the process allow for more efficient memory usage and +integration with monadic concurrency libraries. This library will undoubtedly +diverge further as time goes on, but its name will stand as an homage to its +origin. + +[attoparsec]: https://github.com/bos/attoparsec + + +## License + +BSD3, see LICENSE file for its text. diff --git a/unikernel/duniverse/angstrom/angstrom-async.opam b/unikernel/duniverse/angstrom/angstrom-async.opam new file mode 100644 index 00000000..d3813b7f --- /dev/null +++ b/unikernel/duniverse/angstrom/angstrom-async.opam @@ -0,0 +1,20 @@ +version: "0.16.1" +opam-version: "2.0" +maintainer: "Spiros Eliopoulos " +authors: [ "Spiros Eliopoulos " ] +license: "BSD-3-clause" +homepage: "https://github.com/inhabitedtype/angstrom" +bug-reports: "https://github.com/inhabitedtype/angstrom/issues" +dev-repo: "git+https://github.com/inhabitedtype/angstrom.git" +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +depends: [ + "ocaml" {>= "4.04.1"} + "dune" {>= "1.8"} + "angstrom" {>= "0.9.0"} + "async" {>= "v0.10.0"} +] +synopsis: "Async support for Angstrom" diff --git a/unikernel/duniverse/angstrom/angstrom-lwt-unix.opam b/unikernel/duniverse/angstrom/angstrom-lwt-unix.opam new file mode 100644 index 00000000..38294c27 --- /dev/null +++ b/unikernel/duniverse/angstrom/angstrom-lwt-unix.opam @@ -0,0 +1,21 @@ +version: "0.16.1" +opam-version: "2.0" +maintainer: "Spiros Eliopoulos " +authors: [ "Spiros Eliopoulos " ] +license: "BSD-3-clause" +homepage: "https://github.com/inhabitedtype/angstrom" +bug-reports: "https://github.com/inhabitedtype/angstrom/issues" +dev-repo: "git+https://github.com/inhabitedtype/angstrom.git" +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +depends: [ + "ocaml" {>= "4.03.0"} + "dune" {>= "1.8"} + "angstrom" + "lwt" + "base-unix" +] +synopsis: "Lwt_unix support for Angstrom" diff --git a/unikernel/duniverse/angstrom/angstrom-unix.opam b/unikernel/duniverse/angstrom/angstrom-unix.opam new file mode 100644 index 00000000..0e0f2894 --- /dev/null +++ b/unikernel/duniverse/angstrom/angstrom-unix.opam @@ -0,0 +1,20 @@ +version: "0.16.1" +opam-version: "2.0" +maintainer: "Spiros Eliopoulos " +authors: [ "Spiros Eliopoulos " ] +license: "BSD-3-clause" +homepage: "https://github.com/inhabitedtype/angstrom" +bug-reports: "https://github.com/inhabitedtype/angstrom/issues" +dev-repo: "git+https://github.com/inhabitedtype/angstrom.git" +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +depends: [ + "ocaml" {>= "4.03.0"} + "dune" {>= "1.8"} + "angstrom" + "base-unix" +] +synopsis: "Unix support for Angstrom" diff --git a/unikernel/duniverse/angstrom/angstrom.opam b/unikernel/duniverse/angstrom/angstrom.opam new file mode 100644 index 00000000..08406e02 --- /dev/null +++ b/unikernel/duniverse/angstrom/angstrom.opam @@ -0,0 +1,30 @@ +version: "0.16.1" +opam-version: "2.0" +maintainer: "Spiros Eliopoulos " +authors: [ "Spiros Eliopoulos " ] +license: "BSD-3-clause" +homepage: "https://github.com/inhabitedtype/angstrom" +bug-reports: "https://github.com/inhabitedtype/angstrom/issues" +dev-repo: "git+https://github.com/inhabitedtype/angstrom.git" +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +depends: [ + "ocaml" {>= "4.04.0"} + "dune" {>= "1.8"} + "alcotest" {with-test & >= "0.8.1"} + "bigstringaf" + "ppx_let" {with-test & >= "v0.14.0"} + "ocaml-syntax-shims" {build} +] +synopsis: "Parser combinators built for speed and memory-efficiency" +description: """ +Angstrom is a parser-combinator library that makes it easy to write efficient, +expressive, and reusable parsers suitable for high-performance applications. It +exposes monadic and applicative interfaces for composition, and supports +incremental input through buffered and unbuffered interfaces. Both interfaces +give the user total control over the blocking behavior of their application, +with the unbuffered interface enabling zero-copy IO. Parsers are backtracking by +default and support unbounded lookahead.""" diff --git a/unikernel/duniverse/angstrom/async/angstrom_async.ml b/unikernel/duniverse/angstrom/async/angstrom_async.ml new file mode 100644 index 00000000..f67f764f --- /dev/null +++ b/unikernel/duniverse/angstrom/async/angstrom_async.ml @@ -0,0 +1,85 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +open Angstrom.Unbuffered +open Core +open Async + +let empty_bigstring = Bigstring.create 0 + +let rec finalize state result = + (* It is very important to understand the assumptions that go into the second + * case. If execution reaches that case, then that means that the parser has + * commited all the way up to the last byte that was read by the reader, and + * the reader's internal buffer is empty. If the parser hadn't committed up + * to the last byte, then the reader buffer would not be empty and execution + * would hit the first case rather than the second. + * + * In other words, the second case looks wrong but it's not. *) + match state, result with + | Partial p, `Eof_with_unconsumed_data s -> + let bigstring = Bigstring.of_string s in + finalize (p.continue bigstring ~off:0 ~len:(String.length s) Complete) `Eof + | Partial p, `Eof -> + finalize (p.continue empty_bigstring ~off:0 ~len:0 Complete) `Eof + | Partial _, `Stopped () -> assert false + | (Done _ | Fail _) , _ -> state_to_result state + +let response = function + | Partial p -> `Consumed(p.committed, `Need_unknown) + | Done(c, _) -> `Stop_consumed((), c) + | Fail _ -> `Stop () + +let default_pushback () = Deferred.unit + +let parse ?(pushback=default_pushback) p reader = + let state = ref (parse p) in + let handle_chunk buf ~pos ~len = + begin match !state with + | Partial p -> + state := p.continue buf ~off:pos ~len Incomplete; + | Done _ | Fail _ -> () + end; + pushback () >>| fun () -> response !state + in + Reader.read_one_chunk_at_a_time reader ~handle_chunk >>| fun result -> + finalize !state result + +let async_many e k = + Angstrom.(skip_many (e <* commit >>| k) "async_many") + +let parse_many p write reader = + let wait = ref (default_pushback ()) in + let k x = wait := write x in + let pushback () = !wait in + parse ~pushback (async_many p k) reader diff --git a/unikernel/duniverse/angstrom/async/angstrom_async.mli b/unikernel/duniverse/angstrom/async/angstrom_async.mli new file mode 100644 index 00000000..92341b2a --- /dev/null +++ b/unikernel/duniverse/angstrom/async/angstrom_async.mli @@ -0,0 +1,48 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +open Angstrom +open Async + + +val parse : + ?pushback:(unit -> unit Deferred.t) + -> 'a t + -> Reader.t + -> ('a, string) result Deferred.t + +val parse_many : + 'a t + -> ('a -> unit Deferred.t) + -> Reader.t + -> (unit, string) result Deferred.t diff --git a/unikernel/duniverse/angstrom/async/dune b/unikernel/duniverse/angstrom/async/dune new file mode 100644 index 00000000..cdd8b955 --- /dev/null +++ b/unikernel/duniverse/angstrom/async/dune @@ -0,0 +1,5 @@ +(library + (name angstrom_async) + (public_name angstrom-async) + (flags :standard -safe-string) + (libraries angstrom async)) diff --git a/unikernel/duniverse/angstrom/benchmarks/async_benchmark.ml b/unikernel/duniverse/angstrom/benchmarks/async_benchmark.ml new file mode 100644 index 00000000..e2d15dc5 --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/async_benchmark.ml @@ -0,0 +1,20 @@ +open Async + +let main parser () = + let toss _ = Deferred.unit in + let reader = Lazy.force Reader.stdin in + let parser = + match parser with + | `Http -> Angstrom.(RFC2616.request >>| fun x -> `Http x) + | `Json -> Angstrom.(RFC7159.json >>| fun x -> `Json x) + in + Angstrom_async.parse_many parser toss reader + >>| function + | Ok () -> () + | Error err -> failwith err +;; + +let () = + let parser = Command.Arg_type.of_alist_exn ["http", `Http; "json", `Json] in + Command.(async_spec ~summary:"async benchmark" + Spec.(empty +> Param.(anon ("PARSER" %: parser))) main |> run) diff --git a/unikernel/duniverse/angstrom/benchmarks/data/ACKNOWLEDGEMENTS b/unikernel/duniverse/angstrom/benchmarks/data/ACKNOWLEDGEMENTS new file mode 100644 index 00000000..598b32db --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/data/ACKNOWLEDGEMENTS @@ -0,0 +1,2 @@ +Several of the data files in this directory were taken from the attoparsec +repository on GitHub. The source of twitter.json has been forgotten. diff --git a/unikernel/duniverse/angstrom/benchmarks/data/http-requests.txt b/unikernel/duniverse/angstrom/benchmarks/data/http-requests.txt new file mode 100644 index 00000000..f017911a --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/data/http-requests.txt @@ -0,0 +1,494 @@ +GET / HTTP/1.1 +Host: www.reddit.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive + +GET /reddit.v_EZwRzV-Ns.css HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/css,*/*;q=0.1 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /reddit-init.en-us.O1zuMqOOQvY.js HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /reddit.en-us.31yAfSoTsfo.js HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /kill.png HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /icon.png HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive + +GET /favicon.ico HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive + +GET /AMZM4CWd6zstSC8y.jpg HTTP/1.1 +Host: b.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /jz1d5Nm0w97-YyNm.jpg HTTP/1.1 +Host: b.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /aWGO99I6yOcNUKXB.jpg HTTP/1.1 +Host: a.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /rZ_rD5TjrJM0E9Aj.css HTTP/1.1 +Host: e.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/css,*/*;q=0.1 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /tmsPwagFzyTvrGRx.jpg HTTP/1.1 +Host: a.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /KYgUaLvXCK3TCEJx.jpg HTTP/1.1 +Host: a.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /81pzxT5x2ozuEaxX.jpg HTTP/1.1 +Host: e.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /MFqCUiUVPO5V8t6x.jpg HTTP/1.1 +Host: a.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /TFpYTiAO5aEowokv.jpg HTTP/1.1 +Host: e.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /eMWMpmm9APNeNqcF.jpg HTTP/1.1 +Host: e.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /S-IpsJrOKuaK9GZ8.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /3V6dj9PDsNnheDXn.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /wQ3-VmNXhv8sg4SJ.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /ixd1C1njpczEWC22.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /nGsQj15VyOHMwmq8.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /zT4yQmDxQLbIxK1b.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /L5e1HcZLv1iu4nrG.jpg HTTP/1.1 +Host: f.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /WJFFPxD8X4JO_lIG.jpg HTTP/1.1 +Host: f.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /hVMVTDdjuY3bQox5.jpg HTTP/1.1 +Host: f.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /rnWf8CjBcyPQs5y_.jpg HTTP/1.1 +Host: f.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /gZJL1jNylKbGV4d-.jpg HTTP/1.1 +Host: d.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /aNd2zNRLXiMnKUFh.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /droparrowgray.gif HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css + +GET /sprite-reddit.an0Lnf61Ap4.png HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css + +GET /ga.js HTTP/1.1 +Host: www.google-analytics.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ +If-Modified-Since: Tue, 29 Oct 2013 19:33:51 GMT + +GET /reddit/ads.html?sr=-reddit.com&bust2 HTTP/1.1 +Host: static.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /pixel/of_destiny.png?v=hOlmDALJCWWdjzfBV4ZxJPmrdCLWB%2Ftq7Z%2Ffp4Q%2FxXbVPPREuMJMVGzKraTuhhNWxCCwi6yFEZg%3D&r=783333388 HTTP/1.1 +Host: pixel.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /UNcO-h_QcS9PD-Gn.jpg HTTP/1.1 +Host: c.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://e.thumbs.redditmedia.com/rZ_rD5TjrJM0E9Aj.css + +GET /welcome-lines.png HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css + +GET /welcome-upvote.png HTTP/1.1 +Host: www.redditstatic.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css + +GET /__utm.gif?utmwv=5.5.1&utms=1&utmn=720496082&utmhn=www.reddit.com&utme=8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512705&utmac=UA-12131688-1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=qR~ HTTP/1.1 +Host: www.google-analytics.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /ImnpOQhbXUPkwceN.png HTTP/1.1 +Host: a.thumbs.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /ajax/libs/jquery/1.7.1/jquery.min.js HTTP/1.1 +Host: ajax.googleapis.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 + +GET /__utm.gif?utmwv=5.5.1&utms=2&utmn=1493472678&utmhn=www.reddit.com&utmt=event&utme=5(AdBlock*enabled*false)(0)8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512708&utmac=UA-12131688-1&utmni=1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=6R~ HTTP/1.1 +Host: www.google-analytics.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /ados.js?q=43 HTTP/1.1 +Host: secure.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 + +GET /fetch-trackers?callback=jQuery111005268222517967478_1400862512407&ids%5B%5D=t3_25jzeq-t8_k2ii&_=1400862512408 HTTP/1.1 +Host: tracker.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /ados?t=1400862512892&request={%22Placements%22:[{%22A%22:5146,%22S%22:24950,%22D%22:%22main%22,%22AT%22:5},{%22A%22:5146,%22S%22:24950,%22D%22:%22sponsorship%22,%22AT%22:8}],%22Keywords%22:%22-reddit.com%22,%22Referrer%22:%22http%3A%2F%2Fwww.reddit.com%2F%22,%22IsAsync%22:true,%22WriteResults%22:true} HTTP/1.1 +Host: engine.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 + +GET /pixel/of_doom.png?id=t3_25jzeq-t8_k2ii&hash=da31d967485cdbd459ce1e9a5dde279fef7fc381&r=1738649500 HTTP/1.1 +Host: pixel.redditmedia.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /Extensions/adFeedback.js HTTP/1.1 +Host: static.adzrk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: */* +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 + +GET /Extensions/adFeedback.css HTTP/1.1 +Host: static.adzrk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/css,*/*;q=0.1 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 + +GET /reddit/ads-load.html?bust2 HTTP/1.1 +Host: static.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://www.reddit.com/ + +GET /Advertisers/a774d7d6148046efa89403a8db635a81.jpg HTTP/1.1 +Host: static.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 + +GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo1LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxNSwiZGkiOiI4NmI2Y2UzYWM5NDM0MjhkOTk2ZTg4MjYwZDE5ZTE1YyIsImRtIjoxLCJmYyI6NDE2MTI4LCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ1fQ&s=lwlbFf2Uywt7zVBFRj_qXXu7msY HTTP/1.1 +Host: engine.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 +Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966 + +GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9994987&PluID=0&ord=1400862593644&rtu=-1 HTTP/1.1 +Host: bs.serving-sys.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 + +GET /Advertisers/63cfd0044ffd49c0a71a6626f7a1d8f0.jpg HTTP/1.1 +Host: static.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads-load.html?bust2 + +GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9962555&PluID=0&ord=1400862593645&rtu=-1 HTTP/1.1 +Host: bs.serving-sys.com +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads-load.html?bust2 +Cookie: S_9994987=6754579095859875029; A4=01fmFvgRnI09SF00000; u2=d1263d39-874b-4a89-86cd-a2ab0860ed4e3Zl040 + +GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo4LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxOCwiZGkiOiI3OTdlZjU3OWQ5NjE0ODdiODYyMGMyMGJkOTE4YzNiMSIsImRtIjoxLCJmYyI6NDE2MTMxLCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ2fQ&s=OjzxzXAgQksbdQOHNm-bjZcnZPA HTTP/1.1 +Host: engine.adzerk.net +User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 +Accept: image/png,image/*;q=0.8,*/*;q=0.5 +Accept-Language: en-us,en;q=0.5 +Accept-Encoding: gzip, deflate +Connection: keep-alive +Referer: http://static.adzerk.net/reddit/ads-load.html?bust2 +Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966 + +GET /subscribe?host_int=1042356184&ns_map=571794054_374233948806,464381511_13349283399&user_id=245722467&nid=1399334269710011966&ts=1400862514 HTTP/1.1 +Host: notify8.dropbox.com +Accept-Encoding: identity +Connection: keep-alive +X-Dropbox-Locale: en_US +User-Agent: DropboxDesktopClient/2.7.54 (Macintosh; 10.8; ('i32',); en_US) + diff --git a/unikernel/duniverse/angstrom/benchmarks/data/replicate b/unikernel/duniverse/angstrom/benchmarks/data/replicate new file mode 100755 index 00000000..65f79fd2 --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/data/replicate @@ -0,0 +1,6 @@ +#!/usr/bin/env bash + +# `replicate f n` creates a new file called `f.n` containing n copies of f. +for i in `seq 1 $2`; do + cat $1 >> $1.$2 +done diff --git a/unikernel/duniverse/angstrom/benchmarks/data/twitter.json b/unikernel/duniverse/angstrom/benchmarks/data/twitter.json new file mode 100644 index 00000000..137fb516 --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/data/twitter.json @@ -0,0 +1,15482 @@ +{ + "statuses": [ + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:15 +0000 2014", + "id": 505874924095815700, + "id_str": "505874924095815681", + "text": "@aym0566x \n\n名前:前田あゆみ\n第一印象:なんか怖っ！\n今の印象:とりあえずキモい。噛み合わない\n好きなところ:ぶすでキモいとこ😋✨✨\n思い出:んーーー、ありすぎ😊❤️\nLINE交換できる？:あぁ……ごめん✋\nトプ画をみて:照れますがな😘✨\n一言:お前は一生もんのダチ💖", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": 866260188, + "in_reply_to_user_id_str": "866260188", + "in_reply_to_screen_name": "aym0566x", + "user": { + "id": 1186275104, + "id_str": "1186275104", + "name": "AYUMI", + "screen_name": "ayuu0123", + "location": "", + "description": "元野球部マネージャー❤︎…最高の夏をありがとう…❤︎", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 262, + "friends_count": 252, + "listed_count": 0, + "created_at": "Sat Feb 16 13:40:25 +0000 2013", + "favourites_count": 235, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 1769, + "lang": "en", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/497760886795153410/LDjAwR_y_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/497760886795153410/LDjAwR_y_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1186275104/1409318784", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "aym0566x", + "name": "前田あゆみ", + "id": 866260188, + "id_str": "866260188", + "indices": [ + 0, + 9 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:14 +0000 2014", + "id": 505874922023837700, + "id_str": "505874922023837696", + "text": "RT @KATANA77: えっそれは・・・（一同） http://t.co/PkCJAcSuYK", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 903487807, + "id_str": "903487807", + "name": "RT&ファボ魔のむっつんさっm", + "screen_name": "yuttari1998", + "location": "関西 ↓詳しいプロ↓", + "description": "無言フォローはあまり好みません ゲームと動画が好きですシモ野郎ですがよろしく…最近はMGSとブレイブルー、音ゲーをプレイしてます", + "url": "http://t.co/Yg9e1Fl8wd", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/Yg9e1Fl8wd", + "expanded_url": "http://twpf.jp/yuttari1998", + "display_url": "twpf.jp/yuttari1998", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 95, + "friends_count": 158, + "listed_count": 1, + "created_at": "Thu Oct 25 08:27:13 +0000 2012", + "favourites_count": 3652, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 10276, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/500268849275494400/AoXHZ7Ij_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/500268849275494400/AoXHZ7Ij_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/903487807/1409062272", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 23:49:35 +0000 2014", + "id": 505864943636197400, + "id_str": "505864943636197376", + "text": "えっそれは・・・（一同） http://t.co/PkCJAcSuYK", + "source": "Twitter Web Client", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 77915997, + "id_str": "77915997", + "name": "(有)刀", + "screen_name": "KATANA77", + "location": "", + "description": "プリキュア好きのサラリーマンです。好きなプリキュアシリーズはハートキャッチ、最愛のキャラクターは月影ゆりさんです。 http://t.co/QMLJeFmfMTご質問、お問い合わせはこちら http://t.co/LU8T7vmU3h", + "url": null, + "entities": { + "description": { + "urls": [ + { + "url": "http://t.co/QMLJeFmfMT", + "expanded_url": "http://www.pixiv.net/member.php?id=4776", + "display_url": "pixiv.net/member.php?id=…", + "indices": [ + 58, + 80 + ] + }, + { + "url": "http://t.co/LU8T7vmU3h", + "expanded_url": "http://ask.fm/KATANA77", + "display_url": "ask.fm/KATANA77", + "indices": [ + 95, + 117 + ] + } + ] + } + }, + "protected": false, + "followers_count": 1095, + "friends_count": 740, + "listed_count": 50, + "created_at": "Mon Sep 28 03:41:27 +0000 2009", + "favourites_count": 3741, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": true, + "verified": false, + "statuses_count": 19059, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/808597451/45b82f887085d32bd4b87dfc348fe22a.png", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/808597451/45b82f887085d32bd4b87dfc348fe22a.png", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/480210114964504577/MjVIEMS4_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/480210114964504577/MjVIEMS4_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/77915997/1404661392", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 82, + "favorite_count": 42, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [], + "media": [ + { + "id": 505864942575034400, + "id_str": "505864942575034369", + "indices": [ + 13, + 35 + ], + "media_url": "http://pbs.twimg.com/media/BwUxfC6CIAEr-Ye.jpg", + "media_url_https": "https://pbs.twimg.com/media/BwUxfC6CIAEr-Ye.jpg", + "url": "http://t.co/PkCJAcSuYK", + "display_url": "pic.twitter.com/PkCJAcSuYK", + "expanded_url": "http://twitter.com/KATANA77/status/505864943636197376/photo/1", + "type": "photo", + "sizes": { + "medium": { + "w": 600, + "h": 338, + "resize": "fit" + }, + "small": { + "w": 340, + "h": 192, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "large": { + "w": 765, + "h": 432, + "resize": "fit" + } + } + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + "retweet_count": 82, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "KATANA77", + "name": "(有)刀", + "id": 77915997, + "id_str": "77915997", + "indices": [ + 3, + 12 + ] + } + ], + "media": [ + { + "id": 505864942575034400, + "id_str": "505864942575034369", + "indices": [ + 27, + 49 + ], + "media_url": "http://pbs.twimg.com/media/BwUxfC6CIAEr-Ye.jpg", + "media_url_https": "https://pbs.twimg.com/media/BwUxfC6CIAEr-Ye.jpg", + "url": "http://t.co/PkCJAcSuYK", + "display_url": "pic.twitter.com/PkCJAcSuYK", + "expanded_url": "http://twitter.com/KATANA77/status/505864943636197376/photo/1", + "type": "photo", + "sizes": { + "medium": { + "w": 600, + "h": 338, + "resize": "fit" + }, + "small": { + "w": 340, + "h": 192, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "large": { + "w": 765, + "h": 432, + "resize": "fit" + } + }, + "source_status_id": 505864943636197400, + "source_status_id_str": "505864943636197376" + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:14 +0000 2014", + "id": 505874920140591100, + "id_str": "505874920140591104", + "text": "@longhairxMIURA 朝一ライカス辛目だよw", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": 505874728897085440, + "in_reply_to_status_id_str": "505874728897085440", + "in_reply_to_user_id": 114188950, + "in_reply_to_user_id_str": "114188950", + "in_reply_to_screen_name": "longhairxMIURA", + "user": { + "id": 114786346, + "id_str": "114786346", + "name": "PROTECT-T", + "screen_name": "ttm_protect", + "location": "静岡県長泉町", + "description": "24 / XXX / @andprotector / @lifefocus0545 potato design works", + "url": "http://t.co/5EclbQiRX4", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/5EclbQiRX4", + "expanded_url": "http://ap.furtherplatonix.net/index.html", + "display_url": "ap.furtherplatonix.net/index.html", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 1387, + "friends_count": 903, + "listed_count": 25, + "created_at": "Tue Feb 16 16:13:41 +0000 2010", + "favourites_count": 492, + "utc_offset": 32400, + "time_zone": "Osaka", + "geo_enabled": false, + "verified": false, + "statuses_count": 12679, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/481360383253295104/4B9Rcfys_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/481360383253295104/4B9Rcfys_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/114786346/1403600232", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "longhairxMIURA", + "name": "miura desu", + "id": 114188950, + "id_str": "114188950", + "indices": [ + 0, + 15 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:14 +0000 2014", + "id": 505874919020699650, + "id_str": "505874919020699648", + "text": "RT @omo_kko: ラウワン脱出→友達が家に連んで帰ってって言うから友達ん家に乗せて帰る(1度も行ったことない田舎道)→友達おろして迷子→500メートルくらい続く変な一本道進む→墓地で行き止まりでUターン出来ずバックで500メートル元のところまで進まないといけない←今ここ", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 392585658, + "id_str": "392585658", + "name": "原稿", + "screen_name": "chibu4267", + "location": "キミの部屋の燃えるゴミ箱", + "description": "RTしてTLに濁流を起こすからフォローしない方が良いよ 言ってることもつまらないし 詳細→http://t.co/ANSFlYXERJ 相方@1life_5106_hshd 葛西教徒その壱", + "url": "http://t.co/JTFjV89eaN", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/JTFjV89eaN", + "expanded_url": "http://www.pixiv.net/member.php?id=1778417", + "display_url": "pixiv.net/member.php?id=…", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [ + { + "url": "http://t.co/ANSFlYXERJ", + "expanded_url": "http://twpf.jp/chibu4267", + "display_url": "twpf.jp/chibu4267", + "indices": [ + 45, + 67 + ] + } + ] + } + }, + "protected": false, + "followers_count": 1324, + "friends_count": 1165, + "listed_count": 99, + "created_at": "Mon Oct 17 08:23:46 +0000 2011", + "favourites_count": 9542, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": true, + "verified": false, + "statuses_count": 369420, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/453106940822814720/PcJIZv43.png", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/453106940822814720/PcJIZv43.png", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/505731759216943107/pzhnkMEg_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/505731759216943107/pzhnkMEg_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/392585658/1362383911", + "profile_link_color": "5EB9FF", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 16:51:09 +0000 2014", + "id": 505759640164892700, + "id_str": "505759640164892673", + "text": "ラウワン脱出→友達が家に連んで帰ってって言うから友達ん家に乗せて帰る(1度も行ったことない田舎道)→友達おろして迷子→500メートルくらい続く変な一本道進む→墓地で行き止まりでUターン出来ずバックで500メートル元のところまで進まないといけない←今ここ", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 309565423, + "id_str": "309565423", + "name": "おもっこ", + "screen_name": "omo_kko", + "location": "", + "description": "ぱんすと", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 730, + "friends_count": 200, + "listed_count": 23, + "created_at": "Thu Jun 02 09:15:51 +0000 2011", + "favourites_count": 5441, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": true, + "verified": false, + "statuses_count": 30012, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/499126939378929664/GLWpIKTW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/499126939378929664/GLWpIKTW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/309565423/1409418370", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 67, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "omo_kko", + "name": "おもっこ", + "id": 309565423, + "id_str": "309565423", + "indices": [ + 3, + 11 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:13 +0000 2014", + "id": 505874918198624260, + "id_str": "505874918198624256", + "text": "RT @thsc782_407: #LEDカツカツ選手権\n漢字一文字ぶんのスペースに「ハウステンボス」を収める狂気 http://t.co/vmrreDMziI", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 753161754, + "id_str": "753161754", + "name": "ねこねこみかん＊", + "screen_name": "nekonekomikan", + "location": "ソーダ水のあふれるビンの中", + "description": "猫×6、大学・高校・旦那各1と暮らしています。猫、子供、日常思った事をつぶやいています／今年の目標：読書、庭の手入れ、ランニング、手芸／猫＊花＊写真＊詩＊林ももこさん＊鉄道など好きな方をフォローさせていただいています。よろしくお願いします♬", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 217, + "friends_count": 258, + "listed_count": 8, + "created_at": "Sun Aug 12 14:00:47 +0000 2012", + "favourites_count": 7650, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 20621, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/470627990271848448/m83uy6Vc_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/470627990271848448/m83uy6Vc_normal.jpeg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Fri Feb 28 16:04:13 +0000 2014", + "id": 439430848190742500, + "id_str": "439430848190742528", + "text": "#LEDカツカツ選手権\n漢字一文字ぶんのスペースに「ハウステンボス」を収める狂気 http://t.co/vmrreDMziI", + "source": "Twitter Web Client", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 82900665, + "id_str": "82900665", + "name": "[90]青葉台 芦 (第二粟屋) 屋", + "screen_name": "thsc782_407", + "location": "かんましき", + "description": "湯の街の元勃酩姦なんちゃら大　赤い犬の犬（外資系）　肥後で緑ナンバー屋さん勤め\nくだらないことしかつぶやかないし、いちいち訳のわからない記号を連呼するので相当邪魔になると思います。害はないと思います。のりものの画像とかたくさん上げます。さみしい。車輪のついたものならだいたい好き。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 587, + "friends_count": 623, + "listed_count": 30, + "created_at": "Fri Oct 16 15:13:32 +0000 2009", + "favourites_count": 1405, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": true, + "verified": false, + "statuses_count": 60427, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "352726", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/154137819/__813-1103.jpg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/154137819/__813-1103.jpg", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/493760276676620289/32oLiTtT_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/493760276676620289/32oLiTtT_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/82900665/1398865798", + "profile_link_color": "D02B55", + "profile_sidebar_border_color": "829D5E", + "profile_sidebar_fill_color": "99CC33", + "profile_text_color": "3E4415", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 3291, + "favorite_count": 1526, + "entities": { + "hashtags": [ + { + "text": "LEDカツカツ選手権", + "indices": [ + 0, + 11 + ] + } + ], + "symbols": [], + "urls": [], + "user_mentions": [], + "media": [ + { + "id": 439430848194936800, + "id_str": "439430848194936832", + "indices": [ + 41, + 63 + ], + "media_url": "http://pbs.twimg.com/media/BhksBzoCAAAJeDS.jpg", + "media_url_https": "https://pbs.twimg.com/media/BhksBzoCAAAJeDS.jpg", + "url": "http://t.co/vmrreDMziI", + "display_url": "pic.twitter.com/vmrreDMziI", + "expanded_url": "http://twitter.com/thsc782_407/status/439430848190742528/photo/1", + "type": "photo", + "sizes": { + "medium": { + "w": 600, + "h": 450, + "resize": "fit" + }, + "large": { + "w": 1024, + "h": 768, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "small": { + "w": 340, + "h": 255, + "resize": "fit" + } + } + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + "retweet_count": 3291, + "favorite_count": 0, + "entities": { + "hashtags": [ + { + "text": "LEDカツカツ選手権", + "indices": [ + 17, + 28 + ] + } + ], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "thsc782_407", + "name": "[90]青葉台 芦 (第二粟屋) 屋", + "id": 82900665, + "id_str": "82900665", + "indices": [ + 3, + 15 + ] + } + ], + "media": [ + { + "id": 439430848194936800, + "id_str": "439430848194936832", + "indices": [ + 58, + 80 + ], + "media_url": "http://pbs.twimg.com/media/BhksBzoCAAAJeDS.jpg", + "media_url_https": "https://pbs.twimg.com/media/BhksBzoCAAAJeDS.jpg", + "url": "http://t.co/vmrreDMziI", + "display_url": "pic.twitter.com/vmrreDMziI", + "expanded_url": "http://twitter.com/thsc782_407/status/439430848190742528/photo/1", + "type": "photo", + "sizes": { + "medium": { + "w": 600, + "h": 450, + "resize": "fit" + }, + "large": { + "w": 1024, + "h": 768, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "small": { + "w": 340, + "h": 255, + "resize": "fit" + } + }, + "source_status_id": 439430848190742500, + "source_status_id_str": "439430848190742528" + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:13 +0000 2014", + "id": 505874918039228400, + "id_str": "505874918039228416", + "text": "【金一地区太鼓台】川関と小山の見分けがつかない", + "source": "twittbot.net", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2530194984, + "id_str": "2530194984", + "name": "川之江中高生あるある", + "screen_name": "kw_aru", + "location": "DMにてネタ提供待ってますよ", + "description": "川之江中高生の川之江中高生による川之江中高生のためのあるあるアカウントです。タイムリーなネタはお気に入りにあります。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 113, + "friends_count": 157, + "listed_count": 0, + "created_at": "Wed May 28 15:01:43 +0000 2014", + "favourites_count": 30, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 4472, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/471668359314948097/XbIyXiZK_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/471668359314948097/XbIyXiZK_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2530194984/1401289473", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:13 +0000 2014", + "id": 505874915338104800, + "id_str": "505874915338104833", + "text": "おはようございますん♪ SSDSのDVDが朝一で届いた〜（≧∇≦）", + "source": "TweetList!", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 428179337, + "id_str": "428179337", + "name": "サラ", + "screen_name": "sala_mgn", + "location": "東京都", + "description": "bot遊びと実況が主目的の趣味アカウント。成人済♀。時々TLお騒がせします。リフォ率低いですがＦ／Ｂご自由に。スパムはブロック！[HOT]K[アニメ]タイバニ/Ｋ/薄桜鬼/トライガン/進撃[小説]冲方丁/森博嗣[漫画]内藤泰弘/高河ゆん[他]声優/演劇 ※@sano_bot1二代目管理人", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 104, + "friends_count": 421, + "listed_count": 2, + "created_at": "Sun Dec 04 12:51:18 +0000 2011", + "favourites_count": 3257, + "utc_offset": -36000, + "time_zone": "Hawaii", + "geo_enabled": false, + "verified": false, + "statuses_count": 25303, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "1A1B1F", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/601682567/put73jtg48ytjylq00if.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/601682567/put73jtg48ytjylq00if.jpeg", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/3350624721/755920942e4f512e6ba489df7eb1147e_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/3350624721/755920942e4f512e6ba489df7eb1147e_normal.jpeg", + "profile_link_color": "2FC2EF", + "profile_sidebar_border_color": "181A1E", + "profile_sidebar_fill_color": "252429", + "profile_text_color": "666666", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:13 +0000 2014", + "id": 505874914897690600, + "id_str": "505874914897690624", + "text": "@ran_kirazuki そのようなお言葉を頂けるとは……！この雨太郎、誠心誠意を持って姉御の足の指の第一関節を崇め奉りとうございます", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": 505874276692406300, + "in_reply_to_status_id_str": "505874276692406272", + "in_reply_to_user_id": 531544559, + "in_reply_to_user_id_str": "531544559", + "in_reply_to_screen_name": "ran_kirazuki", + "user": { + "id": 2364828518, + "id_str": "2364828518", + "name": "雨", + "screen_name": "tear_dice", + "location": "変態/日常/創作/室町/たまに版権", + "description": "アイコンは兄さんから！", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 28, + "friends_count": 28, + "listed_count": 0, + "created_at": "Fri Feb 28 00:28:40 +0000 2014", + "favourites_count": 109, + "utc_offset": 32400, + "time_zone": "Seoul", + "geo_enabled": false, + "verified": false, + "statuses_count": 193, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "000000", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/504434510675443713/lvW7ad5b.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/504434510675443713/lvW7ad5b.jpeg", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/505170142284640256/rnW4XeEJ_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/505170142284640256/rnW4XeEJ_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2364828518/1409087198", + "profile_link_color": "0D31BF", + "profile_sidebar_border_color": "000000", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "ran_kirazuki", + "name": "蘭ぴよの日常", + "id": 531544559, + "id_str": "531544559", + "indices": [ + 0, + 13 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:13 +0000 2014", + "id": 505874914591514600, + "id_str": "505874914591514626", + "text": "RT @AFmbsk: @samao21718 \n呼び方☞まおちゃん\n呼ばれ方☞あーちゃん\n第一印象☞平野から？！\n今の印象☞おとなっぽい！！\nLINE交換☞もってるん\\( ˆoˆ )/\nトプ画について☞楽しそうでいーな😳\n家族にするなら☞おねぇちゃん\n最後に一言☞全然会えない…", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2179759316, + "id_str": "2179759316", + "name": "まお", + "screen_name": "samao21718", + "location": "埼玉 UK留学してました✈", + "description": "ﾟ.＊97line おさらに貢いでる系女子＊.゜ DISH// ✯ 佐野悠斗 ✯ 読モ ✯ WEGO ✯ 嵐 I met @OTYOfficial in the London ;)", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 111, + "friends_count": 121, + "listed_count": 0, + "created_at": "Thu Nov 07 09:47:41 +0000 2013", + "favourites_count": 321, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 1777, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501535615351926784/c5AAh6Sz_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501535615351926784/c5AAh6Sz_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2179759316/1407640217", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 14:59:49 +0000 2014", + "id": 505731620456771600, + "id_str": "505731620456771584", + "text": "@samao21718 \n呼び方☞まおちゃん\n呼ばれ方☞あーちゃん\n第一印象☞平野から？！\n今の印象☞おとなっぽい！！\nLINE交換☞もってるん\\( ˆoˆ )/\nトプ画について☞楽しそうでいーな😳\n家族にするなら☞おねぇちゃん\n最後に一言☞全然会えないねー今度会えたらいいな！", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": 2179759316, + "in_reply_to_user_id_str": "2179759316", + "in_reply_to_screen_name": "samao21718", + "user": { + "id": 1680668713, + "id_str": "1680668713", + "name": "★Shiiiii!☆", + "screen_name": "AFmbsk", + "location": "埼玉", + "description": "2310*basketball#41*UVERworld*Pooh☪Bell +.｡*弱さを知って強くなれ*ﾟ", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 429, + "friends_count": 434, + "listed_count": 0, + "created_at": "Sun Aug 18 12:45:00 +0000 2013", + "favourites_count": 2488, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 6352, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/504643170886365185/JN_dlwUd_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/504643170886365185/JN_dlwUd_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1680668713/1408805886", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 1, + "favorite_count": 1, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "samao21718", + "name": "まお", + "id": 2179759316, + "id_str": "2179759316", + "indices": [ + 0, + 11 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 1, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "AFmbsk", + "name": "★Shiiiii!☆", + "id": 1680668713, + "id_str": "1680668713", + "indices": [ + 3, + 10 + ] + }, + { + "screen_name": "samao21718", + "name": "まお", + "id": 2179759316, + "id_str": "2179759316", + "indices": [ + 12, + 23 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:10 +0000 2014", + "id": 505874905712189440, + "id_str": "505874905712189440", + "text": "一、常に身一つ簡素にして、美食を好んではならない", + "source": "twittbot.net", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1330420010, + "id_str": "1330420010", + "name": "獨行道bot", + "screen_name": "dokkodo_bot", + "location": "", + "description": "宮本武蔵の自誓書、「獨行道」に記された二十一箇条をランダムにつぶやくbotです。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 4, + "friends_count": 5, + "listed_count": 1, + "created_at": "Sat Apr 06 01:19:55 +0000 2013", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 9639, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/3482551671/d9e749f7658b523bdd50b7584ed4ba6a_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/3482551671/d9e749f7658b523bdd50b7584ed4ba6a_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1330420010/1365212335", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:10 +0000 2014", + "id": 505874903094939650, + "id_str": "505874903094939648", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "モテモテ大作戦★男子編", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2714526565, + "id_str": "2714526565", + "name": "モテモテ大作戦★男子編", + "screen_name": "mote_danshi1", + "location": "", + "description": "やっぱりモテモテ男子になりたい！自分を磨くヒントをみつけたい！応援してくれる人は RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 664, + "friends_count": 1835, + "listed_count": 0, + "created_at": "Thu Aug 07 12:59:59 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 597, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/497368689386086400/7hqdKMzG_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/497368689386086400/7hqdKMzG_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2714526565/1407416898", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:10 +0000 2014", + "id": 505874902390276100, + "id_str": "505874902390276096", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "心に響くアツい名言集", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2699261263, + "id_str": "2699261263", + "name": "心に響くアツい名言集", + "screen_name": "kokoro_meigen11", + "location": "", + "description": "人生の格言は、人の心や人生を瞬時にに動かしてしまうことがある。\r\nそんな言葉の重みを味わおう。\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 183, + "friends_count": 1126, + "listed_count": 0, + "created_at": "Fri Aug 01 22:00:00 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 749, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495328654126112768/1rKnNuWK_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495328654126112768/1rKnNuWK_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2699261263/1406930543", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:10 +0000 2014", + "id": 505874902247677950, + "id_str": "505874902247677954", + "text": "RT @POTENZA_SUPERGT: ありがとうございます！“@8CBR8: @POTENZA_SUPERGT 13時半ごろ一雨きそうですが、無事全車決勝レース完走出来ること祈ってます！ http://t.co/FzTyFnt9xH”", + "source": "jigtwi", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1021030416, + "id_str": "1021030416", + "name": "narur", + "screen_name": "narur2", + "location": "晴れの国なのに何故か開幕戦では雨や雪や冰や霰が降る✨", + "description": "F1.GP2.Superformula.SuperGT.F3...\nスーパーGTが大好き♡車が好き！新幹線も好き！飛行機も好き！こっそり別アカです(๑´ㅂ`๑)♡*.+゜", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 257, + "friends_count": 237, + "listed_count": 2, + "created_at": "Wed Dec 19 01:14:41 +0000 2012", + "favourites_count": 547, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 55417, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/462180217574789121/1Jf6m_2L.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/462180217574789121/1Jf6m_2L.jpeg", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/444312241395863552/FKl40ebQ_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/444312241395863552/FKl40ebQ_normal.jpeg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:05:11 +0000 2014", + "id": 505868866686169100, + "id_str": "505868866686169089", + "text": "ありがとうございます！“@8CBR8: @POTENZA_SUPERGT 13時半ごろ一雨きそうですが、無事全車決勝レース完走出来ること祈ってます！ http://t.co/FzTyFnt9xH”", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": 505868690588303360, + "in_reply_to_status_id_str": "505868690588303360", + "in_reply_to_user_id": 333344408, + "in_reply_to_user_id_str": "333344408", + "in_reply_to_screen_name": "8CBR8", + "user": { + "id": 359324738, + "id_str": "359324738", + "name": "POTENZA_SUPERGT", + "screen_name": "POTENZA_SUPERGT", + "location": "", + "description": "ブリヂストンのスポーツタイヤ「POTENZA」のアカウントです。レースやタイヤの事などをつぶやきます。今シーズンも「チャンピオンタイヤの称号は譲らない」をキャッチコピーに、タイヤ供給チームを全力でサポートしていきますので、応援よろしくお願いします！なお、返信ができない場合もありますので、ご了承よろしくお願い致します。", + "url": "http://t.co/LruVPk5x4K", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/LruVPk5x4K", + "expanded_url": "http://www.bridgestone.co.jp/sc/potenza/", + "display_url": "bridgestone.co.jp/sc/potenza/", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 9612, + "friends_count": 308, + "listed_count": 373, + "created_at": "Sun Aug 21 11:33:38 +0000 2011", + "favourites_count": 26, + "utc_offset": -36000, + "time_zone": "Hawaii", + "geo_enabled": true, + "verified": false, + "statuses_count": 10032, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "131516", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme14/bg.gif", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme14/bg.gif", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/1507885396/TW_image_normal.jpg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/1507885396/TW_image_normal.jpg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/359324738/1402546267", + "profile_link_color": "FF2424", + "profile_sidebar_border_color": "EEEEEE", + "profile_sidebar_fill_color": "EFEFEF", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 7, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "8CBR8", + "name": "CBR Rider #17 KEIHIN", + "id": 333344408, + "id_str": "333344408", + "indices": [ + 12, + 18 + ] + }, + { + "screen_name": "POTENZA_SUPERGT", + "name": "POTENZA_SUPERGT", + "id": 359324738, + "id_str": "359324738", + "indices": [ + 20, + 36 + ] + } + ], + "media": [ + { + "id": 505868690252779500, + "id_str": "505868690252779521", + "indices": [ + 75, + 97 + ], + "media_url": "http://pbs.twimg.com/media/BwU05MGCUAEY6Wu.jpg", + "media_url_https": "https://pbs.twimg.com/media/BwU05MGCUAEY6Wu.jpg", + "url": "http://t.co/FzTyFnt9xH", + "display_url": "pic.twitter.com/FzTyFnt9xH", + "expanded_url": "http://twitter.com/8CBR8/status/505868690588303360/photo/1", + "type": "photo", + "sizes": { + "medium": { + "w": 600, + "h": 399, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "large": { + "w": 1024, + "h": 682, + "resize": "fit" + }, + "small": { + "w": 340, + "h": 226, + "resize": "fit" + } + }, + "source_status_id": 505868690588303360, + "source_status_id_str": "505868690588303360" + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + "retweet_count": 7, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "POTENZA_SUPERGT", + "name": "POTENZA_SUPERGT", + "id": 359324738, + "id_str": "359324738", + "indices": [ + 3, + 19 + ] + }, + { + "screen_name": "8CBR8", + "name": "CBR Rider #17 KEIHIN", + "id": 333344408, + "id_str": "333344408", + "indices": [ + 33, + 39 + ] + }, + { + "screen_name": "POTENZA_SUPERGT", + "name": "POTENZA_SUPERGT", + "id": 359324738, + "id_str": "359324738", + "indices": [ + 41, + 57 + ] + } + ], + "media": [ + { + "id": 505868690252779500, + "id_str": "505868690252779521", + "indices": [ + 96, + 118 + ], + "media_url": "http://pbs.twimg.com/media/BwU05MGCUAEY6Wu.jpg", + "media_url_https": "https://pbs.twimg.com/media/BwU05MGCUAEY6Wu.jpg", + "url": "http://t.co/FzTyFnt9xH", + "display_url": "pic.twitter.com/FzTyFnt9xH", + "expanded_url": "http://twitter.com/8CBR8/status/505868690588303360/photo/1", + "type": "photo", + "sizes": { + "medium": { + "w": 600, + "h": 399, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "large": { + "w": 1024, + "h": 682, + "resize": "fit" + }, + "small": { + "w": 340, + "h": 226, + "resize": "fit" + } + }, + "source_status_id": 505868690588303360, + "source_status_id_str": "505868690588303360" + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:09 +0000 2014", + "id": 505874901689851900, + "id_str": "505874901689851904", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "ここだけの本音★男子編", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2762136439, + "id_str": "2762136439", + "name": "ここだけの本音★男子編", + "screen_name": "danshi_honne1", + "location": "", + "description": "思ってるけど言えない！でもホントは言いたいこと、実はいっぱいあるんです！ \r\nそんな男子の本音を、つぶやきます。 \r\nその気持わかるって人は RT & フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 101, + "friends_count": 985, + "listed_count": 0, + "created_at": "Sun Aug 24 11:11:30 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 209, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503500282840354816/CEv8UMay_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503500282840354816/CEv8UMay_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2762136439/1408878822", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:09 +0000 2014", + "id": 505874900939046900, + "id_str": "505874900939046912", + "text": "RT @UARROW_Y: ようかい体操第一を踊る国見英 http://t.co/SXoYWH98as", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2454426158, + "id_str": "2454426158", + "name": "ぴかりん", + "screen_name": "gncnToktTtksg", + "location": "", + "description": "銀魂/黒バス/進撃/ハイキュー/BLEACH/うたプリ/鈴木達央さん/神谷浩史さん 気軽にフォローしてください（＾∇＾）✨", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 1274, + "friends_count": 1320, + "listed_count": 17, + "created_at": "Sun Apr 20 07:48:53 +0000 2014", + "favourites_count": 2314, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 5868, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/457788684146716672/KCOy0S75_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/457788684146716672/KCOy0S75_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2454426158/1409371302", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:45 +0000 2014", + "id": 505871779949051900, + "id_str": "505871779949051904", + "text": "ようかい体操第一を踊る国見英 http://t.co/SXoYWH98as", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1261662588, + "id_str": "1261662588", + "name": "ゆう矢", + "screen_name": "UARROW_Y", + "location": "つくり出そう国影の波 広げよう国影の輪", + "description": "HQ!! 成人済腐女子。日常ツイート多いです。赤葦京治夢豚クソツイ含みます注意。フォローをお考えの際はプロフご一読お願い致します。FRBお気軽に", + "url": "http://t.co/LFX2XOzb0l", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/LFX2XOzb0l", + "expanded_url": "http://twpf.jp/UARROW_Y", + "display_url": "twpf.jp/UARROW_Y", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 265, + "friends_count": 124, + "listed_count": 12, + "created_at": "Tue Mar 12 10:42:17 +0000 2013", + "favourites_count": 6762, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": true, + "verified": false, + "statuses_count": 55946, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/502095104618663937/IzuPYx3E_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/502095104618663937/IzuPYx3E_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1261662588/1408618604", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 29, + "favorite_count": 54, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/SXoYWH98as", + "expanded_url": "http://twitter.com/UARROW_Y/status/505871779949051904/photo/1", + "display_url": "pic.twitter.com/SXoYWH98as", + "indices": [ + 15, + 37 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + "retweet_count": 29, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/SXoYWH98as", + "expanded_url": "http://twitter.com/UARROW_Y/status/505871779949051904/photo/1", + "display_url": "pic.twitter.com/SXoYWH98as", + "indices": [ + 29, + 51 + ] + } + ], + "user_mentions": [ + { + "screen_name": "UARROW_Y", + "name": "ゆう矢", + "id": 1261662588, + "id_str": "1261662588", + "indices": [ + 3, + 12 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:09 +0000 2014", + "id": 505874900561580000, + "id_str": "505874900561580032", + "text": "今日は一高と三桜（・θ・）\n光梨ちゃんに会えないかな〜", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1366375976, + "id_str": "1366375976", + "name": "ゆいの", + "screen_name": "yuino1006", + "location": "", + "description": "さんおう 男バスマネ2ねん（＾ω＾）", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 270, + "friends_count": 260, + "listed_count": 0, + "created_at": "Sat Apr 20 07:02:08 +0000 2013", + "favourites_count": 1384, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 5202, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/505354401448349696/nxVFEQQ4_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/505354401448349696/nxVFEQQ4_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1366375976/1399989379", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:09 +0000 2014", + "id": 505874899324248060, + "id_str": "505874899324248064", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "共感★絶対あるあるww", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2704420069, + "id_str": "2704420069", + "name": "共感★絶対あるあるww", + "screen_name": "kyoukan_aru", + "location": "", + "description": "みんなにもわかってもらえる、あるあるを見つけたい。\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 857, + "friends_count": 1873, + "listed_count": 0, + "created_at": "Sun Aug 03 15:50:40 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 682, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495960812670836737/1LqkoyvU_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495960812670836737/1LqkoyvU_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2704420069/1407081298", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:09 +0000 2014", + "id": 505874898493796350, + "id_str": "505874898493796352", + "text": "RT @assam_house: 泉田新潟県知事は、東電の申請書提出を容認させられただけで、再稼働に必要な「同意」はまだ与えていません。今まで柏崎刈羽の再稼働を抑え続けてきた知事に、もう一踏ん張りをお願いする意見を送って下さい。全国の皆様、お願いします！\nhttp://t.co…", + "source": "jigtwi for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 960765968, + "id_str": "960765968", + "name": "さち", + "screen_name": "sachitaka_dears", + "location": "宮城県", + "description": "動物関連のアカウントです。サブアカウント@sachi_dears (さち ❷) もあります。『心あるものは皆、愛し愛されるために生まれてきた。そして愛情を感じながら生を全うするべきなんだ』", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 3212, + "friends_count": 3528, + "listed_count": 91, + "created_at": "Tue Nov 20 16:30:53 +0000 2012", + "favourites_count": 3180, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 146935, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/3659653229/5b698df67f5d105400e9077f5ea50e91_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/3659653229/5b698df67f5d105400e9077f5ea50e91_normal.png", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Tue Aug 19 11:00:53 +0000 2014", + "id": 501685228427964400, + "id_str": "501685228427964417", + "text": "泉田新潟県知事は、東電の申請書提出を容認させられただけで、再稼働に必要な「同意」はまだ与えていません。今まで柏崎刈羽の再稼働を抑え続けてきた知事に、もう一踏ん張りをお願いする意見を送って下さい。全国の皆様、お願いします！\nhttp://t.co/9oH5cgpy1q", + "source": "twittbot.net", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1104771276, + "id_str": "1104771276", + "name": "アッサム山中（殺処分ゼロに一票）", + "screen_name": "assam_house", + "location": "新潟県柏崎市", + "description": "アッサム山中の趣味用アカ。当分の間、選挙啓発用としても使っていきます。このアカウントがアッサム山中本人のものである事は @assam_yamanaka のプロフでご確認下さい。\r\n公選法に係る表示\r\n庶民新党 #脱原発 http://t.co/96UqoCo0oU\r\nonestep.revival@gmail.com", + "url": "http://t.co/AEOCATaNZc", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/AEOCATaNZc", + "expanded_url": "http://www.assam-house.net/", + "display_url": "assam-house.net", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [ + { + "url": "http://t.co/96UqoCo0oU", + "expanded_url": "http://blog.assam-house.net/datsu-genpatsu/index.html", + "display_url": "blog.assam-house.net/datsu-genpatsu…", + "indices": [ + 110, + 132 + ] + } + ] + } + }, + "protected": false, + "followers_count": 2977, + "friends_count": 3127, + "listed_count": 64, + "created_at": "Sat Jan 19 22:10:13 +0000 2013", + "favourites_count": 343, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 18021, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/378800000067217575/e0a85b440429ff50430a41200327dcb8_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/378800000067217575/e0a85b440429ff50430a41200327dcb8_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1104771276/1408948288", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 2, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/9oH5cgpy1q", + "expanded_url": "http://www.pref.niigata.lg.jp/kouhou/info.html", + "display_url": "pref.niigata.lg.jp/kouhou/info.ht…", + "indices": [ + 111, + 133 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + "retweet_count": 2, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/9oH5cgpy1q", + "expanded_url": "http://www.pref.niigata.lg.jp/kouhou/info.html", + "display_url": "pref.niigata.lg.jp/kouhou/info.ht…", + "indices": [ + 139, + 140 + ] + } + ], + "user_mentions": [ + { + "screen_name": "assam_house", + "name": "アッサム山中（殺処分ゼロに一票）", + "id": 1104771276, + "id_str": "1104771276", + "indices": [ + 3, + 15 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:09 +0000 2014", + "id": 505874898468630500, + "id_str": "505874898468630528", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "おしゃれ★ペアルック", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2708607692, + "id_str": "2708607692", + "name": "おしゃれ★ペアルック", + "screen_name": "osyare_pea", + "location": "", + "description": "ラブラブ度がアップする、素敵なペアルックを見つけて紹介します♪ 気に入ったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 129, + "friends_count": 1934, + "listed_count": 0, + "created_at": "Tue Aug 05 07:09:31 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 641, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496554257676382208/Zgg0bmNu_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496554257676382208/Zgg0bmNu_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2708607692/1407222776", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:08 +0000 2014", + "id": 505874897633951740, + "id_str": "505874897633951745", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "LOVE ♥ ラブライブ", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745389137, + "id_str": "2745389137", + "name": "LOVE ♥ ラブライブ", + "screen_name": "love_live55", + "location": "", + "description": "とにかく「ラブライブが好きで～す♥」 \r\nラブライブファンには、たまらない内容ばかり集めています♪ \r\n気に入ったら RT & 相互フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 251, + "friends_count": 969, + "listed_count": 0, + "created_at": "Tue Aug 19 15:45:40 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 348, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501757482448850944/x2uPpqRx_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501757482448850944/x2uPpqRx_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745389137/1408463342", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:08 +0000 2014", + "id": 505874896795086850, + "id_str": "505874896795086848", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "恋する♡ドレスシリーズ", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2726346560, + "id_str": "2726346560", + "name": "恋する♡ドレスシリーズ", + "screen_name": "koisurudoress", + "location": "", + "description": "どれもこれも、見ているだけで欲しくなっちゃう♪ \r\n特別な日に着る素敵なドレスを見つけたいです。 \r\n着てみたいと思ったら RT & フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 314, + "friends_count": 1900, + "listed_count": 0, + "created_at": "Tue Aug 12 14:10:35 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 471, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/499199619465621504/fg7sVusT_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/499199619465621504/fg7sVusT_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2726346560/1407853688", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:08 +0000 2014", + "id": 505874895964626940, + "id_str": "505874895964626944", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "胸キュン♥動物図鑑", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2759192574, + "id_str": "2759192574", + "name": "胸キュン♥動物図鑑", + "screen_name": "doubutuzukan", + "location": "", + "description": "ふとした表情に思わずキュンとしてしまう♪ \r\nそんな愛しの動物たちの写真を見つけます。 \r\n気に入ったら RT & フォローを、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 80, + "friends_count": 959, + "listed_count": 1, + "created_at": "Sat Aug 23 15:47:36 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 219, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503211559552688128/Ej_bixna_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503211559552688128/Ej_bixna_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2759192574/1408809101", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:08 +0000 2014", + "id": 505874895079608300, + "id_str": "505874895079608320", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "ディズニー★パラダイス", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2719228561, + "id_str": "2719228561", + "name": "ディズニー★パラダイス", + "screen_name": "disney_para", + "location": "", + "description": "ディズニーのかわいい画像、ニュース情報、あるあるなどをお届けします♪\r\nディズニーファンは RT & フォローもお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 331, + "friends_count": 1867, + "listed_count": 0, + "created_at": "Sat Aug 09 12:01:32 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 540, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498076922488696832/Ti2AEuOT_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498076922488696832/Ti2AEuOT_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2719228561/1407585841", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:08 +0000 2014", + "id": 505874894135898100, + "id_str": "505874894135898112", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "生々しい風刺画", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2714772727, + "id_str": "2714772727", + "name": "生々しい風刺画", + "screen_name": "nama_fuushi", + "location": "", + "description": "深い意味が込められた「生々しい風刺画」を見つけます。\r\n考えさせられたら RT & 相互フォローでみなさん、お願いします", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 298, + "friends_count": 1902, + "listed_count": 1, + "created_at": "Thu Aug 07 15:04:45 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 595, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/497398363352875011/tS-5FPJB_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/497398363352875011/tS-5FPJB_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2714772727/1407424091", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874893347377150, + "id_str": "505874893347377152", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "嵐★大好きっ娘", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2721682579, + "id_str": "2721682579", + "name": "嵐★大好きっ娘", + "screen_name": "arashi_suki1", + "location": "", + "description": "なんだかんだ言って、やっぱり嵐が好きなんです♪\r\nいろいろ集めたいので、嵐好きな人に見てほしいです。\r\n気に入ったら RT & 相互フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 794, + "friends_count": 1913, + "listed_count": 2, + "created_at": "Sun Aug 10 13:43:56 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 504, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498465364733198336/RO6wupdc_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498465364733198336/RO6wupdc_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2721682579/1407678436", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874893154426900, + "id_str": "505874893154426881", + "text": "RT @Takashi_Shiina: テレビで「成人男性のカロリー摂取量は1900kcal」とか言ってて、それはいままさに私がダイエットのために必死でキープしようとしている量で、「それが普通なら人はいつ天一やココイチに行って大盛りを食えばいいんだ！」と思った。", + "source": "twicca", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 353516742, + "id_str": "353516742", + "name": "おしんこー＠土曜西え41a", + "screen_name": "oshin_koko", + "location": "こたつ", + "description": "ROMって楽しんでいる部分もあり無言フォロー多めですすみません…。ツイート数多め・あらぶり多めなのでフォロー非推奨です。最近は早兵・兵部受け中心ですがBLNLなんでも好きです。地雷少ないため雑多に呟きます。腐・R18・ネタバレ有るのでご注意。他好きなジャンルはプロフ参照願います。　主催→@chounou_antholo", + "url": "http://t.co/mM1dG54NiO", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/mM1dG54NiO", + "expanded_url": "http://twpf.jp/oshin_koko", + "display_url": "twpf.jp/oshin_koko", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 479, + "friends_count": 510, + "listed_count": 43, + "created_at": "Fri Aug 12 05:53:13 +0000 2011", + "favourites_count": 3059, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 104086, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "000000", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/799871497/01583a031f83a45eba881c8acde729ee.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/799871497/01583a031f83a45eba881c8acde729ee.jpeg", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/484347196523835393/iHaYxm-2_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/484347196523835393/iHaYxm-2_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/353516742/1369039651", + "profile_link_color": "FF96B0", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "95E8EC", + "profile_text_color": "3C3940", + "profile_use_background_image": false, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 09:58:30 +0000 2014", + "id": 505655792733650940, + "id_str": "505655792733650944", + "text": "テレビで「成人男性のカロリー摂取量は1900kcal」とか言ってて、それはいままさに私がダイエットのために必死でキープしようとしている量で、「それが普通なら人はいつ天一やココイチに行って大盛りを食えばいいんだ！」と思った。", + "source": "Janetter", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 126573583, + "id_str": "126573583", + "name": "椎名高志", + "screen_name": "Takashi_Shiina", + "location": "BABEL（超能力支援研究局）", + "description": "漫画家。週刊少年サンデーで『絶対可憐チルドレン』連載中。TVアニメ『THE UNLIMITED 兵部京介』公式サイト＞http://t.co/jVqBoBEc", + "url": "http://t.co/K3Oi83wM3w", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/K3Oi83wM3w", + "expanded_url": "http://cnanews.asablo.jp/blog/", + "display_url": "cnanews.asablo.jp/blog/", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [ + { + "url": "http://t.co/jVqBoBEc", + "expanded_url": "http://unlimited-zc.jp/index.html", + "display_url": "unlimited-zc.jp/index.html", + "indices": [ + 59, + 79 + ] + } + ] + } + }, + "protected": false, + "followers_count": 110756, + "friends_count": 61, + "listed_count": 8159, + "created_at": "Fri Mar 26 08:54:51 +0000 2010", + "favourites_count": 25, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 27364, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "EDECE9", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme3/bg.gif", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme3/bg.gif", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/504597210772688896/Uvt4jgf5_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/504597210772688896/Uvt4jgf5_normal.png", + "profile_link_color": "088253", + "profile_sidebar_border_color": "D3D2CF", + "profile_sidebar_fill_color": "E3E2DE", + "profile_text_color": "634047", + "profile_use_background_image": false, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 221, + "favorite_count": 109, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 221, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "Takashi_Shiina", + "name": "椎名高志", + "id": 126573583, + "id_str": "126573583", + "indices": [ + 3, + 18 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874892567244800, + "id_str": "505874892567244801", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "下ネタ＆笑変態雑学", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2762581922, + "id_str": "2762581922", + "name": "下ネタ＆笑変態雑学", + "screen_name": "shimo_hentai", + "location": "", + "description": "普通の人には思いつかない、ちょっと変態チックな 笑える下ネタ雑学をお届けします。 \r\nおもしろかったら RT & フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 37, + "friends_count": 990, + "listed_count": 0, + "created_at": "Sun Aug 24 14:13:20 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 212, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503545991950114816/K9yQbh1Q_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503545991950114816/K9yQbh1Q_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2762581922/1408889893", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874891778703360, + "id_str": "505874891778703360", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "超簡単★初心者英語", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744544025, + "id_str": "2744544025", + "name": "超簡単★初心者英語", + "screen_name": "kantaneigo1", + "location": "", + "description": "すぐに使えるフレーズや簡単な会話を紹介します。 \r\n少しづつ練習して、どんどん使ってみよう☆ \r\n使ってみたいと思ったら RT & フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 147, + "friends_count": 970, + "listed_count": 1, + "created_at": "Tue Aug 19 10:11:48 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 345, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501676136321929216/4MLpyHe3_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501676136321929216/4MLpyHe3_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744544025/1408443928", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874891032121340, + "id_str": "505874891032121344", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "現代のハンドサイン", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2762816814, + "id_str": "2762816814", + "name": "現代のハンドサイン", + "screen_name": "ima_handsign", + "location": "", + "description": "イザという時や、困った時に、必ず役に立つハンドサインのオンパレードです♪ \r\n使ってみたくなったら RT & フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 95, + "friends_count": 996, + "listed_count": 0, + "created_at": "Sun Aug 24 15:33:58 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 210, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503566188253687809/7wtdp1AC_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503566188253687809/7wtdp1AC_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2762816814/1408894540", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874890247782400, + "id_str": "505874890247782401", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "今日からアナタもイイ女♪", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2714167411, + "id_str": "2714167411", + "name": "今日からアナタもイイ女♪", + "screen_name": "anata_iionna", + "location": "", + "description": "みんなが知りたい イイ女の秘密を見つけます♪ いいな～と思ってくれた人は RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 390, + "friends_count": 1425, + "listed_count": 0, + "created_at": "Thu Aug 07 09:27:59 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 609, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/497314455655436288/dz7P3-fy_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/497314455655436288/dz7P3-fy_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2714167411/1407404214", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874890218434560, + "id_str": "505874890218434560", + "text": "@kohecyan3 \n名前:上野滉平\n呼び方:うえの\n呼ばれ方:ずるかわ\n第一印象:過剰な俺イケメンですアピール\n今の印象:バーバリーの時計\n好きなところ:あの自信さ、笑いが絶えない\n一言:大学受かったの？応援してる〜(*^^*)！\n\n#RTした人にやる\nちょっとやってみる笑", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": 2591363659, + "in_reply_to_user_id_str": "2591363659", + "in_reply_to_screen_name": "kohecyan3", + "user": { + "id": 2613282517, + "id_str": "2613282517", + "name": "K", + "screen_name": "kawazurukenna", + "location": "", + "description": "# I surprise even my self", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 113, + "friends_count": 185, + "listed_count": 0, + "created_at": "Wed Jul 09 09:39:13 +0000 2014", + "favourites_count": 157, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 242, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/502436858135973888/PcUU0lov_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/502436858135973888/PcUU0lov_normal.jpeg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [ + { + "text": "RTした人にやる", + "indices": [ + 119, + 128 + ] + } + ], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "kohecyan3", + "name": "上野滉平", + "id": 2591363659, + "id_str": "2591363659", + "indices": [ + 0, + 10 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:07 +0000 2014", + "id": 505874889392156700, + "id_str": "505874889392156672", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "IQ★力だめし", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2709308887, + "id_str": "2709308887", + "name": "IQ★力だめし", + "screen_name": "iq_tameshi", + "location": "", + "description": "解けると楽しい気分になれる問題を見つけて紹介します♪面白かったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 443, + "friends_count": 1851, + "listed_count": 1, + "created_at": "Tue Aug 05 13:14:30 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 664, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496646485266558977/W_W--qV__normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496646485266558977/W_W--qV__normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2709308887/1407244754", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:06 +0000 2014", + "id": 505874888817532900, + "id_str": "505874888817532928", + "text": "第一三軍から２個師団が北へ移動中らしい　　　　　この調子では満州に陸軍兵力があふれかえる", + "source": "如月克己", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1171299612, + "id_str": "1171299612", + "name": "如月 克己", + "screen_name": "kisaragi_katumi", + "location": "満州", + "description": "GパングのA型K月克己中尉の非公式botです。 主に七巻と八巻が中心の台詞をつぶやきます。 4/18.台詞追加しました/現在試運転中/現在軽い挨拶だけTL反応。/追加したい台詞や何おかしい所がありましたらDMやリプライで/フォロー返しは手動です/", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 65, + "friends_count": 63, + "listed_count": 0, + "created_at": "Tue Feb 12 08:21:38 +0000 2013", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 27219, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/3242847112/0ce536444c94cbec607229022d43a27a_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/3242847112/0ce536444c94cbec607229022d43a27a_normal.jpeg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:06 +0000 2014", + "id": 505874888616181760, + "id_str": "505874888616181760", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "徳田有希★応援隊", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2766021865, + "id_str": "2766021865", + "name": "徳田有希★応援隊", + "screen_name": "tokuda_ouen1", + "location": "", + "description": "女子中高生に大人気ww　いやされるイラストを紹介します。 \r\nみんなで RTして応援しよう～♪ \r\n「非公式アカウントです」", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 123, + "friends_count": 978, + "listed_count": 0, + "created_at": "Mon Aug 25 10:48:41 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 210, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503857235802333184/YS0sDN6q_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503857235802333184/YS0sDN6q_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2766021865/1408963998", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:06 +0000 2014", + "id": 505874887802511360, + "id_str": "505874887802511361", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "腐女子の☆部屋", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744683982, + "id_str": "2744683982", + "name": "腐女子の☆部屋", + "screen_name": "fujyoshinoheya", + "location": "", + "description": "腐女子にしかわからないネタや、あるあるを見つけていきます。 \r\n他には、BL～萌えキュン系まで、腐のための画像を集めています♪ \r\n同じ境遇の人には、わかってもらえると思うので、気軽に RT & フォローお願いします☆", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 241, + "friends_count": 990, + "listed_count": 0, + "created_at": "Tue Aug 19 11:47:21 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 345, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501697365590306817/GLP_QH_b_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501697365590306817/GLP_QH_b_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744683982/1408448984", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:06 +0000 2014", + "id": 505874887009767400, + "id_str": "505874887009767424", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "萌え芸術★ラテアート", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2763178045, + "id_str": "2763178045", + "name": "萌え芸術★ラテアート", + "screen_name": "moe_rate", + "location": "", + "description": "ここまで来ると、もはや芸術!! 見てるだけで楽しい♪ \r\nそんなラテアートを、とことん探します。 \r\nスゴイと思ったら RT & フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 187, + "friends_count": 998, + "listed_count": 0, + "created_at": "Sun Aug 24 16:53:16 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 210, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503586151764992000/RC80it20_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503586151764992000/RC80it20_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2763178045/1408899447", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:06 +0000 2014", + "id": 505874886225448960, + "id_str": "505874886225448960", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "全部★ジャニーズ図鑑", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2724158970, + "id_str": "2724158970", + "name": "全部★ジャニーズ図鑑", + "screen_name": "zenbu_johnnys", + "location": "", + "description": "ジャニーズのカッコイイ画像、おもしろエピソードなどを発信します。\r\n「非公式アカウントです」\r\nジャニーズ好きな人は、是非 RT ＆ フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 738, + "friends_count": 1838, + "listed_count": 0, + "created_at": "Mon Aug 11 15:50:08 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 556, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498859581057945600/ncMKwdvC_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498859581057945600/ncMKwdvC_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2724158970/1407772462", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:06 +0000 2014", + "id": 505874885810200600, + "id_str": "505874885810200576", + "text": "RT @naopisu_: 呼び方:\n呼ばれ方:\n第一印象:\n今の印象:\n好きなところ:\n家族にするなら:\n最後に一言:\n#RTした人にやる\n\nお腹痛くて寝れないからやるww\nだれでもどうぞ〜😏🙌", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2347898072, + "id_str": "2347898072", + "name": "にたにた", + "screen_name": "syo6660129", + "location": "", + "description": "", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 64, + "friends_count": 70, + "listed_count": 1, + "created_at": "Mon Feb 17 04:29:46 +0000 2014", + "favourites_count": 58, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 145, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/485603672118669314/73uh_xRS_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/485603672118669314/73uh_xRS_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2347898072/1396957619", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 14:19:31 +0000 2014", + "id": 505721480261300200, + "id_str": "505721480261300224", + "text": "呼び方:\n呼ばれ方:\n第一印象:\n今の印象:\n好きなところ:\n家族にするなら:\n最後に一言:\n#RTした人にやる\n\nお腹痛くて寝れないからやるww\nだれでもどうぞ〜😏🙌", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 856045488, + "id_str": "856045488", + "name": "なおぴす", + "screen_name": "naopisu_", + "location": "Fujino 65th ⇢ Sagaso 12A(LJK", + "description": "＼ もうすぐ18歳 “Only One”になる ／", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 267, + "friends_count": 259, + "listed_count": 2, + "created_at": "Mon Oct 01 08:36:23 +0000 2012", + "favourites_count": 218, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 1790, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496321592553525249/tuzX9ByR_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496321592553525249/tuzX9ByR_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/856045488/1407118111", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 23, + "favorite_count": 1, + "entities": { + "hashtags": [ + { + "text": "RTした人にやる", + "indices": [ + 47, + 56 + ] + } + ], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 23, + "favorite_count": 0, + "entities": { + "hashtags": [ + { + "text": "RTした人にやる", + "indices": [ + 61, + 70 + ] + } + ], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "naopisu_", + "name": "なおぴす", + "id": 856045488, + "id_str": "856045488", + "indices": [ + 3, + 12 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:06 +0000 2014", + "id": 505874885474656260, + "id_str": "505874885474656256", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "爆笑★LINE あるある", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2709561589, + "id_str": "2709561589", + "name": "爆笑★LINE あるある", + "screen_name": "line_aru1", + "location": "", + "description": "思わず笑ってしまうLINEでのやりとりや、あるあるを見つけたいです♪面白かったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 496, + "friends_count": 1875, + "listed_count": 1, + "created_at": "Tue Aug 05 15:01:30 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 687, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496673793939492867/p1BN4YaW_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496673793939492867/p1BN4YaW_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2709561589/1407251270", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874884627410940, + "id_str": "505874884627410944", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "全力★ミサワ的w発言", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2734455415, + "id_str": "2734455415", + "name": "全力★ミサワ的w発言!!", + "screen_name": "misawahatugen", + "location": "", + "description": "ウザすぎて笑えるミサワ的名言や、おもしろミサワ画像を集めています。　\r\nミサワを知らない人でも、いきなりツボにハマっちゃう内容をお届けします。　\r\nウザいｗと思ったら RT & 相互フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 144, + "friends_count": 1915, + "listed_count": 1, + "created_at": "Fri Aug 15 13:20:04 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 436, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/500271070834749444/HvengMe5_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/500271070834749444/HvengMe5_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2734455415/1408108944", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874883809521660, + "id_str": "505874883809521664", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "お宝ww有名人卒アル特集", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2708183557, + "id_str": "2708183557", + "name": "お宝ww有名人卒アル特集", + "screen_name": "otakara_sotuaru", + "location": "", + "description": "みんな昔は若かったんですね。今からは想像もつかない、あの有名人を見つけます。\r\n面白かったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 286, + "friends_count": 1938, + "listed_count": 0, + "created_at": "Tue Aug 05 03:26:54 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 650, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496499121276985344/hC8RoebP_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496499121276985344/hC8RoebP_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2708183557/1407318758", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874883322970100, + "id_str": "505874883322970112", + "text": "レッドクリフのキャラのこと女装ってくそわろたwww朝一で面白かった( ˘ω゜)笑", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1620730616, + "id_str": "1620730616", + "name": "ひーちゃん@橘芋健ぴ", + "screen_name": "2nd_8hkr", + "location": "北の大地.95年組 ☞ 9/28.10/2(5).12/28", + "description": "THE SECOND/劇団EXILE/EXILE/二代目JSB ☞KENCHI.AKIRA.青柳翔.小森隼.石井杏奈☜ Big Love ♡ Respect ..... ✍ MATSU Origin✧ .た ち ば な '' い も '' け ん い ち ろ う さ んTEAM NACS 安田.戸次 Liebe !", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 109, + "friends_count": 148, + "listed_count": 0, + "created_at": "Thu Jul 25 16:09:29 +0000 2013", + "favourites_count": 783, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 9541, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/458760951060123648/Cocoxi-2_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/458760951060123648/Cocoxi-2_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1620730616/1408681982", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874883067129860, + "id_str": "505874883067129857", + "text": "【状態良好】ペンタックス・デジタル一眼レフカメラ・K20D 入札数=38 現在価格=15000円 http://t.co/4WK1f6V2n6終了=2014年08月31日 20:47:53 #一眼レフ http://t.co/PcSaXzfHMW", + "source": "YahooAuction Degicame", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2278053589, + "id_str": "2278053589", + "name": "AuctionCamera", + "screen_name": "AuctionCamera", + "location": "", + "description": "Yahooオークションのデジカメカテゴリから商品を抽出するボットです。", + "url": "https://t.co/3sB1NDnd0m", + "entities": { + "url": { + "urls": [ + { + "url": "https://t.co/3sB1NDnd0m", + "expanded_url": "https://github.com/AKB428/YahooAuctionBot", + "display_url": "github.com/AKB428/YahooAu…", + "indices": [ + 0, + 23 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 5, + "friends_count": 24, + "listed_count": 0, + "created_at": "Sun Jan 05 20:10:56 +0000 2014", + "favourites_count": 1, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 199546, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/419927606146789376/vko-kd6Q_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/419927606146789376/vko-kd6Q_normal.jpeg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [ + { + "text": "一眼レフ", + "indices": [ + 95, + 100 + ] + } + ], + "symbols": [], + "urls": [ + { + "url": "http://t.co/4WK1f6V2n6", + "expanded_url": "http://atq.ck.valuecommerce.com/servlet/atq/referral?sid=2219441&pid=877510753&vcptn=auct/p/RJH492.PLqoLQQx1Jy8U9LE-&vc_url=http://page8.auctions.yahoo.co.jp/jp/auction/h192024356", + "display_url": "atq.ck.valuecommerce.com/servlet/atq/re…", + "indices": [ + 49, + 71 + ] + } + ], + "user_mentions": [], + "media": [ + { + "id": 505874882828046340, + "id_str": "505874882828046336", + "indices": [ + 101, + 123 + ], + "media_url": "http://pbs.twimg.com/media/BwU6hpPCEAAxnpq.jpg", + "media_url_https": "https://pbs.twimg.com/media/BwU6hpPCEAAxnpq.jpg", + "url": "http://t.co/PcSaXzfHMW", + "display_url": "pic.twitter.com/PcSaXzfHMW", + "expanded_url": "http://twitter.com/AuctionCamera/status/505874883067129857/photo/1", + "type": "photo", + "sizes": { + "large": { + "w": 600, + "h": 450, + "resize": "fit" + }, + "medium": { + "w": 600, + "h": 450, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "small": { + "w": 340, + "h": 255, + "resize": "fit" + } + } + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874882995826700, + "id_str": "505874882995826689", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "ヤバすぎる!!ギネス世界記録", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2762405780, + "id_str": "2762405780", + "name": "ヤバすぎる!!ギネス世界記録", + "screen_name": "yabai_giness", + "location": "", + "description": "世の中には、まだまだ知られていないスゴイ記録があるんです！ \r\nそんなギネス世界記録を見つけます☆ \r\nどんどん友達にも教えてあげてくださいねww \r\nヤバイと思ったら RT ＆ フォローを、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 36, + "friends_count": 985, + "listed_count": 0, + "created_at": "Sun Aug 24 13:17:03 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 210, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503531782919045121/NiIC25wL_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503531782919045121/NiIC25wL_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2762405780/1408886328", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874882870009860, + "id_str": "505874882870009856", + "text": "すごく面白い夢見た。魔法科高校通ってて（別に一科二科の区別ない）クラスメイトにヨセアツメ面子や赤僕の拓也がいて、学校対抗合唱コンクールが開催されたり会場入りの際他校の妨害工作受けたり、拓也が連れてきてた実が人質に取られたりとにかくてんこ盛りだった楽しかった赤僕読みたい手元にない", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 597357105, + "id_str": "597357105", + "name": "ふじよし", + "screen_name": "fuji_mark", + "location": "多摩動物公園", + "description": "成人腐女子", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 128, + "friends_count": 126, + "listed_count": 6, + "created_at": "Sat Jun 02 10:06:05 +0000 2012", + "favourites_count": 2842, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 10517, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "0099B9", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme4/bg.gif", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme4/bg.gif", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503553738569560065/D_JW2dCJ_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503553738569560065/D_JW2dCJ_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/597357105/1408864355", + "profile_link_color": "0099B9", + "profile_sidebar_border_color": "5ED4DC", + "profile_sidebar_fill_color": "95E8EC", + "profile_text_color": "3C3940", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874882228281340, + "id_str": "505874882228281345", + "text": "RT @oen_yakyu: ●継続試合（中京対崇徳）46回～　9時～\n　〈ラジオ中継〉\n　らじる★らじる→大阪放送局を選択→NHK-FM\n●決勝戦(三浦対中京or崇徳)　12時30分～\n　〈ラジオ中継〉\n　らじる★らじる→大阪放送局を選択→NHK第一\n　※神奈川の方は普通のラ…", + "source": "twicca", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 18477566, + "id_str": "18477566", + "name": "Natit（なち）＠そうだ、トップ行こう", + "screen_name": "natit_yso", + "location": "福岡市の端っこ", + "description": "ヤー・チャイカ。紫宝勢の末席くらいでQMAやってます。\r\n9/13（土）「九州杯」今年も宜しくお願いします！キーワードは「そうだ、トップ、行こう。」\r\nmore → http://t.co/ezuHyjF4Qy \r\n【旅の予定】9/20-22 関西 → 9/23-28 北海道ぐるり", + "url": "http://t.co/ll2yu78DGR", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/ll2yu78DGR", + "expanded_url": "http://qma-kyushu.sakura.ne.jp/", + "display_url": "qma-kyushu.sakura.ne.jp", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [ + { + "url": "http://t.co/ezuHyjF4Qy", + "expanded_url": "http://twpf.jp/natit_yso", + "display_url": "twpf.jp/natit_yso", + "indices": [ + 83, + 105 + ] + } + ] + } + }, + "protected": false, + "followers_count": 591, + "friends_count": 548, + "listed_count": 93, + "created_at": "Tue Dec 30 14:11:44 +0000 2008", + "favourites_count": 11676, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 130145, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "131516", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme14/bg.gif", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme14/bg.gif", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/1556202861/chibi-Leon_normal.jpg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/1556202861/chibi-Leon_normal.jpg", + "profile_link_color": "009999", + "profile_sidebar_border_color": "EEEEEE", + "profile_sidebar_fill_color": "EFEFEF", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 23:12:39 +0000 2014", + "id": 505855649196953600, + "id_str": "505855649196953600", + "text": "●継続試合（中京対崇徳）46回～　9時～\n　〈ラジオ中継〉\n　らじる★らじる→大阪放送局を選択→NHK-FM\n●決勝戦(三浦対中京or崇徳)　12時30分～\n　〈ラジオ中継〉\n　らじる★らじる→大阪放送局を選択→NHK第一\n　※神奈川の方は普通のラジオのNHK-FMでも", + "source": "Twitter Web Client", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2761692762, + "id_str": "2761692762", + "name": "三浦学苑軟式野球部応援団！", + "screen_name": "oen_yakyu", + "location": "", + "description": "兵庫県で開催される「もう一つの甲子園」こと全国高校軟式野球選手権大会に南関東ブロックから出場する三浦学苑軟式野球部を応援する非公式アカウントです。", + "url": "http://t.co/Cn1tPTsBGY", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/Cn1tPTsBGY", + "expanded_url": "http://www.miura.ed.jp/index.html", + "display_url": "miura.ed.jp/index.html", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 464, + "friends_count": 117, + "listed_count": 4, + "created_at": "Sun Aug 24 07:47:29 +0000 2014", + "favourites_count": 69, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 553, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/504299474445811712/zsxJUmL0_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/504299474445811712/zsxJUmL0_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2761692762/1409069337", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 7, + "favorite_count": 2, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 7, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "oen_yakyu", + "name": "三浦学苑軟式野球部応援団！", + "id": 2761692762, + "id_str": "2761692762", + "indices": [ + 3, + 13 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874882110824450, + "id_str": "505874882110824448", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "スマホに密封★アニメ画像", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2725976444, + "id_str": "2725976444", + "name": "スマホに密封★アニメ画像", + "screen_name": "sumahoanime", + "location": "", + "description": "なんともめずらしい、いろんなキャラがスマホに閉じ込められています。 \r\nあなたのスマホにマッチする画像が見つかるかも♪ \r\n気に入ったら是非 RT ＆ フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 227, + "friends_count": 1918, + "listed_count": 0, + "created_at": "Tue Aug 12 11:27:54 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 527, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/499155646164393984/l5vSz5zu_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/499155646164393984/l5vSz5zu_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2725976444/1407843121", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:05 +0000 2014", + "id": 505874881297133600, + "id_str": "505874881297133568", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "アナタのそばの身近な危険", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2713926078, + "id_str": "2713926078", + "name": "アナタのそばの身近な危険", + "screen_name": "mijika_kiken", + "location": "", + "description": "知らないうちにやっている危険な行動を見つけて自分を守りましょう。 役に立つと思ったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 301, + "friends_count": 1871, + "listed_count": 0, + "created_at": "Thu Aug 07 07:12:50 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 644, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/497279579245907968/Ftvms_HR_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/497279579245907968/Ftvms_HR_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2713926078/1407395683", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:04 +0000 2014", + "id": 505874880294682600, + "id_str": "505874880294682624", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "人気者♥デイジー大好き", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2726199583, + "id_str": "2726199583", + "name": "人気者♥デイジー大好き", + "screen_name": "ninkimono_daosy", + "location": "", + "description": "デイジーの想いを、代わりにつぶやきます♪ \r\nデイジーのかわいい画像やグッズも大好きｗ \r\n可愛いと思ったら RT & フォローお願いします。 \r\n「非公式アカウントです」", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 190, + "friends_count": 474, + "listed_count": 0, + "created_at": "Tue Aug 12 12:58:33 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 469, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/499178622494576640/EzWKdR_p_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/499178622494576640/EzWKdR_p_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2726199583/1407848478", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:04 +0000 2014", + "id": 505874879392919550, + "id_str": "505874879392919552", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "幸せ話でフル充電しよう", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2721453846, + "id_str": "2721453846", + "name": "幸せ話でフル充電しようww", + "screen_name": "shiawasehanashi", + "location": "", + "description": "私が聞いて心に残った感動エピソードをお届けします。\r\n少しでも多くの人へ届けたいと思います。\r\nいいなと思ったら RT & フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 302, + "friends_count": 1886, + "listed_count": 0, + "created_at": "Sun Aug 10 12:16:25 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 508, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498444554916216832/ml8EiQka_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498444554916216832/ml8EiQka_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2721453846/1407673555", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:04 +0000 2014", + "id": 505874879103520800, + "id_str": "505874879103520768", + "text": "RT @Ang_Angel73: 逢坂「くっ…僕の秘められし右目が…！」\n一同「……………。」", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2571968509, + "id_str": "2571968509", + "name": "イイヒト", + "screen_name": "IwiAlohomora", + "location": "草葉の陰", + "description": "大人です。気軽に絡んでくれるとうれしいです！ イラスト大好き！（≧∇≦） BF(仮）逢坂紘夢くんにお熱です！ マンガも好き♡欲望のままにつぶやきますのでご注意を。雑食♡", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 156, + "friends_count": 165, + "listed_count": 14, + "created_at": "Tue Jun 17 01:18:34 +0000 2014", + "favourites_count": 11926, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 7234, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/504990074862178304/DoBvOb9c_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/504990074862178304/DoBvOb9c_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2571968509/1409106012", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:27:01 +0000 2014", + "id": 505874364596621300, + "id_str": "505874364596621313", + "text": "逢坂「くっ…僕の秘められし右目が…！」\n一同「……………。」", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1600750194, + "id_str": "1600750194", + "name": "臙脂", + "screen_name": "Ang_Angel73", + "location": "逢坂紘夢のそばに", + "description": "自由、気ままに。詳しくはツイプロ。アイコンはまめせろりちゃんからだよ☆～（ゝ。∂）", + "url": "http://t.co/kKCCwHTaph", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/kKCCwHTaph", + "expanded_url": "http://twpf.jp/Ang_Angel73", + "display_url": "twpf.jp/Ang_Angel73", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 155, + "friends_count": 154, + "listed_count": 10, + "created_at": "Wed Jul 17 11:44:31 +0000 2013", + "favourites_count": 2115, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 12342, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/378800000027871001/aa764602922050b22bf9ade3741367dc.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/378800000027871001/aa764602922050b22bf9ade3741367dc.jpeg", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/500293786287603713/Ywyh69eG_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/500293786287603713/Ywyh69eG_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1600750194/1403879183", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 2, + "favorite_count": 2, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 2, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "Ang_Angel73", + "name": "臙脂", + "id": 1600750194, + "id_str": "1600750194", + "indices": [ + 3, + 15 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:04 +0000 2014", + "id": 505874877933314050, + "id_str": "505874877933314048", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "秘密の本音♥女子編", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2762237088, + "id_str": "2762237088", + "name": "秘密の本音♥女子編", + "screen_name": "honne_jyoshi1", + "location": "", + "description": "普段は言えない「お・ん・なの建前と本音」をつぶやきます。 気になる あの人の本音も、わかるかも!? \r\nわかるって人は RT ＆ フォローを、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 123, + "friends_count": 988, + "listed_count": 0, + "created_at": "Sun Aug 24 12:27:07 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 211, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503519190364332032/BVjS_XBD_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503519190364332032/BVjS_XBD_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2762237088/1408883328", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:04 +0000 2014", + "id": 505874877148958700, + "id_str": "505874877148958721", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "美し過ぎる★色鉛筆アート", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2740047343, + "id_str": "2740047343", + "name": "美し過ぎる★色鉛筆アート", + "screen_name": "bi_iroenpitu", + "location": "", + "description": "ほんとにコレ色鉛筆なの～？ \r\n本物と見間違える程のリアリティを御覧ください。 \r\n気に入ったら RT & 相互フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 321, + "friends_count": 1990, + "listed_count": 0, + "created_at": "Sun Aug 17 16:15:05 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 396, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501039950972739585/isigil4V_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501039950972739585/isigil4V_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2740047343/1408292283", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874876465295360, + "id_str": "505874876465295361", + "text": "【H15-9-4】道路を利用する利益は反射的利益であり、建築基準法に基づいて道路一の指定がなされている私道の敷地所有者に対し、通行妨害行為の排除を求める人格的権利を認めることはできない。→誤。", + "source": "twittbot.net", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1886570281, + "id_str": "1886570281", + "name": "行政法過去問", + "screen_name": "gyosei_goukaku", + "location": "", + "description": "行政書士の本試験問題の過去問（行政法分野）をランダムにつぶやきます。問題は随時追加中です。基本的に相互フォローします。※140字制限の都合上、表現は一部変えてあります。解説も文字数が可能であればなるべく…。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 1554, + "friends_count": 1772, + "listed_count": 12, + "created_at": "Fri Sep 20 13:24:29 +0000 2013", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 14565, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/378800000487791870/0e45e3c089c6b641cdd8d1b6f1ceb8a4_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/378800000487791870/0e45e3c089c6b641cdd8d1b6f1ceb8a4_normal.jpeg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874876318511100, + "id_str": "505874876318511104", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "K点越えの発想力!!", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744863153, + "id_str": "2744863153", + "name": "K点越えの発想力!!", + "screen_name": "kgoehassou", + "location": "", + "description": "いったいどうやったら、その領域にたどりつけるのか！？ \r\nそんな思わず笑ってしまう別世界の発想力をお届けします♪ \r\nおもしろかったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 76, + "friends_count": 957, + "listed_count": 0, + "created_at": "Tue Aug 19 13:00:08 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 341, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501715651686178816/Fgpe0B8M_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501715651686178816/Fgpe0B8M_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744863153/1408453328", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874875521581060, + "id_str": "505874875521581056", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "血液型の真実２", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2698625690, + "id_str": "2698625690", + "name": "血液型の真実", + "screen_name": "ketueki_sinjitu", + "location": "", + "description": "やっぱりそうだったのか～♪\r\n意外な、あの人の裏側を見つけます。\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 193, + "friends_count": 1785, + "listed_count": 1, + "created_at": "Fri Aug 01 16:11:40 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 769, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495241446706790400/h_0DSFPG_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495241446706790400/h_0DSFPG_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2698625690/1406911319", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874874712072200, + "id_str": "505874874712072192", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "やっぱり神が？？を作る時", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2714868440, + "id_str": "2714868440", + "name": "やっぱり神が？？を作る時", + "screen_name": "yahari_kamiga", + "location": "", + "description": "やっぱり今日も、神は何かを作ろうとしています　笑。　どうやって作っているのかわかったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 243, + "friends_count": 1907, + "listed_count": 0, + "created_at": "Thu Aug 07 16:12:33 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 590, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/497416102108884992/NRMEbKaT_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/497416102108884992/NRMEbKaT_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2714868440/1407428237", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874874275864600, + "id_str": "505874874275864576", + "text": "RT @takuramix: 福島第一原発の構内地図がこちら。\nhttp://t.co/ZkU4TZCGPG\nどう見ても、１号機。\nRT @Lightworker19: 【大拡散】　 福島第一原発　４号機　爆発動画　40秒～ 　http://t.co/lmlgp38fgZ", + "source": "ツイタマ", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 62525372, + "id_str": "62525372", + "name": "NANCY-MOON☆ひよこちゃん☆", + "screen_name": "nancy_moon_703", + "location": "JAPAN", + "description": "【無断転載禁止･コピペ禁止・非公式RT禁止】【必読！】⇒ http://t.co/nuUvfUVD 今現在活動中の東方神起YUNHO＆CHANGMINの2人を全力で応援しています!!(^_-)-☆ ※東方神起及びYUNHO＆CHANGMINを応援していない方・鍵付ユーザーのフォローお断り！", + "url": null, + "entities": { + "description": { + "urls": [ + { + "url": "http://t.co/nuUvfUVD", + "expanded_url": "http://goo.gl/SrGLb", + "display_url": "goo.gl/SrGLb", + "indices": [ + 29, + 49 + ] + } + ] + } + }, + "protected": false, + "followers_count": 270, + "friends_count": 328, + "listed_count": 4, + "created_at": "Mon Aug 03 14:22:24 +0000 2009", + "favourites_count": 3283, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 180310, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "642D8B", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/470849781397336064/ltM6EdFn.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/470849781397336064/ltM6EdFn.jpeg", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/3699005246/9ba2e306518d296b68b7cbfa5e4ce4e6_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/3699005246/9ba2e306518d296b68b7cbfa5e4ce4e6_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/62525372/1401094223", + "profile_link_color": "FF0000", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "F065A8", + "profile_text_color": "080808", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 21:21:33 +0000 2014", + "id": 505827689660313600, + "id_str": "505827689660313600", + "text": "福島第一原発の構内地図がこちら。\nhttp://t.co/ZkU4TZCGPG\nどう見ても、１号機。\nRT @Lightworker19: 【大拡散】　 福島第一原発　４号機　爆発動画　40秒～ 　http://t.co/lmlgp38fgZ", + "source": "TweetDeck", + "truncated": false, + "in_reply_to_status_id": 505774460910043140, + "in_reply_to_status_id_str": "505774460910043136", + "in_reply_to_user_id": 238157843, + "in_reply_to_user_id_str": "238157843", + "in_reply_to_screen_name": "Lightworker19", + "user": { + "id": 29599253, + "id_str": "29599253", + "name": "タクラミックス", + "screen_name": "takuramix", + "location": "i7", + "description": "私の機能一覧：歌う、演劇、ネットワークエンジニア、ライター、プログラマ、翻訳、シルバーアクセサリ、……何をやってる人かは良くわからない人なので、「機能」が欲しい人は私にがっかりするでしょう。私って人間に御用があるなら別ですが。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 5136, + "friends_count": 724, + "listed_count": 335, + "created_at": "Wed Apr 08 01:10:58 +0000 2009", + "favourites_count": 21363, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 70897, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/2049751947/takuramix1204_normal.jpg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/2049751947/takuramix1204_normal.jpg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 1, + "favorite_count": 1, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/ZkU4TZCGPG", + "expanded_url": "http://www.tepco.co.jp/nu/fukushima-np/review/images/review1_01.gif", + "display_url": "tepco.co.jp/nu/fukushima-n…", + "indices": [ + 17, + 39 + ] + }, + { + "url": "http://t.co/lmlgp38fgZ", + "expanded_url": "http://youtu.be/gDXEhyuVSDk", + "display_url": "youtu.be/gDXEhyuVSDk", + "indices": [ + 99, + 121 + ] + } + ], + "user_mentions": [ + { + "screen_name": "Lightworker19", + "name": "Lightworker", + "id": 238157843, + "id_str": "238157843", + "indices": [ + 54, + 68 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + "retweet_count": 1, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/ZkU4TZCGPG", + "expanded_url": "http://www.tepco.co.jp/nu/fukushima-np/review/images/review1_01.gif", + "display_url": "tepco.co.jp/nu/fukushima-n…", + "indices": [ + 32, + 54 + ] + }, + { + "url": "http://t.co/lmlgp38fgZ", + "expanded_url": "http://youtu.be/gDXEhyuVSDk", + "display_url": "youtu.be/gDXEhyuVSDk", + "indices": [ + 114, + 136 + ] + } + ], + "user_mentions": [ + { + "screen_name": "takuramix", + "name": "タクラミックス", + "id": 29599253, + "id_str": "29599253", + "indices": [ + 3, + 13 + ] + }, + { + "screen_name": "Lightworker19", + "name": "Lightworker", + "id": 238157843, + "id_str": "238157843", + "indices": [ + 69, + 83 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874873961308160, + "id_str": "505874873961308160", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "やっぱりアナ雪が好き♥", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2714052962, + "id_str": "2714052962", + "name": "やっぱりアナ雪が好き♥", + "screen_name": "anayuki_suki", + "location": "", + "description": "なんだかんだ言ってもやっぱりアナ雪が好きなんですよね～♪ \r\n私も好きって人は RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 368, + "friends_count": 1826, + "listed_count": 1, + "created_at": "Thu Aug 07 08:29:13 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 670, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/497299646662705153/KMo3gkv7_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/497299646662705153/KMo3gkv7_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2714052962/1407400477", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "zh" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874873759977500, + "id_str": "505874873759977473", + "text": "四川盆地江淮等地将有强降雨 开学日多地将有雨: 　　中新网8月31日电 据中央气象台消息，江淮东部、四川盆地东北部等地今天(31日)又将迎来一场暴雨或大暴雨天气。明天9月1日，是中小学生开学的日子。预计明天，内蒙古中部、... http://t.co/toQgVlXPyH", + "source": "twitterfeed", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2281979863, + "id_str": "2281979863", + "name": "News 24h China", + "screen_name": "news24hchn", + "location": "", + "description": "", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 719, + "friends_count": 807, + "listed_count": 7, + "created_at": "Wed Jan 08 10:56:04 +0000 2014", + "favourites_count": 0, + "utc_offset": 7200, + "time_zone": "Amsterdam", + "geo_enabled": false, + "verified": false, + "statuses_count": 94782, + "lang": "it", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/452558963754561536/QPID3isM.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/452558963754561536/QPID3isM.jpeg", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/439031926569979904/SlBH9iMg_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/439031926569979904/SlBH9iMg_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2281979863/1393508427", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/toQgVlXPyH", + "expanded_url": "http://news24h.allnews24h.com/FX54", + "display_url": "news24h.allnews24h.com/FX54", + "indices": [ + 114, + 136 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "zh" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874873248268300, + "id_str": "505874873248268288", + "text": "@Take3carnifex それは大変！一大事！命に関わります！\n是非うちに受診して下さい！", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": 505874353716600800, + "in_reply_to_status_id_str": "505874353716600832", + "in_reply_to_user_id": 535179785, + "in_reply_to_user_id_str": "535179785", + "in_reply_to_screen_name": "Take3carnifex", + "user": { + "id": 226897125, + "id_str": "226897125", + "name": "ひかり＠hack", + "screen_name": "hikari_thirteen", + "location": "", + "description": "hackというバンドで、ギターを弾いています。 モンハンとポケモンが好き。 \nSPRING WATER リードギター(ヘルプ)\nROCK OUT レギュラーDJ", + "url": "http://t.co/SQLZnvjVxB", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/SQLZnvjVxB", + "expanded_url": "http://s.ameblo.jp/hikarihikarimay", + "display_url": "s.ameblo.jp/hikarihikarimay", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 296, + "friends_count": 348, + "listed_count": 3, + "created_at": "Wed Dec 15 10:51:51 +0000 2010", + "favourites_count": 33, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 3293, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "131516", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme14/bg.gif", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme14/bg.gif", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/378800000504584690/8ccba98eda8c0fd1d15a74e401f621d1_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/378800000504584690/8ccba98eda8c0fd1d15a74e401f621d1_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/226897125/1385551752", + "profile_link_color": "009999", + "profile_sidebar_border_color": "EEEEEE", + "profile_sidebar_fill_color": "EFEFEF", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "Take3carnifex", + "name": "Take3", + "id": 535179785, + "id_str": "535179785", + "indices": [ + 0, + 14 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:03 +0000 2014", + "id": 505874873223110660, + "id_str": "505874873223110656", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "今どき女子高生の謎w", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744236873, + "id_str": "2744236873", + "name": "今どき女子高生の謎w", + "screen_name": "imadokijoshiko", + "location": "", + "description": "思わず耳を疑う男性の方の夢を壊してしまう、\r\n女子高生達のディープな世界を見てください☆ \r\nおもしろいと思ったら RT & 相互フォローでお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 79, + "friends_count": 973, + "listed_count": 0, + "created_at": "Tue Aug 19 07:06:47 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 354, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501627015980535808/avWBgkDh_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501627015980535808/avWBgkDh_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744236873/1408432455", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874872463925250, + "id_str": "505874872463925248", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "私の理想の男性像", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2761782601, + "id_str": "2761782601", + "name": "私の理想の男性像", + "screen_name": "risou_dansei", + "location": "", + "description": "こんな男性♥ ほんとにいるのかしら!? \r\n「いたらいいのになぁ」っていう理想の男性像をを、私目線でつぶやきます。 \r\nいいなと思った人は RT & フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 69, + "friends_count": 974, + "listed_count": 0, + "created_at": "Sun Aug 24 08:03:32 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 208, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503452833719410688/tFU509Yk_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503452833719410688/tFU509Yk_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2761782601/1408867519", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874871713157100, + "id_str": "505874871713157120", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "激アツ★6秒動画", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2725690658, + "id_str": "2725690658", + "name": "激アツ★6秒動画", + "screen_name": "gekiatu_6byou", + "location": "", + "description": "話題の６秒動画！ \r\n思わず「ほんとかよっ」てツッコんでしまう内容のオンパレード！ \r\nおもしろかったら、是非 RT ＆ フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 195, + "friends_count": 494, + "listed_count": 0, + "created_at": "Tue Aug 12 08:17:29 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 477, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/499107997444886528/3rl6FrIk_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/499107997444886528/3rl6FrIk_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2725690658/1407832963", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874871616671740, + "id_str": "505874871616671744", + "text": "爆笑ｗｗ珍解答集！\n先生のツメの甘さと生徒のセンスを感じる一問一答だとFBでも話題！！\nうどん天下一決定戦ウィンドウズ9三重高校竹内由恵アナ花火保険\nhttp://t.co/jRWJt8IrSB http://t.co/okrAoxSbt0", + "source": "笑える博物館", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2748747362, + "id_str": "2748747362", + "name": "笑える博物館", + "screen_name": "waraeru_kan", + "location": "", + "description": "", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 19, + "friends_count": 10, + "listed_count": 0, + "created_at": "Wed Aug 20 11:11:04 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 15137, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://abs.twimg.com/sticky/default_profile_images/default_profile_4_normal.png", + "profile_image_url_https": "https://abs.twimg.com/sticky/default_profile_images/default_profile_4_normal.png", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": true, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/jRWJt8IrSB", + "expanded_url": "http://bit.ly/1qBa1nl", + "display_url": "bit.ly/1qBa1nl", + "indices": [ + 75, + 97 + ] + } + ], + "user_mentions": [], + "media": [ + { + "id": 505874871344066560, + "id_str": "505874871344066560", + "indices": [ + 98, + 120 + ], + "media_url": "http://pbs.twimg.com/media/BwU6g-dCcAALxAW.png", + "media_url_https": "https://pbs.twimg.com/media/BwU6g-dCcAALxAW.png", + "url": "http://t.co/okrAoxSbt0", + "display_url": "pic.twitter.com/okrAoxSbt0", + "expanded_url": "http://twitter.com/waraeru_kan/status/505874871616671744/photo/1", + "type": "photo", + "sizes": { + "small": { + "w": 340, + "h": 425, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "large": { + "w": 600, + "h": 750, + "resize": "fit" + }, + "medium": { + "w": 600, + "h": 750, + "resize": "fit" + } + } + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874871268540400, + "id_str": "505874871268540416", + "text": "@nasan_arai \n名前→なーさん\n第一印象→誰。(´･_･`)\n今の印象→れいら♡\nLINE交換できる？→してる(｢･ω･)｢\n好きなところ→可愛い優しい優しい優しい\n最後に一言→なーさん好き〜(´･_･`)♡GEM現場おいでね(´･_･`)♡\n\n#ふぁぼした人にやる", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": 1717603286, + "in_reply_to_user_id_str": "1717603286", + "in_reply_to_screen_name": "nasan_arai", + "user": { + "id": 2417626784, + "id_str": "2417626784", + "name": "✩.ゆきଘ(*´꒳`)", + "screen_name": "Ymaaya_gem", + "location": "", + "description": "⁽⁽٩( ᐖ )۶⁾⁾ ❤︎ 武 田 舞 彩 ❤︎ ₍₍٩( ᐛ )۶₎₎", + "url": "http://t.co/wR0Qb76TbB", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/wR0Qb76TbB", + "expanded_url": "http://twpf.jp/Ymaaya_gem", + "display_url": "twpf.jp/Ymaaya_gem", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 198, + "friends_count": 245, + "listed_count": 1, + "created_at": "Sat Mar 29 16:03:06 +0000 2014", + "favourites_count": 3818, + "utc_offset": null, + "time_zone": null, + "geo_enabled": true, + "verified": false, + "statuses_count": 8056, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/505516858816987136/4gFGjHzu_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/505516858816987136/4gFGjHzu_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2417626784/1407764793", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [ + { + "text": "ふぁぼした人にやる", + "indices": [ + 128, + 138 + ] + } + ], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "nasan_arai", + "name": "なーさん", + "id": 1717603286, + "id_str": "1717603286", + "indices": [ + 0, + 11 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874871218225150, + "id_str": "505874871218225152", + "text": "\"ソードマスター\"剣聖カミイズミ (CV:緑川光)-「ソードマスター」のアスタリスク所持者\n第一師団団長にして「剣聖」の称号を持つ剣士。イデアの剣の師匠。 \n敵味方からも尊敬される一流の武人。", + "source": "twittbot.net", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1435517814, + "id_str": "1435517814", + "name": "俺、関係ないよ？", + "screen_name": "BDFF_LOVE", + "location": "ルクセンダルクorリングアベルさんの隣", + "description": "自分なりに生きる人、最後まであきらめないの。でも、フォローありがとう…。@ringo_BDFFLOVE ←は、妹です。時々、会話します。「現在BOTで、BDFFのこと呟くよ！」夜は、全滅　「BDFFプレイ中」詳しくは、ツイプロみてください！(絶対)", + "url": "http://t.co/5R4dzpbWX2", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/5R4dzpbWX2", + "expanded_url": "http://twpf.jp/BDFF_LOVE", + "display_url": "twpf.jp/BDFF_LOVE", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 1066, + "friends_count": 1799, + "listed_count": 6, + "created_at": "Fri May 17 12:33:23 +0000 2013", + "favourites_count": 1431, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": true, + "verified": false, + "statuses_count": 6333, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/505696320380612608/qvaxb_zx_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/505696320380612608/qvaxb_zx_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1435517814/1409401948", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874871130136600, + "id_str": "505874871130136576", + "text": "闇「リンと付き合うに当たって歳の差以外にもいろいろ壁があったんだよ。愛し隊の妨害とか風紀厨の生徒会長とか…」\n一号「リンちゃんを泣かせたらシメるかんね！」\n二号「リンちゃんにやましい事したら×す…」\n執行部「不純な交際は僕が取り締まろうじゃないか…」\n闇「（消される）」", + "source": "twittbot.net", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2386208737, + "id_str": "2386208737", + "name": "闇未来Bot", + "screen_name": "StxRinFbot", + "location": "DIVAルーム", + "description": "ProjectDIVAのモジュール・ストレンジダーク×鏡音リンFutureStyleの自己満足非公式Bot　マセレン仕様。CP要素あります。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 7, + "friends_count": 2, + "listed_count": 0, + "created_at": "Thu Mar 13 02:58:09 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 4876, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/443948925351755776/6rmljL5C_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/443948925351755776/6rmljL5C_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2386208737/1396259004", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874870933016600, + "id_str": "505874870933016576", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "絶品!!スイーツ天国", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2725681663, + "id_str": "2725681663", + "name": "絶品!!スイーツ天国", + "screen_name": "suitestengoku", + "location": "", + "description": "美味しそうなスイーツって、見てるだけで幸せな気分になれますね♪\r\nそんな素敵なスイーツに出会いたいです。\r\n食べたいと思ったら是非 RT ＆ フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 401, + "friends_count": 1877, + "listed_count": 1, + "created_at": "Tue Aug 12 07:43:52 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 554, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/499099533507178496/g5dNpArt_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/499099533507178496/g5dNpArt_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2725681663/1407829743", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874870148669440, + "id_str": "505874870148669440", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "電車厳禁!!おもしろ話", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2699667800, + "id_str": "2699667800", + "name": "電車厳禁!!おもしろ話w", + "screen_name": "dengeki_omoro", + "location": "", + "description": "日常のオモシロくて笑える場面を探します♪\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 461, + "friends_count": 1919, + "listed_count": 0, + "created_at": "Sat Aug 02 02:16:32 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 728, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495400387961036800/BBMb_hcG_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495400387961036800/BBMb_hcG_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2699667800/1406947654", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874869339189250, + "id_str": "505874869339189249", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "笑えるwwランキング2", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2695745652, + "id_str": "2695745652", + "name": "笑えるwwランキング", + "screen_name": "wara_runk", + "location": "", + "description": "知ってると使えるランキングを探そう。\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 314, + "friends_count": 1943, + "listed_count": 1, + "created_at": "Thu Jul 31 13:51:57 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 737, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/494844659856728064/xBQfnm5J_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/494844659856728064/xBQfnm5J_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2695745652/1406815103", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:02 +0000 2014", + "id": 505874868533854200, + "id_str": "505874868533854209", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "スニーカー大好き★図鑑", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2707963890, + "id_str": "2707963890", + "name": "スニーカー大好き★図鑑", + "screen_name": "sunikar_daisuki", + "location": "", + "description": "スニーカー好きを見つけて仲間になろう♪\r\n気に入ったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 394, + "friends_count": 1891, + "listed_count": 0, + "created_at": "Tue Aug 05 01:54:28 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 642, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496474952631996416/f0C_u3_u_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496474952631996416/f0C_u3_u_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2707963890/1407203869", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "zh" + }, + "created_at": "Sun Aug 31 00:29:01 +0000 2014", + "id": 505874867997380600, + "id_str": "505874867997380608", + "text": "\"@BelloTexto: ¿Quieres ser feliz? \n一\"No stalkees\" \n一\"No stalkees\" \n一\"No stalkees\" \n一\"No stalkees\" \n一\"No stalkees\" \n一\"No stalkees\".\"", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2249378935, + "id_str": "2249378935", + "name": "Maggie Becerril ", + "screen_name": "maggdesie", + "location": "", + "description": "cambiando la vida de las personas.", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 120, + "friends_count": 391, + "listed_count": 0, + "created_at": "Mon Dec 16 21:56:49 +0000 2013", + "favourites_count": 314, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 1657, + "lang": "es", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/505093371665604608/K0x_LV2y_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/505093371665604608/K0x_LV2y_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2249378935/1409258479", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "BelloTexto", + "name": "Indirectas... ✉", + "id": 833083404, + "id_str": "833083404", + "indices": [ + 1, + 12 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "zh" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:01 +0000 2014", + "id": 505874867720183800, + "id_str": "505874867720183808", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "ザ・異性の裏の顔", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2719746578, + "id_str": "2719746578", + "name": "ザ・異性の裏の顔", + "screen_name": "iseiuragao", + "location": "", + "description": "異性について少し学ぶことで、必然的にモテるようになる！？　相手を理解することで見えてくるもの「それは・・・●●」　いい内容だと思ったら RT & フォローもお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 238, + "friends_count": 1922, + "listed_count": 0, + "created_at": "Sat Aug 09 17:18:43 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 532, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498157077726900224/tW8q4di__normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498157077726900224/tW8q4di__normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2719746578/1407604947", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:01 +0000 2014", + "id": 505874866910687200, + "id_str": "505874866910687233", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "超w美女☆アルバム", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744054334, + "id_str": "2744054334", + "name": "超w美女☆アルバム", + "screen_name": "bijyoalbum", + "location": "", + "description": "「おお～っ！いいね～」って、思わず言ってしまう、美女を見つけます☆ \r\nタイプだと思ったら RT & 相互フォローでお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 45, + "friends_count": 966, + "listed_count": 0, + "created_at": "Tue Aug 19 05:36:48 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 352, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501604413312491520/GP66eKWr_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501604413312491520/GP66eKWr_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744054334/1408426814", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:01 +0000 2014", + "id": 505874866105376800, + "id_str": "505874866105376769", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "男に見せない女子の裏生態", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744261238, + "id_str": "2744261238", + "name": "男に見せない女子の裏生態", + "screen_name": "jyoshiuraseitai", + "location": "", + "description": "男の知らない女子ならではのあるある☆ \r\nそんな生々しい女子の生態をつぶやきます。 \r\nわかる～って人は RT & フォローでお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 203, + "friends_count": 967, + "listed_count": 0, + "created_at": "Tue Aug 19 08:01:28 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 348, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501641354804346880/Uh1-n1LD_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501641354804346880/Uh1-n1LD_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744261238/1408435630", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:01 +0000 2014", + "id": 505874865354584060, + "id_str": "505874865354584064", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "驚きの動物たちの生態", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2759403146, + "id_str": "2759403146", + "name": "驚きの動物たちの生態", + "screen_name": "soubutu_seitai", + "location": "", + "description": "「おお～っ」と 言われるような、動物の生態をツイートします♪ \r\n知っていると、あなたも人気者に!? \r\nおもしろかったら RT & フォローを、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 67, + "friends_count": 954, + "listed_count": 0, + "created_at": "Sat Aug 23 16:39:31 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 219, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503220468128567296/Z8mGDIBS_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503220468128567296/Z8mGDIBS_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2759403146/1408812130", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:01 +0000 2014", + "id": 505874864603820000, + "id_str": "505874864603820032", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "モテ女子★ファションの秘密", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2706659820, + "id_str": "2706659820", + "name": "モテ女子★ファションの秘密", + "screen_name": "mote_woman", + "location": "", + "description": "オシャレかわいい♥モテ度UPの注目アイテムを見つけます。\r\n気に入ったら RT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 217, + "friends_count": 1806, + "listed_count": 0, + "created_at": "Mon Aug 04 14:30:24 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 682, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496303370936668161/s7xP8rTy_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496303370936668161/s7xP8rTy_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2706659820/1407163059", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:00 +0000 2014", + "id": 505874863874007040, + "id_str": "505874863874007040", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "男女の違いを解明する", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2761896468, + "id_str": "2761896468", + "name": "男女の違いを解明する", + "screen_name": "danjyonotigai1", + "location": "", + "description": "意外と理解できていない男女それぞれの事情。 \r\n「えっ　マジで!?」と驚くような、男女の習性をつぶやきます♪ ためになったら、是非 RT ＆ フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 82, + "friends_count": 992, + "listed_count": 0, + "created_at": "Sun Aug 24 09:47:44 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 237, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503479057380413441/zDLu5Z9o_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503479057380413441/zDLu5Z9o_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2761896468/1408873803", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:00 +0000 2014", + "id": 505874862900924400, + "id_str": "505874862900924416", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "神レベル★極限の発想", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744950735, + "id_str": "2744950735", + "name": "神レベル★極限の発想", + "screen_name": "kamihassou", + "location": "", + "description": "見ているだけで、本気がビシバシ伝わってきます！ \r\n人生のヒントになるような、そんな究極の発想を集めています。 \r\nいいなと思ったら RT & 相互フォローで、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 84, + "friends_count": 992, + "listed_count": 0, + "created_at": "Tue Aug 19 13:36:05 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 343, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501725053189226496/xZNOTYz2_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501725053189226496/xZNOTYz2_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744950735/1408455571", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:00 +0000 2014", + "id": 505874862397591550, + "id_str": "505874862397591552", + "text": "@kaoritoxx そうよ！あたしはそう思うようにしておる。いま職場一やけとる気がする(°_°)！満喫幸せ焼け！！wあー、なるほどね！毎回そうだよね！ティアラちゃんみにいってるもんね♡五月と九月恐ろしい、、、\nハリポタエリアはいった？？", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": 505838547308277760, + "in_reply_to_status_id_str": "505838547308277761", + "in_reply_to_user_id": 796000214, + "in_reply_to_user_id_str": "796000214", + "in_reply_to_screen_name": "kaoritoxx", + "user": { + "id": 2256249487, + "id_str": "2256249487", + "name": "はあちゃん@海賊同盟中", + "screen_name": "onepiece_24", + "location": "どえすえろぉたんの助手兼ね妹(願望)", + "description": "ONE PIECE愛しすぎて今年２３ちゃい(歴１４年目)ゾロ様に一途だったのにロー、このやろー。ロビンちゃんが幸せになればいい。ルフィは無条件にすき。ゾロビン、ローロビ、ルロビ♡usj、声優さん、コナン、進撃、クレしん、H x Hも好き♩", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 415, + "friends_count": 384, + "listed_count": 3, + "created_at": "Sat Dec 21 09:37:25 +0000 2013", + "favourites_count": 1603, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 9636, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501686340564418561/hMQFN4vD_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501686340564418561/hMQFN4vD_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2256249487/1399987924", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "kaoritoxx", + "name": "かおちゃん", + "id": 796000214, + "id_str": "796000214", + "indices": [ + 0, + 10 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:00 +0000 2014", + "id": 505874861973991400, + "id_str": "505874861973991424", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "恋愛仙人", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2698885082, + "id_str": "2698885082", + "name": "恋愛仙人", + "screen_name": "renai_sennin", + "location": "", + "description": "豊富でステキな恋愛経験を、シェアしましょう。\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 618, + "friends_count": 1847, + "listed_count": 1, + "created_at": "Fri Aug 01 18:09:38 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 726, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495272204641132544/GNA18aOg_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495272204641132544/GNA18aOg_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2698885082/1406917096", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:00 +0000 2014", + "id": 505874861881700350, + "id_str": "505874861881700353", + "text": "@itsukibot_ 一稀の俺のソーセージをペロペロする音はデカイ", + "source": "jigtwi", + "truncated": false, + "in_reply_to_status_id": 505871017428795400, + "in_reply_to_status_id_str": "505871017428795392", + "in_reply_to_user_id": 141170845, + "in_reply_to_user_id_str": "141170845", + "in_reply_to_screen_name": "itsukibot_", + "user": { + "id": 2184752048, + "id_str": "2184752048", + "name": "アンドー", + "screen_name": "55dakedayo", + "location": "", + "description": "", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 15, + "friends_count": 24, + "listed_count": 0, + "created_at": "Sat Nov 09 17:42:22 +0000 2013", + "favourites_count": 37249, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 21070, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://abs.twimg.com/sticky/default_profile_images/default_profile_3_normal.png", + "profile_image_url_https": "https://abs.twimg.com/sticky/default_profile_images/default_profile_3_normal.png", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": true, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "itsukibot_", + "name": "前田一稀", + "id": 141170845, + "id_str": "141170845", + "indices": [ + 0, + 11 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:00 +0000 2014", + "id": 505874861185437700, + "id_str": "505874861185437697", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "あの伝説の名ドラマ＆名場面", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2706951979, + "id_str": "2706951979", + "name": "あの伝説の名ドラマ＆名場面", + "screen_name": "densetunodorama", + "location": "", + "description": "誰にでも記憶に残る、ドラマの名場面があると思います。そんな感動のストーリーを、もう一度わかちあいたいです。\r\n「これ知ってる！」とか「あ～懐かしい」と思ったら RT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 300, + "friends_count": 1886, + "listed_count": 0, + "created_at": "Mon Aug 04 16:38:25 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 694, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/496335892152209408/fKzb8Nv3_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/496335892152209408/fKzb8Nv3_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2706951979/1407170704", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:29:00 +0000 2014", + "id": 505874860447260700, + "id_str": "505874860447260672", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "マジで食べたい♥ケーキ特集", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2724328646, + "id_str": "2724328646", + "name": "マジで食べたい♥ケーキ特集", + "screen_name": "tabetaicake1", + "location": "", + "description": "女性の目線から見た、美味しそうなケーキを探し求めています。\r\n見てるだけで、あれもコレも食べたくなっちゃう♪\r\n美味しそうだと思ったら、是非 RT ＆ フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 158, + "friends_count": 1907, + "listed_count": 0, + "created_at": "Mon Aug 11 17:15:22 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 493, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498881289844293632/DAa9No9M_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498881289844293632/DAa9No9M_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2724328646/1407777704", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:59 +0000 2014", + "id": 505874859662925800, + "id_str": "505874859662925824", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "アディダス★マニア", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2704003662, + "id_str": "2704003662", + "name": "アディダス★マニア", + "screen_name": "adi_mania11", + "location": "", + "description": "素敵なアディダスのアイテムを見つけたいです♪\r\n気に入ってもらえたららRT & 相互フォローで みなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 340, + "friends_count": 1851, + "listed_count": 0, + "created_at": "Sun Aug 03 12:26:37 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 734, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495911561781727235/06QAMVrR_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495911561781727235/06QAMVrR_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2704003662/1407069046", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:59 +0000 2014", + "id": 505874858920513540, + "id_str": "505874858920513537", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "萌えペット大好き", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2719061228, + "id_str": "2719061228", + "name": "萌えペット大好き", + "screen_name": "moe_pet1", + "location": "", + "description": "かわいいペットを見るのが趣味です♥そんな私と一緒にいやされたい人いませんか？かわいいと思ったら RT & フォローもお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 289, + "friends_count": 1812, + "listed_count": 0, + "created_at": "Sat Aug 09 10:20:25 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 632, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498051549537386496/QizThq7N_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498051549537386496/QizThq7N_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2719061228/1407581287", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:59 +0000 2014", + "id": 505874858115219460, + "id_str": "505874858115219456", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "恋愛の教科書　", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2744344514, + "id_str": "2744344514", + "name": "恋愛の教科書", + "screen_name": "renaikyoukasyo", + "location": "", + "description": "もっと早く知っとくべきだった～！知っていればもっと上手くいく♪ \r\n今すぐ役立つ恋愛についての雑学やマメ知識をお届けします。 \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 124, + "friends_count": 955, + "listed_count": 0, + "created_at": "Tue Aug 19 08:32:45 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 346, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501655512018997248/7SznYGWi_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501655512018997248/7SznYGWi_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2744344514/1408439001", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:59 +0000 2014", + "id": 505874857335074800, + "id_str": "505874857335074816", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "オモロすぎる★学生の日常", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2699365116, + "id_str": "2699365116", + "name": "オモロすぎる★学生の日常", + "screen_name": "omorogakusei", + "location": "", + "description": "楽しすぎる学生の日常を探していきます。\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 289, + "friends_count": 1156, + "listed_count": 2, + "created_at": "Fri Aug 01 23:35:18 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 770, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495353473886478336/S-4B_RVl_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495353473886478336/S-4B_RVl_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2699365116/1406936481", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:59 +0000 2014", + "id": 505874856605257700, + "id_str": "505874856605257728", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "憧れの★インテリア図鑑", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2721907602, + "id_str": "2721907602", + "name": "憧れの★インテリア図鑑", + "screen_name": "akogareinteria", + "location": "", + "description": "自分の住む部屋もこんなふうにしてみたい♪　\r\nそんな素敵なインテリアを、日々探していますw　\r\nいいなと思ったら RT & 相互フォローお願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 298, + "friends_count": 1925, + "listed_count": 0, + "created_at": "Sun Aug 10 15:59:13 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 540, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498499374423343105/Wi_izHvT_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498499374423343105/Wi_izHvT_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2721907602/1407686543", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:59 +0000 2014", + "id": 505874856089378800, + "id_str": "505874856089378816", + "text": "天冥の標 VI 宿怨 PART1 / 小川 一水\nhttp://t.co/fXIgRt4ffH\n \n#キンドル #天冥の標VI宿怨PART1", + "source": "waromett", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1953404612, + "id_str": "1953404612", + "name": "わろめっと", + "screen_name": "waromett", + "location": "", + "description": "たのしいついーとしょうかい", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 16980, + "friends_count": 16983, + "listed_count": 18, + "created_at": "Fri Oct 11 05:49:57 +0000 2013", + "favourites_count": 3833, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": false, + "verified": false, + "statuses_count": 98655, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "352726", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme5/bg.gif", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme5/bg.gif", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/378800000578908101/14c4744c7aa34b1f8bbd942b78e59385_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/378800000578908101/14c4744c7aa34b1f8bbd942b78e59385_normal.jpeg", + "profile_link_color": "D02B55", + "profile_sidebar_border_color": "829D5E", + "profile_sidebar_fill_color": "99CC33", + "profile_text_color": "3E4415", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [ + { + "text": "キンドル", + "indices": [ + 50, + 55 + ] + }, + { + "text": "天冥の標VI宿怨PART1", + "indices": [ + 56, + 70 + ] + } + ], + "symbols": [], + "urls": [ + { + "url": "http://t.co/fXIgRt4ffH", + "expanded_url": "http://j.mp/1kHBOym", + "display_url": "j.mp/1kHBOym", + "indices": [ + 25, + 47 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "zh" + }, + "created_at": "Sun Aug 31 00:28:58 +0000 2014", + "id": 505874855770599400, + "id_str": "505874855770599425", + "text": "四川盆地江淮等地将有强降雨 开学日多地将有雨: 　　中新网8月31日电 据中央气象台消息，江淮东部、四川盆地东北部等地今天(31日)又将迎来一场暴雨或大暴雨天气。明天9月1日，是中小学生开学的日子。预计明天，内蒙古中部、... http://t.co/RNdqIHmTby", + "source": "twitterfeed", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 402427654, + "id_str": "402427654", + "name": "中国新闻", + "screen_name": "zhongwenxinwen", + "location": "", + "description": "中国的新闻，世界的新闻。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 2429, + "friends_count": 15, + "listed_count": 29, + "created_at": "Tue Nov 01 01:56:43 +0000 2011", + "favourites_count": 0, + "utc_offset": -28800, + "time_zone": "Alaska", + "geo_enabled": false, + "verified": false, + "statuses_count": 84564, + "lang": "zh-cn", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "709397", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme6/bg.gif", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme6/bg.gif", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/2700523149/5597e347b2eb880425faef54287995f2_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/2700523149/5597e347b2eb880425faef54287995f2_normal.jpeg", + "profile_link_color": "FF3300", + "profile_sidebar_border_color": "86A4A6", + "profile_sidebar_fill_color": "A0C5C7", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/RNdqIHmTby", + "expanded_url": "http://bit.ly/1tOdNsI", + "display_url": "bit.ly/1tOdNsI", + "indices": [ + 114, + 136 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "zh" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:58 +0000 2014", + "id": 505874854877200400, + "id_str": "505874854877200384", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "LDH ★大好き応援団", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2700961603, + "id_str": "2700961603", + "name": "LDH ★大好き応援団", + "screen_name": "LDH_daisuki1", + "location": "", + "description": "LDHファンは、全員仲間です♪\r\n面白かったらRT & 相互フォローでみなさん、お願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 458, + "friends_count": 1895, + "listed_count": 0, + "created_at": "Sat Aug 02 14:23:46 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 735, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/495578007298252800/FOZflgYu_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/495578007298252800/FOZflgYu_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2700961603/1406989928", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:58 +0000 2014", + "id": 505874854147407900, + "id_str": "505874854147407872", + "text": "RT @shiawaseomamori: 一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるの…", + "source": "マジ!?怖いアニメ都市伝説", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2719489172, + "id_str": "2719489172", + "name": "マジ!?怖いアニメ都市伝説", + "screen_name": "anime_toshiden1", + "location": "", + "description": "あなたの知らない、怖すぎるアニメの都市伝説を集めています。\r\n「え～知らなかったよww]」って人は RT & フォローお願いします♪", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 377, + "friends_count": 1911, + "listed_count": 1, + "created_at": "Sat Aug 09 14:41:15 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 536, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/498118027322208258/h7XOTTSi_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/498118027322208258/h7XOTTSi_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2719489172/1407595513", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:06 +0000 2014", + "id": 505871615125491700, + "id_str": "505871615125491712", + "text": "一に止まると書いて、正しいという意味だなんて、この年になるまで知りませんでした。 人は生きていると、前へ前へという気持ちばかり急いて、どんどん大切なものを置き去りにしていくものでしょう。本当に正しいことというのは、一番初めの場所にあるのかもしれません。 by神様のカルテ、夏川草介", + "source": "幸せの☆お守り", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2745121514, + "id_str": "2745121514", + "name": "幸せの☆お守り", + "screen_name": "shiawaseomamori", + "location": "", + "description": "自分が幸せだと周りも幸せにできる！ \r\nそんな人生を精一杯生きるために必要な言葉をお届けします♪ \r\nいいなと思ったら RT & 相互フォローで、お願いします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 213, + "friends_count": 991, + "listed_count": 0, + "created_at": "Tue Aug 19 14:45:19 +0000 2014", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 349, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/501742437606244354/scXy81ZW_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2745121514/1408459730", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 58, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "shiawaseomamori", + "name": "幸せの☆お守り", + "id": 2745121514, + "id_str": "2745121514", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:58 +0000 2014", + "id": 505874854134820860, + "id_str": "505874854134820864", + "text": "@vesperia1985 おはよー！\n今日までなのですよ…！！明日一生来なくていい", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": 505868030329364500, + "in_reply_to_status_id_str": "505868030329364480", + "in_reply_to_user_id": 2286548834, + "in_reply_to_user_id_str": "2286548834", + "in_reply_to_screen_name": "vesperia1985", + "user": { + "id": 2389045190, + "id_str": "2389045190", + "name": "りいこ", + "screen_name": "riiko_dq10", + "location": "", + "description": "サマーエルフです、りいこです。えるおくんラブです！随時ふれぼしゅ〜〜(っ˘ω˘c )＊日常のどうでもいいことも呟いてますがよろしくね〜", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 67, + "friends_count": 69, + "listed_count": 0, + "created_at": "Fri Mar 14 13:02:27 +0000 2014", + "favourites_count": 120, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 324, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/503906346815610881/BfSrCoBr_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/503906346815610881/BfSrCoBr_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2389045190/1409232058", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "vesperia1985", + "name": "ユーリ", + "id": 2286548834, + "id_str": "2286548834", + "indices": [ + 0, + 13 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:58 +0000 2014", + "id": 505874853778685950, + "id_str": "505874853778685952", + "text": "【映画パンフレット】　永遠の０ （永遠のゼロ）　監督　山崎貴　キャスト　岡田准一、三浦春馬、井上真央東宝(2)11点の新品／中古品を見る: ￥ 500より\n(この商品の現在のランクに関する正式な情報については、アートフレーム... http://t.co/4hbyB1rbQ7", + "source": "IFTTT", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1319883571, + "id_str": "1319883571", + "name": "森林木工家具製作所", + "screen_name": "Furniturewood", + "location": "沖縄", + "description": "家具（かぐ、Furniture）は、家財道具のうち家の中に据え置いて利用する比較的大型の道具類、または元々家に作り付けられている比較的大型の道具類をさす。なお、日本の建築基準法上は、作り付け家具は、建築確認及び完了検査の対象となるが、後から置かれるものについては対象外である。", + "url": "http://t.co/V4oyL0xtZk", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/V4oyL0xtZk", + "expanded_url": "http://astore.amazon.co.jp/furniturewood-22", + "display_url": "astore.amazon.co.jp/furniturewood-…", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 677, + "friends_count": 743, + "listed_count": 1, + "created_at": "Mon Apr 01 07:55:14 +0000 2013", + "favourites_count": 0, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 17210, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/3460466135/c67d9df9b760787b9ed284fe80b1dd31_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/3460466135/c67d9df9b760787b9ed284fe80b1dd31_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1319883571/1364804982", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/4hbyB1rbQ7", + "expanded_url": "http://ift.tt/1kT55bk", + "display_url": "ift.tt/1kT55bk", + "indices": [ + 116, + 138 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:58 +0000 2014", + "id": 505874852754907140, + "id_str": "505874852754907136", + "text": "RT @siranuga_hotoke: ゴキブリは一世帯に平均して480匹いる。", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 413944345, + "id_str": "413944345", + "name": "泥酔イナバウアー", + "screen_name": "Natade_co_co_21", + "location": "", + "description": "君の瞳にうつる僕に乾杯。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 298, + "friends_count": 300, + "listed_count": 4, + "created_at": "Wed Nov 16 12:52:46 +0000 2011", + "favourites_count": 3125, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 12237, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "FFF04D", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/378800000115928444/9bf5fa13385cc80bfeb097e51af9862a.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/378800000115928444/9bf5fa13385cc80bfeb097e51af9862a.jpeg", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/500849752351600640/lMQqIzYj_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/500849752351600640/lMQqIzYj_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/413944345/1403511193", + "profile_link_color": "0099CC", + "profile_sidebar_border_color": "000000", + "profile_sidebar_fill_color": "F6FFD1", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sat Aug 30 23:24:23 +0000 2014", + "id": 505858599411666940, + "id_str": "505858599411666944", + "text": "ゴキブリは一世帯に平均して480匹いる。", + "source": "twittbot.net", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2243896200, + "id_str": "2243896200", + "name": "知らぬが仏bot", + "screen_name": "siranuga_hotoke", + "location": "奈良・京都辺り", + "description": "知らぬが仏な情報をお伝えします。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 3288, + "friends_count": 3482, + "listed_count": 7, + "created_at": "Fri Dec 13 13:16:35 +0000 2013", + "favourites_count": 0, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 1570, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/378800000866399372/ypy5NnPe_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/378800000866399372/ypy5NnPe_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/2243896200/1386997755", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 1, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + "retweet_count": 1, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "siranuga_hotoke", + "name": "知らぬが仏bot", + "id": 2243896200, + "id_str": "2243896200", + "indices": [ + 3, + 19 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:58 +0000 2014", + "id": 505874852603908100, + "id_str": "505874852603908096", + "text": "RT @UARROW_Y: ようかい体操第一を踊る国見英 http://t.co/SXoYWH98as", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 2463035136, + "id_str": "2463035136", + "name": "や", + "screen_name": "yae45", + "location": "", + "description": "きもちわるいことつぶやく用", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 4, + "friends_count": 30, + "listed_count": 0, + "created_at": "Fri Apr 25 10:49:20 +0000 2014", + "favourites_count": 827, + "utc_offset": 32400, + "time_zone": "Irkutsk", + "geo_enabled": false, + "verified": false, + "statuses_count": 390, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/505345820137234433/csFeRxPm_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/505345820137234433/csFeRxPm_normal.jpeg", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:16:45 +0000 2014", + "id": 505871779949051900, + "id_str": "505871779949051904", + "text": "ようかい体操第一を踊る国見英 http://t.co/SXoYWH98as", + "source": "Twitter for Android", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1261662588, + "id_str": "1261662588", + "name": "ゆう矢", + "screen_name": "UARROW_Y", + "location": "つくり出そう国影の波 広げよう国影の輪", + "description": "HQ!! 成人済腐女子。日常ツイート多いです。赤葦京治夢豚クソツイ含みます注意。フォローをお考えの際はプロフご一読お願い致します。FRBお気軽に", + "url": "http://t.co/LFX2XOzb0l", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/LFX2XOzb0l", + "expanded_url": "http://twpf.jp/UARROW_Y", + "display_url": "twpf.jp/UARROW_Y", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 265, + "friends_count": 124, + "listed_count": 12, + "created_at": "Tue Mar 12 10:42:17 +0000 2013", + "favourites_count": 6762, + "utc_offset": 32400, + "time_zone": "Tokyo", + "geo_enabled": true, + "verified": false, + "statuses_count": 55946, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/502095104618663937/IzuPYx3E_normal.png", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/502095104618663937/IzuPYx3E_normal.png", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1261662588/1408618604", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 29, + "favorite_count": 54, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/SXoYWH98as", + "expanded_url": "http://twitter.com/UARROW_Y/status/505871779949051904/photo/1", + "display_url": "pic.twitter.com/SXoYWH98as", + "indices": [ + 15, + 37 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + "retweet_count": 29, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/SXoYWH98as", + "expanded_url": "http://twitter.com/UARROW_Y/status/505871779949051904/photo/1", + "display_url": "pic.twitter.com/SXoYWH98as", + "indices": [ + 29, + 51 + ] + } + ], + "user_mentions": [ + { + "screen_name": "UARROW_Y", + "name": "ゆう矢", + "id": 1261662588, + "id_str": "1261662588", + "indices": [ + 3, + 12 + ] + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "zh" + }, + "created_at": "Sun Aug 31 00:28:57 +0000 2014", + "id": 505874848900341760, + "id_str": "505874848900341760", + "text": "RT @fightcensorship: 李克強總理的臉綠了！在前日南京青奧會閉幕式，觀眾席上一名貪玩韓國少年運動員，竟斗膽用激光筆射向中國總理李克強的臉。http://t.co/HLX9mHcQwe http://t.co/fVVOSML5s8", + "source": "Twitter for iPhone", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 889332218, + "id_str": "889332218", + "name": "民權初步", + "screen_name": "JoeyYoungkm", + "location": "km/cn", + "description": "经历了怎样的曲折才从追求“一致通过”发展到今天人们接受“过半数通过”，正是人们认识到对“一致”甚至是“基本一致”的追求本身就会变成一种独裁。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 313, + "friends_count": 46, + "listed_count": 0, + "created_at": "Thu Oct 18 17:21:17 +0000 2012", + "favourites_count": 24, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 15707, + "lang": "en", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "C0DEED", + "profile_background_image_url": "http://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_image_url_https": "https://abs.twimg.com/images/themes/theme1/bg.png", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/378800000563062033/a7e8274752ce36a6cd5bad971ec7d416_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/378800000563062033/a7e8274752ce36a6cd5bad971ec7d416_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/889332218/1388896916", + "profile_link_color": "0084B4", + "profile_sidebar_border_color": "C0DEED", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": true, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweeted_status": { + "metadata": { + "result_type": "recent", + "iso_language_code": "zh" + }, + "created_at": "Sat Aug 30 23:56:27 +0000 2014", + "id": 505866670356070400, + "id_str": "505866670356070401", + "text": "李克強總理的臉綠了！在前日南京青奧會閉幕式，觀眾席上一名貪玩韓國少年運動員，竟斗膽用激光筆射向中國總理李克強的臉。http://t.co/HLX9mHcQwe http://t.co/fVVOSML5s8", + "source": "Twitter Web Client", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 67661086, + "id_str": "67661086", + "name": "※范强※法特姗瑟希蒲※", + "screen_name": "fightcensorship", + "location": "Middle of Nowhere", + "description": "被人指责“封建”、“落后”、“保守”的代表，当代红卫兵攻击对象。致力于言论自由，人权； 倡导资讯公开，反对网络封锁。既不是精英分子，也不是意见领袖，本推言论不代表任何国家、党派和组织，也不标榜伟大、光荣和正确。", + "url": null, + "entities": { + "description": { + "urls": [] + } + }, + "protected": false, + "followers_count": 7143, + "friends_count": 779, + "listed_count": 94, + "created_at": "Fri Aug 21 17:16:22 +0000 2009", + "favourites_count": 364, + "utc_offset": 28800, + "time_zone": "Singapore", + "geo_enabled": false, + "verified": false, + "statuses_count": 16751, + "lang": "en", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "FFFFFF", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/611138516/toeccqnahbpmr0sw9ybv.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/611138516/toeccqnahbpmr0sw9ybv.jpeg", + "profile_background_tile": true, + "profile_image_url": "http://pbs.twimg.com/profile_images/3253137427/3524557d21ef2c04871e985d4d136bdb_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/3253137427/3524557d21ef2c04871e985d4d136bdb_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/67661086/1385608347", + "profile_link_color": "ED1313", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "E0FF92", + "profile_text_color": "000000", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 4, + "favorite_count": 2, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/HLX9mHcQwe", + "expanded_url": "http://is.gd/H3OgTO", + "display_url": "is.gd/H3OgTO", + "indices": [ + 57, + 79 + ] + } + ], + "user_mentions": [], + "media": [ + { + "id": 505866668485386240, + "id_str": "505866668485386241", + "indices": [ + 80, + 102 + ], + "media_url": "http://pbs.twimg.com/media/BwUzDgbIIAEgvhD.jpg", + "media_url_https": "https://pbs.twimg.com/media/BwUzDgbIIAEgvhD.jpg", + "url": "http://t.co/fVVOSML5s8", + "display_url": "pic.twitter.com/fVVOSML5s8", + "expanded_url": "http://twitter.com/fightcensorship/status/505866670356070401/photo/1", + "type": "photo", + "sizes": { + "large": { + "w": 640, + "h": 554, + "resize": "fit" + }, + "medium": { + "w": 600, + "h": 519, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "small": { + "w": 340, + "h": 294, + "resize": "fit" + } + } + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "zh" + }, + "retweet_count": 4, + "favorite_count": 0, + "entities": { + "hashtags": [], + "symbols": [], + "urls": [ + { + "url": "http://t.co/HLX9mHcQwe", + "expanded_url": "http://is.gd/H3OgTO", + "display_url": "is.gd/H3OgTO", + "indices": [ + 78, + 100 + ] + } + ], + "user_mentions": [ + { + "screen_name": "fightcensorship", + "name": "※范强※法特姗瑟希蒲※", + "id": 67661086, + "id_str": "67661086", + "indices": [ + 3, + 19 + ] + } + ], + "media": [ + { + "id": 505866668485386240, + "id_str": "505866668485386241", + "indices": [ + 101, + 123 + ], + "media_url": "http://pbs.twimg.com/media/BwUzDgbIIAEgvhD.jpg", + "media_url_https": "https://pbs.twimg.com/media/BwUzDgbIIAEgvhD.jpg", + "url": "http://t.co/fVVOSML5s8", + "display_url": "pic.twitter.com/fVVOSML5s8", + "expanded_url": "http://twitter.com/fightcensorship/status/505866670356070401/photo/1", + "type": "photo", + "sizes": { + "large": { + "w": 640, + "h": 554, + "resize": "fit" + }, + "medium": { + "w": 600, + "h": 519, + "resize": "fit" + }, + "thumb": { + "w": 150, + "h": 150, + "resize": "crop" + }, + "small": { + "w": 340, + "h": 294, + "resize": "fit" + } + }, + "source_status_id": 505866670356070400, + "source_status_id_str": "505866670356070401" + } + ] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "zh" + }, + { + "metadata": { + "result_type": "recent", + "iso_language_code": "ja" + }, + "created_at": "Sun Aug 31 00:28:56 +0000 2014", + "id": 505874847260352500, + "id_str": "505874847260352513", + "text": "【マイリスト】【彩りりあ】妖怪体操第一　踊ってみた【反転】 http://t.co/PjL9if8OZC #sm24357625", + "source": "ニコニコ動画", + "truncated": false, + "in_reply_to_status_id": null, + "in_reply_to_status_id_str": null, + "in_reply_to_user_id": null, + "in_reply_to_user_id_str": null, + "in_reply_to_screen_name": null, + "user": { + "id": 1609789375, + "id_str": "1609789375", + "name": "食いしん坊前ちゃん", + "screen_name": "2no38mae", + "location": "ニノと二次元の間", + "description": "ニコ動で踊り手やってます!!応援本当に嬉しいですありがとうございます!!　ぽっちゃりだけど前向きに頑張る腐女子です。嵐と弱虫ペダルが大好き！【お返事】りぷ(基本は)”○”　DM (同業者様を除いて)”×”　動画の転載は絶対にやめてください。 ブログ→http://t.co/8E91tqoeKX　　", + "url": "http://t.co/ulD2e9mcwb", + "entities": { + "url": { + "urls": [ + { + "url": "http://t.co/ulD2e9mcwb", + "expanded_url": "http://www.nicovideo.jp/mylist/37917495", + "display_url": "nicovideo.jp/mylist/37917495", + "indices": [ + 0, + 22 + ] + } + ] + }, + "description": { + "urls": [ + { + "url": "http://t.co/8E91tqoeKX", + "expanded_url": "http://ameblo.jp/2no38mae/", + "display_url": "ameblo.jp/2no38mae/", + "indices": [ + 125, + 147 + ] + } + ] + } + }, + "protected": false, + "followers_count": 560, + "friends_count": 875, + "listed_count": 11, + "created_at": "Sun Jul 21 05:09:43 +0000 2013", + "favourites_count": 323, + "utc_offset": null, + "time_zone": null, + "geo_enabled": false, + "verified": false, + "statuses_count": 3759, + "lang": "ja", + "contributors_enabled": false, + "is_translator": false, + "is_translation_enabled": false, + "profile_background_color": "F2C6E4", + "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/378800000029400927/114b242f5d838ec7cb098ea5db6df413.jpeg", + "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/378800000029400927/114b242f5d838ec7cb098ea5db6df413.jpeg", + "profile_background_tile": false, + "profile_image_url": "http://pbs.twimg.com/profile_images/487853237723095041/LMBMGvOc_normal.jpeg", + "profile_image_url_https": "https://pbs.twimg.com/profile_images/487853237723095041/LMBMGvOc_normal.jpeg", + "profile_banner_url": "https://pbs.twimg.com/profile_banners/1609789375/1375752225", + "profile_link_color": "FF9EDD", + "profile_sidebar_border_color": "FFFFFF", + "profile_sidebar_fill_color": "DDEEF6", + "profile_text_color": "333333", + "profile_use_background_image": true, + "default_profile": false, + "default_profile_image": false, + "following": false, + "follow_request_sent": false, + "notifications": false + }, + "geo": null, + "coordinates": null, + "place": null, + "contributors": null, + "retweet_count": 0, + "favorite_count": 0, + "entities": { + "hashtags": [ + { + "text": "sm24357625", + "indices": [ + 53, + 64 + ] + } + ], + "symbols": [], + "urls": [ + { + "url": "http://t.co/PjL9if8OZC", + "expanded_url": "http://nico.ms/sm24357625", + "display_url": "nico.ms/sm24357625", + "indices": [ + 30, + 52 + ] + } + ], + "user_mentions": [] + }, + "favorited": false, + "retweeted": false, + "possibly_sensitive": false, + "lang": "ja" + } + ], + "search_metadata": { + "completed_in": 0.087, + "max_id": 505874924095815700, + "max_id_str": "505874924095815681", + "next_results": "?max_id=505874847260352512&q=%E4%B8%80&count=100&include_entities=1", + "query": "%E4%B8%80", + "refresh_url": "?since_id=505874924095815681&q=%E4%B8%80&include_entities=1", + "count": 100, + "since_id": 0, + "since_id_str": "0" + } +} \ No newline at end of file diff --git a/unikernel/duniverse/angstrom/benchmarks/data/twitter1.json b/unikernel/duniverse/angstrom/benchmarks/data/twitter1.json new file mode 100644 index 00000000..021b0541 --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/data/twitter1.json @@ -0,0 +1 @@ +{"results":[{"from_user_id_str":"80430860","profile_image_url":"http://a2.twimg.com/profile_images/536455139/icon32_normal.png","created_at":"Wed, 26 Jan 2011 07:07:02 +0000","from_user":"kazu_yamamoto","id_str":"30159761706061824","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Haskell Server Pages \u3063\u3066\u3001\u307e\u3060\u7d9a\u3044\u3066\u3044\u305f\u306e\u304b\uff01","id":30159761706061824,"from_user_id":80430860,"geo":null,"iso_language_code":"no","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"}],"max_id":30159761706061824,"since_id":0,"refresh_url":"?since_id=30159761706061824&q=haskell","next_page":"?page=2&max_id=30159761706061824&rpp=1&q=haskell","results_per_page":1,"page":1,"completed_in":0.012606,"since_id_str":"0","max_id_str":"30159761706061824","query":"haskell"} \ No newline at end of file diff --git a/unikernel/duniverse/angstrom/benchmarks/data/twitter10.json b/unikernel/duniverse/angstrom/benchmarks/data/twitter10.json new file mode 100644 index 00000000..38d00682 --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/data/twitter10.json @@ -0,0 +1 @@ +{"results":[{"from_user_id_str":"207858021","profile_image_url":"http://a3.twimg.com/sticky/default_profile_images/default_profile_2_normal.png","created_at":"Wed, 26 Jan 2011 04:30:38 +0000","from_user":"pboudarga","id_str":"30120402839666689","metadata":{"result_type":"recent"},"to_user_id":null,"text":"I'm at Rolla Sushi Grill (27737 Bouquet Canyon Road, #106, Btw Haskell Canyon and Rosedell Drive, Saugus) http://4sq.com/gqqdhs","id":30120402839666689,"from_user_id":207858021,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://foursquare.com" rel="nofollow">foursquare</a>"},{"from_user_id_str":"69988683","profile_image_url":"http://a0.twimg.com/profile_images/1211955817/avatar_7888_normal.gif","created_at":"Wed, 26 Jan 2011 04:25:23 +0000","from_user":"YNK33","id_str":"30119083059978240","metadata":{"result_type":"recent"},"to_user_id":null,"text":"hsndfile 0.5.0: Free and open source Haskell bindings for libsndfile http://bit.ly/gHaBWG Mac Os","id":30119083059978240,"from_user_id":69988683,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitterfeed.com" rel="nofollow">twitterfeed</a>"},{"from_user_id_str":"81492","profile_image_url":"http://a1.twimg.com/profile_images/423894208/Picture_7_normal.jpg","created_at":"Wed, 26 Jan 2011 04:24:28 +0000","from_user":"satzz","id_str":"30118851488251904","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Emacs\u306e\u30e2\u30fc\u30c9\u8868\u793a\u304c\u4eca(Ruby Controller Outputz RoR Flymake REl hs)\u3068\u306a\u3063\u3066\u3066\u3088\u304f\u308f\u304b\u3089\u306a\u3044\u3093\u3060\u3051\u3069\u6700\u5f8c\u306eREl\u3068\u304bhs\u3063\u3066\u4f55\u3060\u308d\u3046\u2026haskell\u3068\u304b2\u5e74\u4ee5\u4e0a\u66f8\u3044\u3066\u306a\u3044\u3051\u3069\u2026","id":30118851488251904,"from_user_id":81492,"geo":null,"iso_language_code":"ja","to_user_id_str":null,"source":"<a href="http://www.hootsuite.com" rel="nofollow">HootSuite</a>"},{"from_user_id_str":"9518356","profile_image_url":"http://a2.twimg.com/profile_images/119165723/ocaml-icon_normal.png","created_at":"Wed, 26 Jan 2011 04:19:19 +0000","from_user":"planet_ocaml","id_str":"30117557788741632","metadata":{"result_type":"recent"},"to_user_id":null,"text":"I so miss #haskell type classes in #ocaml - i want to do something like refinement. Also why does ocaml not have... http://bit.ly/geYRwt","id":30117557788741632,"from_user_id":9518356,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitterfeed.com" rel="nofollow">twitterfeed</a>"},{"from_user_id_str":"218059","profile_image_url":"http://a1.twimg.com/profile_images/1053837723/twitter-icon9_normal.jpg","created_at":"Wed, 26 Jan 2011 04:16:32 +0000","from_user":"aprikip","id_str":"30116854940835840","metadata":{"result_type":"recent"},"to_user_id":null,"text":"yatex-mode\u3084haskell-mode\u306e\u3053\u3068\u3067\u3059\u306d\u3001\u308f\u304b\u308a\u307e\u3059\u3002","id":30116854940835840,"from_user_id":218059,"geo":null,"iso_language_code":"ja","to_user_id_str":null,"source":"<a href="http://sites.google.com/site/yorufukurou/" rel="nofollow">YoruFukurou</a>"},{"from_user_id_str":"216363","profile_image_url":"http://a1.twimg.com/profile_images/72454310/Tim-Avatar_normal.png","created_at":"Wed, 26 Jan 2011 04:15:30 +0000","from_user":"dysinger","id_str":"30116594684264448","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Haskell in Hawaii tonight for me... #fun","id":30116594684264448,"from_user_id":216363,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://www.nambu.com/" rel="nofollow">Nambu</a>"},{"from_user_id_str":"1774820","profile_image_url":"http://a2.twimg.com/profile_images/61169291/dan_desert_thumb_normal.jpg","created_at":"Wed, 26 Jan 2011 04:13:36 +0000","from_user":"DanMil","id_str":"30116117682851840","metadata":{"result_type":"recent"},"to_user_id":1594784,"text":"@ojrac @chewedwire @tomheon Haskell isn't a language, it's a belief system. A seductive one...","id":30116117682851840,"from_user_id":1774820,"to_user":"ojrac","geo":null,"iso_language_code":"en","to_user_id_str":"1594784","source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"659256","profile_image_url":"http://a0.twimg.com/profile_images/746976711/angular-final_normal.jpg","created_at":"Wed, 26 Jan 2011 04:11:06 +0000","from_user":"djspiewak","id_str":"30115488931520512","metadata":{"result_type":"recent"},"to_user_id":null,"text":"One of the very nice things about Haskell as opposed to SML is the reduced proliferation of identifiers (e.g. andb, orb, etc). #typeclasses","id":30115488931520512,"from_user_id":659256,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://itunes.apple.com/us/app/twitter/id409789998?mt=12" rel="nofollow">Twitter for Mac</a>"},{"from_user_id_str":"144546280","profile_image_url":"http://a1.twimg.com/a/1295051201/images/default_profile_1_normal.png","created_at":"Wed, 26 Jan 2011 04:06:12 +0000","from_user":"listwarenet","id_str":"30114255890026496","metadata":{"result_type":"recent"},"to_user_id":null,"text":"http://www.listware.net/201101/haskell-cafe/84752-re-haskell-cafe-gpl-license-of-h-matrix-and-prelude-numeric.html Re: Haskell-c","id":30114255890026496,"from_user_id":144546280,"geo":null,"iso_language_code":"no","to_user_id_str":null,"source":"<a href="http://1e10.org/cloud/" rel="nofollow">1e10</a>"},{"from_user_id_str":"1594784","profile_image_url":"http://a2.twimg.com/profile_images/378515773/square-profile_normal.jpg","created_at":"Wed, 26 Jan 2011 04:01:29 +0000","from_user":"ojrac","id_str":"30113067333324800","metadata":{"result_type":"recent"},"to_user_id":null,"text":"RT @tomheon: @ojrac @chewedwire Don't worry, learning Haskell will not give you any clear idea what monad means.","id":30113067333324800,"from_user_id":1594784,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"}],"max_id":30120402839666689,"since_id":0,"refresh_url":"?since_id=30120402839666689&q=haskell","next_page":"?page=2&max_id=30120402839666689&rpp=10&q=haskell","results_per_page":10,"page":1,"completed_in":0.012714,"since_id_str":"0","max_id_str":"30120402839666689","query":"haskell"} \ No newline at end of file diff --git a/unikernel/duniverse/angstrom/benchmarks/data/twitter20.json b/unikernel/duniverse/angstrom/benchmarks/data/twitter20.json new file mode 100644 index 00000000..fbe3e19e --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/data/twitter20.json @@ -0,0 +1 @@ +{"results":[{"from_user_id_str":"166199691","profile_image_url":"http://a2.twimg.com/profile_images/1252958188/38_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:26 +0000","from_user":"_classicc","id_str":"41191052790603776","metadata":{"result_type":"recent"},"to_user_id":null,"text":"my twitter is actin slow today.","id":41191052790603776,"from_user_id":166199691,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/" rel="nofollow">Twitter for iPhone</a>"},{"from_user_id_str":"138835410","profile_image_url":"http://a1.twimg.com/profile_images/1250985094/243321801_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:26 +0000","from_user":"amereronday","id_str":"41191050307567616","metadata":{"result_type":"recent"},"to_user_id":null,"text":"twitter jail, here i come.","id":41191050307567616,"from_user_id":138835410,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"359548","profile_image_url":"http://a2.twimg.com/profile_images/53612334/don_otvos_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:26 +0000","from_user":"donnyo","id_str":"41191050110451712","metadata":{"result_type":"recent"},"to_user_id":7074534,"text":"@stlsmallbiz I see there is currently a Twitter promo too....tempting....","id":41191050110451712,"from_user_id":359548,"to_user":"stlsmallbiz","geo":null,"iso_language_code":"en","place":{"id":"82b7b2f97b12261d","type":"poi","full_name":"Yammer Inc, San Francisco"},"to_user_id_str":"7074534","source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"122523770","profile_image_url":"http://a0.twimg.com/profile_images/1073533262/11646_1076222405045_1810798478_156114_3663737_n_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:26 +0000","from_user":"msBreChan","id_str":"41191049720238080","metadata":{"result_type":"recent"},"to_user_id":null,"text":"so twitter gt spam now -_-","id":41191049720238080,"from_user_id":122523770,"geo":{"type":"Point","coordinates":[35.2213,-80.8276]},"iso_language_code":"en","place":{"id":"4d5ed95f830e9b41","type":"neighborhood","full_name":"Elizabeth, Charlotte"},"to_user_id_str":null,"source":"<a href="http://mobile.twitter.com" rel="nofollow">Twitter for Android</a>"},{"from_user_id_str":"229024950","profile_image_url":"http://a3.twimg.com/sticky/default_profile_images/default_profile_6_normal.png","created_at":"Fri, 25 Feb 2011 17:41:25 +0000","from_user":"NinaMaechik","id_str":"41191047853912064","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Glad I can remember my twitter password! LOL! Hugs to Nick from his aunties...","id":41191047853912064,"from_user_id":229024950,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"215545822","profile_image_url":"http://a2.twimg.com/profile_images/1239909540/RTL_normal.png","created_at":"Fri, 25 Feb 2011 17:41:25 +0000","from_user":"RightToLaugh","id_str":"41191047371558912","metadata":{"result_type":"recent"},"to_user_id":null,"text":"#Bacon wrapped dates http://bit.ly/hUxVC9 Just like my grandma used to make http://twitter.com/#","id":41191047371558912,"from_user_id":215545822,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"217845526","profile_image_url":"http://a0.twimg.com/sticky/default_profile_images/default_profile_3_normal.png","created_at":"Fri, 25 Feb 2011 17:41:25 +0000","from_user":"TheShoeLooker","id_str":"41191047052804096","metadata":{"result_type":"recent"},"to_user_id":38033240,"text":"@ShoeDazzle love love love to twitter or blog about your deals and shoes!\ntheshoelooker.blogspot.com","id":41191047052804096,"from_user_id":217845526,"to_user":"shoedazzle","geo":null,"iso_language_code":"en","to_user_id_str":"38033240","source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"24953438","profile_image_url":"http://a3.twimg.com/profile_images/1181252763/76820_10150100014748783_677998782_7386695_4377006_n_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:25 +0000","from_user":"liljermaine32","id_str":"41191046025056256","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Twitter fam I gotta question 4 ya is texas south or midwest #arguments","id":41191046025056256,"from_user_id":24953438,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://mobile.twitter.com" rel="nofollow">Twitter for Android</a>"},{"from_user_id_str":"122451024","profile_image_url":"http://a2.twimg.com/profile_images/1143400129/100706-ETCanada_201134_1__normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:25 +0000","from_user":"Kim_DEon","id_str":"41191045161164801","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Help @CARE @EvaLongoria and ME use Twitter to change the lives of girls in poverty across the world! Ready? Go to http://TwitChange.com NOW!","id":41191045161164801,"from_user_id":122451024,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"128351479","profile_image_url":"http://a3.twimg.com/profile_images/1150198829/Kirby_Photo__edit__normal.JPG","created_at":"Fri, 25 Feb 2011 17:41:24 +0000","from_user":"TheDaveKirby","id_str":"41191043894493184","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Maybe its time to clean house...MY HOUSE http://bit.ly/ejG22P","id":41191043894493184,"from_user_id":128351479,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://www.tweetdeck.com" rel="nofollow">TweetDeck</a>"},{"from_user_id_str":"87512773","profile_image_url":"http://a0.twimg.com/profile_images/1252511106/image_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:24 +0000","from_user":"supportthehood","id_str":"41191043206610946","metadata":{"result_type":"recent"},"to_user_id":2467330,"text":"@eastcoastmp3 #FF it's the way twitter works !!!","id":41191043206610946,"from_user_id":87512773,"to_user":"eastcoastmp3","geo":null,"iso_language_code":"en","to_user_id_str":"2467330","source":"<a href="http://twitter.com/" rel="nofollow">Twitter for iPhone</a>"},{"from_user_id_str":"149894545","profile_image_url":"http://a0.twimg.com/profile_images/1219334400/patrick_camo_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:24 +0000","from_user":"suburbpat","id_str":"41191040912330752","metadata":{"result_type":"recent"},"to_user_id":null,"text":"I havent had a rib session on twitter in a while.......I wanna Rib with a nigga with alot followers lol","id":41191040912330752,"from_user_id":149894545,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"97749622","profile_image_url":"http://a0.twimg.com/profile_images/1254640781/IMG1633A_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:24 +0000","from_user":"jrricardosantos","id_str":"41191040547430400","metadata":{"result_type":"recent"},"to_user_id":101017476,"text":"@yofzs pq tirou o CAPS LOCK? kkkk tava bem legal...hehehe eu estou no t\u00e9dio...kkk tbm estou no twitter e msn..aff!!","id":41191040547430400,"from_user_id":97749622,"to_user":"yofzs","geo":null,"iso_language_code":"en","to_user_id_str":"101017476","source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"94381536","profile_image_url":"http://a1.twimg.com/profile_images/1174777929/41509_100001699300415_3521888_n_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:23 +0000","from_user":"DonNieves","id_str":"41191038978752512","metadata":{"result_type":"recent"},"to_user_id":151926400,"text":"@TiiH13 cheira meu ovo, no email, no orkut, no msn, no facebook, no twitter, no skype, no spark, no ICQ e no google talk","id":41191038978752512,"from_user_id":94381536,"to_user":"TiiH13","geo":null,"iso_language_code":"en","to_user_id_str":"151926400","source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"211858432","profile_image_url":"http://a3.twimg.com/profile_images/1231906180/JonasBrothers_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:23 +0000","from_user":"OriginalJBfans","id_str":"41191038328651776","metadata":{"result_type":"recent"},"to_user_id":null,"text":"I literally forgot about this twitter... so whats occuring followers?","id":41191038328651776,"from_user_id":211858432,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"90317132","profile_image_url":"http://a3.twimg.com/profile_images/1230085056/254101635_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:23 +0000","from_user":"Just2smooth","id_str":"41191036936126464","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Wassup twitter","id":41191036936126464,"from_user_id":90317132,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://ubersocial.com" rel="nofollow">\u00dcberSocial</a>"},{"from_user_id_str":"144771504","profile_image_url":"http://a1.twimg.com/profile_images/1243343836/image_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:23 +0000","from_user":"ima_b_b_badman","id_str":"41191036638339072","metadata":{"result_type":"recent"},"to_user_id":null,"text":"i been M.I.A. all day twitter my bad","id":41191036638339072,"from_user_id":144771504,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://twitter.com/">web</a>"},{"from_user_id_str":"207922664","profile_image_url":"http://a2.twimg.com/profile_images/1237106108/258356167_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:22 +0000","from_user":"itsthecarter_","id_str":"41191036013391873","metadata":{"result_type":"recent"},"to_user_id":null,"text":"twitter is a stupid addiction.","id":41191036013391873,"from_user_id":207922664,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://ubersocial.com" rel="nofollow">\u00dcberSocial</a>"},{"from_user_id_str":"150000649","profile_image_url":"http://a0.twimg.com/profile_images/1237789059/belllaa_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:22 +0000","from_user":"angelicabrvo","id_str":"41191035707207680","metadata":{"result_type":"recent"},"to_user_id":null,"text":"que hubo twitter? huy que feoxd","id":41191035707207680,"from_user_id":150000649,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://blackberry.com/twitter" rel="nofollow">Twitter for BlackBerry\u00ae</a>"},{"from_user_id_str":"185713003","profile_image_url":"http://a2.twimg.com/profile_images/1191421540/163229_177015295661467_154687431227587_492170_2147500_n_normal.jpg","created_at":"Fri, 25 Feb 2011 17:41:22 +0000","from_user":"downbytheshores","id_str":"41191033945595905","metadata":{"result_type":"recent"},"to_user_id":null,"text":"follow us on twitter\nwww.twitter.com/downbytheshores http://fb.me/DhDS915e","id":41191033945595905,"from_user_id":185713003,"geo":null,"iso_language_code":"en","to_user_id_str":null,"source":"<a href="http://www.facebook.com/twitter" rel="nofollow">Facebook</a>"}],"max_id":41191052790603776,"since_id":38643906774044672,"refresh_url":"?since_id=41191052790603776&q=twitter","next_page":"?page=2&max_id=41191052790603776&rpp=20&lang=en&q=twitter","results_per_page":20,"page":1,"completed_in":0.128719,"warning":"adjusted since_id to 38643906774044672 (), requested since_id was older than allowed -- since_id removed for pagination.","since_id_str":"38643906774044672","max_id_str":"41191052790603776","query":"twitter"} \ No newline at end of file diff --git a/unikernel/duniverse/angstrom/benchmarks/dune b/unikernel/duniverse/angstrom/benchmarks/dune new file mode 100644 index 00000000..9101a97d --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/dune @@ -0,0 +1,14 @@ +(executables + (libraries angstrom core_bench threads RFC2616 RFC7159) + (modules pure_benchmark) + (names pure_benchmark)) + +(executables + (libraries angstrom-async RFC2616 RFC7159) + (modules async_benchmark) + (names async_benchmark)) + +(executables + (libraries angstrom-lwt-unix RFC2616 RFC7159) + (modules lwt_benchmark) + (names lwt_benchmark)) diff --git a/unikernel/duniverse/angstrom/benchmarks/lwt_benchmark.ml b/unikernel/duniverse/angstrom/benchmarks/lwt_benchmark.ml new file mode 100644 index 00000000..695d8350 --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/lwt_benchmark.ml @@ -0,0 +1,18 @@ +open Lwt + +let main () = + let toss _ = Lwt.return_unit in + let parser = + match Sys.argv.(1) with + | "http" -> Angstrom.(RFC2616.request >>| fun x -> `Http x) + | "json" -> Angstrom.(RFC7159.json >>| fun x -> `Json x) + | _ -> print_endline "usage: lwt_json_benchmark.native PARSER"; exit 1 + in + Lwt_io.resize_buffer Lwt_io.stdin 0x10000 >>= fun () -> + Angstrom_lwt_unix.parse_many parser toss Lwt_io.stdin + >|= function + | _, Ok () -> () + | _, Error err -> failwith err +;; + +Lwt_main.run (main ()) diff --git a/unikernel/duniverse/angstrom/benchmarks/pure_benchmark.ml b/unikernel/duniverse/angstrom/benchmarks/pure_benchmark.ml new file mode 100644 index 00000000..b7c54d98 --- /dev/null +++ b/unikernel/duniverse/angstrom/benchmarks/pure_benchmark.ml @@ -0,0 +1,125 @@ +open Core +open Core_bench + +let read file = + let open Unix in + let size = Int64.to_int_exn (stat file).st_size in + let buf = Bytes.create size in + let rec loop pos len fd = + let n = read ~pos ~len ~buf fd in + if n > 0 then loop (pos + n) (len - n) fd + in + with_file ~mode:[O_RDONLY] file ~f:(fun fd -> + loop 0 size fd); + Bigstring.of_bytes buf +;; + +let zero = + let len = 65_536 in + Bigstring.of_string (String.make len '\x00') +;; + +let make_bench name parser contents = + Bench.Test.create ~name (fun () -> + match Angstrom.(parse_bigstring ~consume:Consume.Prefix parser contents) with + | Ok _ -> () + | Error err -> failwith err) +;; + +let make_endian name p = make_bench name (Angstrom.skip_many p) zero +let make_json name contents = make_bench name RFC7159.json contents +let make_http name contents = make_bench name (Angstrom.skip_many RFC2616.request) contents + +(* For input files involving trailing numbers, .e.g, [http-requests.txt.100], + * go into the [benchmarks/data] directory and use the [replicate] script to + * generate the file, i.e., + * + * [./replicate http-requests.txt 100] + * + *) +let main () = + let twitter1 = read "benchmarks/data/twitter1.json" in + let twitter10 = read "benchmarks/data/twitter10.json" in + let twitter20 = read "benchmarks/data/twitter20.json" in + let twitter_big = read "benchmarks/data/twitter.json" in + let http_get = read "benchmarks/data/http-requests.txt.100" in + let json = + Bench.make_command [ + make_json "twitter1" twitter1; + make_json "twitter10" twitter10; + make_json "twitter20" twitter20; + make_json "twitter-big" twitter_big; + ] + in + let endian = + Bench.make_command [ + make_endian "int64 le" Angstrom.LE.any_int64; + make_endian "int64 be" Angstrom.BE.any_int64; + ] + in + let http = + Bench.make_command [ make_http "http" http_get ] + in + let numbers = + Bench.make_command [ + Bench.Test.create ~name:"float" (fun () -> + float_of_string "1.7242915150166418e+36"); + Bench.Test.create ~name:"int" (fun () -> + int_of_string "172429151501664"); + Bench.Test.create ~name:"int-float" (fun () -> + float_of_string "172429151501664"); + ] + in + let characters = + let contents = Bigstring.of_string "a" in + let open Angstrom in + Bench.make_command [ + make_bench "peek_char_fail" peek_char_fail contents; + make_bench "any_char" any_char contents; + make_bench "char" (char 'a') contents; + make_bench "not_char" (not_char 'b') contents; + make_bench "advance 1" (advance 1) contents; + ] + in + let loops = + let contents = Bigstring.of_string (String.make 1024 'a') in + let open Angstrom in + Bench.make_command [ + make_bench "skip_while true" (skip_while (fun _ -> true)) contents; + make_bench "take_while true" (take_while (fun _ -> true)) contents; + make_bench "take_while1 true" (take_while1 (fun _ -> true)) contents; + make_bench "many any_char " (many any_char) contents; + ] + in + let short_strings = + let contents = Bigstring.of_string "\r\n\r\n\r\n" in + let old_style_be (n : int) = + Angstrom.(BE.any_int16 >>= fun i -> if i = n then return () else fail "not newline") in + Bench.make_command [ + make_bench "string \"\\r\\n\"" (Angstrom.string "\r\n") contents; + make_bench "BE.any_int16 >>= f" (old_style_be 0x0d0a) contents; + make_bench "BE.int16 0x0d0a" (Angstrom.BE.int16 0x0d0a) contents; + make_bench "LE.int16 0x0a0d" (Angstrom.LE.int16 0x0a0d) contents; + ] + in + let http_version = + let contents = Bigstring.of_string "HTTP/" in + Bench.make_command [ + make_bench "string \"HTTP/\"" (Angstrom.string "HTTP/") contents; + make_bench "BE.int32 *> char" (Angstrom.(BE.int32 0x48545450l *> char '/')) contents; + make_bench "LE.int32 *> char" (Angstrom.(LE.int32 0x50545448l *> char '/')) contents; + ] + in + Command.run + (Command.group ~summary:"various angstrom benchmarks" + [ "json" , json + ; "endian" , endian + ; "http" , http + ; "numbers" , numbers + ; "characters" , characters + ; "loops" , loops + ; "short-strings", short_strings + ; "http-version" , http_version + ]) + +let () = main () diff --git a/unikernel/duniverse/angstrom/dune-project b/unikernel/duniverse/angstrom/dune-project new file mode 100644 index 00000000..5bfddd03 --- /dev/null +++ b/unikernel/duniverse/angstrom/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.8) +(name angstrom) diff --git a/unikernel/duniverse/angstrom/examples/dune b/unikernel/duniverse/angstrom/examples/dune new file mode 100644 index 00000000..0fd2e294 --- /dev/null +++ b/unikernel/duniverse/angstrom/examples/dune @@ -0,0 +1,16 @@ +(library + (name RFC7159) + (wrapped false) + (modules RFC7159) + (libraries angstrom)) + +(library + (name RFC2616) + (wrapped false) + (modules RFC2616) + (libraries angstrom)) + +;; Build bytecode library just to make sure this compiles +(alias + (name examples) + (deps RFC7159.cma RFC2616.cma)) diff --git a/unikernel/duniverse/angstrom/examples/rFC2616.ml b/unikernel/duniverse/angstrom/examples/rFC2616.ml new file mode 100644 index 00000000..6bce4346 --- /dev/null +++ b/unikernel/duniverse/angstrom/examples/rFC2616.ml @@ -0,0 +1,76 @@ +open Angstrom + +module P = struct + let is_space = + function | ' ' | '\t' -> true | _ -> false + + let is_eol = + function | '\r' | '\n' -> true | _ -> false + + let is_hex = + function | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false + + let is_digit = + function '0' .. '9' -> true | _ -> false + + let is_separator = + function + | ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"' + | '/' | '[' | ']' | '?' | '=' | '{' | '}' | ' ' | '\t' -> true + | _ -> false + + let is_token = + (* The commented-out ' ' and '\t' are not necessary because of the range at + * the top of the match. *) + function + | '\000' .. '\031' | '\127' + | ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"' + | '/' | '[' | ']' | '?' | '=' | '{' | '}' (* | ' ' | '\t' *) -> false + | _ -> true +end + +let token = take_while1 P.is_token +let digits = take_while1 P.is_digit +let spaces = skip_while P.is_space + +let lex p = p <* spaces + +let version = + string "HTTP/" *> + lift2 (fun major minor -> major, minor) + (digits <* char '.') + digits + +let uri = + take_till P.is_space + +let meth = token +let eol = string "\r\n" + +let request_first_line = + lift3 (fun meth uri version -> (meth, uri, version)) + (lex meth) + (lex uri) + version + +let response_first_line = + lift3 (fun version status msg -> (version, status, msg)) + (lex version) + (lex (take_till P.is_space)) + (take_till P.is_eol) + +let header = + let colon = char ':' <* spaces in + lift2 (fun key value -> (key, value)) + token + (colon *> take_till P.is_eol) + +let request = + lift2 (fun (meth, uri, version) headers -> (meth, uri, version, headers)) + (request_first_line <* eol) + (many (header <* eol) <* eol) + +let response = + lift2 (fun (version, status, msg) headers -> (version, status, msg, headers)) + (response_first_line <* eol) + (many (header <* eol) <* eol) diff --git a/unikernel/duniverse/angstrom/examples/rFC7159.ml b/unikernel/duniverse/angstrom/examples/rFC7159.ml new file mode 100644 index 00000000..1c7cf8b6 --- /dev/null +++ b/unikernel/duniverse/angstrom/examples/rFC7159.ml @@ -0,0 +1,169 @@ +open Angstrom + +type json = + [ `Null + | `False + | `True + | `String of string + | `Number of float + | `Object of (string * json) list + | `Array of json list ] + +let ws = skip_while (function + | '\x20' | '\x0a' | '\x0d' | '\x09' -> true + | _ -> false) + +let lchar c = + ws *> char c + +let rsb = lchar ']' +let rcb = lchar '}' +let ns, vs = lchar ':', lchar ',' +let quo = lchar '"' + +let _false : json t = string "false" *> return `False +let _true : json t = string "true" *> return `True +let _null : json t = string "null" *> return `Null + +let num = + take_while1 (function + | '\x20' | '\x0a' | '\x0d' | '\x09' + | '[' | ']' | '{' | '}' | ':' | ',' -> false + | _ -> true) + >>= fun s -> + try return (`Number (float_of_string s)) + with _ -> fail "number" + +module S = struct + type t = + [ `Unescaped + | `Escaped + | `UTF8 of char list + | `UTF16 of int * [`S | `U | `C of char list] + | `Error of string + | `Done ] + + let to_string : [`Terminate | t] -> string = function + | `Unescaped -> "unescaped" + | `Escaped -> "escaped" + | `UTF8 _ -> "utf-8 _" + | `UTF16 _ -> "utf-16 _ _" + | `Error e -> Printf.sprintf "error %S" e + | `Terminate -> "terminate" + | `Done -> "done" + + let unescaped buf = function + | '"' -> `Terminate + | '\\' -> `Escaped + | c -> + if c <= '\031' + then `Error (Printf.sprintf "unexpected character '%c'" c) + else begin Buffer.add_char buf c; `Unescaped end + + let escaped buf = function + | '\x22' -> Buffer.add_char buf '\x22'; `Unescaped + | '\x5c' -> Buffer.add_char buf '\x5c'; `Unescaped + | '\x2f' -> Buffer.add_char buf '\x2f'; `Unescaped + | '\x62' -> Buffer.add_char buf '\x08'; `Unescaped + | '\x66' -> Buffer.add_char buf '\x0c'; `Unescaped + | '\x6e' -> Buffer.add_char buf '\x0a'; `Unescaped + | '\x72' -> Buffer.add_char buf '\x0d'; `Unescaped + | '\x74' -> Buffer.add_char buf '\x09'; `Unescaped + | '\x75' -> `UTF8 [] + | _ -> `Error "invalid escape sequence" + + let hex c = + match c with + | '0' .. '9' -> Char.code c - 0x30 (* '0' *) + | 'a' .. 'f' -> Char.code c - 87 + | 'A' .. 'F' -> Char.code c - 55 + | _ -> 255 + + let utf_8 buf d = function + | [c;b;a] -> + let a = hex a and b = hex b and c = hex c and d = hex d in + if a lor b lor c lor d = 255 then + `Error "invalid hex escape" + else + let cp = (a lsl 12) lor (b lsl 8) lor (c lsl 4) lor d in + if cp >= 0xd800 && cp <= 0xdbff then + `UTF16(cp, `S) + else begin + Buffer.add_char buf (Char.unsafe_chr (0b11100000 lor ((cp lsr 12) land 0b00001111))); + Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor ((cp lsr 6) land 0b00111111))); + Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor (cp land 0b00111111))); + `Unescaped + end + | cs -> `UTF8 (d::cs) + + let utf_16 buf d x s = + match s, d with + | `S , '\\' -> `UTF16(x, `U) + | `U , 'u' -> `UTF16(x, `C []) + | `C [c;b;a], _ -> + let a = hex a and b = hex b and c = hex c and d = hex d in + if a lor b lor c lor d = 255 then + `Error "invalid hex escape" + else + let y = (a lsl 12) lor (b lsl 8) lor (c lsl 4) lor d in + if y >= 0xdc00 && y <= 0xdfff then begin + let hi = x - 0xd800 in + let lo = y - 0xdc00 in + let cp = 0x10000 + ((hi lsl 10) lor lo) in + Buffer.add_char buf (Char.unsafe_chr (0b11110000 lor ((cp lsr 18) land 0b00000111))); + Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor ((cp lsr 12) land 0b00111111))); + Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor ((cp lsr 6) land 0b00111111))); + Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor (cp land 0b00111111))); + `Unescaped + end else + `Error "invalid escape sequence for utf-16 low surrogate" + | `C cs, _ -> `UTF16(x, `C (d::cs)) + | _, _ -> `Error "invalid escape sequence for utf-16 low surrogate" + + let str buf = + let state : t ref = ref `Unescaped in + skip_while (fun c -> + match + begin match !state with + | `Unescaped -> unescaped buf c + | `Escaped -> escaped buf c + | `UTF8 cs -> utf_8 buf c cs + | `UTF16(x, cs) -> utf_16 buf c x cs + | (`Error _ | `Done) as state -> state + end + with + | (`Error _) | `Done -> false + | `Terminate -> state := `Done; true + | #t as state' -> state := state'; true) + >>= fun () -> + match !state with + | `Done -> + let result = Buffer.contents buf in + Buffer.clear buf; + state := `Unescaped; + return result + | `Error msg -> + Buffer.clear buf; state := `Unescaped; fail msg + | `Unescaped | `Escaped | `UTF8 _ | `UTF16 _ -> + Buffer.clear buf; state := `Unescaped; fail "unterminated string" +end + +let json = + let advance1 = advance 1 in + let pair x y = (x, y) in + let buf = Buffer.create 0x1000 in + let str = S.str buf in + fix (fun json -> + let mem = lift2 pair (quo *> str <* ns) json in + let obj = advance1 *> sep_by vs mem <* rcb >>| fun ms -> `Object ms in + let arr = advance1 *> sep_by vs json <* rsb >>| fun vs -> `Array vs in + let str = advance1 *> str >>| fun s -> `String s in + ws *> peek_char_fail + >>= function + | 'f' -> _false + | 'n' -> _null + | 't' -> _true + | '{' -> obj + | '[' -> arr + | '"' -> str + | _ -> num) "json" diff --git a/unikernel/duniverse/angstrom/lib/angstrom.ml b/unikernel/duniverse/angstrom/lib/angstrom.ml new file mode 100644 index 00000000..da86ecfd --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/angstrom.ml @@ -0,0 +1,749 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +module Bigarray = struct + (* Do not access Bigarray operations directly. If anything's needed, refer to + * the internal Bigstring module. *) +end + +type bigstring = Bigstringaf.t + + +module Unbuffered = struct + include Parser + + include Exported_state + + type more = More.t = + | Complete + | Incomplete +end + +include Unbuffered +include Parser.Monad +include Parser.Choice + +module Buffered = struct + type unconsumed = Buffering.unconsumed = + { buf : bigstring + ; off : int + ; len : int } + + type input = + [ `Bigstring of bigstring + | `String of string ] + + type 'a state = + | Partial of ([ input | `Eof ] -> 'a state) + | Done of unconsumed * 'a + | Fail of unconsumed * string list * string + + let from_unbuffered_state ~f buffering = function + | Unbuffered.Partial p -> Partial (f p) + | Unbuffered.Done(consumed, v) -> + let unconsumed = Buffering.unconsumed ~shift:consumed buffering in + Done(unconsumed, v) + | Unbuffered.Fail(consumed, marks, msg) -> + let unconsumed = Buffering.unconsumed ~shift:consumed buffering in + Fail(unconsumed, marks, msg) + + let parse ?(initial_buffer_size=0x1000) p = + if initial_buffer_size < 1 then + failwith "parse: invalid argument, initial_buffer_size < 1"; + let buffering = Buffering.create initial_buffer_size in + let rec f p input = + Buffering.shift buffering p.committed; + let more : More.t = + match input with + | `Eof -> Complete + | #input as input -> + Buffering.feed_input buffering input; + Incomplete + in + let for_reading = Buffering.for_reading buffering in + p.continue for_reading ~off:0 ~len:(Bigstringaf.length for_reading) more + |> from_unbuffered_state buffering ~f + in + Unbuffered.parse p + |> from_unbuffered_state buffering ~f + + let feed state input = + match state with + | Partial k -> k input + | Fail(unconsumed, marks, msg) -> + begin match input with + | `Eof -> state + | #input as input -> + let buffering = Buffering.of_unconsumed unconsumed in + Buffering.feed_input buffering input; + Fail(Buffering.unconsumed buffering, marks, msg) + end + | Done(unconsumed, v) -> + begin match input with + | `Eof -> state + | #input as input -> + let buffering = Buffering.of_unconsumed unconsumed in + Buffering.feed_input buffering input; + Done(Buffering.unconsumed buffering, v) + end + + let state_to_option = function + | Done(_, v) -> Some v + | Partial _ -> None + | Fail _ -> None + + let state_to_result = function + | Partial _ -> Error "incomplete input" + | Done(_, v) -> Ok v + | Fail(_, marks, msg) -> Error (Unbuffered.fail_to_string marks msg) + + let state_to_unconsumed = function + | Done(unconsumed, _) + | Fail(unconsumed, _, _) -> Some unconsumed + | Partial _ -> None + +end + +(** BEGIN: getting input *) + +let rec prompt input pos fail succ = + (* [prompt] should only call [succ] if it has received more input. If there + * is no chance that the input will grow, i.e., [more = Complete], then + * [prompt] should call [fail]. Otherwise (in the case where the input + * hasn't grown but [more = Incomplete] just prompt again. *) + let parser_uncommitted_bytes = Input.parser_uncommitted_bytes input in + let parser_committed_bytes = Input.parser_committed_bytes input in + (* The continuation should not hold any references to input above. *) + let continue input ~off ~len more = + if len < parser_uncommitted_bytes then + failwith "prompt: input shrunk!"; + let input = Input.create input ~off ~len ~committed_bytes:parser_committed_bytes in + if len = parser_uncommitted_bytes then + match (more : More.t) with + | Complete -> fail input pos More.Complete + | Incomplete -> prompt input pos fail succ + else + succ input pos more + in + State.Partial { committed = Input.bytes_for_client_to_commit input; continue } + +let demand_input = + { run = fun input pos more fail succ -> + match (more : More.t) with + | Complete -> fail input pos more [] "not enough input" + | Incomplete -> + let succ' input' pos' more' = succ input' pos' more' () + and fail' input' pos' more' = fail input' pos' more' [] "not enough input" in + prompt input pos fail' succ' + } + +let ensure_suspended n input pos more fail succ = + let rec go = + { run = fun input' pos' more' fail' succ' -> + if pos' + n <= Input.length input' then + succ' input' pos' more' () + else + (demand_input *> go).run input' pos' more' fail' succ' + } + in + (demand_input *> go).run input pos more fail succ + +let unsafe_apply len ~f = + { run = fun input pos more _fail succ -> + succ input (pos + len) more (Input.apply input pos len ~f) + } + +let unsafe_apply_opt len ~f = + { run = fun input pos more fail succ -> + match Input.apply input pos len ~f with + | Error e -> fail input pos more [] e + | Ok x -> succ input (pos + len) more x + } + +let ensure n p = + { run = fun input pos more fail succ -> + if pos + n <= Input.length input + then p.run input pos more fail succ + else + let succ' input' pos' more' () = p.run input' pos' more' fail succ in + ensure_suspended n input pos more fail succ' } + +(** END: getting input *) + +let at_end_of_input = + { run = fun input pos more _ succ -> + if pos < Input.length input then + succ input pos more false + else match more with + | Complete -> succ input pos more true + | Incomplete -> + let succ' input' pos' more' = succ input' pos' more' false + and fail' input' pos' more' = succ input' pos' more' true in + prompt input pos fail' succ' + } + +let end_of_input = + at_end_of_input + >>= function + | true -> return () + | false -> fail "end_of_input" + +let advance n = + if n < 0 + then fail "advance" + else + let p = + { run = fun input pos more _fail succ -> succ input (pos + n) more () } + in + ensure n p + +let pos = + { run = fun input pos more _fail succ -> succ input pos more pos } + +let available = + { run = fun input pos more _fail succ -> + succ input pos more (Input.length input - pos) + } + +let commit = + { run = fun input pos more _fail succ -> + Input.commit input pos; + succ input pos more () } + +(* Do not use this if [p] contains a [commit]. *) +let unsafe_lookahead p = + { run = fun input pos more fail succ -> + let succ' input' _ more' v = succ input' pos more' v in + p.run input pos more fail succ' } + +let peek_char = + { run = fun input pos more _fail succ -> + if pos < Input.length input then + succ input pos more (Some (Input.unsafe_get_char input pos)) + else if more = Complete then + succ input pos more None + else + let succ' input' pos' more' = + succ input' pos' more' (Some (Input.unsafe_get_char input' pos')) + and fail' input' pos' more' = + succ input' pos' more' None in + prompt input pos fail' succ' + } + +(* This parser is too important to not be optimized. Do a custom job. *) +let rec peek_char_fail = + { run = fun input pos more fail succ -> + if pos < Input.length input + then succ input pos more (Input.unsafe_get_char input pos) + else + let succ' input' pos' more' () = + peek_char_fail.run input' pos' more' fail succ in + ensure_suspended 1 input pos more fail succ' } + +let satisfy f = + { run = fun input pos more fail succ -> + if pos < Input.length input then + let c = Input.unsafe_get_char input pos in + if f c + then succ input (pos + 1) more c + else Printf.ksprintf (fail input pos more []) "satisfy: %C" c + else + let succ' input' pos' more' () = + let c = Input.unsafe_get_char input' pos' in + if f c + then succ input' (pos' + 1) more' c + else Printf.ksprintf (fail input' pos' more' []) "satisfy: %C" c + in + ensure_suspended 1 input pos more fail succ' } + +let char c = + let p = + { run = fun input pos more fail succ -> + if Input.unsafe_get_char input pos = c + then succ input (pos + 1) more c + else fail input pos more [] (Printf.sprintf "char %C" c) } + in + ensure 1 p + +let not_char c = + let p = + { run = fun input pos more fail succ -> + let c' = Input.unsafe_get_char input pos in + if c <> c' + then succ input (pos + 1) more c' + else fail input pos more [] (Printf.sprintf "not char %C" c) } + in + ensure 1 p + +let any_char = + let p = + { run = fun input pos more _fail succ -> + succ input (pos + 1) more (Input.unsafe_get_char input pos) } + in + ensure 1 p + +let int8 i = + let p = + { run = fun input pos more fail succ -> + let c = Char.code (Input.unsafe_get_char input pos) in + if c = i land 0xff + then succ input (pos + 1) more c + else fail input pos more [] (Printf.sprintf "int8 %d" i) } + in + ensure 1 p + +let any_uint8 = + let p = + { run = fun input pos more _fail succ -> + let c = Input.unsafe_get_char input pos in + succ input (pos + 1) more (Char.code c) } + in + ensure 1 p + +let any_int8 = + (* https://graphics.stanford.edu/~seander/bithacks.html#VariableSignExtendRisky *) + let s = Sys.int_size - 8 in + let p = + { run = fun input pos more _fail succ -> + let c = Input.unsafe_get_char input pos in + succ input (pos + 1) more ((Char.code c lsl s) asr s) } + in + ensure 1 p + +let skip f = + let p = + { run = fun input pos more fail succ -> + if f (Input.unsafe_get_char input pos) + then succ input (pos + 1) more () + else fail input pos more [] "skip" } + in + ensure 1 p + +let rec count_while ~init ~f ~with_buffer = + { run = fun input pos more fail succ -> + let len = Input.count_while input (pos + init) ~f in + let input_len = Input.length input in + let init' = init + len in + (* Check if the loop terminated because it reached the end of the input + * buffer. If so, then prompt for additional input and continue. *) + if pos + init' < input_len || more = Complete + then succ input (pos + init') more (Input.apply input pos init' ~f:with_buffer) + else + let succ' input' pos' more' = + (count_while ~init:init' ~f ~with_buffer).run input' pos' more' fail succ + and fail' input' pos' more' = + succ input' (pos' + init') more' (Input.apply input' pos' init' ~f:with_buffer) + in + prompt input pos fail' succ' + } + +let rec count_while1 ~f ~with_buffer = + { run = fun input pos more fail succ -> + let len = Input.count_while input pos ~f in + let input_len = Input.length input in + (* Check if the loop terminated because it reached the end of the input + * buffer. If so, then prompt for additional input and continue. *) + if len < 1 + then + if pos < input_len || more = Complete + then fail input pos more [] "count_while1" + else + let succ' input' pos' more' = + (count_while1 ~f ~with_buffer).run input' pos' more' fail succ + and fail' input' pos' more' = + fail input' pos' more' [] "count_while1" + in + prompt input pos fail' succ' + else if pos + len < input_len || more = Complete + then succ input (pos + len) more (Input.apply input pos len ~f:with_buffer) + else + let succ' input' pos' more' = + (count_while ~init:len ~f ~with_buffer).run input' pos' more' fail succ + and fail' input' pos' more' = + succ input' (pos' + len) more' (Input.apply input' pos' len ~f:with_buffer) + in + prompt input pos fail' succ' + } + +let string_ f s = + (* XXX(seliopou): Inefficient. Could check prefix equality to short-circuit + * the io. *) + let len = String.length s in + ensure len (unsafe_apply_opt len ~f:(fun buffer ~off ~len -> + let i = ref 0 in + while !i < len && Char.equal (f (Bigstringaf.unsafe_get buffer (off + !i))) + (f (String.unsafe_get s !i)) + do + incr i + done; + if len = !i + then Ok (Bigstringaf.substring buffer ~off ~len) + else Error "string")) + +let string s = string_ (fun x -> x) s +let string_ci s = string_ Char.lowercase_ascii s + +let skip_while f = + count_while ~init:0 ~f ~with_buffer:(fun _ ~off:_ ~len:_ -> ()) + +let take n = + if n < 0 + then fail "take: n < 0" + else + let n = max n 0 in + ensure n (unsafe_apply n ~f:Bigstringaf.substring) + +let take_bigstring n = + if n < 0 + then fail "take_bigstring: n < 0" + else + let n = max n 0 in + ensure n (unsafe_apply n ~f:Bigstringaf.copy) + +let take_bigstring_while f = + count_while ~init:0 ~f ~with_buffer:Bigstringaf.copy + +let take_bigstring_while1 f = + count_while1 ~f ~with_buffer:Bigstringaf.copy + +let take_bigstring_till f = + take_bigstring_while (fun c -> not (f c)) + +let peek_string n = + unsafe_lookahead (take n) + +let take_while f = + count_while ~init:0 ~f ~with_buffer:Bigstringaf.substring + +let take_while1 f = + count_while1 ~f ~with_buffer:Bigstringaf.substring + +let take_till f = + take_while (fun c -> not (f c)) + +let choice ?(failure_msg="no more choices") ps = + List.fold_right (<|>) ps (fail failure_msg) + +let notset = { run = fun _buf _pos _more _fail _succ -> failwith "Angstrom.fix_direct not set" } + +let fix_direct f = + let rec p = ref notset + and r = { run = fun buf pos more fail succ -> + (!p).run buf pos more fail succ } + in + p := f r; + r + +let fix_lazy ~max_steps f = + let steps = ref max_steps in + let rec p = lazy (f r) + and r = { run = fun buf pos more fail succ -> + decr steps; + if !steps < 0 + then ( + steps := max_steps; + State.Lazy (lazy ((Lazy.force p).run buf pos more fail succ))) + else + (Lazy.force p).run buf pos more fail succ + } + in + r + +let fix = match Sys.backend_type with + | Native -> fix_direct + | Bytecode -> fix_direct + | Other _ -> fun f -> fix_lazy ~max_steps:20 f + +let option x p = + p <|> return x + +let cons x xs = x :: xs + +let rec list ps = + match ps with + | [] -> return [] + | p::ps -> lift2 cons p (list ps) + +let count n p = + if n < 0 + then fail "count: n < 0" + else + let rec loop = function + | 0 -> return [] + | n -> lift2 cons p (loop (n - 1)) + in + loop n + +let many p = + fix (fun m -> + (lift2 cons p m) <|> return []) + +let many1 p = + lift2 cons p (many p) + +let many_till p t = + fix (fun m -> + (t *> return []) <|> (lift2 cons p m)) + +let sep_by1 s p = + fix (fun m -> + lift2 cons p ((s *> m) <|> return [])) + +let sep_by s p = + (lift2 cons p ((s *> sep_by1 s p) <|> return [])) <|> return [] + +let skip_many p = + fix (fun m -> + ((p >>| fun _ -> true) <|> return false) >>= function + | true -> m + | false -> return () + ) + +let skip_many1 p = + p *> skip_many p + +let end_of_line = + (char '\n' *> return ()) <|> (string "\r\n" *> return ()) "end_of_line" + +let scan_ state f ~with_buffer = + { run = fun input pos more fail succ -> + let state = ref state in + let parser = + count_while ~init:0 ~f:(fun c -> + match f !state c with + | None -> false + | Some state' -> state := state'; true) + ~with_buffer + >>| fun x -> x, !state + in + parser.run input pos more fail succ } + +let scan state f = + scan_ state f ~with_buffer:Bigstringaf.substring + +let scan_state state f = + scan_ state f ~with_buffer:(fun _ ~off:_ ~len:_ -> ()) + >>| fun ((), state) -> state + +let scan_string state f = + scan state f >>| fst + +let consume_with p f = + { run = fun input pos more fail succ -> + let start = pos in + let parser_committed_bytes = Input.parser_committed_bytes input in + let succ' input' pos' more' _ = + if parser_committed_bytes <> Input.parser_committed_bytes input' + then fail input' pos' more' [] "consumed: parser committed" + else ( + let len = pos' - start in + let consumed = Input.apply input' start len ~f in + succ input' pos' more' consumed) + in + p.run input pos more fail succ' + } + +let consumed p = consume_with p Bigstringaf.substring +let consumed_bigstring p = consume_with p Bigstringaf.copy + +let both a b = lift2 (fun a b -> a, b) a b +let map t ~f = t >>| f +let bind t ~f = t >>= f +let map2 a b ~f = lift2 f a b +let map3 a b c ~f = lift3 f a b c +let map4 a b c d ~f = lift4 f a b c d + +module Let_syntax = struct + let return = return + let ( >>| ) = ( >>| ) + let ( >>= ) = ( >>= ) + + module Let_syntax = struct + let return = return + let map = map + let bind = bind + let both = both + let map2 = map2 + let map3 = map3 + let map4 = map4 + end +end + +let ( let+ ) = ( >>| ) +let ( let* ) = ( >>= ) +let ( and+ ) = both + +module BE = struct + (* XXX(seliopou): The pattern in both this module and [LE] are a compromise + * between efficiency and code reuse. By inlining [ensure] you can recover + * about 2 nanoseconds on average. That may add up in certain applications. + * + * This pattern does not allocate in the fast (success) path. + * *) + let int16 n = + let bytes = 2 in + let p = + { run = fun input pos more fail succ -> + if Input.unsafe_get_int16_be input pos = (n land 0xffff) + then succ input (pos + bytes) more () + else fail input pos more [] "BE.int16" } + in + ensure bytes p + + let int32 n = + let bytes = 4 in + let p = + { run = fun input pos more fail succ -> + if Int32.equal (Input.unsafe_get_int32_be input pos) n + then succ input (pos + bytes) more () + else fail input pos more [] "BE.int32" } + in + ensure bytes p + + let int64 n = + let bytes = 8 in + let p = + { run = fun input pos more fail succ -> + if Int64.equal (Input.unsafe_get_int64_be input pos) n + then succ input (pos + bytes) more () + else fail input pos more [] "BE.int64" } + in + ensure bytes p + + let any_uint16 = + ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_be bs off)) + + let any_int16 = + ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_sign_extended_be bs off)) + + let any_int32 = + ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int32_be bs off)) + + let any_int64 = + ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int64_be bs off)) + + let any_float = + ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Int32.float_of_bits (Bigstringaf.unsafe_get_int32_be bs off))) + + let any_double = + ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Int64.float_of_bits (Bigstringaf.unsafe_get_int64_be bs off))) +end + +module LE = struct + let int16 n = + let bytes = 2 in + let p = + { run = fun input pos more fail succ -> + if Input.unsafe_get_int16_le input pos = (n land 0xffff) + then succ input (pos + bytes) more () + else fail input pos more [] "LE.int16" } + in + ensure bytes p + + let int32 n = + let bytes = 4 in + let p = + { run = fun input pos more fail succ -> + if Int32.equal (Input.unsafe_get_int32_le input pos) n + then succ input (pos + bytes) more () + else fail input pos more [] "LE.int32" } + in + ensure bytes p + + let int64 n = + let bytes = 8 in + let p = + { run = fun input pos more fail succ -> + if Int64.equal (Input.unsafe_get_int64_le input pos) n + then succ input (pos + bytes) more () + else fail input pos more [] "LE.int64" } + in + ensure bytes p + + + let any_uint16 = + ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_le bs off)) + + let any_int16 = + ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_sign_extended_le bs off)) + + let any_int32 = + ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int32_le bs off)) + + let any_int64 = + ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int64_le bs off)) + + let any_float = + ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Int32.float_of_bits (Bigstringaf.unsafe_get_int32_le bs off))) + + let any_double = + ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Int64.float_of_bits (Bigstringaf.unsafe_get_int64_le bs off))) +end + +module Unsafe = struct + let take n f = + let n = max n 0 in + ensure n (unsafe_apply n ~f) + + let peek n f = + unsafe_lookahead (take n f) + + let take_while check f = + count_while ~init:0 ~f:check ~with_buffer:f + + let take_while1 check f = + count_while1 ~f:check ~with_buffer:f + + let take_till check f = + take_while (fun c -> not (check c)) f +end + +module Consume = struct + type t = + | Prefix + | All +end + +let parse_bigstring ~consume p bs = + let p = + match (consume : Consume.t) with + | Prefix -> p + | All -> p <* end_of_input + in + Unbuffered.parse_bigstring p bs + +let parse_string ~consume p s = + let len = String.length s in + let bs = Bigstringaf.create len in + Bigstringaf.unsafe_blit_from_string s ~src_off:0 bs ~dst_off:0 ~len; + parse_bigstring ~consume p bs diff --git a/unikernel/duniverse/angstrom/lib/angstrom.mli b/unikernel/duniverse/angstrom/lib/angstrom.mli new file mode 100644 index 00000000..d6695959 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/angstrom.mli @@ -0,0 +1,688 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +(** Parser combinators built for speed and memory-efficiency. + + Angstrom is a parser-combinator library that provides monadic and + applicative interfaces for constructing parsers with unbounded lookahead. + Its parsers can consume input incrementally, whether in a blocking or + non-blocking environment. To achieve efficient incremental parsing, + Angstrom offers both a buffered and unbuffered interface to input streams, + with the {!module:Unbuffered} interface enabling zero-copy IO. With these + features and low-level iteration parser primitives like {!take_while} and + {!skip_while}, Angstrom makes it easy to write efficient, expressive, and + reusable parsers suitable for high-performance applications. *) + + +type +'a t +(** A parser for values of type ['a]. *) + + +type bigstring = Bigstringaf.t + +(** {2 Basic parsers} *) + +val peek_char : char option t +(** [peek_char] accepts any char and returns it, or returns [None] if the end + of input has been reached. + + This parser does not advance the input. Use it for lookahead. *) + +val peek_char_fail : char t +(** [peek_char_fail] accepts any char and returns it. If end of input has been + reached, it will fail. + + This parser does not advance the input. Use it for lookahead. *) + +val peek_string : int -> string t +(** [peek_string n] accepts exactly [n] characters and returns them as a + string. If there is not enough input, it will fail. + + This parser does not advance the input. Use it for lookahead. *) + +val char : char -> char t +(** [char c] accepts [c] and returns it. *) + +val not_char : char -> char t +(** [not_char] accepts any character that is not [c] and returns the matched + character. *) + +val any_char : char t +(** [any_char] accepts any character and returns it. *) + +val satisfy : (char -> bool) -> char t +(** [satisfy f] accepts any character for which [f] returns [true] and + returns the accepted character. In the case that none of the parser + succeeds, then the parser will fail indicating the offending + character. *) + +val string : string -> string t +(** [string s] accepts [s] exactly and returns it. *) + +val string_ci : string -> string t +(** [string_ci s] accepts [s], ignoring case, and returns the matched string, + preserving the case of the original input. *) + +val skip : (char -> bool) -> unit t +(** [skip f] accepts any character for which [f] returns [true] and discards + the accepted character. [skip f] is equivalent to [satisfy f] but discards + the accepted character. *) + +val skip_while : (char -> bool) -> unit t +(** [skip_while f] accepts input as long as [f] returns [true] and discards + the accepted characters. *) + +val take : int -> string t +(** [take n] accepts exactly [n] characters of input and returns them as a + string. *) + +val take_while : (char -> bool) -> string t +(** [take_while f] accepts input as long as [f] returns [true] and returns the + accepted characters as a string. + + This parser does not fail. If [f] returns [false] on the first character, + it will return the empty string. *) + +val take_while1 : (char -> bool) -> string t +(** [take_while1 f] accepts input as long as [f] returns [true] and returns the + accepted characters as a string. + + This parser requires that [f] return [true] for at least one character of + input, and will fail otherwise. *) + +val take_till : (char -> bool) -> string t +(** [take_till f] accepts input as long as [f] returns [false] and returns the + accepted characters as a string. + + This parser does not fail. If [f] returns [true] on the first character, it + will return the empty string. *) + +val consumed : _ t -> string t +(** [consumed p] runs [p] and returns the contents that were consumed during the + parsing as a string *) + +val take_bigstring : int -> bigstring t +(** [take_bigstring n] accepts exactly [n] characters of input and returns them + as a newly allocated bigstring. *) + +val take_bigstring_while : (char -> bool) -> bigstring t +(** [take_bigstring_while f] accepts input as long as [f] returns [true] and + returns the accepted characters as a newly allocated bigstring. + + This parser does not fail. If [f] returns [false] on the first character, + it will return the empty bigstring. *) + +val take_bigstring_while1 : (char -> bool) -> bigstring t +(** [take_bigstring_while1 f] accepts input as long as [f] returns [true] and + returns the accepted characters as a newly allocated bigstring. + + This parser requires that [f] return [true] for at least one character of + input, and will fail otherwise. *) + +val take_bigstring_till : (char -> bool) -> bigstring t +(** [take_bigstring_till f] accepts input as long as [f] returns [false] and + returns the accepted characters as a newly allocated bigstring. + + This parser does not fail. If [f] returns [true] on the first character, it + will return the empty bigstring. *) + +val consumed_bigstring : _ t -> bigstring t +(** [consumed p] runs [p] and returns the contents that were consumed during the + parsing as a bigstring *) + +val advance : int -> unit t +(** [advance n] advances the input [n] characters, failing if the remaining + input is less than [n]. *) + +val end_of_line : unit t +(** [end_of_line] accepts either a line feed [\n], or a carriage return + followed by a line feed [\r\n] and returns unit. *) + +val at_end_of_input : bool t +(** [at_end_of_input] returns whether the end of the end of input has been + reached. This parser always succeeds. *) + +val end_of_input : unit t +(** [end_of_input] succeeds if all the input has been consumed, and fails + otherwise. *) + +val scan : 'state -> ('state -> char -> 'state option) -> (string * 'state) t +(** [scan init f] consumes until [f] returns [None]. Returns the final state + before [None] and the accumulated string *) + +val scan_state : 'state -> ('state -> char -> 'state option) -> 'state t +(** [scan_state init f] is like {!scan} but only returns the final state before + [None]. Much more efficient than {!scan}. *) + +val scan_string : 'state -> ('state -> char -> 'state option) -> string t +(** [scan_string init f] is like {!scan} but discards the final state and returns + the accumulated string. *) + +val int8 : int -> int t +(** [int8 i] accepts one byte that matches the lower-order byte of [i] and + returns unit. *) + +val any_uint8 : int t +(** [any_uint8] accepts any byte and returns it as an unsigned int8. *) + +val any_int8 : int t +(** [any_int8] accepts any byte and returns it as a signed int8. *) + +(** Big endian parsers *) +module BE : sig + val int16 : int -> unit t + (** [int16 i] accept two bytes that match the two lower order bytes of [i] + and returns unit. *) + + val int32 : int32 -> unit t + (** [int32 i] accept four bytes that match the four bytes of [i] + and returns unit. *) + + val int64 : int64 -> unit t + (** [int64 i] accept eight bytes that match the eight bytes of [i] and + returns unit. *) + + val any_int16 : int t + val any_int32 : int32 t + val any_int64 : int64 t + (** [any_intN] reads [N] bits and interprets them as big endian signed integers. *) + + val any_uint16 : int t + (** [any_uint16] reads [16] bits and interprets them as a big endian unsigned + integer. *) + + val any_float : float t + (** [any_float] reads 32 bits and interprets them as a big endian floating + point value. *) + + val any_double : float t + (** [any_double] reads 64 bits and interprets them as a big endian floating + point value. *) +end + +(** Little endian parsers *) +module LE : sig + val int16 : int -> unit t + (** [int16 i] accept two bytes that match the two lower order bytes of [i] + and returns unit. *) + + val int32 : int32 -> unit t + (** [int32 i] accept four bytes that match the four bytes of [i] + and returns unit. *) + + val int64 : int64 -> unit t + (** [int32 i] accept eight bytes that match the eight bytes of [i] and + returns unit. *) + + val any_int16 : int t + val any_int32 : int32 t + val any_int64 : int64 t + (** [any_intN] reads [N] bits and interprets them as little endian signed + integers. *) + + val any_uint16 : int t + (** [uint16] reads [16] bits and interprets them as a little endian unsigned + integer. *) + + val any_float : float t + (** [any_float] reads 32 bits and interprets them as a little endian floating + point value. *) + + val any_double : float t + (** [any_double] reads 64 bits and interprets them as a little endian floating + point value. *) +end + + +(** {2 Combinators} *) + +val option : 'a -> 'a t -> 'a t +(** [option v p] runs [p], returning the result of [p] if it succeeds and [v] + if it fails. *) + + +val both : 'a t -> 'b t -> ('a * 'b) t +(** [both p q] runs [p] followed by [q] and returns both results in a tuple *) + +val list : 'a t list -> 'a list t +(** [list ps] runs each [p] in [ps] in sequence, returning a list of results of + each [p]. *) + +val count : int -> 'a t -> 'a list t +(** [count n p] runs [p] [n] times, returning a list of the results. *) + +val many : 'a t -> 'a list t +(** [many p] runs [p] {i zero} or more times and returns a list of results from + the runs of [p]. *) + +val many1 : 'a t -> 'a list t +(** [many1 p] runs [p] {i one} or more times and returns a list of results from + the runs of [p]. *) + +val many_till : 'a t -> _ t -> 'a list t +(** [many_till p e] runs parser [p] {i zero} or more times until action [e] + succeeds and returns the list of result from the runs of [p]. *) + +val sep_by : _ t -> 'a t -> 'a list t +(** [sep_by s p] runs [p] {i zero} or more times, interspersing runs of [s] in between. *) + +val sep_by1 : _ t -> 'a t -> 'a list t +(** [sep_by1 s p] runs [p] {i one} or more times, interspersing runs of [s] in between. *) + +val skip_many : _ t -> unit t +(** [skip_many p] runs [p] {i zero} or more times, discarding the results. *) + +val skip_many1 : _ t -> unit t +(** [skip_many1 p] runs [p] {i one} or more times, discarding the results. *) + +val fix : ('a t -> 'a t) -> 'a t +(** [fix f] computes the fixpoint of [f] and runs the resultant parser. The + argument that [f] receives is the result of [fix f], which [f] must use, + paradoxically, to define [fix f]. + + [fix] is useful when constructing parsers for inductively-defined types + such as sequences, trees, etc. Consider for example the implementation of + the {!many} combinator defined in this library: + +{[let many p = + fix (fun m -> + (cons <$> p <*> m) <|> return [])]} + + [many p] is a parser that will run [p] zero or more times, accumulating the + result of every run into a list, returning the result. It's defined by + passing [fix] a function. This function assumes its argument [m] is a + parser that behaves exactly like [many p]. You can see this in the + expression comprising the left hand side of the alternative operator + [<|>]. This expression runs the parser [p] followed by the parser [m], and + after which the result of [p] is cons'd onto the list that [m] produces. + The right-hand side of the alternative operator provides a base case for + the combinator: if [p] fails and the parse cannot proceed, return an empty + list. + + Another way to illustrate the uses of [fix] is to construct a JSON parser. + Assuming that parsers exist for the basic types such as [false], [true], + [null], strings, and numbers, the question then becomes how to define a + parser for objects and arrays? Both contain values that are themselves JSON + values, so it seems as though it's impossible to write a parser that will + accept JSON objects and arrays before writing a parser for JSON values as a + whole. + + This is the exact situation that [fix] was made for. By defining the + parsers for arrays and objects within the function that you pass to [fix], + you will gain access to a parser that you can use to parse JSON values, the + very parser you are defining! + +{[let json = + fix (fun json -> + let arr = char '[' *> sep_by (char ',') json <* char ']' in + let obj = char '{' *> ... json ... <* char '}' in + choice [str; num; arr json, ...])]} *) + +(** [fix_lazy] is like [fix], but after the function reaches [max_steps] + deep, it wraps up the remaining computation and yields + back to the root of the parsing loop where it continues from there. + + This is an effective way to break up the stack trace into more managable + chunks, which is important for Js_of_ocaml due to the lack of tailrec + optimizations for CPS-style tail calls. When compiling for Js_of_ocaml, + [fix] itself is defined as [fix_lazy ~max_steps:20]. *) +val fix_lazy : max_steps:int -> ('a t -> 'a t) -> 'a t + +(** {2 Alternatives} *) + +val (<|>) : 'a t -> 'a t -> 'a t +(** [p <|> q] runs [p] and returns the result if succeeds. If [p] fails, then + the input will be reset and [q] will run instead. *) + +val choice : ?failure_msg:string -> 'a t list -> 'a t +(** [choice ?failure_msg ts] runs each parser in [ts] in order until one + succeeds and returns that result. In the case that none of the parser + succeeds, then the parser will fail with the message [failure_msg], if + provided, or a much less informative message otherwise. *) + +val () : 'a t -> string -> 'a t +(** [p name] associates [name] with the parser [p], which will be reported + in the case of failure. *) + +val commit : unit t +(** [commit] prevents backtracking beyond the current position of the input, + allowing the manager of the input buffer to reuse the preceding bytes for + other purposes. + + The {!module:Unbuffered} parsing interface will report directly to the + caller the number of bytes committed to the when returning a + {!Unbuffered.state.Partial} state, allowing the caller to reuse those bytes + for any purpose. The {!module:Buffered} will keep track of the region of + committed bytes in its internal buffer and reuse that region to store + additional input when necessary. *) + + +(** {2 Monadic/Applicative interface} *) + +val return : 'a -> 'a t +(** [return v] creates a parser that will always succeed and return [v] *) + +val fail : string -> _ t +(** [fail msg] creates a parser that will always fail with the message [msg] *) + +val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +(** [p >>= f] creates a parser that will run [p], pass its result to [f], run + the parser that [f] produces, and return its result. *) + +val bind : 'a t -> f:('a -> 'b t) -> 'b t +(** [bind] is a prefix version of [>>=] *) + +val (>>|) : 'a t -> ('a -> 'b) -> 'b t +(** [p >>| f] creates a parser that will run [p], and if it succeeds with + result [v], will return [f v] *) + +val (<*>) : ('a -> 'b) t -> 'a t -> 'b t +(** [f <*> p] is equivalent to [f >>= fun f -> p >>| f]. *) + +val (<$>) : ('a -> 'b) -> 'a t -> 'b t +(** [f <$> p] is equivalent to [p >>| f] *) + +val ( *>) : _ t -> 'a t -> 'a t +(** [p *> q] runs [p], discards its result and then runs [q], and returns its + result. *) + +val (<* ) : 'a t -> _ t -> 'a t +(** [p <* q] runs [p], then runs [q], discards its result, and returns the + result of [p]. *) + +val lift : ('a -> 'b) -> 'a t -> 'b t +val lift2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t +val lift3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t +val lift4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t +(** The [liftn] family of functions promote functions to the parser monad. + For any of these functions, the following equivalence holds: + +{[liftn f p1 ... pn = f <$> p1 <*> ... <*> pn]} + + These functions are more efficient than using the applicative interface + directly, mostly in terms of memory allocation but also in terms of speed. + Prefer them over the applicative interface, even when the arity of the + function to be lifted exceeds the maximum [n] for which there is an + implementation for [liftn]. In other words, if [f] has an arity of [5] but + only [lift4] is provided, do the following: + +{[lift4 f m1 m2 m3 m4 <*> m5]} + + Even with the partial application, it will be more efficient than the + applicative implementation. *) + +val map : 'a t -> f:('a -> 'b) -> 'b t +val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t +val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t +val map4 : 'a t -> 'b t -> 'c t -> 'd t -> f:('a -> 'b -> 'c -> 'd -> 'e) -> 'e t +(** The [mapn] family of functions are just like [liftn], with a slightly + different interface. *) + +(** The [Let_syntax] module is intended to be used with the [ppx_let] + pre-processor, and just contains copies of functions described elsewhere. *) +module Let_syntax : sig + val return : 'a -> 'a t + val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t + val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t + + module Let_syntax : sig + val return : 'a -> 'a t + val map : 'a t -> f:('a -> 'b) -> 'b t + val bind : 'a t -> f:('a -> 'b t) -> 'b t + val both : 'a t -> 'b t -> ('a * 'b) t + val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t + val map4 : 'a t -> 'b t -> 'c t -> 'd t -> f:('a -> 'b -> 'c -> 'd -> 'e) -> 'e t + end +end + +val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t +val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t +val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t + +(** Unsafe Operations on Angstrom's Internal Buffer + + These functions are considered {b unsafe} as they expose the input buffer + to client code without any protections against modification, or leaking + references. They are exposed to support performance-sensitive parsers that + want to avoid allocation at all costs. Client code should take care to + write the input buffer callback functions such that they: + + {ul + {- do not modify the input buffer {i outside} of the range + [\[off, off + len)];} + {- do not modify the input buffer {i inside} of the range + [\[off, off + len)] if the parser might backtrack; and} + {- do not return any direct or indirect references to the input buffer.}} + + If the input buffer callback functions do not do any of these things, then + the client may consider their use safe. *) +module Unsafe : sig + + val take : int -> (bigstring -> off:int -> len:int -> 'a) -> 'a t + (** [take n f] accepts exactly [n] characters of input into the parser's + internal buffer then calls [f buffer ~off ~len]. [buffer] is the + parser's internal buffer. [off] is the offset from the start of [buffer] + containing the requested content. [len] is the length of the requested + content. [len] is guaranteed to be equal to [n]. *) + + val take_while : (char -> bool) -> (bigstring -> off:int -> len:int -> 'a) -> 'a t + (** [take_while check f] accepts input into the parser's interal buffer as + long as [check] returns [true] then calls [f buffer ~off ~len]. [buffer] + is the parser's internal buffer. [off] is the offset from the start of + [buffer] containing the requested content. [len] is the length of the + content matched by [check]. + + This parser does not fail. If [check] returns [false] on the first + character, [len] will be [0]. *) + + val take_while1 : (char -> bool) -> (bigstring -> off:int -> len:int -> 'a) -> 'a t + (** [take_while1 check f] accepts input into the parser's interal buffer as + long as [check] returns [true] then calls [f buffer ~off ~len]. [buffer] + is the parser's internal buffer. [off] is the offset from the start of + [buffer] containing the requested content. [len] is the length of the + content matched by [check]. + + This parser requires that [f] return [true] for at least one character of + input, and will fail otherwise. *) + + val take_till : (char -> bool) -> (bigstring -> off:int -> len:int -> 'a) -> 'a t + (** [take_till check f] accepts input into the parser's interal buffer as + long as [check] returns [false] then calls [f buffer ~off ~len]. [buffer] + is the parser's internal buffer. [off] is the offset from the start of + [buffer] containing the requested content. [len] is the length of the + content matched by [check]. + + This parser does not fail. If [check] returns [true] on the first + character, [len] will be [0]. *) + + val peek : int -> (bigstring -> off:int -> len:int -> 'a) -> 'a t + (** [peek n ~f] accepts exactly [n] characters and calls [f buffer ~off ~len] + with [len = n]. If there is not enough input, it will fail. + + This parser does not advance the input. Use it for lookahead. *) +end + + +(** {2 Running} *) + +module Consume : sig + type t = + | Prefix + | All +end + +val parse_bigstring : consume:Consume.t -> 'a t -> bigstring -> ('a, string) result + +(** [parse_bigstring ~consume t bs] runs [t] on [bs]. The parser will receive + an [`Eof] after all of [bs] has been consumed. Passing {!Prefix} in the + [consume] argument allows the parse to successfully complete without + reaching eof. To require the parser to reach eof, pass {!All} in the + [consume] argument. + + For use-cases requiring that the parser be fed input incrementally, see the + {!module:Buffered} and {!module:Unbuffered} modules below. *) + + +val parse_string : consume:Consume.t -> 'a t -> string -> ('a, string) result +(** [parse_string ~consume t bs] runs [t] on [bs]. The parser will receive an + [`Eof] after all of [bs] has been consumed. Passing {!Prefix} in the + [consume] argument allows the parse to successfully complete without + reaching eof. To require the parser to reach eof, pass {!All} in the + [consume] argument. + + For use-cases requiring that the parser be fed input incrementally, see the + {!module:Buffered} and {!module:Unbuffered} modules below. *) + + +(** Buffered parsing interface. + + Parsers run through this module perform internal buffering of input. The + parser state will keep track of unconsumed input and attempt to minimize + memory allocation and copying. The {!Buffered.state.Partial} parser state + will accept newly-read, incremental input and copy it into the internal + buffer. Users can feed parser states using the {!feed} function. As a + result, the interface is much easier to use than the one exposed by the + {!Unbuffered} module. + + On success or failure, any unconsumed input will be returned to the user + for additional processing. The buffer that the unconsumed input is returned + in can also be reused. *) +module Buffered : sig + type unconsumed = + { buf : bigstring + ; off : int + ; len : int } + + type input = + [ `Bigstring of bigstring + | `String of string ] + + type 'a state = + | Partial of ([ input | `Eof ] -> 'a state) (** The parser requires more input. *) + | Done of unconsumed * 'a (** The parser succeeded. *) + | Fail of unconsumed * string list * string (** The parser failed. *) + + val parse : ?initial_buffer_size:int -> 'a t -> 'a state + (** [parse ?initial_buffer_size t] runs [t] and awaits input if needed. + [parse] will allocate a buffer of size [initial_buffer_size] (defaulting + to 4k bytes) to do input buffering and automatically grows the buffer as + needed. *) + + val feed : 'a state -> [ input | `Eof ] -> 'a state + (** [feed state input] supplies the parser state with more input. If [state] is + [Partial], then parsing will continue where it left off. Otherwise, the + parser is in a [Fail] or [Done] state, in which case the [input] will be + copied into the state's buffer for later use by the caller. *) + + val state_to_option : 'a state -> 'a option + (** [state_to_option state] returns [Some v] if the parser is in the + [Done (bs, v)] state and [None] otherwise. This function has no effect on + the current state of the parser. *) + + val state_to_result : 'a state -> ('a, string) result + (** [state_to_result state] returns [Ok v] if the parser is in the [Done (bs, v)] + state and [Error msg] if it is in the [Fail] or [Partial] state. + + This function has no effect on the current state of the parser. *) + + val state_to_unconsumed : _ state -> unconsumed option + (** [state_to_unconsumed state] returns [Some bs] if [state = Done(bs, _)] or + [state = Fail(bs, _, _)] and [None] otherwise. *) + +end + +(** Unbuffered parsing interface. + + Use this module for total control over memory allocation and copying. + Parsers run through this module perform no internal buffering. Instead, the + user is responsible for managing a buffer containing the entirety of the + input that has yet to be consumed by the parser. The + {!Unbuffered.state.Partial} parser state reports to the user how much input + the parser consumed during its last run, via the + {!Unbuffered.partial.committed} field. This area of input must be discarded + before parsing can resume. Once additional input has been collected, the + unconsumed input as well as new input must be passed to the parser state + via the {!Unbuffered.partial.continue} function, together with an + indication of whether there is {!Unbuffered.more} input to come. + + The logic that must be implemented in order to make proper use of this + module is intricate and tied to your OS environment. It's advisable to use + the {!Buffered} module when initially developing and testing your parsers. + For production use-cases, consider the Async and Lwt support that this + library includes before attempting to use this module directly. *) +module Unbuffered : sig + type more = + | Complete + | Incomplete + + type 'a state = + | Partial of 'a partial (** The parser requires more input. *) + | Done of int * 'a (** The parser succeeded, consuming specified bytes. *) + | Fail of int * string list * string (** The parser failed, consuming specified bytes. *) + and 'a partial = + { committed : int + (** The number of bytes committed during the last input feeding. + Callers must drop this number of bytes from the beginning of the + input on subsequent calls. See {!commit} for additional details. *) + ; continue : bigstring -> off:int -> len:int -> more -> 'a state + (** A continuation of a parse that requires additional input. The input + should include all uncommitted input (as reported by previous partial + states) in addition to any new input that has become available, as + well as an indication of whether there is {!more} input to come. *) + } + + val parse : 'a t -> 'a state + (** [parse t] runs [t] and await input if needed. *) + + val state_to_option : 'a state -> 'a option + + (** [state_to_option state] returns [Some v] if the parser is in the + [Done (bs, v)] state and [None] otherwise. This function has no effect on the + current state of the parser. *) + + val state_to_result : 'a state -> ('a, string) result + (** [state_to_result state] returns [Ok v] if the parser is in the + [Done (bs, v)] state and [Error msg] if it is in the [Fail] or [Partial] + state. + + This function has no effect on the current state of the parser. *) +end + +(** {2 Expert Parsers} + + For people that know what they're doing. If you want to use them, read the + code. No further documentation will be provided. *) + +val pos : int t +val available : int t diff --git a/unikernel/duniverse/angstrom/lib/buffering.ml b/unikernel/duniverse/angstrom/lib/buffering.ml new file mode 100644 index 00000000..8d71cd47 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/buffering.ml @@ -0,0 +1,88 @@ +type t = + { mutable buf : Bigstringaf.t + ; mutable off : int + ; mutable len : int } + +let of_bigstring ~off ~len buf = + assert (off >= 0); + assert (Bigstringaf.length buf >= len - off); + { buf; off; len } + +let create len = + of_bigstring ~off:0 ~len:0 (Bigstringaf.create len) + +let writable_space t = + Bigstringaf.length t.buf - t.len + +let trailing_space t = + Bigstringaf.length t.buf - (t.off + t.len) + +let compress t = + Bigstringaf.unsafe_blit t.buf ~src_off:t.off t.buf ~dst_off:0 ~len:t.len; + t.off <- 0 + +let grow t to_copy = + let old_len = Bigstringaf.length t.buf in + let new_len = ref old_len in + let space = writable_space t in + while space + !new_len - old_len < to_copy do + new_len := (3 * !new_len) / 2 + done; + let new_buf = Bigstringaf.create !new_len in + Bigstringaf.unsafe_blit t.buf ~src_off:t.off new_buf ~dst_off:0 ~len:t.len; + t.buf <- new_buf; + t.off <- 0 + +let ensure t to_copy = + if trailing_space t < to_copy then + if writable_space t >= to_copy + then compress t + else grow t to_copy + +let write_pos t = + t.off + t.len + +let feed_string t ~off ~len str = + assert (off >= 0); + assert (String.length str >= len - off); + ensure t len; + Bigstringaf.unsafe_blit_from_string str ~src_off:off t.buf ~dst_off:(write_pos t) ~len; + t.len <- t.len + len + +let feed_bigstring t ~off ~len b = + assert (off >= 0); + assert (Bigstringaf.length b >= len - off); + ensure t len; + Bigstringaf.unsafe_blit b ~src_off:off t.buf ~dst_off:(write_pos t) ~len; + t.len <- t.len + len + +let feed_input t = function + | `String s -> feed_string t ~off:0 ~len:(String .length s) s + | `Bigstring b -> feed_bigstring t ~off:0 ~len:(Bigstringaf.length b) b + +let shift t n = + assert (t.len >= n); + t.off <- t.off + n; + t.len <- t.len - n + +let for_reading { buf; off; len } = + Bigstringaf.sub ~off ~len buf + +module Unconsumed = struct + type t = + { buf : Bigstringaf.t + ; off : int + ; len : int } +end + +let unconsumed ?(shift=0) { buf; off; len } = + assert (len >= shift); + { Unconsumed.buf; off = off + shift; len = len - shift } + +let of_unconsumed { Unconsumed.buf; off; len } = + { buf; off; len } + +type unconsumed = Unconsumed.t = + { buf : Bigstringaf.t + ; off : int + ; len : int } diff --git a/unikernel/duniverse/angstrom/lib/buffering.mli b/unikernel/duniverse/angstrom/lib/buffering.mli new file mode 100644 index 00000000..f458471d --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/buffering.mli @@ -0,0 +1,20 @@ +type t + +val create : int -> t +val of_bigstring : off:int -> len:int -> Bigstringaf.t -> t + +val feed_string : t -> off:int -> len:int -> string -> unit +val feed_bigstring : t -> off:int -> len:int -> Bigstringaf.t -> unit +val feed_input : t -> [ `String of string | `Bigstring of Bigstringaf.t ] -> unit + +val shift : t -> int -> unit + +val for_reading : t -> Bigstringaf.t + +type unconsumed = + { buf : Bigstringaf.t + ; off : int + ; len : int } + +val unconsumed : ?shift:int -> t -> unconsumed +val of_unconsumed : unconsumed -> t diff --git a/unikernel/duniverse/angstrom/lib/dune b/unikernel/duniverse/angstrom/lib/dune new file mode 100644 index 00000000..65b87bc0 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/dune @@ -0,0 +1,6 @@ +(library + (name angstrom) + (public_name angstrom) + (libraries bigstringaf) + (flags :standard -safe-string) + (preprocess future_syntax)) diff --git a/unikernel/duniverse/angstrom/lib/exported_state.ml b/unikernel/duniverse/angstrom/lib/exported_state.ml new file mode 100644 index 00000000..5bb5c706 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/exported_state.ml @@ -0,0 +1,22 @@ +type 'a state = + | Partial of 'a partial + | Done of int * 'a + | Fail of int * string list * string + +and 'a partial = + { committed : int + ; continue : Bigstringaf.t -> off:int -> len:int -> More.t -> 'a state } + + +let state_to_option x = match x with + | Done(_, v) -> Some v + | Fail _ -> None + | Partial _ -> None + +let fail_to_string marks err = + String.concat " > " marks ^ ": " ^ err + +let state_to_result x = match x with + | Done(_, v) -> Ok v + | Partial _ -> Error "incomplete input" + | Fail(_, marks, err) -> Error (fail_to_string marks err) diff --git a/unikernel/duniverse/angstrom/lib/input.ml b/unikernel/duniverse/angstrom/lib/input.ml new file mode 100644 index 00000000..0355d36d --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/input.ml @@ -0,0 +1,111 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2017 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +type t = + { mutable parser_committed_bytes : int + ; client_committed_bytes : int + ; off : int + ; len : int + ; buffer : Bigstringaf.t + } + +let create buffer ~off ~len ~committed_bytes = + { parser_committed_bytes = committed_bytes + ; client_committed_bytes = committed_bytes + ; off + ; len + ; buffer } + +let length t = t.client_committed_bytes + t.len +let client_committed_bytes t = t.client_committed_bytes +let parser_committed_bytes t = t.parser_committed_bytes + +let committed_bytes_discrepancy t = t.parser_committed_bytes - t.client_committed_bytes +let bytes_for_client_to_commit t = committed_bytes_discrepancy t + +let parser_uncommitted_bytes t = t.len - bytes_for_client_to_commit t + +let invariant t = + assert (parser_committed_bytes t + parser_uncommitted_bytes t = length t); + assert (parser_committed_bytes t - client_committed_bytes t = bytes_for_client_to_commit t); +;; + +let offset_in_buffer t pos = + t.off + pos - t.client_committed_bytes + +let apply t pos len ~f = + let off = offset_in_buffer t pos in + f t.buffer ~off ~len + +let unsafe_get_char t pos = + let off = offset_in_buffer t pos in + Bigstringaf.unsafe_get t.buffer off + +let unsafe_get_int16_le t pos = + let off = offset_in_buffer t pos in + Bigstringaf.unsafe_get_int16_le t.buffer off + +let unsafe_get_int32_le t pos = + let off = offset_in_buffer t pos in + Bigstringaf.unsafe_get_int32_le t.buffer off + +let unsafe_get_int64_le t pos = + let off = offset_in_buffer t pos in + Bigstringaf.unsafe_get_int64_le t.buffer off + +let unsafe_get_int16_be t pos = + let off = offset_in_buffer t pos in + Bigstringaf.unsafe_get_int16_be t.buffer off + +let unsafe_get_int32_be t pos = + let off = offset_in_buffer t pos in + Bigstringaf.unsafe_get_int32_be t.buffer off + +let unsafe_get_int64_be t pos = + let off = offset_in_buffer t pos in + Bigstringaf.unsafe_get_int64_be t.buffer off + +let count_while t pos ~f = + let buffer = t.buffer in + let off = offset_in_buffer t pos in + let i = ref off in + let limit = t.off + t.len in + while !i < limit && f (Bigstringaf.unsafe_get buffer !i) do + incr i + done; + !i - off +;; + +let commit t pos = + t.parser_committed_bytes <- pos +;; diff --git a/unikernel/duniverse/angstrom/lib/input.mli b/unikernel/duniverse/angstrom/lib/input.mli new file mode 100644 index 00000000..cc9cc4a3 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/input.mli @@ -0,0 +1,88 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2017 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +(** An [Input.t] represents a series of buffers, of which we only have access + to one, and a pointer to how much has been committed, which is in the + current buffer. + + parser commit point + V + +--------------------------------------+ + |#################'####################| current buffer + +-----------------+--------------------------------------+----- + |#################|#################'####################|###.. input + +-----------------+--------------------------------------+----- + ' ' ' ' + |--------------------------------------------------------| + ' ' length ' ' + |-----------------| ' ' + client_committed_bytes ' ' + ' ' |--------------------| + ' ' parser_uncommitted_bytes + ' |-----------------| + ' bytes_for_client_to_commit + |-----------------------------------| + parser_committed_bytes + + Note that a buffer is a subsequence of a [Bigstringaf.t], defined by [off] and [len]. + + All [int] position arguments should be relative to the beginning of the + whole input. *) + +type t + +val create : Bigstringaf.t -> off:int -> len:int -> committed_bytes:int -> t + +val length : t -> int + +val client_committed_bytes : t -> int +val parser_committed_bytes : t -> int +val parser_uncommitted_bytes : t -> int + +val bytes_for_client_to_commit : t -> int + +val unsafe_get_char : t -> int -> char +val unsafe_get_int16_le : t -> int -> int +val unsafe_get_int32_le : t -> int -> int32 +val unsafe_get_int64_le : t -> int -> int64 +val unsafe_get_int16_be : t -> int -> int +val unsafe_get_int32_be : t -> int -> int32 +val unsafe_get_int64_be : t -> int -> int64 + +val count_while : t -> int -> f:(char -> bool) -> int + +val apply : t -> int -> int -> f:(Bigstringaf.t -> off:int -> len:int -> 'a) -> 'a + +val commit : t -> int -> unit + +val invariant : t -> unit diff --git a/unikernel/duniverse/angstrom/lib/more.ml b/unikernel/duniverse/angstrom/lib/more.ml new file mode 100644 index 00000000..fe6d510e --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/more.ml @@ -0,0 +1,3 @@ +type t = + | Complete + | Incomplete diff --git a/unikernel/duniverse/angstrom/lib/more.mli b/unikernel/duniverse/angstrom/lib/more.mli new file mode 100644 index 00000000..9d96703f --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/more.mli @@ -0,0 +1,3 @@ +type t = + | Complete + | Incomplete diff --git a/unikernel/duniverse/angstrom/lib/parser.ml b/unikernel/duniverse/angstrom/lib/parser.ml new file mode 100644 index 00000000..7afcc2ad --- /dev/null +++ b/unikernel/duniverse/angstrom/lib/parser.ml @@ -0,0 +1,173 @@ +module State = struct + type 'a t = + | Partial of 'a partial + | Lazy of 'a t Lazy.t + | Done of int * 'a + | Fail of int * string list * string + + and 'a partial = + { committed : int + ; continue : Bigstringaf.t -> off:int -> len:int -> More.t -> 'a t } + +end +type 'a with_state = Input.t -> int -> More.t -> 'a + +type 'a failure = (string list -> string -> 'a State.t) with_state +type ('a, 'r) success = ('a -> 'r State.t) with_state + +type 'a t = + { run : 'r. ('r failure -> ('a, 'r) success -> 'r State.t) with_state } + +let fail_k input pos _ marks msg = + State.Fail(pos - Input.client_committed_bytes input, marks, msg) +let succeed_k input pos _ v = + State.Done(pos - Input.client_committed_bytes input, v) + +let rec to_exported_state = function + | State.Partial {committed;continue} -> + Exported_state.Partial + { committed + ; continue = + fun bs ~off ~len more -> + to_exported_state (continue bs ~off ~len more)} + | State.Done (i,x) -> Exported_state.Done (i,x) + | State.Fail (i, sl, s) -> Exported_state.Fail (i, sl, s) + | State.Lazy x -> to_exported_state (Lazy.force x) + +let parse p = + let input = Input.create Bigstringaf.empty ~committed_bytes:0 ~off:0 ~len:0 in + to_exported_state (p.run input 0 Incomplete fail_k succeed_k) + +let parse_bigstring p input = + let input = Input.create input ~committed_bytes:0 ~off:0 ~len:(Bigstringaf.length input) in + Exported_state.state_to_result (to_exported_state (p.run input 0 Complete fail_k succeed_k)) + +module Monad = struct + let return v = + { run = fun input pos more _fail succ -> + succ input pos more v + } + + let fail msg = + { run = fun input pos more fail _succ -> + fail input pos more [] msg + } + + let (>>=) p f = + { run = fun input pos more fail succ -> + let succ' input' pos' more' v = (f v).run input' pos' more' fail succ in + p.run input pos more fail succ' + } + + let (>>|) p f = + { run = fun input pos more fail succ -> + let succ' input' pos' more' v = succ input' pos' more' (f v) in + p.run input pos more fail succ' + } + + let (<$>) f m = + m >>| f + + let (<*>) f m = + (* f >>= fun f -> m >>| f *) + { run = fun input pos more fail succ -> + let succ0 input0 pos0 more0 f = + let succ1 input1 pos1 more1 m = succ input1 pos1 more1 (f m) in + m.run input0 pos0 more0 fail succ1 + in + f.run input pos more fail succ0 } + + let lift f m = + f <$> m + + let lift2 f m1 m2 = + { run = fun input pos more fail succ -> + let succ1 input1 pos1 more1 m1 = + let succ2 input2 pos2 more2 m2 = succ input2 pos2 more2 (f m1 m2) in + m2.run input1 pos1 more1 fail succ2 + in + m1.run input pos more fail succ1 } + + let lift3 f m1 m2 m3 = + { run = fun input pos more fail succ -> + let succ1 input1 pos1 more1 m1 = + let succ2 input2 pos2 more2 m2 = + let succ3 input3 pos3 more3 m3 = + succ input3 pos3 more3 (f m1 m2 m3) in + m3.run input2 pos2 more2 fail succ3 in + m2.run input1 pos1 more1 fail succ2 + in + m1.run input pos more fail succ1 } + + let lift4 f m1 m2 m3 m4 = + { run = fun input pos more fail succ -> + let succ1 input1 pos1 more1 m1 = + let succ2 input2 pos2 more2 m2 = + let succ3 input3 pos3 more3 m3 = + let succ4 input4 pos4 more4 m4 = + succ input4 pos4 more4 (f m1 m2 m3 m4) in + m4.run input3 pos3 more3 fail succ4 in + m3.run input2 pos2 more2 fail succ3 in + m2.run input1 pos1 more1 fail succ2 + in + m1.run input pos more fail succ1 } + + let ( *>) a b = + (* a >>= fun _ -> b *) + { run = fun input pos more fail succ -> + let succ' input' pos' more' _ = b.run input' pos' more' fail succ in + a.run input pos more fail succ' + } + + let (<* ) a b = + (* a >>= fun x -> b >>| fun _ -> x *) + { run = fun input pos more fail succ -> + let succ0 input0 pos0 more0 x = + let succ1 input1 pos1 more1 _ = succ input1 pos1 more1 x in + b.run input0 pos0 more0 fail succ1 + in + a.run input pos more fail succ0 } +end + +module Choice = struct + let () p mark = + { run = fun input pos more fail succ -> + let fail' input' pos' more' marks msg = + fail input' pos' more' (mark::marks) msg in + p.run input pos more fail' succ + } + + let (<|>) p q = + { run = fun input pos more fail succ -> + let fail' input' pos' more' marks msg = + (* The only two constructors that introduce new failure continuations are + * [] and [<|>]. If the initial input position is less than the length + * of the committed input, then calling the failure continuation will + * have the effect of unwinding all choices and collecting marks along + * the way. *) + if pos < Input.parser_committed_bytes input' then + fail input' pos' more marks msg + else + q.run input' pos more' fail succ in + p.run input pos more fail' succ + } +end + +module Monad_use_for_debugging = struct + let return = Monad.return + let fail = Monad.fail + let (>>=) = Monad.(>>=) + + let (>>|) m f = m >>= fun x -> return (f x) + + let (<$>) f m = m >>| f + let (<*>) f m = f >>= fun f -> m >>| f + + let lift = (>>|) + let lift2 f m1 m2 = f <$> m1 <*> m2 + let lift3 f m1 m2 m3 = f <$> m1 <*> m2 <*> m3 + let lift4 f m1 m2 m3 m4 = f <$> m1 <*> m2 <*> m3 <*> m4 + + let ( *>) a b = a >>= fun _ -> b + let (<* ) a b = a >>= fun x -> b >>| fun _ -> x +end diff --git a/unikernel/duniverse/angstrom/lib_test/dune b/unikernel/duniverse/angstrom/lib_test/dune new file mode 100644 index 00000000..6e00fe3b --- /dev/null +++ b/unikernel/duniverse/angstrom/lib_test/dune @@ -0,0 +1,27 @@ +(library + (name angstrom_test) + (libraries angstrom) + (flags :standard -safe-string) + (modules test_let_syntax_native test_let_syntax_ppx) + (preprocess + (per_module + (future_syntax test_let_syntax_native) + ((pps ppx_let) test_let_syntax_ppx)))) + +(executables + (libraries alcotest angstrom angstrom_test) + (modules test_angstrom) + (names test_angstrom)) + +(executables + (libraries bigstringaf angstrom RFC7159) + (modules test_json) + (names test_json)) + +(alias + (name runtest) + (package angstrom) + (deps + (:< test_angstrom.exe)) + (action + (run %{<}))) \ No newline at end of file diff --git a/unikernel/duniverse/angstrom/lib_test/test_angstrom.ml b/unikernel/duniverse/angstrom/lib_test/test_angstrom.ml new file mode 100644 index 00000000..7651e4a9 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib_test/test_angstrom.ml @@ -0,0 +1,449 @@ +open Angstrom + +module Alcotest = struct + include Alcotest + + let bigstring = + Alcotest.testable + (fun fmt _bs -> Fmt.pf fmt "") + ( = ) +end + +let check ?size f p is = + let open Buffered in + let state = + List.fold_left (fun state chunk -> + feed state (`String chunk)) + (parse ?initial_buffer_size:size p) is + in + f (state_to_result (feed state `Eof)) + +let check_ok ?size ~msg test p is r = + let r = Ok r in + check ?size (fun result -> Alcotest.(check (result test string)) msg r result) + p is + +let check_fail ?size ~msg p is = + let r = Error "" in + check ?size (fun result -> Alcotest.(check (result reject pass)) msg r result) + p is + +let check_c ?size ~msg p is r = check_ok ?size ~msg Alcotest.char p is r +let check_lc ?size ~msg p is r = check_ok ?size ~msg Alcotest.(list char) p is r +let check_co ?size ~msg p is r = check_ok ?size ~msg Alcotest.(option char) p is r +let check_s ?size ~msg p is r = check_ok ?size ~msg Alcotest.string p is r +let check_bs ?size ~msg p is r = check_ok ?size ~msg Alcotest.bigstring p is r +let check_ls ?size ~msg p is r = check_ok ?size ~msg Alcotest.(list string) p is r +let check_int ?size ~msg p is r = check_ok ?size ~msg Alcotest.int p is r + +let bigstring_of_string s = Bigstringaf.of_string s ~off:0 ~len:(String.length s) + +let basic_constructors = + [ "peek_char", `Quick, begin fun () -> + check_co ~msg:"singleton input" peek_char ["t"] (Some 't'); + check_co ~msg:"longer input" peek_char ["true"] (Some 't'); + check_co ~msg:"empty input" peek_char [""] None; + end + ; "peek_char_fail", `Quick, begin fun () -> + check_c ~msg:"singleton input" peek_char_fail ["t"] 't'; + check_c ~msg:"longer input" peek_char_fail ["true"] 't'; + check_fail ~msg:"empty input" peek_char_fail [""] + end + ; "char", `Quick, begin fun () -> + check_c ~msg:"singleton 'a'" (char 'a') ["a"] 'a'; + check_c ~msg:"prefix 'a'" (char 'a') ["asdf"] 'a'; + check_fail ~msg:"'a' failure" (char 'a') ["b"]; + check_fail ~msg:"empty buffer" (char 'a') [""] + end + ; "int8", `Quick, begin fun () -> + check_int ~msg:"singleton 'a'" (int8 0x0061) ["a"] 0x61; + check_int ~msg:"prefix 'a'" (int8 0xff61) ["asdf"] 0x61; + check_fail ~msg:"'a' failure" (int8 0xff61) ["b"]; + check_fail ~msg:"empty buffer" (int8 0xff61) [""]; + end + ; "not_char", `Quick, begin fun () -> + check_c ~msg:"not 'a' singleton" (not_char 'a') ["b"] 'b'; + check_c ~msg:"not 'a' prefix" (not_char 'a') ["baba"] 'b'; + check_fail ~msg:"not 'a' failure" (not_char 'a') ["a"]; + check_fail ~msg:"empty buffer" (not_char 'a') [""] + end + ; "any_char", `Quick, begin fun () -> + check_c ~msg:"non-empty buffer" any_char ["a"] 'a'; + check_fail ~msg:"empty buffer" any_char [""] + end + ; "any_{,u}int8", `Quick, begin fun () -> + check_int ~msg:"positive sign preserved" any_int8 ["\127"] 127; + check_int ~msg:"negative sign preserved" any_int8 ["\129"] (-127); + check_int ~msg:"sign invariant" any_uint8 ["\127"] 127; + check_int ~msg:"sign invariant" any_uint8 ["\129"] (129) + end + ; "string", `Quick, begin fun () -> + check_s ~msg:"empty string, non-empty buffer" (string "") ["asdf"] ""; + check_s ~msg:"empty string, empty buffer" (string "") [""] ""; + check_s ~msg:"exact string match" (string "asdf") ["asdf"] "asdf"; + check_s ~msg:"string is prefix of input" (string "as") ["asdf"] "as"; + + check_fail ~msg:"input is prefix of string" (string "asdf") ["asd"]; + check_fail ~msg:"non-empty string, empty input" (string "test") [""] + end + ; "string_ci", `Quick, begin fun () -> + check_s ~msg:"empty string, non-empty input" (string_ci "") ["asdf"] ""; + check_s ~msg:"empty string, empty input" (string_ci "") [""] ""; + check_s ~msg:"exact string match" (string_ci "asdf") ["AsDf"] "AsDf"; + check_s ~msg:"string is prefix of input" (string_ci "as") ["AsDf"] "As"; + + check_fail ~msg:"input is prefix of string" (string_ci "asdf") ["Asd"]; + check_fail ~msg:"non-empty string, empty input" (string_ci "test") [""] + end + ; "take_bigstring", `Quick, begin fun () -> + check_bs ~msg:"empty bigstring" (take_bigstring 0) ["asdf"] (bigstring_of_string ""); + check_bs ~msg:"bigstring" (take_bigstring 2) ["asdf"] (bigstring_of_string "as"); + + check_fail ~msg:"asking for too much" (take_bigstring 5) ["asdf"]; + end + ; "take_while", `Quick, begin fun () -> + check_s ~msg:"true, non-empty input" (take_while (fun _ -> true)) ["asdf"] "asdf"; + check_s ~msg:"true, empty input" (take_while (fun _ -> true)) [""] ""; + check_s ~msg:"false, non-empty input" (take_while (fun _ -> false)) ["asdf"] ""; + check_s ~msg:"false, empty input" (take_while (fun _ -> false)) [""] ""; + end + ; "take_while1", `Quick, begin fun () -> + check_s ~msg:"true, non-empty input" (take_while1 (fun _ -> true)) ["asdf"] "asdf"; + check_fail ~msg:"false, non-empty input" (take_while1 (fun _ -> false)) ["asdf"]; + check_fail ~msg:"true, empty input" (take_while1 (fun _ -> true)) [""]; + check_fail ~msg:"false, empty input" (take_while1 (fun _ -> false)) [""]; + end + ; "advance", `Quick, begin fun () -> + check_s ~msg:"non-empty input" (advance 3 >>= fun () -> take 1) ["asdf"] "f"; + check_fail ~msg:"advance more than available" (advance 5) ["asdf"]; + check_fail ~msg:"advance on empty input" (advance 3) [""]; + end + ] + +module type EndianBigstring = sig + val set_int16 : Bigstringaf.t -> int -> int -> unit + val set_int32 : Bigstringaf.t -> int -> int32 -> unit + val set_int64 : Bigstringaf.t -> int -> int64 -> unit + + val set_float : Bigstringaf.t -> int -> float -> unit + val set_double : Bigstringaf.t -> int -> float -> unit +end + +module Endian(Es : EndianBigstring) = struct + type 'a endian = { + name : string; + size : int; + zero : 'a; + min : 'a; + max : 'a; + dump : Bigstringaf.t -> int -> 'a -> unit; + testable : 'a Alcotest.testable + } + + let int16 = { + name = "int16"; + size = 2; + zero = 0; + min = ~-32768; + max = 32767; + dump = Es.set_int16; + testable = Alcotest.int + } + let int32 = { + name = "int32"; + size = 4; + zero = Int32.zero; + min = Int32.min_int; + max = Int32.max_int; + dump = Es.set_int32; + testable = Alcotest.int32 + } + let int64 = { + name = "int64"; + size = 8; + zero = Int64.zero; + min = Int64.min_int; + max = Int64.max_int; + dump = Es.set_int64; + testable = Alcotest.int64 + } + let float = { + name = "float"; + size = 4; + zero = 0.0; + (* XXX: Not really min/max *) + min = ~-.2e10; + max = 2e10; + dump = Es.set_float; + testable = Alcotest.float 0.0 + } + let double = { + name = "double"; + size = 8; + zero = 0.0; + (* XXX: Not really min/max *) + min = ~-.2e30; + max = 2e30; + dump = Es.set_double; + testable = Alcotest.float 0.0 + } + + let uint16 = { int16 with name = "uint16"; min = 0; max = 65535 } + let uint32 = { int32 with name = "uint32" } + + let dump actual size value = + let buf = Bigstringaf.of_string ~off:0 ~len:size (String.make size '\xff') in + actual buf 0 value; + Bigstringaf.substring ~off:0 ~len:size buf + + let make_tests e parse = e.name, `Quick, begin fun () -> + check_ok ~msg:"zero" e.testable parse [dump e.dump e.size e.zero] e.zero; + check_ok ~msg:"min" e.testable parse [dump e.dump e.size e.min ] e.min; + check_ok ~msg:"max" e.testable parse [dump e.dump e.size e.max ] e.max; + check_ok ~msg:"trailing" e.testable parse [dump e.dump (e.size + 1) e.zero] e.zero; + end + + module type EndianSig = module type of LE + + let tests (module E : EndianSig) = [ + make_tests int16 E.any_int16; + make_tests int32 E.any_int32; + make_tests int64 E.any_int64; + make_tests uint16 E.any_uint16; + make_tests float E.any_float; + make_tests double E.any_double; + ] +end +let little_endian = + let module E = Endian(struct + let set_int16 = Bigstringaf.unsafe_set_int16_le + let set_int32 = Bigstringaf.unsafe_set_int32_le + let set_int64 = Bigstringaf.unsafe_set_int64_le + + let set_float bs off f = Bigstringaf.unsafe_set_int32_le bs off (Int32.bits_of_float f) + let set_double bs off d = Bigstringaf.unsafe_set_int64_le bs off (Int64.bits_of_float d) + end) in + E.tests (module LE) + +let big_endian = + let module E = Endian(struct + let set_int16 = Bigstringaf.unsafe_set_int16_be + let set_int32 = Bigstringaf.unsafe_set_int32_be + let set_int64 = Bigstringaf.unsafe_set_int64_be + + let set_float bs off f = Bigstringaf.unsafe_set_int32_be bs off (Int32.bits_of_float f) + let set_double bs off d = Bigstringaf.unsafe_set_int64_be bs off (Int64.bits_of_float d) + end) in + E.tests (module BE) + +let monadic = + [ "fail", `Quick, begin fun () -> + check_fail ~msg:"non-empty input" (fail "") ["asdf"]; + check_fail ~msg:"empty input" (fail "") [""] + end + ; "return", `Quick, begin fun () -> + check_s ~msg:"non-empty input" (return "test") ["asdf"] "test"; + check_s ~msg:"empty input" (return "test") [""] "test"; + end + ; "bind", `Quick, begin fun () -> + check_s ~msg:"data dependency" (take 2 >>= fun s -> string s) ["asas"] "as"; + end + ] + +let applicative = + [ "applicative", `Quick, begin fun () -> + check_s ~msg:"`foo *> bar` returns bar" (string "foo" *> string "bar") ["foobar"] "bar"; + check_s ~msg:"`foo <* bar` returns bar" (string "foo" <* string "bar") ["foobar"] "foo"; + end + ] + +let alternative = + [ "alternative", `Quick, begin fun () -> + check_c ~msg:"char a | char b" (char 'a' <|> char 'b') ["a"] 'a'; + check_c ~msg:"char b | char a" (char 'b' <|> char 'a') ["a"] 'a'; + check_s ~msg:"string 'a' | string 'b'" (string "a" <|> string "b") ["a"] "a"; + check_s ~msg:"string 'b' | string 'a'" (string "b" <|> string "a") ["a"] "a"; + end ] + +let combinators = + [ "many", `Quick, begin fun () -> + check_lc ~msg:"empty input" (many (char 'a')) [""] []; + check_lc ~msg:"single char" (many (char 'a')) ["a"] ['a']; + check_lc ~msg:"two chars" (many (char 'a')) ["aa"] ['a'; 'a']; + end + ; "many_till", `Quick, begin fun () -> + check_lc ~msg:"not greedy" (many_till any_char (char '-')) ["ab-ab-"] ['a'; 'b']; + end + ; "sep_by1", `Quick, begin fun () -> + let parser = sep_by1 (char ',') (char 'a') in + check_lc ~msg:"single char" parser ["a"] ['a']; + check_lc ~msg:"many chars" parser ["a,a"] ['a'; 'a']; + check_lc ~msg:"no trailing sep" parser ["a,"] ['a']; + end + ; "count", `Quick, begin fun () -> + check_lc ~msg:"empty input" (count 0 (char 'a')) [""] []; + check_lc ~msg:"exact input" (count 1 (char 'a')) ["a"] ['a']; + check_lc ~msg:"additonal input" (count 2 (char 'a')) ["aaa"] ['a'; 'a']; + check_fail ~msg:"bad input" (count 2 (char 'a')) ["abb"]; + end + ; "scan_state", `Quick, begin fun () -> + check_s ~msg:"scan_state" (scan_state "" (fun s -> function + | 'a' -> Some s + | '.' -> None + | c -> Some ((String.make 1 c) ^ s) + )) ["abaacba."] "bcb"; + let p = + count 2 (scan_state "" (fun s -> function + | '.' -> None + | c -> Some (s ^ String.make 1 c) + )) + >>| String.concat "" in + check_s ~msg:"state reset between runs" p ["bcd."] "bcd"; + end + ; "consumed", `Quick, begin fun () -> + check_s ~msg:"from beginning" (consumed any_char) + ["abc"] "a"; + check_s ~msg:"from middle" (any_char *> consumed any_char) + ["abc"] "b"; + check_c ~msg:"advances input" (any_char *> consumed any_char *> any_char) + ["abc"] 'c'; + check_s ~msg:"with backtracking" (consumed (char 'a' *> (char 'c' <|> char 'b'))) + ["abc"] "ab"; + check_s ~msg:"with more input" (consumed (string "abc")) + ["a"; "bc"] "abc"; + check_fail ~msg:"with commit" (consumed (char 'a' *> commit *> char 'b')) + ["a"; "b"]; + let integer = + option '+' (char '-') *> take_while (function '0'..'9' -> true | _ -> false) + in + check_int ~msg:"parsing an integer" (consumed integer >>| int_of_string) + ["-12345"] (-12345); + check_bs ~msg:"bigstring variant" (consumed_bigstring (string "ab")) + ["abc"] (bigstring_of_string "ab"); + end + ] + +let incremental = + [ "within chunk boundary", `Quick, begin fun () -> + check_s ~msg:"string on each side of 2 inputs" + (string "this" *> string "that") ["this"; "that"] "that"; + check_s ~msg:"string on each side of 3 inputs" + (string "thi" *> string "st" *> string "hat") ["thi"; "st"; "hat"] "hat"; + check_s ~msg:"string straddling 2 inputs" + (string "thisthat") ["this"; "that"] "thisthat"; + check_s ~msg:"string straddling 3 inputs" + (string "thisthat") ["thi"; "st"; "hat"] "thisthat"; + end + ; "peek_char and empty chunks", `Quick, begin fun () -> + let decoder len = + let open Angstrom in + + let buf = Buffer.create len in + + fix @@ fun m -> + available >>= function + | 0 -> peek_char >>= (function + | Some _ -> commit *> m + | None -> + let ret = Buffer.contents buf in + Buffer.clear buf; + commit *> return ret) + | n -> take n >>= fun chunk -> Buffer.add_string buf chunk; commit *> m + in + + check_s ~msg:"empty input multiple times and peek_char" + (decoder 0xFF) [ "Whole Lotta Love"; ""; ""; "" ] "Whole Lotta Love" + end + ; "across chunk boundary", `Quick, begin fun () -> + check_s ~size:4 ~msg:"string on each side of 2 chunks" + (string "this" *> string "that") ["this"; "that"] "that"; + check_s ~size:3 ~msg:"string on each side of 3 chunks" + (string "thi" *> string "st" *> string "hat") ["thi"; "st"; "hat"] "hat"; + check_s ~size:4 ~msg:"string straddling 2 chunks" + (string "thisthat") ["this"; "that"] "thisthat"; + check_s ~size:3 ~msg:"string straddling 3 chunks" + (string "thisthat") ["thi"; "st"; "hat"] "thisthat"; + end + ; "across chunk boundary with commit", `Quick, begin fun () -> + check_s ~size:4 ~msg:"string on each side of 2 chunks" + (string "this" *> commit *> string "that") ["this"; "that"] "that"; + check_s ~size:3 ~msg:"string on each side of 3 chunks" + (string "thi" *> string "st" *> commit *> string "hat") ["thi"; "st"; "hat"] "hat"; + end ] + +let count_while_regression = + [ "proper position set after count_while", `Quick, begin fun () -> + check_s ~msg:"take_while then eof" + (take_while (fun _ -> true) <* end_of_input) ["asdf"; ""] "asdf"; + check_s ~msg:"take_while1 then eof" + (take_while1 (fun _ -> true) <* end_of_input) ["asdf"; ""] "asdf"; + end ] + +let choice_commit = + [ "", `Quick, begin fun () -> + let p = + choice [ string "@@" *> commit *> char '*' + ; string "@" *> commit *> char '!' ] + in + Alcotest.(check (result reject string)) + "commit to branch" + (Error ": char '*'") + (parse_string ~consume:All p "@@^"); + end ] + +let input = + let test p input ~off ~len expect = + match Angstrom.Unbuffered.parse p with + | Done _ | Fail _ -> assert false + | Partial { continue; committed } -> + Alcotest.(check int) "committed is zero" 0 committed; + let bs = Bigstringaf.of_string input ~off:0 ~len:(String.length input) in + let state = continue bs ~off ~len Complete in + Alcotest.(check (result string string)) + "offset and length respected" + (Ok expect) + (Angstrom.Unbuffered.state_to_result state); + in + + [ "offset and length respected", `Quick, begin fun () -> + let open Angstrom in + let take_all = take_while (fun _ -> true) in + test take_all "abcd" ~off:1 ~len:2 "bc"; + test (take 4 *> take_all) "abcdefg" ~off:0 ~len:7 "efg"; + end ] +;; + +let consume = + [ "consume with choice matching prefix", `Quick, begin fun () -> + let open Angstrom in + let parse ~consume = + parse_string ~consume (many (char 'a')) "aaabbb" + in + Alcotest.(check (result (list char) string)) + "consume prefix passes" + (parse ~consume:Prefix) + (Ok [ 'a'; 'a'; 'a' ]) + ; + Alcotest.(check (result (list char) string)) + "consume all fails" + (parse ~consume:All) + (Error ": end_of_input"); + end + ] +;; + +let () = + Alcotest.run "test suite" + [ "basic constructors" , basic_constructors + ; "little endian" , little_endian + ; "big endian" , big_endian + ; "monadic interface" , monadic + ; "applicative interface" , applicative + ; "alternative" , alternative + ; "combinators" , combinators + ; "incremental input" , incremental + ; "count_while regression", count_while_regression + ; "choice and commit" , choice_commit + ; "input" , input + ; "consume" , consume + ] diff --git a/unikernel/duniverse/angstrom/lib_test/test_json.ml b/unikernel/duniverse/angstrom/lib_test/test_json.ml new file mode 100644 index 00000000..96d720ed --- /dev/null +++ b/unikernel/duniverse/angstrom/lib_test/test_json.ml @@ -0,0 +1,19 @@ +let read f = + try + let ic = open_in_bin f in + let n = in_channel_length ic in + let s = Bytes.create n in + really_input ic s 0 n; + close_in ic; + let b = Bigstringaf.create n in + Bigstringaf.blit_from_bytes s ~src_off:0 b ~dst_off:0 ~len:n; + b + with e -> + failwith (Printf.sprintf "Cannot read content of %s.\n%s" f (Printexc.to_string e)) +;; + +let () = + let twitter_big = read Sys.argv.(1) in + match Angstrom.(parse_bigstring ~consume:Consume.Prefix RFC7159.json twitter_big) with + | Ok _ -> () + | Error err -> failwith err diff --git a/unikernel/duniverse/angstrom/lib_test/test_let_syntax_native.ml b/unikernel/duniverse/angstrom/lib_test/test_let_syntax_native.ml new file mode 100644 index 00000000..46db4801 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib_test/test_let_syntax_native.ml @@ -0,0 +1,11 @@ +open Angstrom + +let (_ : int t) = + let* () = end_of_input in + return 1 + +let (_ : int t) = + let+ (_ : char) = any_char + and+ (_ : string) = string "foo" + in + 2 diff --git a/unikernel/duniverse/angstrom/lib_test/test_let_syntax_ppx.ml b/unikernel/duniverse/angstrom/lib_test/test_let_syntax_ppx.ml new file mode 100644 index 00000000..a21173c8 --- /dev/null +++ b/unikernel/duniverse/angstrom/lib_test/test_let_syntax_ppx.ml @@ -0,0 +1,18 @@ +open Angstrom +open Let_syntax + +let (_ : int t) = + let%bind () = end_of_input in + return 1 + +let (_ : int t) = + let%map (_ : char) = any_char + and (_ : string) = string "foo" + in + 2 + +let (_ : int t) = + let%mapn (_ : char) = any_char + and (_ : string) = string "foo" + in + 2 diff --git a/unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.ml b/unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.ml new file mode 100644 index 00000000..9da187ed --- /dev/null +++ b/unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.ml @@ -0,0 +1,81 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +open Angstrom.Buffered +open Lwt + +let default_pushback () = return_unit + +let rec buffered_state_loop pushback state in_chan bytes = + let size = Bytes.length bytes in + match state with + | Partial k -> + Lwt_io.read_into in_chan bytes 0 size + >|= begin function + | 0 -> k `Eof + | len -> + assert (len > 0); + k (`String (Bytes.(unsafe_to_string (sub bytes 0 len)))) + end + >>= fun state' -> pushback () + >>= fun () -> buffered_state_loop pushback state' in_chan bytes + | state -> return state + +let handle_parse_result state = + match state_to_unconsumed state with + | None -> assert false + | Some us -> us, state_to_result state + +let parse ?(pushback=default_pushback) p in_chan = + let size = Lwt_io.buffer_size in_chan in + let bytes = Bytes.create size in + buffered_state_loop pushback (parse ~initial_buffer_size:size p) in_chan bytes + >|= handle_parse_result + +let with_buffered_parse_state ?(pushback=default_pushback) state in_chan = + let size = Lwt_io.buffer_size in_chan in + let bytes = Bytes.create size in + begin match state with + | Partial _ -> buffered_state_loop pushback state in_chan bytes + | _ -> return state + end + >|= handle_parse_result + +let async_many e k = + Angstrom.(skip_many (e <* commit >>| k) "async_many") + +let parse_many p write in_chan = + let wait = ref (default_pushback ()) in + let k x = wait := write x in + let pushback () = !wait in + parse ~pushback (async_many p k) in_chan diff --git a/unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.mli b/unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.mli new file mode 100644 index 00000000..93c9db0f --- /dev/null +++ b/unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.mli @@ -0,0 +1,72 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +open Angstrom + + +val parse + : ?pushback:(unit -> unit Lwt.t) + -> 'a t + -> Lwt_io.input_channel + -> (Buffered.unconsumed * ('a, string) result) Lwt.t + +val parse_many + : 'a t + -> ('a -> unit Lwt.t) + -> Lwt_io.input_channel + -> (Buffered.unconsumed * (unit, string) result) Lwt.t + +(** Useful for resuming a {!parse} that returns unconsumed data. Construct a + [Buffered.state] by using [Buffered.parse] and provide it into this + function. This is essentially what {!parse_many} does, so consider using + that if you don't require fine-grained control over how many times you want + the parser to succeed. + + Usage example: + + {[ + parse parser in_channel >>= fun (unconsumed, result) -> + match result with + | Ok a -> + let { buf; off; len } = unconsumed in + let state = Buffered.parse parser in + let state = Buffered.feed state (`Bigstring (Bigstringaf.sub ~off ~len buf)) in + with_buffered_parse_state state in_channel + | Error err -> failwith err + ]} *) +val with_buffered_parse_state + : ?pushback:(unit -> unit Lwt.t) + -> 'a Buffered.state + -> Lwt_io.input_channel + -> (Buffered.unconsumed * ('a, string) result) Lwt.t + diff --git a/unikernel/duniverse/angstrom/lwt/dune b/unikernel/duniverse/angstrom/lwt/dune new file mode 100644 index 00000000..ffe68dc0 --- /dev/null +++ b/unikernel/duniverse/angstrom/lwt/dune @@ -0,0 +1,5 @@ +(library + (name angstrom_lwt_unix) + (public_name angstrom-lwt-unix) + (flags :standard -safe-string) + (libraries angstrom lwt.unix)) diff --git a/unikernel/duniverse/angstrom/unix/angstrom_unix.ml b/unikernel/duniverse/angstrom/unix/angstrom_unix.ml new file mode 100644 index 00000000..fcf5d4cc --- /dev/null +++ b/unikernel/duniverse/angstrom/unix/angstrom_unix.ml @@ -0,0 +1,52 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +open Angstrom.Buffered + +let parse ?(buf_size=0x1000) p in_chan = + let bytes = Bytes.create buf_size in + let rec loop = function + | Partial k -> + begin match input in_chan bytes 0 buf_size with + | 0 -> loop (k `Eof) + | n -> loop (k (`String (Bytes.(unsafe_to_string (sub bytes 0 n))))) + end + | state -> state + in + let state = loop (parse p) in + match state_to_unconsumed state with + | None -> assert false + | Some us -> us, state_to_result state + +let parse_many ?buf_size p k in_chan = + parse ?buf_size Angstrom.(skip_many (p <* commit >>| k)) in_chan diff --git a/unikernel/duniverse/angstrom/unix/angstrom_unix.mli b/unikernel/duniverse/angstrom/unix/angstrom_unix.mli new file mode 100644 index 00000000..97ecede1 --- /dev/null +++ b/unikernel/duniverse/angstrom/unix/angstrom_unix.mli @@ -0,0 +1,48 @@ +(*---------------------------------------------------------------------------- + Copyright (c) 2016 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*) + +open Angstrom + + +val parse : + ?buf_size:int + -> 'a t + -> in_channel + -> Buffered.unconsumed * ('a, string) result + +val parse_many : + ?buf_size:int + -> 'a t + -> ('a -> unit) + -> in_channel + -> Buffered.unconsumed * (unit, string) result diff --git a/unikernel/duniverse/angstrom/unix/dune b/unikernel/duniverse/angstrom/unix/dune new file mode 100644 index 00000000..2e051d6b --- /dev/null +++ b/unikernel/duniverse/angstrom/unix/dune @@ -0,0 +1,4 @@ +(library + (name angstrom_unix) + (public_name angstrom-unix) + (libraries angstrom unix)) diff --git a/unikernel/duniverse/arp/.gitignore b/unikernel/duniverse/arp/.gitignore new file mode 100644 index 00000000..6937a8ff --- /dev/null +++ b/unikernel/duniverse/arp/.gitignore @@ -0,0 +1,4 @@ +_build/ +.merlin +*.install +.*.swp diff --git a/unikernel/duniverse/arp/CHANGES.md b/unikernel/duniverse/arp/CHANGES.md new file mode 100644 index 00000000..c3b40647 --- /dev/null +++ b/unikernel/duniverse/arp/CHANGES.md @@ -0,0 +1,107 @@ +## v4.1.0 (2025-10-20) + +* Use LRU cache for Dynamic entries to avoid excessive memory consumption + (#35 @edwintorok) + +## v4.0.0 (2025-02-05) + +* Use mirage-sleep instead of mirage-time (no need to functorize over + Mirage_time.S) (#32 @hannesm) + +## v3.1.1 (2024-05-08) + +* Remove mirage-random and mirage-random-test dependency (#29 @hannesm) +* Remove superfluous mirage-clock-unix and mirage-flow dependencies (#29 @hannesm) +* Remove bisect-ppx dependency (#29 @hannesm) + +## v3.1.0 (2023-03-12) + +* Remove mirage-profile dependency (#28 @hannesm) + +## v3.0.0 (2021-12-10) + +* Include Mirage_protocols.ARP module type directly, remove dependency on + mirage-protocols (#27 @hannesm) + +## v2.3.2 (2021-04-22) + +* Compatibility with alcotest 1.4.0 (#22 @CraigFE) +* Minor updates for CI (#23 @hannesm) + +## v2.3.1 (2020-11-25) + +* Fix opam file to include mirage-profile dependency (#21 @hannesm) + +## v2.3.0 (2020-11-25) + +* Update to dune 2 (#19 @hannesm) +* Merge opam packages into a single one (#20 @hannesm) + +## v2.2.1 (2019-12-17) + +* adapt to lwt 5.0.0 change (#18 @hannesm) + +## v2.2.0 (2019-10-30) + +* adapt to mirage-protocols 4.0.0 changes (#17 @hannesm) + +## v2.1.0 (2019-07-16) + +* Update to ipaddr.4.0.0 interfaces (#16 @avsm) + +## v2.0.0 (2019-02-24) + +* provide Arp_packet.size +* Arp_handler API changes: return Arp_packet.t instead of Cstruct.t +* adapt to ethernet 2.0.0 changes + +## v1.0.0 (2019-02-02) + +* split opam package into two separate ones: a core + `arp` package and the `arp-mirage` implementation + for MirageOS that has more dependencies. This + eliminates the use of depopts that was done previously + to build the Mirage layer. (#7 @avsm) + +* port build system to Dune (#7 @avsm). The `make coverage` + and `make bench` targets will do the job of the previous + topkg targets for those. + +* minor fixes to ocamldoc comments to be compatible with + odoc. + +* use mirage-random and mirage-random-test instead of a + nocrypto dependency in tests and bench (#7 @hannesm) + +* import tests from mirage-tcpip (#8 @hannesm) + +* depend on the ethernet opam package, no longer provided + by tcpip >3.7.0 (#9 @hannesm) + +## 0.2.3 (2019-01-04) + +* port to ipaddr 3.0.0 + +## 0.2.2 (2018-08-25) + +* remove Arp_wire module, now integrated into Arp_packet +* remove usage of ppx_cstruct + +## 0.2.1 (2018-05-06) + +* Avoid an initial gratitious ARP with Ipaddr.V4.any + +## 0.2.0 (2017-01-17) + +* MirageOS3 support +* Don't ship with -warn-error +A, use it only in `./build` +* Fix testsuite compilation on OCaml 4.02 +* Renamed `Marp` to `Arpv4` (same as MirageOS ARP handler in tcpip) + +## 0.1.1 (2016-07-13) + +* Minor nits for topkg + +## 0.1.0 (2016-07-12) + +* Initial release diff --git a/unikernel/duniverse/arp/CODEOWNERS b/unikernel/duniverse/arp/CODEOWNERS new file mode 100644 index 00000000..f0842e0b --- /dev/null +++ b/unikernel/duniverse/arp/CODEOWNERS @@ -0,0 +1 @@ +* @hannesm diff --git a/unikernel/duniverse/arp/LICENSE.md b/unikernel/duniverse/arp/LICENSE.md new file mode 100644 index 00000000..1879ae00 --- /dev/null +++ b/unikernel/duniverse/arp/LICENSE.md @@ -0,0 +1,18 @@ +(* + * Copyright (c) 2016 Hannes Mehnert + * Portions copyright to MirageOS team under ISC license: + * src/arp_packet.ml mirage/arpv4.mli mirage/arpv4.ml + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) diff --git a/unikernel/duniverse/arp/README.md b/unikernel/duniverse/arp/README.md new file mode 100644 index 00000000..53a05dd3 --- /dev/null +++ b/unikernel/duniverse/arp/README.md @@ -0,0 +1,24 @@ +## ARP - Address Resolution Protocol purely in OCaml + +v4.1.0 + +ARP is an implementation of the address resolution protocol (RFC826) purely in +OCaml. It handles IPv4 protocol addresses and Ethernet hardware addresses only. + +A [MirageOS](https://mirage.io) ARP implementation is in the `mirage` subdirectory. + +Motivation for this implementation is [written up](https://hannes.robur.coop/Posts/ARP). + +## Documentation + +[API documentation](https://mirage.github.io/arp/arp/index.html) is available online. + +## Installation + +`opam install arp` will install this library, once you have installed OCaml (>= +4.08.0) and opam (>= 2.0.0). + +Benchmarks require more opam libraries, namely `mirage-vnetif mirage-clock-unix +mirage-unix`. Use +`dune build --release bench/bench.exe && _build/default/bench/bench.exe` +to build and run it. diff --git a/unikernel/duniverse/arp/arp.opam b/unikernel/duniverse/arp/arp.opam new file mode 100644 index 00000000..c68575d0 --- /dev/null +++ b/unikernel/duniverse/arp/arp.opam @@ -0,0 +1,37 @@ +version: "4.1.0" +opam-version: "2.0" +maintainer: "Hannes Mehnert " +authors: ["Hannes Mehnert "] +homepage: "https://github.com/mirage/arp" +doc: "https://mirage.github.io/arp/" +dev-repo: "git+https://github.com/mirage/arp.git" +bug-reports: "https://github.com/mirage/arp/issues" +license: "ISC" +depends: [ + "ocaml" {>= "4.06.0"} + "dune" {>= "2.7.0"} + "cstruct" {>= "6.0.0"} + "ipaddr" {>= "4.0.0"} + "macaddr" {>= "4.0.0"} + "logs" + "mirage-sleep" {>= "4.0.0"} + "lru" {>= "0.3.0"} + "lwt" + "duration" + "ethernet" {>= "3.0.0"} + "fmt" {>= "0.8.7"} + "alcotest" {with-test} + "mirage-vnetif" {with-test & >= "0.5.0"} + "bos" {with-test & >= "0.2.1"} +] +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test & os != "macos"} +] +synopsis: "Address Resolution Protocol purely in OCaml" +description: """ +ARP is an implementation of the address resolution protocol (RFC826) purely in +OCaml. It handles IPv4 protocol addresses and Ethernet hardware addresses only. +""" +x-maintenance-intent: [ "(latest)" ] \ No newline at end of file diff --git a/unikernel/duniverse/arp/bench/bench.ml b/unikernel/duniverse/arp/bench/bench.ml new file mode 100644 index 00000000..d791e9fd --- /dev/null +++ b/unikernel/duniverse/arp/bench/bench.ml @@ -0,0 +1,187 @@ +(* derived from ISC-licensed mirage-tcpip/lib_test/test_arp.ml *) + +let count2 = ref 0 + +let generate l = + let buf = Cstruct.create l in + for i = 0 to pred l do + Cstruct.set_uint8 buf i (Random.int 256) + done; + buf + +let hdr buf = + Cstruct.BE.set_uint16 buf 0 1 ; + Cstruct.BE.set_uint16 buf 2 0x0800 ; + Cstruct.set_uint8 buf 4 6 ; + Cstruct.set_uint8 buf 5 4 + +let gen_int () = + let buf = generate 1 in + Cstruct.get_uint8 buf 0 + +let gen_op buf off = + let op = gen_int () in + let op = 1 + op mod 2 in + Cstruct.BE.set_uint16 buf off op + +let gen_arp buf = + hdr buf ; + gen_op buf 6 ; + let addresses = generate 20 in + Cstruct.blit addresses 0 buf 8 20 ; + 28 + +let gen_req buf = + hdr buf ; + Cstruct.BE.set_uint16 buf 6 1 ; + let addresses = generate 20 in + Cstruct.blit addresses 0 buf 8 20 ; + 28 + +let gen_ip () = + let last = generate 1 in + let ip = "\010\000\000" ^ (Cstruct.to_string last) in + Ipaddr.V4.of_octets_exn ip + +let ip = Ipaddr.V4.of_string_exn "10.0.0.0" +let mac = Macaddr.of_string_exn "00:de:ad:be:ef:00" + +let gen_rep buf = + hdr buf ; + Cstruct.BE.set_uint16 buf 6 2 ; + let omac = generate 6 in + Cstruct.blit omac 0 buf 8 6 ; + let oip = gen_ip () in + Cstruct.blit_from_string (Ipaddr.V4.to_octets oip) 0 buf 14 4 ; + Cstruct.blit_from_string (Macaddr.to_octets mac) 0 buf 18 6 ; + Cstruct.blit_from_string (Ipaddr.V4.to_octets ip) 0 buf 24 4 ; + 28 + +let other_ip = Ipaddr.V4.of_string_exn "10.0.0.1" +let other_mac = Macaddr.of_string_exn "00:de:ad:be:ef:01" + +let myreq buf = + hdr buf ; + Cstruct.BE.set_uint16 buf 6 1 ; + Cstruct.blit_from_string (Macaddr.to_octets other_mac) 0 buf 8 6 ; + Cstruct.blit_from_string (Ipaddr.V4.to_octets other_ip) 0 buf 14 4 ; + Cstruct.blit_from_string (Macaddr.to_octets mac) 0 buf 18 6 ; + Cstruct.blit_from_string (Ipaddr.V4.to_octets ip) 0 buf 24 4 ; + 28 + +open Lwt.Infix + +module B = Basic_backend.Make +module V = Vnetif.Make(B) +module E = Ethernet.Make(V) +module A = Arp.Make(E) + +let c = ref 0 +let gen arp buf = + c := !c mod 100 ; + match !c with + | x when x >= 00 && x < 10 -> + let len = gen_int () mod 28 in + let r = generate len in + Cstruct.blit r 0 buf 0 len ; + len + | x when x >= 10 && x < 20 -> gen_req buf + | x when x >= 20 && x < 50 -> myreq buf + | x when x >= 50 && x < 80 -> + if x mod 2 = 0 then + (let rand = gen_int () in + for _i = 0 to rand do + let ip = gen_ip () in + Lwt.async (fun () -> A.query arp ip >|= fun _ -> ()) + done) ; + gen_rep buf + | x when x >= 80 && x < 100 -> gen_arp buf + | _ -> invalid_arg "bla" + +let rec query arp () = + incr count2 ; + let ip = gen_ip () in + Lwt.async (fun () -> A.query arp ip >|= fun _ -> ()); + Mirage_sleep.ns (Duration.of_us 100) >>= fun () -> + query arp () + +type arp_stack = { + backend : B.t; + netif: V.t; + ethif: E.t; + arp: A.t; +} + +let get_arp ?(backend = B.create ~use_async_readers:true + ~yield:(fun() -> Lwt.pause ()) ()) () = + V.connect backend >>= fun netif -> + E.connect netif >>= fun ethif -> + A.connect ethif >>= fun arp -> + Lwt.return { backend; netif; ethif; arp } + +let rec send ethernet gen () = + E.write ethernet Macaddr.broadcast `ARP ~size:Arp_packet.size gen >>= function + | Ok _ -> send ethernet gen () + | Error _ -> Lwt.return_unit + +let header_size = Ethernet.Packet.sizeof_ethernet + +let runit () = + Printf.printf "starting\n%!"; + get_arp () >>= fun stack -> + get_arp ~backend:stack.backend () >>= fun other -> + A.set_ips stack.arp [ip] >>= fun () -> + let count = ref 0 in + Lwt.pick [ + (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ()); + send other.ethif (fun b -> + let res = generate 28 in + Cstruct.blit res 0 b 0 28 ; + 28) () ; + Mirage_sleep.ns (Duration.of_sec 5) + ] >>= fun () -> + Printf.printf "%d random input\n%!" !count ; + count := 0 ; + Lwt.pick [ + (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ()); + send other.ethif gen_arp () ; + Mirage_sleep.ns (Duration.of_sec 5) + ] >>= fun () -> + Printf.printf "%d random ARP input\n%!" !count ; + count := 0 ; + Lwt.pick [ + (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ()); + send other.ethif gen_req () ; + Mirage_sleep.ns (Duration.of_sec 5) + ] >>= fun () -> + Printf.printf "%d requests\n%!" !count ; + count := 0 ; + Lwt.pick [ + (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ()); + send other.ethif gen_rep () ; + Mirage_sleep.ns (Duration.of_sec 5) + ] >>= fun () -> + Printf.printf "%d replies\n%!" !count ; + count := 0 ; + Lwt.pick [ + (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ()); + send other.ethif (gen stack.arp) () ; + Mirage_sleep.ns (Duration.of_sec 5) + ] >>= fun () -> + Printf.printf "%d mixed\n%!" !count ; + count := 0 ; + Lwt.pick [ + (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ()); + send other.ethif gen_rep () ; + query stack.arp () ; + Mirage_sleep.ns (Duration.of_sec 5) + ] >|= fun () -> + Printf.printf "%d queries (%d qs)\n%!" !count !count2 + +let () = + Random.self_init (); + Lwt_main.run (runit ()) ; + count2 := 0 ; + Lwt_main.run (runit ()) ; + count2 := 0 ; + Lwt_main.run (runit ()) diff --git a/unikernel/duniverse/arp/bench/dune b/unikernel/duniverse/arp/bench/dune new file mode 100644 index 00000000..f44fd063 --- /dev/null +++ b/unikernel/duniverse/arp/bench/dune @@ -0,0 +1,3 @@ +(executable + (name bench) + (libraries arp.mirage mirage-vnetif lwt ipaddr ethernet mirage-sleep lwt.unix)) diff --git a/unikernel/duniverse/arp/dune-project b/unikernel/duniverse/arp/dune-project new file mode 100644 index 00000000..f43ed76a --- /dev/null +++ b/unikernel/duniverse/arp/dune-project @@ -0,0 +1,4 @@ +(lang dune 2.7) +(name arp) +(version v4.1.0) +(formatting disabled) diff --git a/unikernel/duniverse/arp/mirage/arp.ml b/unikernel/duniverse/arp/mirage/arp.ml new file mode 100644 index 00000000..3b8521c3 --- /dev/null +++ b/unikernel/duniverse/arp/mirage/arp.ml @@ -0,0 +1,148 @@ +(* + * Copyright (c) 2010-2011 Anil Madhavapeddy + * Copyright (c) 2016 Hannes Mehnert + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) + +module type S = sig + type t + val disconnect : t -> unit Lwt.t + type error = private [> `Timeout ] + val pp_error: error Fmt.t + val pp : t Fmt.t + val get_ips : t -> Ipaddr.V4.t list + val set_ips : t -> Ipaddr.V4.t list -> unit Lwt.t + val remove_ip : t -> Ipaddr.V4.t -> unit Lwt.t + val add_ip : t -> Ipaddr.V4.t -> unit Lwt.t + val query : t -> Ipaddr.V4.t -> (Macaddr.t, error) result Lwt.t + val input : t -> Cstruct.t -> unit Lwt.t +end + +open Lwt.Infix + +let logsrc = Logs.Src.create "ARP" ~doc:"Mirage ARP handler" + +module Make (Ethernet : Ethernet.S) = struct + + type error = [ + | `Timeout + ] + let pp_error ppf = function + | `Timeout -> Fmt.pf ppf "could not determine a link-level address for the IP address given" + + type t = { + mutable state : ((Macaddr.t, error) result Lwt.t * (Macaddr.t, error) result Lwt.u) Arp_handler.t ; + ethif : Ethernet.t ; + mutable ticking : bool ; + } + + let probe_repeat_delay = Duration.of_ms 1500 (* per rfc5227, 2s >= probe_repeat_delay >= 1s *) + + let output t (arp, destination) = + let size = Arp_packet.size in + Ethernet.write t.ethif destination `ARP ~size + (fun b -> Arp_packet.encode_into arp b ; size) >|= function + | Ok () -> () + | Error e -> + Logs.warn ~src:logsrc + (fun m -> m "error %a while outputting packet %a to %a" + Ethernet.pp_error e Arp_packet.pp arp Macaddr.pp destination) + + let rec tick ~probe_delay t () = + if t.ticking then + Mirage_sleep.ns probe_delay >>= fun () -> + let state, requests, timeouts = Arp_handler.tick t.state in + t.state <- state ; + Lwt_list.iter_p (output t) requests >>= fun () -> + List.iter (fun (_, u) -> Lwt.wakeup u (Error `Timeout)) timeouts ; + tick ~probe_delay t () + else + Lwt.return_unit + + let pp ppf t = Arp_handler.pp ppf t.state + + let input t frame = + let state, out, wake = Arp_handler.input t.state frame in + t.state <- state ; + (match out with + | None -> Lwt.return_unit + | Some pkt -> output t pkt) >|= fun () -> + match wake with + | None -> () + | Some (mac, (_, u)) -> Lwt.wakeup u (Ok mac) + + let get_ips t = Arp_handler.ips t.state + + let create ?ipaddr t = + let mac = Arp_handler.mac t.state in + let state, out = Arp_handler.create ~logsrc ?ipaddr mac in + t.state <- state ; + match out with + | None -> Lwt.return_unit + | Some x -> output t x + + let add_ip t ipaddr = + match Arp_handler.ips t.state with + | [] -> create ~ipaddr t + | _ -> + let state, out, wake = Arp_handler.alias t.state ipaddr in + t.state <- state ; + output t out >|= fun () -> + match wake with + | None -> () + | Some (_, u) -> Lwt.wakeup u (Ok (Arp_handler.mac t.state)) + + let init_empty mac = + let state, _ = Arp_handler.create ~logsrc mac in + state + + let set_ips t = function + | [] -> + let mac = Arp_handler.mac t.state in + let state = init_empty mac in + t.state <- state ; + Lwt.return_unit + | ipaddr::xs -> + create ~ipaddr t >>= fun () -> + Lwt_list.iter_s (add_ip t) xs + + let remove_ip t ip = + let state = Arp_handler.remove t.state ip in + t.state <- state ; + Lwt.return_unit + + let query t ip = + let merge = function + | None -> Lwt.wait () + | Some a -> a + in + let state, res = Arp_handler.query t.state ip merge in + t.state <- state ; + match res with + | Arp_handler.RequestWait (pkt, (tr, _)) -> output t pkt >>= fun () -> tr + | Arp_handler.Wait (t, _) -> t + | Arp_handler.Mac mac -> Lwt.return (Ok mac) + + let connect ?(probe_delay = probe_repeat_delay) ethif = + let mac = Ethernet.mac ethif in + let state = init_empty mac in + let t = { ethif; state; ticking = true} in + Lwt.async (tick ~probe_delay t); + Lwt.return t + + let disconnect t = + t.ticking <- false ; + Lwt.return_unit +end diff --git a/unikernel/duniverse/arp/mirage/arp.mli b/unikernel/duniverse/arp/mirage/arp.mli new file mode 100644 index 00000000..48fc810c --- /dev/null +++ b/unikernel/duniverse/arp/mirage/arp.mli @@ -0,0 +1,72 @@ +(* + * Copyright (c) 2010-2011 Anil Madhavapeddy + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) + +(** {2 ARP} *) + +(** Address resolution protocol, translating network addresses (e.g. IPv4) + into link layer addresses (MAC). *) +module type S = sig + type t + (** The type representing the internal state of the ARP layer. *) + + val disconnect: t -> unit Lwt.t + (** Disconnect from the ARP layer. While this might take some time to + complete, it can never result in an error. *) + + type error = private [> `Timeout ] + (** The type for ARP errors. *) + + val pp_error: error Fmt.t + (** [pp_error] is the pretty-printer for errors. *) + + (** Prettyprint cache contents *) + val pp : t Fmt.t + + (** [get_ips arp] gets the bound IP address list in the [arp] + value. *) + val get_ips : t -> Ipaddr.V4.t list + + (** [set_ips arp] sets the bound IP address list, which will transmit a + GARP packet also. *) + val set_ips : t -> Ipaddr.V4.t list -> unit Lwt.t + + (** [remove_ip arp ip] removes [ip] to the bound IP address list in + the [arp] value, which will transmit a GARP packet for any remaining IPs in + the bound IP address list after the removal. *) + val remove_ip : t -> Ipaddr.V4.t -> unit Lwt.t + + (** [add_ip arp ip] adds [ip] to the bound IP address list in the + [arp] value, which will transmit a GARP packet also. *) + val add_ip : t -> Ipaddr.V4.t -> unit Lwt.t + + (** [query arp ip] queries the cache in [arp] for an ARP entry + corresponding to [ip], which may result in the sender sleeping + waiting for a response. *) + val query : t -> Ipaddr.V4.t -> (Macaddr.t, error) result Lwt.t + + (** [input arp frame] will handle an ARP frame. If it is a response, + it will update its cache, otherwise will try to satisfy the + request. *) + val input : t -> Cstruct.t -> unit Lwt.t +end + + +module Make (Ethernet : Ethernet.S) : sig + include S + + val connect : ?probe_delay:int64 -> Ethernet.t -> t Lwt.t +end diff --git a/unikernel/duniverse/arp/mirage/dune b/unikernel/duniverse/arp/mirage/dune new file mode 100644 index 00000000..74087560 --- /dev/null +++ b/unikernel/duniverse/arp/mirage/dune @@ -0,0 +1,5 @@ +(library + (name arp_mirage) + (public_name arp.mirage) + (wrapped false) + (libraries arp ethernet mirage-sleep lwt logs duration)) diff --git a/unikernel/duniverse/arp/src/arp_handler.ml b/unikernel/duniverse/arp/src/arp_handler.ml new file mode 100644 index 00000000..d92cd0a8 --- /dev/null +++ b/unikernel/duniverse/arp/src/arp_handler.ml @@ -0,0 +1,281 @@ + +type 'a entry = + | Static of Macaddr.t * bool + | Dynamic of Macaddr.t * int + | Pending of 'a * int + +module M = struct + module M = Map.Make(Ipaddr.V4) + module Present = struct + type t = unit + let weight (_: t) = 1 + end + module LRU = Lru.F.Make(Ipaddr.V4)(Present) + + type 'a t = + { map: 'a entry M.t + ; mutable dynamic_lru: LRU.t + } + + let empty capacity = + { map = M.empty; dynamic_lru = LRU.empty capacity } + + let fold f t init = + M.fold f t.map init + + let cardinal t = M.cardinal t.map + + let iter f t = M.iter f t.map + + let find k t = + let v = M.find k t.map in + t.dynamic_lru <- LRU.promote k t.dynamic_lru; + v + + let add k v t = + let map = M.add k v t.map + and dynamic_lru = match v with + | Dynamic _ -> LRU.add k () t.dynamic_lru + | _ -> LRU.remove k t.dynamic_lru + in + let map, dynamic_lru = + if LRU.weight t.dynamic_lru > LRU.capacity t.dynamic_lru then begin + match LRU.pop_lru t.dynamic_lru with + | Some ((drop, ()), dynamic_lru) -> + M.remove drop t.map, dynamic_lru + | None -> map, dynamic_lru + end else + map, dynamic_lru + in + { map; dynamic_lru } + + let remove k t = + { map = M.remove k t.map; dynamic_lru = LRU.remove k t.dynamic_lru } +end + +type 'a t = { + cache : 'a M.t; + mac : Macaddr.t ; + ip : Ipaddr.V4.t ; + timeout : int ; + retries : int ; + epoch : int ; + logsrc : Logs.src +} + +let ips t = + M.fold (fun ip entry acc -> match entry with + | Static (_, true) -> ip :: acc + | _ -> acc) + t.cache [] + +let mac t = t.mac + +let[@coverage off] pp_entry now k pp = + function + | Static (m, adv) -> + let adv = if adv then " advertising" else "" in + Format.fprintf pp "%a at %a (static%s)" Ipaddr.V4.pp k Macaddr.pp m adv + | Dynamic (m, t) -> + Format.fprintf pp "%a at %a (timeout in %d)" Ipaddr.V4.pp k + Macaddr.pp m (t - now) + | Pending (_, retries) -> + Format.fprintf pp "%a (incomplete, %d retries left)" + Ipaddr.V4.pp k (retries - now) + +let[@coverage off] pp pp t = + Format.fprintf pp "mac %a ip %a entries %d timeout %d retries %d@." + Macaddr.pp t.mac + Ipaddr.V4.pp t.ip + (M.cardinal t.cache) + t.timeout t.retries ; + M.iter (fun k v -> pp_entry t.epoch k pp v ; Format.pp_print_space pp ()) t.cache + +let pending t ip = + match M.find ip t.cache with + | exception Not_found -> None + | Pending (a, _) -> Some a + | _ -> None + +let mac0 = Macaddr.of_octets_exn (String.make 6 '\000') + +let alias t ip = + let cache = M.add ip (Static (t.mac, true)) t.cache in + (* see RFC5227 Section 3 why we send out an ARP request *) + let garp = Arp_packet.({ + operation = Request ; + source_mac = t.mac ; + target_mac = mac0 ; + source_ip = ip ; target_ip = ip }) + in + Logs.info ~src:t.logsrc + (fun pp -> pp "Sending gratuitous ARP for %a (%a)" + Ipaddr.V4.pp ip Macaddr.pp t.mac) ; + { t with cache }, (garp, Macaddr.broadcast), pending t ip + +let create ?(cache_size=1024) ?(timeout = 800) ?(retries = 5) + ?(logsrc = Logs.Src.create "arp" ~doc:"ARP handler") + ?ipaddr + mac = + if timeout <= 0 then + invalid_arg "timeout must be strictly positive" ; + if retries < 0 then + invalid_arg "retries must be positive" ; + let cache = M.empty cache_size in + let ip = match ipaddr with None -> Ipaddr.V4.any | Some x -> x in + let t = { cache ; mac ; ip ; timeout ; retries ; epoch = 0 ; logsrc } in + match ipaddr with + | None -> t, None + | Some ip -> + let t, garp, _ = alias t ip in + t, Some garp + +let static t ip mac = + let cache = M.add ip (Static (mac, false)) t.cache in + { t with cache }, pending t ip + +let remove t ip = + let cache = M.remove ip t.cache in + { t with cache } + +let in_cache t ip = + match M.find ip t.cache with + | exception Not_found -> None + | Pending _ -> None + | Static (m, _) -> Some m + | Dynamic (m, _) -> Some m + +let request t ip = + let target = Macaddr.broadcast in + let request = { + Arp_packet.operation = Arp_packet.Request ; + source_mac = t.mac ; source_ip = t.ip ; + target_mac = target ; target_ip = ip + } + in + request, target + +let reply arp m = + let reply = { + Arp_packet.operation = Arp_packet.Reply ; + source_mac = m ; source_ip = arp.Arp_packet.target_ip ; + target_mac = arp.Arp_packet.source_mac ; target_ip = arp.Arp_packet.source_ip ; + } in + reply, arp.Arp_packet.source_mac + +let tick t = + let epoch = t.epoch in + let entry k v (cache, acc, r) = match v with + | Dynamic (m, tick) when tick = epoch -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "removing ARP entry %a (mac %a)" + Ipaddr.V4.pp k Macaddr.pp m) ; + M.remove k cache, acc, r + | Dynamic (_, tick) when tick = succ epoch -> + cache, request t k :: acc, r + | Pending (a, retry) when retry = epoch -> + Logs.info ~src:t.logsrc + (fun pp -> pp "ARP timeout after %d retries for %a" + t.retries Ipaddr.V4.pp k) ; + M.remove k cache, acc, a :: r + | Pending _ -> cache, request t k :: acc, r + | _ -> cache, acc, r + in + let cache, outs, r = M.fold entry t.cache (t.cache, [], []) in + { t with cache ; epoch = succ epoch }, outs, r + +let handle_reply t source mac = + let extcache = + let cache = M.add source (Dynamic (mac, t.epoch + t.timeout)) t.cache in + { t with cache } + in + match M.find source t.cache with + | exception Not_found -> + t, None, None + | Static (_, adv) -> + if adv && Macaddr.compare mac mac0 = 0 then + Logs.info ~src:t.logsrc + (fun pp -> + pp "ignoring gratuitous ARP from %a using my IP address %a" + Macaddr.pp mac Ipaddr.V4.pp source)[@coverage off] + else + Logs.info ~src:t.logsrc + (fun pp -> + pp "ignoring ARP reply for %a (static %sarp entry in cache)" + Ipaddr.V4.pp source (if adv then "advertised " else "")) + [@coverage off] ; + t, None, None + | Dynamic (m, _) -> + if Macaddr.compare mac m <> 0 then + Logs.warn ~src:t.logsrc + (fun pp -> pp "ARP for %a moved from %a to %a" + Ipaddr.V4.pp source + Macaddr.pp m + Macaddr.pp mac) ; + extcache, None, None + | Pending (xs, _) -> extcache, None, Some (mac, xs) + + +let handle_request t arp = + let dest = arp.Arp_packet.target_ip + and source = arp.Arp_packet.source_ip + in + match M.find dest t.cache with + | exception Not_found -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "ignoring ARP request for %a from %a (mac %a)" + Ipaddr.V4.pp dest + Ipaddr.V4.pp source + Macaddr.pp arp.Arp_packet.source_mac) ; + t, None, None + | Static (m, true) -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "replying to ARP request for %a from %a (mac %a)" + Ipaddr.V4.pp dest + Ipaddr.V4.pp source + Macaddr.pp arp.Arp_packet.source_mac) ; + t, Some (reply arp m), None + | _ -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "ignoring ARP request for %a from %a (mac %a)" + Ipaddr.V4.pp dest + Ipaddr.V4.pp source + Macaddr.pp arp.Arp_packet.source_mac) + [@coverage off] ; + t, None, None + +let input t buf = + match Arp_packet.decode buf with + | Error e -> + Logs.info ~src:t.logsrc + (fun pp -> pp "Failed to parse ARP frame %a" Arp_packet.pp_error e) ; + t, None, None + | Ok arp -> + if + Ipaddr.V4.compare arp.Arp_packet.source_ip arp.Arp_packet.target_ip = 0 || + arp.Arp_packet.operation = Arp_packet.Reply + then + let mac = arp.Arp_packet.source_mac + and source = arp.Arp_packet.source_ip + in + handle_reply t source mac + else (* must be a request *) + handle_request t arp + +type 'a qres = + | Mac of Macaddr.t + | Wait of 'a + | RequestWait of (Arp_packet.t * Macaddr.t) * 'a + +let query t ip a = + match M.find ip t.cache with + | exception Not_found -> + let a = a None in + let cache = M.add ip (Pending (a, t.epoch + t.retries)) t.cache in + { t with cache }, RequestWait (request t ip, a) + | Pending (x, r) -> + let a = a (Some x) in + let cache = M.add ip (Pending (a, r)) t.cache in + { t with cache }, Wait a + | Static (m, _) -> t, Mac m + | Dynamic (m, _) -> t, Mac m diff --git a/unikernel/duniverse/arp/src/arp_handler.mli b/unikernel/duniverse/arp/src/arp_handler.mli new file mode 100644 index 00000000..15857a64 --- /dev/null +++ b/unikernel/duniverse/arp/src/arp_handler.mli @@ -0,0 +1,120 @@ +(** Protocol handler for the Address Resolution Protocol + + This library provides a pure implementation of ARP, which handles only IPv4 + addresses as protocol and Ethernet (MAC) addresses as hardware. This is the + most common usage of ARP currently. There is no support for other types of + addresses. ARP is initially specified in + {{:https://tools.ietf.org/html/rfc826}, RFC826}, and further refined in + {{:https://tools.ietf.org/html/rfc1122}, RFC1122} and partially + {{:https://tools.ietf.org/html/rfc5227}, RFC5227}. + + The ARP handler consists of a cache, which maps IPv4 addresses to Ethernet + addresses, and access to it. Its configuration is set during + {{!create}construction}, together with the own IPv4 address and Ethernet + address. The cache can be modified with {{!static}static} entries of other + hosts, {{!alias}IPv4 aliases}, {{!remove}removal} of entries. Outgoing + frames always use its {{!ip}main IPv4 address}. Whether an entry + {{!in_cache}is available} or not can be inspected. + + The ARP handler can process {{!input}network input}, which may extend the + cache with dynamic ARP entries which time out after the configured period. + Periodic calls to {!tick} are required for the timeout and retry mechanisms. + Since ARP usually uses network communication, callers may {!query} the cache + and wait until either a response was received or a timeout occured after + several retries. + + The embedded merge strategy is simple: static entries always win (and thus, + both {!alias} and {!static} overwrite existing entries). Log messages at + the are generated if an ARP reply wants to overwrite a static entry, or the + Ethernet address of a dynamic entry changed. + + ARP frames which should be send on the wire are given as a pair of buffer + and destination address, to be passed to the underlying layer (usually + Ethernet). When adding entries, gratuitous ARP frames are to be sent. + + While the {!Arp_packet} module is exposed, for normal operation it is not + needed, but this module should be sufficient. + + {e v4.1.0 - {{:https://github.com/mirage/arp }homepage}} +*) + + +(** The type of an ARP handler. It is polymorphic over the tasks waiting for + an ARP reply. *) +type 'a t + +(** {2 Constructor} *) + +(** [create ~cache_size ~timeout ~retries ~ipaddr mac)] is [t, garp]. The constructor of + the ARP handler, specifying timeouts (defaults to 800) and amount of + retries (defaults to 5). If [ipaddr] is provided, a gratuitous ARP + request will be encoded in [garp], otherwise {!Ipaddr.V4.any} is temporarily + used and [garp] is [None]. The value of [timeout] is the number of + [Tick] events. + [cache_size] limits the number of dynamic entries in the ARP cache. + + @raise Invalid_argument is [timeout] is 0 or negative or [retries] is + negative. *) +val create : ?cache_size: int -> ?timeout:int -> ?retries:int -> ?logsrc:Logs.src -> + ?ipaddr:Ipaddr.V4.t -> Macaddr.t -> 'a t * (Arp_packet.t * Macaddr.t) option + +(** [pp ppf t] prints the ARP handler [t] on [ppf] by iterating over all cache + entries. *) +val pp : Format.formatter -> 'a t -> unit + +(** {2 Predicates} *) + +(** [ips t] is [ips], the advertised IPv4 addresses. *) +val ips : 'a t -> Ipaddr.V4.t list + +(** [mac t] is [mac], the mac address used by the ARP handler. *) +val mac : 'a t -> Macaddr.t + +(** [in_cache t ip] is [mac option], a MAC address if the ARP cache contains an + entry, [None] otherwise. *) +val in_cache : 'a t -> Ipaddr.V4.t -> Macaddr.t option + +(** {2 Operations on the cache} *) + +(** [static t ip mac] is [t', as], where [t'] is [t] extended with a static ARP + entry using the given [ip] and [mac]. The tasks waiting for [ip] are + [as]. *) +val static : 'a t -> Ipaddr.V4.t -> Macaddr.t -> 'a t * 'a option + +(** [alias t ip] is [t', out, as], where [t'] is [t] extended by a static ARP + entry for [ip]. This entry will be used to answer further ARP requests. + [out] is a gratuitous ARP frame. The tasks waiting for [ip] are [as]. *) +val alias : 'a t -> Ipaddr.V4.t -> 'a t * (Arp_packet.t * Macaddr.t) * 'a option + +(** [remove t ip] is [t'], where [ip] is no longer in the cache. *) +val remove : 'a t -> Ipaddr.V4.t -> 'a t + +(** {2 Events} *) + +(** [tick t] is [t', requests, timeouts], which advances the state [t] into + [t']. Possibly retransmissions of ARP requests need to be done, provided in + the [requests] list. Timed out queries are in the [timeouts] list. *) +val tick : 'a t -> 'a t * (Arp_packet.t * Macaddr.t) list * 'a list + +(** [input t buf] is [t', reply, w], which handles the input buffer [buf] in the + state [t]. The state is transformed into [t']. If it was an ARP request + for one of our IPv4 addresses, an ARP reply should be send out [reply]. If + the input was an awaited ARP reply, some elements [w] can be informed. *) +val input : 'a t -> Cstruct.t -> + ('a t * (Arp_packet.t * Macaddr.t) option * (Macaddr.t * 'a) option) + +(** The type returned by query, either a [Mac] and a mac address, or [Wait] for + a reply, or [RequestWait], consisting of an ARP request to be send on the wire, + and await its answer. *) +type 'a qres = + | Mac of Macaddr.t + | Wait of 'a + | RequestWait of (Arp_packet.t * Macaddr.t) * 'a + +(** [query t ip merge] is [t', qres], which looks for the [ip] in the cache. If + it is found, its value is [Mac mac]. If the [ip] is not in the cache, + either some ['a] is waiting for it already, then the value is [Wait a], + where [a] is produced by applying [merge (Some 'a)] to the waiting thing. + Otherwise, both an ARP request needs to be send out, and the value of + [merge None] is put into the cache, both as part of [RequestWait]. *) +val query : 'a t -> Ipaddr.V4.t -> ('a option -> 'a) -> 'a t * 'a qres diff --git a/unikernel/duniverse/arp/src/arp_packet.ml b/unikernel/duniverse/arp/src/arp_packet.ml new file mode 100644 index 00000000..9fd07b74 --- /dev/null +++ b/unikernel/duniverse/arp/src/arp_packet.ml @@ -0,0 +1,114 @@ +(* based on ISC-licensed mirage-tcpip module *) + +type op = + | Request + | Reply + +let op_to_int = function Request -> 1 | Reply -> 2 +let int_to_op = function 1 -> Some Request | 2 -> Some Reply | _ -> None + +(* ARP packet contains: + 16 bit hardware type = ethernet = 0x01 + 16 bit protocol type = ipv4 = 0x0800 + 8 bit hardware address length = 6 + 8 bit protocol address length = 4 + 16 bit operation + sender hardware address = 6 byte + sender protocol address = 4 byte + target hardware address = 6 byte + target protocol address = 4 byte + *) + +type t = { + operation : op; + source_mac : Macaddr.t; + source_ip : Ipaddr.V4.t; + target_mac : Macaddr.t; + target_ip : Ipaddr.V4.t; +} + +let equal a b = + op_to_int a.operation = op_to_int b.operation && + Macaddr.compare a.source_mac b.source_mac = 0 && + Ipaddr.V4.compare a.source_ip b.source_ip = 0 && + Macaddr.compare a.target_mac b.target_mac = 0 && + Ipaddr.V4.compare a.target_ip b.target_ip = 0 + +type error = + | Too_short + | Unusable + | Unknown_operation of Cstruct.uint16 + +let[@coverage off] pp fmt t = + if t.operation = Request then + Format.fprintf fmt "ARP request from %a to %a, who has %a tell %a" + Macaddr.pp t.source_mac Macaddr.pp t.target_mac + Ipaddr.V4.pp t.target_ip Ipaddr.V4.pp t.source_ip + else (* t.op = Reply *) + Format.fprintf fmt "ARP reply from %a to %a, %a is at %a" + Macaddr.pp t.source_mac Macaddr.pp t.target_mac + Ipaddr.V4.pp t.source_ip Macaddr.pp t.source_mac + +let[@coverage off] pp_error ppf = function + | Too_short -> Format.pp_print_string ppf "frame too short (below 28 bytes)" + | Unusable -> Format.pp_print_string ppf "ARP address types are not IPv4 and Ethernet" + | Unknown_operation i -> Format.fprintf ppf "ARP message has unsupported operation %d" i + +(* may be defined elsewhere *) +let ipv4_ethertype = 0x0800 +and ipv4_size = 4 +and ether_htype = 1 +and ether_size = 6 +and size = 28 + +let guard p e = if p then Ok () else Error e + +let (>>=) x f = match x with + | Ok y -> f y + | Error e -> Error e + +let decode buf = + let check_len buf = Cstruct.length buf >= size in + let check_hdr buf = + Cstruct.BE.get_uint16 buf 0 = ether_htype && + Cstruct.BE.get_uint16 buf 2 = ipv4_ethertype && + Cstruct.get_uint8 buf 4 = ether_size && + Cstruct.get_uint8 buf 5 = ipv4_size + in + guard (check_len buf) Too_short >>= fun () -> + guard (check_hdr buf) Unusable >>= fun () -> + let op = Cstruct.BE.get_uint16 buf 6 in + match int_to_op op with + | None -> Error (Unknown_operation op) + | Some operation -> + let source_mac = Macaddr.of_octets_exn (Cstruct.to_string (Cstruct.sub buf 8 6)) + and target_mac = Macaddr.of_octets_exn (Cstruct.to_string (Cstruct.sub buf 18 6)) + and source_ip = Ipaddr.V4.of_int32 (Cstruct.BE.get_uint32 buf 14) + and target_ip = Ipaddr.V4.of_int32 (Cstruct.BE.get_uint32 buf 24) in + Ok { + operation ; + source_mac; source_ip ; + target_mac; target_ip + } + +let hdr = + let buf = Cstruct.create 6 in + Cstruct.BE.set_uint16 buf 0 ether_htype; + Cstruct.BE.set_uint16 buf 2 ipv4_ethertype; + Cstruct.set_uint8 buf 4 ether_size; + Cstruct.set_uint8 buf 5 ipv4_size; + buf + +let encode_into t buf = + Cstruct.blit hdr 0 buf 0 6 ; + Cstruct.BE.set_uint16 buf 6 (op_to_int t.operation) ; + Cstruct.blit_from_string (Macaddr.to_octets t.source_mac) 0 buf 8 6 ; + Cstruct.BE.set_uint32 buf 14 (Ipaddr.V4.to_int32 t.source_ip) ; + Cstruct.blit_from_string (Macaddr.to_octets t.target_mac) 0 buf 18 6 ; + Cstruct.BE.set_uint32 buf 24 (Ipaddr.V4.to_int32 t.target_ip) + [@@inline] + +let encode t = + let buf = Cstruct.create_unsafe size in + encode_into t buf; + buf diff --git a/unikernel/duniverse/arp/src/arp_packet.mli b/unikernel/duniverse/arp/src/arp_packet.mli new file mode 100644 index 00000000..7d06076f --- /dev/null +++ b/unikernel/duniverse/arp/src/arp_packet.mli @@ -0,0 +1,61 @@ +(** Conversion between wire and high-level data + + The {{!t}high-level datatype} can be decoded and encoded to bytes to be sent + on the wire. ARP specifies hardware and protocol addresses, but this + implementation picks Ethernet and IPv4 statically. While decoding can result + in an error, encoding can not. *) + +type op = + | Request + | Reply + +val op_to_int : op -> int +val int_to_op : int -> op option + +(** The high-level ARP frame consisting of the two address pairs and an operation. *) +type t = { + operation : op; + source_mac : Macaddr.t; + source_ip : Ipaddr.V4.t; + target_mac : Macaddr.t; + target_ip : Ipaddr.V4.t; +} + +(** [size] is the size of an ARP frame. *) +val size : int + +(** [pp ppf t] prints the frame [t] on [ppf]. *) +val pp : Format.formatter -> t -> unit + +(** [equal a b] returns [true] if frames [a] and [b] are equal, [false] otherwise. *) +val equal : t -> t -> bool + +(** The type of possible errors during decoding + + - [Too_short] if the provided buffer is not long enough + - [Unusable] if the protocol or hardware address type is not IPv4 and Ethernet + - [Unknown_operation] if it is neither a request nor a reply + *) +type error = + | Too_short + | Unusable + | Unknown_operation of Cstruct.uint16 + +(** [pp_error ppf err] prints the error [err] on [ppf]. *) +val pp_error : Format.formatter -> error -> unit + +(** {2 Decoding} *) + +(** [decode buf] attempts to decode the buffer into an ARP frame [t]. *) +val decode : Cstruct.t -> (t, error) result + +(** {2 Encoding} *) + +(** [encode t] is a [buf], a freshly allocated buffer, which contains the + encoded ARP frame [t]. *) +val encode : t -> Cstruct.t + +(** [encode_into t buf] encodes [t] into the buffer [buf] at offset 0. + + @raise Invalid_argument if the buffer [buf] is too small (below 28 bytes). *) +val encode_into : t -> Cstruct.t -> unit diff --git a/unikernel/duniverse/arp/src/dune b/unikernel/duniverse/arp/src/dune new file mode 100644 index 00000000..9c5de72e --- /dev/null +++ b/unikernel/duniverse/arp/src/dune @@ -0,0 +1,8 @@ +(library + (name arp) + (synopsis "Address Resolution Protocol purely in OCaml") + (public_name arp) + (wrapped false) + (instrumentation + (backend bisect_ppx)) + (libraries cstruct logs ipaddr macaddr fmt lru)) diff --git a/unikernel/duniverse/arp/test/dune b/unikernel/duniverse/arp/test/dune new file mode 100644 index 00000000..8cd25fb2 --- /dev/null +++ b/unikernel/duniverse/arp/test/dune @@ -0,0 +1,4 @@ +(test + (name tests) + (package arp) + (libraries arp macaddr cstruct alcotest)) diff --git a/unikernel/duniverse/arp/test/mirage/dune b/unikernel/duniverse/arp/test/mirage/dune new file mode 100644 index 00000000..325aa07b --- /dev/null +++ b/unikernel/duniverse/arp/test/mirage/dune @@ -0,0 +1,5 @@ +(test + (name tests) + (package arp) + (libraries alcotest lwt.unix logs logs.fmt fmt mirage-vnetif + duration ethernet arp arp.mirage cstruct bos)) diff --git a/unikernel/duniverse/arp/test/mirage/tests.ml b/unikernel/duniverse/arp/test/mirage/tests.ml new file mode 100644 index 00000000..3980772c --- /dev/null +++ b/unikernel/duniverse/arp/test/mirage/tests.ml @@ -0,0 +1,530 @@ +open Lwt.Infix + +module B = Basic_backend.Make +module V = Vnetif.Make(B) +module E = Ethernet.Make(V) +module A = Arp.Make(E) + +let src = Logs.Src.create "test_arp" ~doc:"Mirage ARP tester" +module Log = (val Logs.src_log src : Logs.LOG) + +type arp_stack = { + backend : B.t; + netif: V.t; + ethif: E.t; + arp: A.t; +} + +let first_ip = Ipaddr.V4.of_string_exn "192.168.3.1" +let second_ip = Ipaddr.V4.of_string_exn "192.168.3.10" +let sample_mac = Macaddr.of_string_exn "10:9a:dd:c0:ff:ee" + +let packet = (module Arp_packet : Alcotest.TESTABLE with type t = Arp_packet.t) + +let ip = + let module M = struct + type t = Ipaddr.V4.t + let pp = Ipaddr.V4.pp + let equal p q = (Ipaddr.V4.compare p q) = 0 + end in + (module M : Alcotest.TESTABLE with type t = M.t) + +let macaddr = + let module M = struct + type t = Macaddr.t + let pp = Macaddr.pp + let equal p q = (Macaddr.compare p q) = 0 + end in + (module M : Alcotest.TESTABLE with type t = M.t) + +let header_size = Ethernet.Packet.sizeof_ethernet +let size = Arp_packet.size + +let check_header ~message expected actual = + Alcotest.(check packet) message expected actual + +let fail = Alcotest.fail +let failf fmt = Fmt.kstr (fun s -> Alcotest.fail s) fmt + +let timeout ~time t = + let msg = Printf.sprintf "Timed out: didn't complete in %d milliseconds" time in + Lwt.pick [ t; Mirage_sleep.ns (Duration.of_ms time) >>= fun () -> fail msg; ] + +let check_response expected buf = + match Arp_packet.decode buf with + | Error s -> Alcotest.fail (Fmt.to_to_string Arp_packet.pp_error s) + | Ok actual -> + Alcotest.(check packet) "parsed packet comparison" expected actual + +let check_ethif_response expected buf = + let open Ethernet.Packet in + match of_cstruct buf with + | Error s -> Alcotest.fail s + | Ok ({ethertype; _}, arp) -> + match ethertype with + | `ARP -> check_response expected arp + | _ -> Alcotest.fail "Ethernet packet with non-ARP ethertype" + +let garp source_mac source_ip = + let open Arp_packet in + { + operation = Request; + source_mac; + target_mac = Macaddr.of_octets_exn "\000\000\000\000\000\000"; + source_ip; + target_ip = source_ip; + } + +let fail_on_receipt netif buf = + Alcotest.fail (Format.asprintf "received traffic when none was expected on interface %a: %a" + Macaddr.pp (V.mac netif) Cstruct.hexdump_pp buf) + +let single_check netif expected = + V.listen netif ~header_size (fun buf -> + match Ethernet.Packet.of_cstruct buf with + | Error _ -> failwith "sad face" + | Ok (_, payload) -> + check_response expected payload; V.disconnect netif) >|= fun _ -> () + +(* { Ethernet_packet.source = arp.source_mac; + destination = arp.target_mac; + ethertype = `ARP; + } *) + +let arp_reply ~from_netif ~to_netif ~from_ip ~to_ip arp = + let open Arp_packet in + let a = + { operation = Reply; + source_mac = V.mac from_netif; + target_mac = V.mac to_netif; + source_ip = from_ip; + target_ip = to_ip} + in + encode_into a arp ; + Arp_packet.size + +let arp_request ~from_netif ~to_mac ~from_ip ~to_ip arp = + let open Arp_packet in + let a = + { operation = Request; + source_mac = V.mac from_netif; + target_mac = to_mac; + source_ip = from_ip; + target_ip = to_ip} + in + encode_into a arp ; + Arp_packet.size + +let get_arp ?backend () = + let backend = match backend with + | None -> B.create ~use_async_readers:true ~yield:Lwt.pause () + | Some b -> b + in + V.connect backend >>= fun netif -> + E.connect netif >>= fun ethif -> + A.connect ~probe_delay:(Duration.of_ms 2) ethif >>= fun arp -> + Lwt.return { backend; netif; ethif; arp } + +(* we almost always want two stacks on the same backend *) +let two_arp () = + get_arp () >>= fun first -> + get_arp ~backend:first.backend () >>= fun second -> + Lwt.return (first, second) + +(* ...but sometimes we want three *) +let three_arp () = + get_arp () >>= fun first -> + get_arp ~backend:first.backend () >>= fun second -> + get_arp ~backend:first.backend () >>= fun third -> + Lwt.return (first, second, third) + +let query_or_die arp ip expected_mac = + A.query arp ip >>= function + | Error `Timeout -> + Log.warn (fun f -> f "Timeout querying %a. Table contents: %a" + Ipaddr.V4.pp ip A.pp arp); + fail "ARP query failed when success was mandatory"; + | Ok mac -> + Alcotest.(check macaddr) "mismatch for expected query value" expected_mac mac; + Lwt.return_unit + | Error e -> failf "ARP query failed with %a" A.pp_error e + +let query_and_no_response arp ip = + A.query arp ip >>= function + | Error `Timeout -> + Log.warn (fun f -> f "Timeout querying %a. Table contents: %a" Ipaddr.V4.pp ip A.pp arp); + Lwt.return_unit + | Ok _ -> failf "expected nothing, found something in cache" + | Error e -> + Log.err (fun m -> m "another err"); + failf "ARP query failed with %a" A.pp_error e + +let set_and_check ~listener ~claimant ip = + A.set_ips claimant.arp [ ip ] >>= fun () -> + Log.debug (fun f -> f "Set IP for %a to %a" Macaddr.pp (V.mac claimant.netif) Ipaddr.V4.pp ip); + Logs.debug (fun f -> f "Listener table contents after IP set on claimant: %a" A.pp listener); + query_or_die listener ip (V.mac claimant.netif) + +let start_arp_listener stack () = + let noop = (fun _ -> Lwt.return_unit) in + Log.debug (fun f -> f "starting arp listener for %a" Macaddr.pp (V.mac stack.netif)); + let arpv4 frame = + Log.debug (fun f -> f "frame received for arpv4"); + A.input stack.arp frame + in + E.input ~arpv4 ~ipv4:noop ~ipv6:noop stack.ethif + +let not_in_cache ~listen probe arp ip = + Lwt.pick [ + single_check listen probe; + Mirage_sleep.ns (Duration.of_ms 100) >>= fun () -> + A.query arp ip >>= function + | Ok _ -> failf "entry in cache when it shouldn't be %a" Ipaddr.V4.pp ip + | Error `Timeout -> Lwt.return_unit + | Error e -> failf "error for %a while reading the cache: %a" + Ipaddr.V4.pp ip A.pp_error e + ] + +let set_ip_sends_garp () = + two_arp () >>= fun (speak, listen) -> + let emit_garp = + Mirage_sleep.ns (Duration.of_ms 100) >>= fun () -> + A.set_ips speak.arp [ first_ip ] >>= fun () -> + Alcotest.(check (list ip)) "garp emitted when setting ip" [ first_ip ] (A.get_ips speak.arp); + Lwt.return_unit + in + let expected_garp = garp (V.mac speak.netif) first_ip in + timeout ~time:500 ( + Lwt.join [ + single_check listen.netif expected_garp; + emit_garp; + ]) >>= fun () -> + (* now make sure we have consistency when setting *) + A.set_ips speak.arp [] >>= fun () -> + Alcotest.(check (slist ip Ipaddr.V4.compare)) "list of bound IPs on initialization" [] (A.get_ips speak.arp); + A.set_ips speak.arp [ first_ip; second_ip ] >>= fun () -> + Alcotest.(check (slist ip Ipaddr.V4.compare)) "list of bound IPs after setting two IPs" + [ first_ip; second_ip ] (A.get_ips speak.arp); + Lwt.return_unit + +let add_get_remove_ips () = + get_arp () >>= fun stack -> + let check str expected = + Alcotest.(check (list ip)) str expected (A.get_ips stack.arp) + in + check "bound ips is an empty list on startup" []; + A.set_ips stack.arp [ first_ip; first_ip ] >>= fun () -> + check "set ips with duplicate elements result in deduplication" [first_ip]; + A.remove_ip stack.arp first_ip >>= fun () -> + check "ip list is empty after removing only ip" []; + A.remove_ip stack.arp first_ip >>= fun () -> + check "ip list is empty after removing from empty list" []; + A.add_ip stack.arp first_ip >>= fun () -> + check "first ip is the only member of the set of bound ips" [first_ip]; + A.add_ip stack.arp first_ip >>= fun () -> + check "adding ips is idempotent" [first_ip]; + Lwt.return_unit + +let input_single_garp () = + two_arp () >>= fun (listen, speak) -> + (* set the IP on speak_arp, which should cause a GARP to be emitted which + listen_arp will hear and cache. *) + let one_and_done buf = + let arpbuf = Cstruct.shift buf 14 in + A.input listen.arp arpbuf >>= fun () -> + V.disconnect listen.netif + in + timeout ~time:500 ( + Lwt.join [ + (V.listen listen.netif ~header_size one_and_done >|= fun _ -> ()); + Mirage_sleep.ns (Duration.of_ms 100) >>= fun () -> + Lwt.async (fun () -> A.query listen.arp first_ip >|= ignore) ; + A.set_ips speak.arp [ first_ip ]; + ]) + >>= fun () -> + (* try a lookup of the IP set by speak.arp, and fail if this causes listen_arp + to block or send an ARP query -- listen_arp should answer immediately from + the cache. An attempt to resolve via query will result in a timeout, since + speak.arp has no listener running and therefore won't answer any arp + who-has requests. *) + timeout ~time:500 (query_or_die listen.arp first_ip (V.mac speak.netif)) (* >>= fun () -> + Time.sleep_ns (Duration.of_sec 5) *) + +let input_single_unicast () = + two_arp () >>= fun (listen, speak) -> + (* contrive to make a reply packet for the listener to hear *) + let for_listener = + arp_reply + ~from_netif:speak.netif ~to_netif:listen.netif + ~from_ip:first_ip ~to_ip:second_ip + in + let listener = start_arp_listener listen () in + timeout ~time:500 ( + Lwt.choose [ + (V.listen listen.netif ~header_size listener >|= fun _ -> ()); + Mirage_sleep.ns (Duration.of_ms 2) >>= fun () -> + E.write speak.ethif (V.mac listen.netif) `ARP ~size for_listener >>= fun _ -> + query_and_no_response listen.arp first_ip + ]) + +let input_resolves_wait () = + two_arp () >>= fun (listen, speak) -> + (* contrive to make a reply packet for the listener to hear *) + let for_listener = arp_reply ~from_netif:speak.netif ~to_netif:listen.netif + ~from_ip:first_ip ~to_ip:second_ip in + (* initiate query when the cache is empty. On resolution, fail for a timeout + and test the MAC if resolution was successful, then disconnect the + listening interface to ensure the test terminates. + Fail with a timeout message if the whole thing takes more than 5s. *) + let listener = start_arp_listener listen () in + let query_then_disconnect = + query_or_die listen.arp first_ip (V.mac speak.netif) >>= fun () -> + V.disconnect listen.netif + in + timeout ~time:5000 ( + Lwt.join [ + (V.listen listen.netif ~header_size listener >|= fun _ -> ()); + query_then_disconnect; + Mirage_sleep.ns (Duration.of_ms 1) >>= fun () -> + E.write speak.ethif (V.mac listen.netif) `ARP ~size for_listener >|= function + | Ok x -> x + | Error _ -> failf "ethernet write failed" + ] + ) + +let unreachable_times_out () = + get_arp () >>= fun speak -> + A.query speak.arp first_ip >>= function + | Ok _ -> failf "query claimed success when impossible for %a" Ipaddr.V4.pp first_ip + | Error `Timeout -> Lwt.return_unit + | Error e -> failf "error waiting for a timeout: %a" A.pp_error e + +let input_replaces_old () = + three_arp () >>= fun (listen, claimant_1, claimant_2) -> + (* query for IP to accept responses *) + Lwt.async (fun () -> A.query listen.arp first_ip >|= ignore) ; + Lwt.async (fun () -> + Log.debug (fun f -> f "arp listener started"); + V.listen listen.netif ~header_size (start_arp_listener listen ()) >|= fun _ -> ()); + timeout ~time:2000 ( + set_and_check ~listener:listen.arp ~claimant:claimant_1 first_ip >>= fun () -> + set_and_check ~listener:listen.arp ~claimant:claimant_2 first_ip >>= fun () -> + V.disconnect listen.netif + ) + +let os_linux_bsd () = + let cmd = Bos.Cmd.(v "uname" % "-s") in + match Bos.OS.Cmd.(run_out cmd |> out_string |> success) with + | Ok s when s = "FreeBSD" -> true + | Ok s when s = "Linux" -> true + | Ok _ -> false + | Error _ -> false + +let entries_expire () = + (* this test fails on windows and macOS for unknown reasons. please, if you + happen to have your hands on such a machine, investigate the issue. *) + if not (os_linux_bsd ()) then + Lwt.return_unit + else + two_arp () >>= fun (listen, speak) -> + A.set_ips listen.arp [ second_ip ] >>= fun () -> + (* here's what we expect listener to emit once its cache entry has expired *) + let expected_arp_query = + Arp_packet.({operation = Request; + source_mac = V.mac listen.netif; + target_mac = Macaddr.broadcast; + source_ip = second_ip; target_ip = first_ip}) + in + (* query for IP to accept responses *) + Lwt.async (fun () -> A.query listen.arp first_ip >|= ignore) ; + Lwt.async (fun () -> V.listen listen.netif ~header_size (start_arp_listener listen ()) >|= fun _ -> ()); + let test = + Mirage_sleep.ns (Duration.of_ms 10) >>= fun () -> + set_and_check ~listener:listen.arp ~claimant:speak first_ip >>= fun () -> + (* sleep for 5s to make sure we hit `tick` often enough *) + Mirage_sleep.ns (Duration.of_sec 5) >>= fun () -> + (* asking now should generate a query *) + not_in_cache ~listen:speak.netif expected_arp_query listen.arp first_ip + in + timeout ~time:7000 test + +(* RFC isn't strict on how many times to try, so we'll just say any number + greater than 1 is fine *) +let query_retries () = + two_arp () >>= fun (listen, speak) -> + let expected_query = Arp_packet.({source_mac = V.mac speak.netif; + target_mac = Macaddr.broadcast; + source_ip = Ipaddr.V4.any; + target_ip = first_ip; + operation = Request;}) + in + let how_many = ref 0 in + let listener buf = + check_ethif_response expected_query buf; + if !how_many = 0 then begin + how_many := !how_many + 1; + Lwt.return_unit + end else V.disconnect listen.netif + in + let ask () = + A.query speak.arp first_ip >>= function + | Error e -> failf "Received error before >1 query: %a" A.pp_error e + | Ok _ -> failf "got result from query for %a, erroneously" Ipaddr.V4.pp first_ip + in + Lwt.pick [ + (V.listen listen.netif ~header_size listener >|= fun _ -> ()); + Mirage_sleep.ns (Duration.of_ms 2) >>= ask; + Mirage_sleep.ns (Duration.of_sec 6) >>= fun () -> + fail "query didn't succeed or fail within 6s" + ] + +(* requests for us elicit a reply *) +let requests_are_responded_to () = + let (answerer_ip, inquirer_ip) = (first_ip, second_ip) in + two_arp () >>= fun (inquirer, answerer) -> + (* neither has a listener set up when we set IPs, so no GARPs in the cache *) + A.add_ip answerer.arp answerer_ip >>= fun () -> + A.add_ip inquirer.arp inquirer_ip >>= fun () -> + let request = arp_request ~from_netif:inquirer.netif ~to_mac:Macaddr.broadcast + ~from_ip:inquirer_ip ~to_ip:answerer_ip + in + let expected_reply = + Arp_packet.({ operation = Reply; + source_mac = V.mac answerer.netif; + target_mac = V.mac inquirer.netif; + source_ip = answerer_ip; target_ip = inquirer_ip}) + in + let listener close_netif buf = + check_ethif_response expected_reply buf; + V.disconnect close_netif + in + let arp_listener = + V.listen answerer.netif ~header_size (start_arp_listener answerer ()) >|= fun _ -> () + in + timeout ~time:1000 ( + Lwt.join [ + (* listen for responses and check them against an expected result *) + (V.listen inquirer.netif ~header_size (listener inquirer.netif) >|= fun _ -> ()); + (* start the usual ARP listener, which should respond to requests *) + arp_listener; + (* send a request for the ARP listener to respond to *) + Mirage_sleep.ns (Duration.of_ms 100) >>= fun () -> + E.write inquirer.ethif Macaddr.broadcast `ARP ~size request >>= fun _ -> + Mirage_sleep.ns (Duration.of_ms 100) >>= fun () -> + V.disconnect answerer.netif + ]; + ) + +let requests_not_us () = + let (answerer_ip, inquirer_ip) = (first_ip, second_ip) in + two_arp () >>= fun (answerer, inquirer) -> + A.add_ip answerer.arp answerer_ip >>= fun () -> + A.add_ip inquirer.arp inquirer_ip >>= fun () -> + let ask ip buf = + let open Arp_packet in + encode_into + { operation = Request; + source_mac = V.mac inquirer.netif; target_mac = Macaddr.broadcast; + source_ip = inquirer_ip; target_ip = ip } + buf ; + size + in + let requests = List.map ask [ inquirer_ip; Ipaddr.V4.any; + Ipaddr.V4.of_string_exn "255.255.255.255" ] in + let make_requests = + Lwt_list.iter_s (fun b -> E.write inquirer.ethif Macaddr.broadcast `ARP ~size b >|= fun _ -> ()) + requests + in + let disconnect_listeners () = + Lwt_list.iter_s (V.disconnect) [answerer.netif; inquirer.netif] + in + Lwt.join [ + (V.listen answerer.netif ~header_size (start_arp_listener answerer ()) >|= fun _ -> ()); + (V.listen inquirer.netif ~header_size (fail_on_receipt inquirer.netif) >|= fun _ -> ()); + make_requests >>= fun _ -> + Mirage_sleep.ns (Duration.of_ms 100) >>= + disconnect_listeners + ] + +let nonsense_requests () = + let (answerer_ip, inquirer_ip) = (first_ip, second_ip) in + three_arp () >>= fun (answerer, inquirer, checker) -> + A.set_ips answerer.arp [ answerer_ip ] >>= fun () -> + let request number arp = + let open Arp_packet in + encode_into + { operation = Request; + source_mac = V.mac inquirer.netif; + target_mac = Macaddr.broadcast; + source_ip = inquirer_ip; + target_ip = answerer_ip } arp ; + Cstruct.BE.set_uint16 arp 6 number; + Arp_packet.size + in + let requests = List.map request [0; 3; -1; 255; 256; 257; 65536] in + let make_requests = + Lwt_list.iter_s (fun l -> E.write inquirer.ethif Macaddr.broadcast `ARP ~size l >|= fun _ -> ()) requests in + let expected_probe = Arp_packet.{ operation = Request; + source_mac = V.mac answerer.netif; + source_ip = answerer_ip; + target_mac = Macaddr.broadcast; + target_ip = inquirer_ip; } + in + Lwt.async (fun () -> V.listen answerer.netif ~header_size (start_arp_listener answerer ()) >|= fun _ -> ()); + timeout ~time:1000 ( + Lwt.join [ + (V.listen inquirer.netif ~header_size (fail_on_receipt inquirer.netif) >|= fun _ -> ()); + make_requests >>= fun () -> + V.disconnect inquirer.netif >>= fun () -> + (* not sufficient to just check to see whether we've replied; it's equally + possible that we erroneously make a cache entry. Make sure querying + inquirer_ip results in an outgoing request. *) + not_in_cache ~listen:checker.netif expected_probe answerer.arp inquirer_ip + ] ) + +let packet () = + let first_mac = Macaddr.of_string_exn "10:9a:dd:01:23:45" in + let second_mac = Macaddr.of_string_exn "00:16:3e:ab:cd:ef" in + let example_request = + Arp_packet.{ operation = Request; + source_mac = first_mac; + target_mac = second_mac; + source_ip = first_ip; + target_ip = second_ip; + } + in + let marshalled = Arp_packet.encode example_request in + match Arp_packet.decode marshalled with + | Error _ -> Alcotest.fail "couldn't unmarshal something we made ourselves" + | Ok unmarshalled -> + Alcotest.(check packet) "serialize/deserialize" example_request unmarshalled; + Lwt.return_unit + +let suite = + [ + "conversions neither lose nor gain information", `Quick, packet; + "nonsense requests are ignored", `Quick, nonsense_requests; + "requests are responded to", `Quick, requests_are_responded_to; + "entries expire", `Quick, entries_expire; + "irrelevant requests are ignored", `Quick, requests_not_us; + "set_ip sets ip, sends GARP", `Quick, set_ip_sends_garp; + "add_ip, get_ip and remove_ip as advertised", `Quick, add_get_remove_ips; + "GARPs are heard and not cached", `Quick, input_single_garp; + "unsolicited unicast replies are heard and not cached", `Quick, input_single_unicast; + "solicited unicast replies resolve pending threads", `Quick, input_resolves_wait; + "entries are replaced with new information", `Quick, input_replaces_old; + "unreachable IPs time out", `Quick, unreachable_times_out; + "queries are tried repeatedly before timing out", `Quick, query_retries; + ] + +let run test () = + Lwt_main.run (test ()) + +let () = + (* enable logging to stdout for all modules *) + Logs.set_reporter (Logs_fmt.reporter ()); + Logs.set_level ~all:true (Some Logs.Debug); + let suite = + [ "arp", List.map (fun (d, s, f) -> d, s, run f) suite ] + in + Alcotest.run "arp" suite diff --git a/unikernel/duniverse/arp/test/tests.ml b/unikernel/duniverse/arp/test/tests.ml new file mode 100644 index 00000000..dd505c83 --- /dev/null +++ b/unikernel/duniverse/arp/test/tests.ml @@ -0,0 +1,878 @@ +let generate n = + let data = Cstruct.create n in + for i = 0 to pred n do + Cstruct.set_uint8 data i (Random.int 256) + done; + data + +let rec gen_ip () = + let buf = generate 4 in + let ip = Ipaddr.V4.of_octets_exn (Cstruct.to_string buf) in + if ip = Ipaddr.V4.any || ip = Ipaddr.V4.broadcast then + gen_ip () + else + buf, ip + +let rec gen_mac () = + let buf = generate 6 in + let mac = Macaddr.of_octets_exn (Cstruct.to_string buf) in + if mac = Macaddr.broadcast then + gen_mac () + else + buf, mac + +let hdr = Cstruct.of_string "\000\001\008\000\006\004" + +let gen_int () = + let buf = generate 1 in + (buf, Cstruct.get_uint8 buf 0) + +let gen_op () = + let _, op = gen_int () in + let buf = Cstruct.create 2 in + let op = 1 + op mod 2 in + Cstruct.BE.set_uint16 buf 0 op ; + (if op = 1 then Arp_packet.Request else Arp_packet.Reply), buf + +let gen_arp () = + let sm, source_mac = gen_mac () + and si, source_ip = gen_ip () + and tm, target_mac = gen_mac () + and ti, target_ip = gen_ip () + and op, opb = gen_op () + in + { Arp_packet.operation = op ; source_mac ; source_ip ; target_mac ; target_ip }, + Cstruct.concat [ hdr ; opb ; sm ; si ; tm ; ti ] + +let p = + let module M = struct + type t = Arp_packet.t + let pp = Arp_packet.pp + let equal s t = + let open Arp_packet in + s.operation = t.operation && + Macaddr.compare s.source_mac t.source_mac = 0 && + Macaddr.compare s.target_mac t.target_mac = 0 && + Ipaddr.V4.compare s.source_ip t.source_ip = 0 && + Ipaddr.V4.compare s.target_ip t.target_ip = 0 + end in + (module M : Alcotest.TESTABLE with type t = M.t) + +module Coding = struct + let gen_op_arp () = + let rec gen_op () = + let buf = generate 2 in + match Cstruct.BE.get_uint16 buf 0 with + | 1 | 2 -> gen_op () + | x -> (x, buf) + in + let data = generate 20 + and o, opb = gen_op () + in + o, Cstruct.concat [ hdr ; opb ; data ] + + let rec gen_unhandled_arp () = + (* some consistency -- hlen and plen *) + let htype = generate 2 + and ptype = generate 2 + in + (* if we don't have at least length m, we'll end up in Too_short *) + let rec i_min m () = + let buf, len = gen_int () in + if len < m then i_min m () + else buf, len + in + let hl, hlen = i_min 6 () + and pl, plen = i_min 4 () + in + let my_hdr = Cstruct.concat [ htype ; ptype ; hl ; pl ] in + if Cstruct.equal my_hdr hdr then + gen_unhandled_arp () + else + let rec gen_op () = + let buf = generate 2 in + match Cstruct.BE.get_uint16 buf 0 with + | 1 | 2 -> gen_op () + | _ -> buf + in + let op = gen_op () + and sha = generate hlen + and tha = generate hlen + and spa = generate plen + and tpa = generate plen + in + Cstruct.concat [ my_hdr ; op ; sha ; spa ; tha ; tpa ] + + let gen_short_arp () = + let _, l = gen_int () in + generate (l mod 28) + + let e = + let module M = struct + type t = Arp_packet.error + let pp = Arp_packet.pp_error + let equal a b = + let open Arp_packet in + match a, b with + | Too_short, Too_short -> true + | Unusable, Unusable -> true + | Unknown_operation x, Unknown_operation y -> x = y + | _ -> false + end in + (module M : Alcotest.TESTABLE with type t = M.t) + + let repeat f n () = + for _i = 0 to n do + f () + done + + let check_r s res buf = + Alcotest.(check (result p e) s res (Arp_packet.decode buf)) + + let dec_valid_arp () = + let pkt, buf = gen_arp () in + check_r "decoding valid ARP frames" (Ok pkt) buf + + let dec_unhandled_arp () = + let buf = gen_unhandled_arp () in + check_r "invalid header is error" (Error Arp_packet.Unusable) buf + + let dec_short_arp () = + let buf = gen_short_arp () in + check_r "short is error" (Error Arp_packet.Too_short) buf + + let dec_op_arp () = + let o, buf = gen_op_arp () in + check_r "invalid op is error" (Error (Arp_packet.Unknown_operation o)) buf + + let dec_enc () = + let pkt, buf = gen_arp () in + let cbuf = Arp_packet.encode pkt in + Alcotest.(check bool "encoding produces same buffer" true (Cstruct.equal buf cbuf)) ; + match Arp_packet.decode buf with + | Error _ -> Alcotest.fail "decoding failed, should not happen" + | Ok pack -> + Alcotest.(check p "decoding worked" pkt pack) ; + let cbuf = Arp_packet.encode pack in + Alcotest.(check bool "encoding produces same buffer" true (Cstruct.equal buf cbuf)) + + let enc_into () = + let pkt, buf = gen_arp () in + let cbuf = Cstruct.create 28 in + Arp_packet.encode_into pkt cbuf ; + Alcotest.(check bool "encode_into works" true (Cstruct.equal cbuf buf)) + + let enc_fail () = + for i = 0 to 27 do + let buf = Cstruct.create i + and pkg, _ = gen_arp () + in + Alcotest.check_raises "buffer is too small" (Invalid_argument "too small") + (fun () -> + try Arp_packet.encode_into pkg buf with Invalid_argument _ -> invalid_arg "too small") + done + + let coder_tsts = [ + "valid arp decoding", `Quick, (repeat dec_valid_arp 1000) ; + "unhandled arp decoding", `Quick, (repeat dec_unhandled_arp 1000) ; + "short arp decoding", `Quick, (repeat dec_short_arp 1000) ; + "invalid operation decoding", `Quick, (repeat dec_op_arp 1000) ; + "decoding is inverse of encoding", `Quick, (repeat dec_enc 1000) ; + "encode_into works", `Quick, (repeat enc_into 1000) ; + "encode_into fails with small bufs", `Quick, enc_fail ; + ] +end + +module Handling = struct + let garp_of ip mac = + let mac0 = Macaddr.of_octets_exn (String.make 6 '\000') in + { Arp_packet.operation = Arp_packet.Request ; + source_ip = ip ; target_ip = ip ; + source_mac = mac ; target_mac = mac0 } + + let gen_ip () = snd (gen_ip ()) + and gen_mac () = snd (gen_mac ()) + + let m = + let module M = struct + type t = Macaddr.t + let pp = Macaddr.pp + let equal a b = Macaddr.compare a b = 0 + end in + (module M : Alcotest.TESTABLE with type t = M.t) + + let i = + let module M = struct + type t = Ipaddr.V4.t + let pp = Ipaddr.V4.pp + let equal a b = Ipaddr.V4.compare a b = 0 + end in + (module M : Alcotest.TESTABLE with type t = M.t) + + let create_raises () = + let mac = gen_mac () in + Alcotest.check_raises "timeout <= 0" (Invalid_argument "timeout must be strictly positive") + (fun () -> ignore(Arp_handler.create ~timeout:0 mac)) ; + Alcotest.check_raises "retries < 0" (Invalid_argument "retries must be positive") + (fun () -> ignore(Arp_handler.create ~retries:(-1) mac)) + + let basic_good () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, garp = Arp_handler.create ~ipaddr mac in + let garp = match garp with + | None -> Alcotest.fail "expected some garp" + | Some garp -> garp + in + Alcotest.(check bool "create has good GARP" true + (Cstruct.equal (Arp_packet.encode (garp_of ipaddr mac)) + (Arp_packet.encode (fst garp)))) ; + Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ; + Alcotest.(check (option m) "own entry is in cache" + (Some mac) (Arp_handler.in_cache t ipaddr)) ; + Alcotest.(check (option m) "any is not in cache" None + (Arp_handler.in_cache t Ipaddr.V4.any)) ; + Alcotest.(check (option m) "broadcast is not in cache" None + (Arp_handler.in_cache t Ipaddr.V4.broadcast)) + + let remove_good () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ; + Alcotest.(check (option m) "own entry is in cache" + (Some mac) (Arp_handler.in_cache t ipaddr)) ; + let t = Arp_handler.remove t ipaddr in + Alcotest.(check (option m) "own entry is no longer in cache" None + (Arp_handler.in_cache t ipaddr)) + + let remove_no () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ; + Alcotest.(check (option m) "own entry is in cache" + (Some mac) (Arp_handler.in_cache t ipaddr)) ; + let t = Arp_handler.remove t Ipaddr.V4.any in + Alcotest.(check (option m) "own entry is still in cache" (Some mac) + (Arp_handler.in_cache t ipaddr)) + + let alias_good () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ; + Alcotest.(check (option m) "own entry is in cache" + (Some mac) (Arp_handler.in_cache t ipaddr)) ; + let t, _, _ = Arp_handler.alias t ipaddr in + Alcotest.(check (option m) "own entry is still in cache" (Some mac) + (Arp_handler.in_cache t ipaddr)) ; + let ip' = gen_ip () in + let t, _, _ = Arp_handler.alias t ip' in + Alcotest.(check (option m) "own entry is still in cache" (Some mac) + (Arp_handler.in_cache t ipaddr)) ; + Alcotest.(check (option m) "aliased entry is in cache" (Some mac) + (Arp_handler.in_cache t ip')) + + let alias_remove_inverse () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + let ip' = gen_ip () in + let t, _, _ = Arp_handler.alias t ip' in + Alcotest.(check (option m) "own entry is in cache" (Some mac) + (Arp_handler.in_cache t ipaddr)) ; + Alcotest.(check (option m) "aliased entry is in cache" (Some mac) + (Arp_handler.in_cache t ip')) ; + let t = Arp_handler.remove t ip' in + Alcotest.(check (option m) "aliased entry is no longer in cache" None + (Arp_handler.in_cache t ip')) + + let static_good () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + let ip' = gen_ip () in + let mac' = gen_mac () in + let t, _ = Arp_handler.static t ip' mac' in + Alcotest.(check (option m) "own entry is in cache" (Some mac) + (Arp_handler.in_cache t ipaddr)) ; + Alcotest.(check (option m) "static entry is in cache" (Some mac') + (Arp_handler.in_cache t ip')) ; + let t = Arp_handler.remove t ip' in + Alcotest.(check (option m) "static entry is no longer in cache" None + (Arp_handler.in_cache t ip')) + + let static_alias_good () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + let ip' = gen_ip () in + let mac' = gen_mac () in + let t, _ = Arp_handler.static t ip' mac' in + Alcotest.(check (option m) "own entry is in cache" (Some mac) + (Arp_handler.in_cache t ipaddr)) ; + Alcotest.(check (option m) "static entry is in cache" (Some mac') + (Arp_handler.in_cache t ip')) ; + let t, _, _ = Arp_handler.alias t ip' in + Alcotest.(check (option m) "alias entry overwrote static one" (Some mac) + (Arp_handler.in_cache t ip')) ; + let t, _ = Arp_handler.static t ip' mac' in + Alcotest.(check (option m) "static entry overwrite aliased one" (Some mac') + (Arp_handler.in_cache t ip')) ; + let t = Arp_handler.remove t ip' in + Alcotest.(check (option m) "static entry is no longer in cache" None + (Arp_handler.in_cache t ip')) + + let more_good () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + let rec more_entries acc t = function + | 0 -> acc, t + | n -> + let ip' = gen_ip () in + if List.mem ip' (List.map fst acc) then + more_entries acc t n + else + let t, e = + if n mod 2 = 0 then + let mac' = gen_mac () in + let t, _ = Arp_handler.static t ip' mac' in + (t, (ip', mac')) + else + let t, _, _ = Arp_handler.alias t ip' in + (t, (ip', mac)) + in + more_entries (e::acc) t (pred n) + in + let acc, t = more_entries [(ipaddr,mac)] t 100 in + List.iter (fun (ip, mac) -> + Alcotest.(check (option m) "entry is in cache" (Some mac) + (Arp_handler.in_cache t ip))) + acc ; + List.iter (fun (ip, _) -> + let t = Arp_handler.remove t ip in + Alcotest.(check (option m) "entry is no longer in cache" None + (Arp_handler.in_cache t ip))) + acc ; + let t = List.fold_left (fun t (ip, _) -> Arp_handler.remove t ip) t acc in + Alcotest.(check (option m) "own entry is no longer in cache" None + (Arp_handler.in_cache t ipaddr)) + + let packet = + let module M = struct + type t = Arp_packet.t + let pp = Arp_packet.pp + let equal = Arp_packet.equal + end in + (module M : Alcotest.TESTABLE with type t = M.t) + + let out = + let module M = struct + type t = Arp_packet.t * Macaddr.t + let pp ppf (cs, mac) = + Format.fprintf ppf "out: %a to %a" Arp_packet.pp cs Macaddr.pp mac + let equal (acs, amac) (bcs, bmac) = + Arp_packet.equal acs bcs && Macaddr.compare amac bmac = 0 + end in + (module M : Alcotest.TESTABLE with type t = M.t) + + let qres = + let module M = struct + type t = int list Arp_handler.qres + let pp ppf = function + | Arp_handler.Mac mac -> Format.fprintf ppf "ok %a" Macaddr.pp mac + | Arp_handler.RequestWait ((cs, mac), xs) -> + Format.fprintf ppf "requestwait %a to %a, wait %s" + Arp_packet.pp cs Macaddr.pp mac + (String.concat ", " (List.map string_of_int xs)) + | Arp_handler.Wait xs -> + Format.fprintf ppf "wait %s" + (String.concat ", " (List.map string_of_int xs)) + let equal a b = match a, b with + | Arp_handler.Mac a, Arp_handler.Mac b -> Macaddr.compare a b = 0 + | Arp_handler.RequestWait ((csa, maca), xsa), + Arp_handler.RequestWait ((csb, macb), xsb) -> + Arp_packet.equal csa csb && Macaddr.compare maca macb = 0 && + List.length xsa = List.length xsb && + List.for_all (fun x -> List.mem x xsb) xsa + | Arp_handler.Wait xsa, Arp_handler.Wait xsb -> + List.length xsa = List.length xsb && + List.for_all (fun x -> List.mem x xsb) xsa + | _ -> false + end in + (module M : Alcotest.TESTABLE with type t = M.t) + + let merge v = function + | None -> [v] + | Some xs -> v::xs + + let handle_good () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + let _t, res = Arp_handler.query t ipaddr (merge 1) in + Alcotest.check qres "own IP can be queried" (Arp_handler.Mac mac) res + + let query source_mac source_ip target_ip = + { Arp_packet.operation = Arp_packet.Request ; + source_mac ; source_ip ; + target_mac = Macaddr.broadcast ; target_ip }, + Macaddr.broadcast + + let handle_gen_request () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~retries:1 ~ipaddr mac in + let other = gen_ip () in + let _, res = Arp_handler.query t other (merge 1) in + let out = query mac ipaddr other in + Alcotest.check qres "res is requestwait" (Arp_handler.RequestWait (out, [1])) res + + let handle_gen_request_twice () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr ~retries:1 mac in + let other = gen_ip () in + let t, res = Arp_handler.query t other (merge 1) in + let out = query mac ipaddr other in + Alcotest.check qres "res is requestwait" (Arp_handler.RequestWait (out, [1])) res ; + let _, res = Arp_handler.query t other (merge 2) in + Alcotest.check qres "res is wait" (Arp_handler.Wait [2;1]) res + + let alias_wakes () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + let other = gen_ip () in + let t, res = Arp_handler.query t other (merge 1) in + let out = query mac ipaddr other in + Alcotest.check qres "res is requestwait!" (Arp_handler.RequestWait (out, [1])) res ; + Alcotest.(check (option m) "query is not cache" None (Arp_handler.in_cache t other)) ; + let _, _, a = Arp_handler.alias t other in + Alcotest.(check (option (list int)) "alias wakes up" (Some [1]) a) + + let static_wakes () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~ipaddr mac in + let other = gen_ip () in + let t, res = Arp_handler.query t other (merge 1) in + let out = query mac ipaddr other in + Alcotest.check qres "res is requestwait" (Arp_handler.RequestWait (out, [1])) res ; + let _, a = Arp_handler.static t other mac in + Alcotest.(check (option (list int)) "alias wakes up" (Some [1]) a) + + let handle_timeout () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~retries:1 ~ipaddr mac in + let other = gen_ip () in + let t, _ = Arp_handler.query t other (merge 1) in + let t, _, a = Arp_handler.tick t in + Alcotest.(check (list (list int)) "tick didn't timeout" [] a) ; + let _, _, a = Arp_handler.tick t in + Alcotest.(check (list (list int)) "tick timed out" [[1]] a) + + let req_before_timeout () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let t, _ = Arp_handler.query t other (merge 1) in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let t, outp, wake = Arp_handler.input t pkt in + Alcotest.(check (option out) "out is none" None outp) ; + Alcotest.(check (option (pair m (list int))) "wake is correct" + (Some (omac, [1])) wake) ; + let _, outp, rs = Arp_handler.tick t in + Alcotest.(check bool "timeouts are empty" true (rs = [])) ; + Alcotest.(check (list out) "arp request is sent" [query mac ipaddr other] outp) + + let multiple_reqs () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~retries:1 ~ipaddr mac in + let other = gen_ip () in + let t, res = Arp_handler.query t other (merge 1) in + let q = query mac ipaddr other in + Alcotest.check qres "query generates ARP request" (Arp_handler.RequestWait (q, [1])) res ; + let t, outs, touts = Arp_handler.tick t in + Alcotest.(check (list out) "tick generates second ARP request" [q] outs) ; + Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ; + let _, outs, touts = Arp_handler.tick t in + Alcotest.(check (list out) "tick generated no other request" [] outs) ; + Alcotest.(check (list (list int)) "tick generated a timeout" [[1]] touts) + + let multiple_reqs_2 () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~retries:4 ~ipaddr mac in + let other = gen_ip () in + let t, res = Arp_handler.query t other (merge 1) in + let q = query mac ipaddr other in + Alcotest.check qres "query generates ARP request" (Arp_handler.RequestWait (q, [1])) res ; + let t, outs, touts = Arp_handler.tick t in + Alcotest.(check (list out) "tick generates second ARP request" [q] outs) ; + Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ; + let t, outs, touts = Arp_handler.tick t in + Alcotest.(check (list out) "tick generates third ARP request" [q] outs) ; + Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ; + let t, outs, touts = Arp_handler.tick t in + Alcotest.(check (list out) "tick generates fourth ARP request" [q] outs) ; + Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ; + let t, outs, touts = Arp_handler.tick t in + Alcotest.(check (list out) "tick generates fifth ARP request" [q] outs) ; + Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ; + let _, outs, touts = Arp_handler.tick t in + Alcotest.(check (list out) "tick generated no other request" [] outs) ; + Alcotest.(check (list (list int)) "tick generated a timeout" [[1]] touts) + + let handle_reply () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing to be sent" None outp) ; + Alcotest.(check (option (pair m (list int))) "noone wakes up" None w) ; + Alcotest.(check (option m) "received entry is not in cache" None + (Arp_handler.in_cache t other)) + + let handle_garp () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = Arp_packet.encode (garp_of other omac) in + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ; + Alcotest.(check (option m) "received garp entry is not in cache" None + (Arp_handler.in_cache t other)) + + let answer_req_broadcast () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt, _ = query omac other ipaddr in + let _, outp, w = Arp_handler.input t (Arp_packet.encode pkt) in + Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ; + Alcotest.(check (option out) "request to us provokes a reply" + (Some ({ Arp_packet.operation = Arp_packet.Reply ; + source_mac = mac ; source_ip = ipaddr ; + target_mac = omac ; target_ip = other }, + omac)) outp) + + let answer_req_unicast () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Request ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let _, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ; + Alcotest.(check (option out) "request to us provokes a reply" + (Some ({ Arp_packet.operation = Arp_packet.Reply ; + source_mac = mac ; source_ip = ipaddr ; + target_mac = omac ; target_ip = other }, + omac)) outp) + + let not_answer_req () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let third = gen_ip () in + let omac = gen_mac () in + let pkt, _ = query omac other third in + let _, outp, w = Arp_handler.input t (Arp_packet.encode pkt) in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) + + let ignoring_random () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let pkt = generate 24 in + let _, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) + + let reply_does_not_override () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = ipaddr ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ; + Alcotest.(check (option m) "our entry is still in cache" (Some mac) + (Arp_handler.in_cache t ipaddr)) + + let reply_query () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let q = query mac ipaddr other in + let t, r = Arp_handler.query t other (merge 1) in + Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ; + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ; + let _t, res = Arp_handler.query t other (merge 2) in + Alcotest.check qres "dynamic entry can be queried" (Arp_handler.Mac omac) res + + let reply_in_cache () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let q = query mac ipaddr other in + let t, r = Arp_handler.query t other (merge 1) in + Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ; + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ; + Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ; + Alcotest.(check (list i) "ips do not include dynamic entries" [ipaddr] (Arp_handler.ips t)) + + + let reply_overriden () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let q = query mac ipaddr other in + let t, r = Arp_handler.query t other (merge 1) in + Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ; + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ; + Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ; + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "nothing woken up" None w) ; + Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) + + let reply_overriden_other () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let q = query mac ipaddr other in + let t, r = Arp_handler.query t other (merge 1) in + Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ; + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ; + Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ; + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "nothing woken up" None w) ; + Alcotest.(check (option m) "overriden entry in cache" (Some omac) + (Arp_handler.in_cache t other)) + + let reply_times_out () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let q = query mac ipaddr other in + let t, r = Arp_handler.query t other (merge 1) in + Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ; + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ; + Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ; + let t, outp, timeout = Arp_handler.tick t in + Alcotest.(check (list out) "request sent" [q] outp) ; + Alcotest.(check (list (list int)) "nothing timed out" [] timeout) ; + let t, outp, timeout = Arp_handler.tick t in + Alcotest.(check (list out) "nada sent" [] outp) ; + Alcotest.(check (list (list int)) "nothing timed out" [] timeout) ; + Alcotest.(check (option m) "entry no longer in cache" None + (Arp_handler.in_cache t other)) + + let dyn_not_advertised () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let q = query mac ipaddr other in + let t, r = Arp_handler.query t other (merge 1) in + Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ; + let t, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ; + let third = gen_ip () + and third_mac = gen_mac () + in + let q, _ = query third_mac third other in + let _, outp, w = Arp_handler.input t (Arp_packet.encode q) in + Alcotest.(check (option out) "request a dynamic entry is not answered" None outp) ; + Alcotest.(check (option (pair m (list int))) "nothing woken up" None w) + + let handle_reply_wakesup () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let other = gen_ip () in + let omac = gen_mac () in + let pkt = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac ; + target_ip = ipaddr ; target_mac = mac } + in + let q = query mac ipaddr other in + let t, r = Arp_handler.query t other (merge 1) in + Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ; + let t, r = Arp_handler.query t other (merge 2) in + Alcotest.check qres "r is wait" (Arp_handler.Wait [2;1]) r ; + let _, outp, w = Arp_handler.input t pkt in + Alcotest.(check (option out) "nothing out" None outp) ; + Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [2;1])) w) + + let handl_tsts = [ + "create raises", `Quick, create_raises ; + "basic tests", `Quick, basic_good ; + "remove test", `Quick, remove_good ; + "remove no test", `Quick, remove_no ; + "alias test", `Quick, alias_good ; + "alias remove test", `Quick, alias_remove_inverse ; + "static test", `Quick, static_good ; + "static alias test", `Quick, static_alias_good ; + "more tests", `Quick, more_good ; + "handle good", `Quick, handle_good ; + "handle generates req", `Quick, handle_gen_request ; + "handle generates req, next doesn't", `Quick, handle_gen_request_twice ; + "alias wakes", `Quick, alias_wakes ; + "static wakes", `Quick, static_wakes ; + "handle timeout", `Quick, handle_timeout ; + "request send before timeout", `Quick, req_before_timeout ; + "multiple requests are send", `Quick, multiple_reqs ; + "multiple requests are send 2", `Quick, multiple_reqs_2 ; + "handle reply", `Quick, handle_reply ; + "handle garp", `Quick, handle_garp ; + "answers broadcast request", `Quick, answer_req_broadcast ; + "answers unicast request", `Quick, answer_req_unicast ; + "not answering random request", `Quick, not_answer_req ; + "ignoring random", `Quick, ignoring_random ; + "reply does not harm static entries", `Quick, reply_does_not_override ; + "reply is in cache", `Quick, reply_in_cache ; + "dynamic entry can be queried", `Quick, reply_query ; + "reply times out", `Quick, reply_times_out ; + "dynamic entry overriden by same", `Quick, reply_overriden ; + "dynamic entry overriden by other", `Quick, reply_overriden_other ; + "dynamic entry is not advertised", `Quick, dyn_not_advertised ; + "reply wakes tasks", `Quick, handle_reply_wakesup ; + ] +end + +let tests = [ + "Coder", Coding.coder_tsts ; + "Handler", Handling.handl_tsts ; +] + +let () = + Random.self_init (); + Alcotest.run "ARP tests" tests diff --git a/unikernel/duniverse/astring/.gitignore b/unikernel/duniverse/astring/.gitignore new file mode 100644 index 00000000..308c61a8 --- /dev/null +++ b/unikernel/duniverse/astring/.gitignore @@ -0,0 +1,10 @@ +_b0 +_build +tmp +CLOCK.org +*~ +\.\#* +\#*# +*.native +*.byte +*.install diff --git a/unikernel/duniverse/astring/.merlin b/unikernel/duniverse/astring/.merlin new file mode 100644 index 00000000..2a1dd140 --- /dev/null +++ b/unikernel/duniverse/astring/.merlin @@ -0,0 +1,3 @@ +S src +S test +B _build/** diff --git a/unikernel/duniverse/astring/.ocp-indent b/unikernel/duniverse/astring/.ocp-indent new file mode 100644 index 00000000..ad2fbcbf --- /dev/null +++ b/unikernel/duniverse/astring/.ocp-indent @@ -0,0 +1 @@ +strict_with=always,match_clause=4,strict_else=never \ No newline at end of file diff --git a/unikernel/duniverse/astring/CHANGES.md b/unikernel/duniverse/astring/CHANGES.md new file mode 100644 index 00000000..6dabd9d4 --- /dev/null +++ b/unikernel/duniverse/astring/CHANGES.md @@ -0,0 +1,37 @@ +v0.8.5 2020-08-08 Zagreb +------------------------ + +- Support OCaml 4.12 injectiviy annotation of Map.S (#18). + Thanks to Jeremy Yallop for the patch. + +v0.8.4 2020-06-18 Zagreb +------------------------ + +- Handle `Pervasives`'s deprecation. +- Require OCaml 4.05 +- Add conversions to/from Stdlib sets and maps. Thanks + to Hezekiah M. Carty for the patch. + +v0.8.3 2016-09-12 Zagreb +------------------------ + +- Fix potential segfault on 32-bit platforms due to overflow in + `String[.Sub].concat`. Spotted by Jeremy Yallop in the standard + library. The same bug was present in Astring. + +v0.8.2 2016-08-26 Zagreb +------------------------ + +- Fix `String.Set.pp` not using the `sep` argument. +- Build depend on topkg. +- Relicense from BSD3 to ISC. + +v0.8.1 2015-02-22 La Forclaz (VS) +--------------------------------- + +- Fix a bug in `String.Sub.span`. + +v0.8.0 2015-12-14 Cambridge (UK) +-------------------------------- + +First release. diff --git a/unikernel/duniverse/astring/LICENSE.md b/unikernel/duniverse/astring/LICENSE.md new file mode 100644 index 00000000..f0feec0d --- /dev/null +++ b/unikernel/duniverse/astring/LICENSE.md @@ -0,0 +1,13 @@ +Copyright (c) 2016 The astring programmers + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/unikernel/duniverse/astring/README.md b/unikernel/duniverse/astring/README.md new file mode 100644 index 00000000..d9397435 --- /dev/null +++ b/unikernel/duniverse/astring/README.md @@ -0,0 +1,41 @@ +Astring — Alternative String module for OCaml +------------------------------------------------------------------------------- +%%VERSION%% + +Astring exposes an alternative `String` module for OCaml. This module +tries to balance minimality and expressiveness for basic, index-free, +string processing and provides types and functions for substrings, +string sets and string maps. + +Remaining compatible with the OCaml `String` module is a non-goal. The +`String` module exposed by Astring has exception safe functions, +removes deprecated and rarely used functions, alters some signatures +and names, adds a few missing functions and fully exploits OCaml's +newfound string immutability. + +Astring depends only on the OCaml standard library. It is distributed +under the ISC license. + +Home page: http://erratique.ch/software/astring + +## Installation + +Astring can be installed with `opam`: + + opam install astring + +If you don't use `opam` consult the [`opam`](opam) file for build +instructions. + +## Documentation + +The documentation and API reference is automatically generated by +`ocamldoc` from the interfaces. It can be consulted [online][doc] +or via `odig doc astring`. + +[doc]: http://erratique.ch/software/astring/doc/ + +## Sample programs + +If you installed Astring with `opam` sample programs are located in +the directory `opam config var astring:doc`. diff --git a/unikernel/duniverse/astring/_tags b/unikernel/duniverse/astring/_tags new file mode 100644 index 00000000..022b4374 --- /dev/null +++ b/unikernel/duniverse/astring/_tags @@ -0,0 +1,5 @@ +true : bin_annot, safe_string +<_b0> : -traverse + : include + : package(compiler-libs.toplevel) + : include diff --git a/unikernel/duniverse/astring/astring.opam b/unikernel/duniverse/astring/astring.opam new file mode 100644 index 00000000..1579fc79 --- /dev/null +++ b/unikernel/duniverse/astring/astring.opam @@ -0,0 +1,33 @@ +opam-version: "2.0" +maintainer: "Daniel Bünzli " +authors: ["The astring programmers"] +homepage: "https://erratique.ch/software/astring" +doc: "https://erratique.ch/software/astring/doc" +dev-repo: "git+https://github.com/dune-universe/astring.git" +bug-reports: "https://github.com/dbuenzli/astring/issues" +tags: [ "string" "org:erratique" ] +license: "ISC" +depends: [ + "dune" + "ocaml" {>= "4.05.0"} + "base-bytes" +] +build: [[ "dune" "build" "-p" name ]] +synopsis: "Alternative String module for OCaml" +description: """ +Astring exposes an alternative `String` module for OCaml. This module +tries to balance minimality and expressiveness for basic, index-free, +string processing and provides types and functions for substrings, +string sets and string maps. + +Remaining compatible with the OCaml `String` module is a non-goal. The +`String` module exposed by Astring has exception safe functions, +removes deprecated and rarely used functions, alters some signatures +and names, adds a few missing functions and fully exploits OCaml's +newfound string immutability. + +Astring depends only on the OCaml standard library. It is distributed +under the ISC license.""" +url { + src: "git://github.com/dune-universe/astring.git#duniverse-v0.8.5" +} diff --git a/unikernel/duniverse/astring/doc/.merlin b/unikernel/duniverse/astring/doc/.merlin new file mode 100644 index 00000000..987ec79e --- /dev/null +++ b/unikernel/duniverse/astring/doc/.merlin @@ -0,0 +1,3 @@ +# Generated by brzo +S ./** +B /Users/dbuenzli/sync/repos/astring/doc/_b0/brzo/ocaml-doc/** \ No newline at end of file diff --git a/unikernel/duniverse/astring/doc/index.mld b/unikernel/duniverse/astring/doc/index.mld new file mode 100644 index 00000000..251e5477 --- /dev/null +++ b/unikernel/duniverse/astring/doc/index.mld @@ -0,0 +1,12 @@ +{0 Astring {%html: %%VERSION%%%}} + +Astring exposes an alternative [String] module for OCaml. This module +tries to balance minimality and expressiveness for basic, index-free, +string processing and provides types and functions for substrings, +string sets and string maps. + +{1:api API} + +{!modules: +Astring +} diff --git a/unikernel/duniverse/astring/dune-project b/unikernel/duniverse/astring/dune-project new file mode 100644 index 00000000..55bd8e8a --- /dev/null +++ b/unikernel/duniverse/astring/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.0) +(name astring) diff --git a/unikernel/duniverse/astring/pkg/META b/unikernel/duniverse/astring/pkg/META new file mode 100644 index 00000000..e48a9294 --- /dev/null +++ b/unikernel/duniverse/astring/pkg/META @@ -0,0 +1,17 @@ +description = "Alternative String module for OCaml" +version = "%%VERSION_NUM%%" +requires = "" +archive(byte) = "astring.cma" +archive(native) = "astring.cmxa" +plugin(byte) = "astring.cma" +plugin(native) = "astring.cmxs" + +package "top" ( + description = "Astring toplevel support" + version = "%%VERSION_NUM%%" + requires = "astring" + archive(byte) = "astring_top.cma" + archive(native) = "astring_top.cmxa" + plugin(byte) = "astring_top.cma" + plugin(native) = "astring_top.cmxs" +) diff --git a/unikernel/duniverse/astring/pkg/pkg.ml b/unikernel/duniverse/astring/pkg/pkg.ml new file mode 100755 index 00000000..f0b9a568 --- /dev/null +++ b/unikernel/duniverse/astring/pkg/pkg.ml @@ -0,0 +1,13 @@ +#!/usr/bin/env ocaml +#use "topfind" +#require "topkg" +open Topkg + +let () = + Pkg.describe "astring" @@ fun c -> + Ok [ Pkg.mllib ~api:["Astring"] "src/astring.mllib"; + Pkg.mllib ~api:[] "src/astring_top.mllib"; + Pkg.lib "src/astring_top_init.ml"; + Pkg.doc "test/examples.ml"; + Pkg.test "test/test"; + Pkg.test "test/examples"; ] diff --git a/unikernel/duniverse/astring/src/astring.ml b/unikernel/duniverse/astring/src/astring.ml new file mode 100644 index 00000000..f73b9485 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring.ml @@ -0,0 +1,26 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let strf = Format.asprintf +let ( ^ ) = Astring_string.append + +module Char = Astring_char +module String = Astring_string + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring.mli b/unikernel/duniverse/astring/src/astring.mli new file mode 100644 index 00000000..21e452a2 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring.mli @@ -0,0 +1,1374 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Alternative [Char] and [String] modules. + + Open the module to use it. This defines {{!strf}one value} in your + scope, redefines the [(^)] operator, the [Char] module and the [String] + module. + + Consult the {{!diff}differences} with the OCaml + {{!Stdlib.String}[String]} + module, the {{!port}porting guide} and a few {{!examples}examples}. *) + +(** {1 String} *) + +val strf : ('a, Format.formatter, unit, string) format4 -> 'a +(** [strf] is {!Format.asprintf}. *) + +val ( ^ ) : string -> string -> string +(** [s ^ s'] is {!val:String.append}. *) + +(** Characters (bytes in fact). *) +module Char : sig + + (** {1 Bytes} *) + + type t = char + (** The type for bytes. *) + + val of_byte : int -> char + (** [of_byte b] is a byte from [b]. + + @raise Invalid_argument if [b] is not in the range \[[0x00];[0xFF]\]. *) + + (**/**) + val unsafe_of_byte : int -> char + (**/**) + + val of_int : int -> char option + (** [of_int b] is a byte from [b]. [None] is returned if [b] is not in the + range \[[0x00];[0xFF]\]. *) + + val to_int : char -> int + (** [to_int b] is the byte [b] as an integer. *) + + val hash : char -> int + (** [hash] is {!Hashtbl.hash}. *) + + (** {1:pred Predicates} *) + + val equal : char -> char -> bool + (** [equal b b'] is [b = b']. *) + + val compare : char -> char -> int + (** [compare b b'] is {!Stdlib.compare}[ b b']. *) + + (** {1 Bytes as US-ASCII characters} *) + + (** US-ASCII character support + + The following functions act only on US-ASCII code points, that + is on the bytes in range \[[0x00];[0x7F]\]. The functions can + be safely used on UTF-8 encoded strings, they will of course + only deal with US-ASCII related matters. + + {b References.} + {ul + {- Vint Cerf. + {{:http://tools.ietf.org/html/rfc20} + {e ASCII format for Network Interchange}}. RFC 20, 1969.}} *) + module Ascii : sig + + (** {1 Predicates} *) + + val is_valid : char -> bool + (** [is_valid c] is [true] iff [c] is an US-ASCII character, + that is a byte in the range \[[0x00];[0x7F]\]. *) + + val is_digit : char -> bool + (** [is_digit c] is [true] iff [c] is an US-ASCII digit + ['0'] ... ['9'], that is a byte in the range \[[0x30];[0x39]\]. *) + + val is_hex_digit : char -> bool + (** [is_hex_digit c] is [true] iff [c] is an US-ASCII hexadecimal + digit ['0'] ... ['9'], ['a'] ... ['f'], ['A'] ... ['F'], + that is a byte in one of the ranges \[[0x30];[0x39]\], + \[[0x41];[0x46]\], \[[0x61];[0x66]\]. *) + + val is_upper : char -> bool + (** [is_upper c] is [true] iff [c] is an US-ASCII uppercase + letter ['A'] ... ['Z'], that is a byte in the range + \[[0x41];[0x5A]\]. *) + + val is_lower : char -> bool + (** [is_lower c] is [true] iff [c] is an US-ASCII lowercase + letter ['a'] ... ['z'], that is a byte in the range + \[[0x61];[0x7A]\]. *) + + val is_letter : char -> bool + (** [is_letter c] is [is_lower c || is_upper c]. *) + + val is_alphanum : char -> bool + (** [is_alphanum c] is [is_letter c || is_digit c]. *) + + val is_white : char -> bool + (** [is_white c] is [true] iff [c] is an US-ASCII white space + character, that is one of space [' '] ([0x20]), tab ['\t'] + ([0x09]), newline ['\n'] ([0x0A]), vertical tab ([0x0B]), form + feed ([0x0C]), carriage return ['\r'] ([0x0D]). *) + + val is_blank : char -> bool + (** [is_blank c] is [true] iff [c] is an US-ASCII blank character, + that is either space [' '] ([0x20]) or tab ['\t'] ([0x09]). *) + + val is_graphic : char -> bool + (** [is_graphic c] is [true] iff [c] is an US-ASCII graphic + character that is a byte in the range \[[0x21];[0x7E]\]. *) + + val is_print : char -> bool + (** [is_print c] is [is_graphic c || c = ' ']. *) + + val is_control : char -> bool + (** [is_control c] is [true] iff [c] is an US-ASCII control character, + that is a byte in the range \[[0x00];[0x1F]\] or [0x7F]. *) + + (** {1 Casing transforms} *) + + val uppercase : char -> char + (** [uppercase c] is [c] with US-ASCII characters ['a'] to ['z'] mapped + to ['A'] to ['Z']. *) + + val lowercase : char -> char + (** [lowercase c] is [c] with US-ASCII characters ['A'] to ['Z'] mapped + to ['a'] to ['z']. *) + + (** {1 Escaping to printable US-ASCII} *) + + val escape : char -> string + (** [escape c] escapes [c] with: + {ul + {- ['\\'] ([0x5C]) escaped to the sequence ["\\\\"] ([0x5C],[0x5C]).} + {- Any byte in the ranges \[[0x00];[0x1F]\] and + \[[0x7F];[0xFF]\] escaped by an {e hexadecimal} ["\xHH"] + escape with [H] a capital hexadecimal number. These bytes + are the US-ASCII control characters and non US-ASCII bytes.} + {- Any other byte is left unchanged.}} + + Use {!String.Ascii.unescape} to unescape. *) + + val escape_char : char -> string + (** [escape_char c] is like {!escape} except is escapes [s] according + to OCaml's lexical conventions for characters with: + {ul + {- ['\b'] ([0x08]) escaped to the sequence ["\\b"] ([0x5C,0x62]).} + {- ['\t'] ([0x09]) escaped to the sequence ["\\t"] ([0x5C,0x74]).} + {- ['\n'] ([0x0A]) escaped to the sequence ["\\n"] ([0x5C,0x6E]).} + {- ['\r'] ([0x0D]) escaped to the sequence ["\\r"] ([0x5C,0x72]).} + {- ['\\''] ([0x27]) escaped to the sequence ["\\'"] ([0x5C,0x27]).} + {- Other bytes follow the rules of {!escape}}} + + Use {!String.Ascii.unescape_string} to unescape. *) + end + + (** {1:pp Pretty printing} *) + + val pp : Format.formatter -> char -> unit + (** [pp ppf c] prints [c] on [ppf]. *) + + val dump : Format.formatter -> char -> unit + (** [dump ppf c] prints [c] as a syntactically valid OCaml + char on [ppf] using {!Ascii.escape_char} *) +end + +(** Strings, {{!Sub}substrings}, string {{!Set}sets} and {{!Map}maps}. + + A string [s] of length [l] is a zero-based indexed sequence of [l] + bytes. An index [i] of [s] is an integer in the range + \[[0];[l-1]\], it represents the [i]th byte of [s] which can be + accessed using the string indexing operator [s.[i]]. + + {b Important.} OCaml's [string]s became immutable since 4.02. + Whenever possible compile your code with the [-safe-string] + option. This module does not expose any mutable operation on + strings and {b assumes} strings are immutable. See the + {{!port}porting guide}. *) +module String : sig + + (** {1 String} *) + + type t = string + (** The type for strings. Finite sequences of immutable bytes. *) + + val empty : string + (** [empty] is an empty string. *) + + val v : len:int -> (int -> char) -> string + (** [v len f] is a string [s] of length [len] with [s.[i] = f + i] for all indices [i] of [s]. [f] is invoked + in increasing index order. + + @raise Invalid_argument if [len] is not in the range \[[0]; + {!Sys.max_string_length}\]. *) + + val length : string -> int + (** [length s] is the number of bytes in [s]. *) + + val get : string -> int -> char + (** [get s i] is the byte of [s]' at index [i]. This is + equivalent to the [s.[i]] notation. + + @raise Invalid_argument if [i] is not an index of [s]. *) + + val get_byte : string -> int -> int + (** [get_byte s i] is [Char.to_int (get s i)] *) + + (**/**) + val unsafe_get : string -> int -> char + val unsafe_get_byte : string -> int -> int + (**/**) + + val head : ?rev:bool -> string -> char option + (** [head s] is [Some (get s h)] with [h = 0] if [rev = false] (default) or + [h = length s - 1] if [rev = true]. [None] is returned if [s] is + empty. *) + + val get_head : ?rev:bool -> string -> char + (** [get_head s] is like {!head} but @raise Invalid_argument if [s] + is empty. *) + + val hash : string -> int + (** [hash s] is {!Hashtbl.hash}[ s]. *) + + (** {1:append Appending strings} *) + + val append : string -> string -> string + (** [append s s'] appends [s'] to [s]. This is equivalent to + [s ^ s']. + + @raise Invalid_argument if the result is longer than + {!Sys.max_string_length}. *) + + val concat : ?sep:string -> string list -> string + (** [concat ~sep ss] concatenates the list of strings [ss], separating + each consecutive elements in the list [ss] with [sep] (defaults to + {!empty}). + + @raise Invalid_argument if the result is longer than + {!Sys.max_string_length}. *) + + (** {1 Predicates} *) + + val is_empty : string -> bool + (** [is_empty s] is [length s = 0]. *) + + val is_prefix : affix:string -> string -> bool + (** [is_prefix ~affix s] is [true] iff [affix.[i] = s.[i]] for + all indices [i] of [affix]. *) + + val is_infix : affix:string -> string -> bool + (** [is_infix ~affix s] is [true] iff there exists an index [j] in [s] such + that for all indices [i] of [affix] we have [affix.[i] = s.[j + i]]. *) + + val is_suffix : affix:string -> string -> bool + (** [is_suffix ~affix s] is true iff [affix.[n - i] = s.[m - i]] for all + indices [i] of [affix] with [n = String.length affix - 1] and [m = + String.length s - 1]. *) + + val for_all : (char -> bool) -> string -> bool + (** [for_all p s] is [true] iff for all indices [i] of [s], [p s.[i] + = true]. *) + + val exists : (char -> bool) -> string -> bool + (** [exists p s] is [true] iff there exists an index [i] of [s] with + [p s.[i] = true]. *) + + val equal : string -> string -> bool + (** [equal s s'] is [s = s']. *) + + val compare : string -> string -> int + (** [compare s s'] is [Stdlib.compare s s'], it compares the + byte sequences of [s] and [s'] in lexicographical order. *) + + (** {1:extract Extracting substrings} + + {b Tip.} These functions extract substrings as new strings. Using + {{!Sub}substrings} may be less wasteful and more flexible. *) + + val with_range : ?first:int -> ?len:int -> string -> string + (** [with_range ~first ~len s] are the consecutive bytes of [s] whose + indices exist in the range \[[first];[first + len - 1]\]. + + [first] defaults to [0] and [len] to [max_int]. Note that + [first] can be any integer and [len] any positive integer. + + @raise Invalid_argument if [len] is negative. *) + + val with_index_range : ?first:int -> ?last:int -> string -> string + (** [with_index_range ~first ~last s] are the consecutive bytes of + [s] whose indices exist in the range \[[first];[last]\]. + + [first] defaults to [0] and [last] to [String.length s - 1]. + + Note that both [first] and [last] can be any integer. If + [first > last] the interval is empty and the empty string + is returned. *) + + val trim : ?drop:(char -> bool) -> string -> string + (** [trim ~drop s] is [s] with prefix and suffix bytes satisfying + [drop] in [s] removed. [drop] defaults to {!Char.Ascii.is_white}. *) + + val span : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> + string -> (string * string) + (** [span ~rev ~min ~max ~sat s] is [(l, r)] where: + {ul + {- if [rev] is [false] (default), [l] is at least [min] + and at most [max] consecutive [sat] satisfying initial bytes of + [s] or {!empty} if there are no such bytes. [r] are the remaining + bytes of [s].} + {- if [rev] is [true], [r] is at least [min] and at most [max] + consecutive [sat] satisfying final bytes of [s] or {!empty} + if there are no such bytes. [l] are the remaining + the bytes of [s].}} + If [max] is unspecified the span is unlimited. If [min] + is unspecified it defaults to [0]. If [min > max] the condition + can't be satisfied and the left or right span, depending on [rev], is + always empty. [sat] defaults to [(fun _ -> true)]. + + The invariant [l ^ r = s] holds. + + @raise Invalid_argument if [max] or [min] is negative. *) + + val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> + string -> string + (** [take ~rev ~min ~max ~sat s] is the matching span of {!span} without + the remaining one. In other words: + {[(if rev then snd else fst) @@ span ~rev ~min ~max ~sat s]} *) + + val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> + string -> string + (** [drop ~rev ~min ~max ~sat s] is the remaining span of {!span} without + the matching span. In other words: + {[(if rev then fst else snd) @@ span ~rev ~min ~max ~sat s]} *) + + val cut : ?rev:bool -> sep:string -> string -> (string * string) option + (** [cut ~sep s] is either the pair [Some (l,r)] of the two + (possibly empty) substrings of [s] that are delimited by the + first match of the non empty separator string [sep] or [None] if + [sep] can't be matched in [s]. Matching starts from the + beginning of [s] ([rev] is [false], default) or the end ([rev] + is [true]). + + The invariant [l ^ sep ^ r = s] holds. + + @raise Invalid_argument if [sep] is the empty string. *) + + val cuts : ?rev:bool -> ?empty:bool -> sep:string -> string -> string list + (** [cuts sep s] is the list of all substrings of [s] that are + delimited by matches of the non empty separator string + [sep]. Empty substrings are omitted in the list if [empty] is + [false] (defaults to [true]). + + Matching separators in [s] starts from the beginning of [s] + ([rev] is [false], default) or the end ([rev] is [true]). Once + one is found, the separator is skipped and matching starts + again, that is separator matches can't overlap. If there is no + separator match in [s], the list [[s]] is returned. + + The following invariants hold: + {ul + {- [concat ~sep (cuts ~empty:true ~sep s) = s]} + {- [cuts ~empty:true ~sep s <> []]}} + + @raise Invalid_argument if [sep] is the empty string. *) + + val fields : ?empty:bool -> ?is_sep:(char -> bool) -> string -> string list + (** [fields ~empty ~is_sep s] is the list of (possibly empty) + substrings that are delimited by bytes for which [is_sep] is + [true]. Empty substrings are omitted in the list if [empty] is + [false] (defaults to [true]). [is_sep] defaults to + {!Char.Ascii.is_white}. *) + + (** {1:subs Substrings} *) + + type sub + (** The type for {{!Sub}substrings}. *) + + val sub : ?start:int -> ?stop:int -> string -> sub + (** [sub] is {!Sub.v}. *) + + val sub_with_range : ?first:int -> ?len:int -> string -> sub + (** [sub_with_range] is like {!with_range} but returns a substring + value. If [first] is smaller than [0] the empty string at the start + of [s] is returned. If [first] is greater than the last index of [s] + the empty string at the end of [s] is returned. *) + + val sub_with_index_range : ?first:int -> ?last:int -> string -> sub + (** [sub_with_index_range] is like {!with_index_range} but returns + a substring value. If [first] and [last] are smaller than [0] + the empty string at the start of [s] is returned. If [first] and + is greater than the last index of [s] the empty string at + the end of [s] is returned. If [first > last] and [first] is an + index of [s] the empty string at [first] is returned. *) + + (** Substrings. + + A substring defines a possibly empty subsequence of bytes in + a {e base} string. + + The positions of a string [s] of length [l] are the slits found + before each byte and after the last byte of the string. They + are labelled from left to right by increasing number in the + range \[[0];[l]\]. +{v +positions 0 1 2 3 4 l-1 l + +---+---+---+---+ +-----+ + indices | 0 | 1 | 2 | 3 | ... | l-1 | + +---+---+---+---+ +-----+ +v} + + The [i]th byte index is between positions [i] and [i+1]. + + Formally we define a substring of [s] as being a subsequence + of bytes defined by a {e start} and a {e stop} position. The + former is always smaller or equal to the latter. When both + positions are equal the substring is {e empty}. Note that for a + given base string there are as many empty substrings as there + are positions in the string. + + Like in strings, we index the bytes of a substring using + zero-based indices. + + See how to {{!examples}use} substrings to parse data. *) + module Sub : sig + + (** {1 Substrings} *) + + type t = sub + (** The type for substrings. *) + + val empty : sub + (** [empty] is the empty substring of the empty string {!String.empty}. *) + + val v : ?start:int -> ?stop:int -> string -> sub + (** [v ~start ~stop s] is the substring of [s] that starts + at position [start] (defaults to [0]) and stops at position + [stop] (defaults to [String.length s]). + + @raise Invalid_argument if [start] or [stop] are not positions of + [s] or if [stop < start]. *) + + val start_pos : sub -> int + (** [start_pos s] is [s]'s start position in the base string. *) + + val stop_pos : sub -> int + (** [stop_pos s] is [s]'s stop position in the base string. *) + + val base_string : sub -> string + (** [base_string s] is [s]'s base string. *) + + val length : sub -> int + (** [length s] is the number of bytes in [s]. *) + + val get : sub -> int -> char + (** [get s i] is the byte of [s] at its zero-based index [i]. + + @raise Invalid_argument if [i] is not an index of [s]. *) + + val get_byte : sub -> int -> int + (** [get_byte s i] is [Char.to_int (get s i)]. *) + + (**/**) + val unsafe_get : sub -> int -> char + val unsafe_get_byte : sub -> int -> int + (**/**) + + val head : ?rev:bool -> sub -> char option + (** [head s] is [Some (get s h)] with [h = 0] if [rev = false] (default) or + [h = length s - 1] if [rev = true]. [None] is returned if [s] is + empty. *) + + val get_head : ?rev:bool -> sub -> char + (** [get_head s] is like {!head} but @raise Invalid_argument if [s] + is empty. *) + + val of_string : string -> sub + (** [of_string s] is [v s] *) + + val to_string : sub -> string + (** [to_string s] is the bytes of [s] as a string. *) + + val rebase : sub -> sub + (** [rebase s] is [v (to_string s)]. This puts [s] on a base + string made solely of its bytes. *) + + val hash : sub -> int + (** [hash s] is {!Hashtbl.hash s}. *) + + (** {1:stretch Stretching substrings} + + See the {{!fig}graphical guide}. *) + + val start : sub -> sub + (** [start s] is the empty substring at the start position of [s]. *) + + val stop : sub -> sub + (** [stop s] is the empty substring at the stop position of [s]. *) + + val base : sub -> sub + (** [base s] is a substring that spans the whole base string of [s]. *) + + val tail : ?rev:bool -> sub -> sub + (** [tail s] is [s] without its first ([rev] is [false], default) + or last ([rev] is [true]) byte or [s] if it is empty. *) + + val extend : ?rev:bool -> ?max:int -> ?sat:(char -> bool) -> sub -> sub + (** [extend ~rev ~max ~sat s] extends [s] by at most [max] + consecutive [sat] satisfiying bytes of the base string located + after [stop s] ([rev] is [false], default) or before [start s] + ([rev] is [true]). If [max] is unspecified the extension is + limited by the extents of the base string of [s]. [sat] + defaults to [fun _ -> true]. + + @raise Invalid_argument if [max] is negative. *) + + val reduce : ?rev:bool -> ?max:int -> ?sat:(char -> bool) -> sub -> sub + (** [reduce ~rev ~max ~sat s] reduces [s] by at most [max] + consecutive [sat] satisfying bytes of [s] located before [stop + s] ([rev] is [false], default) or after [start s] ([rev] is + [true]). If [max] is unspecified the reduction is limited by + the extents of the substring [s]. [sat] defaults to [fun _ -> + true]. + + @raise Invalid_argument if [max] is negative. *) + + val extent : sub -> sub -> sub + (** [extent s s'] is the smallest substring that includes all the + positions of [s] and [s']. + + @raise Invalid_argument if [s] and [s'] are not on the same base + string according to physical equality. *) + + val overlap : sub -> sub -> sub option + (** [overlap s s'] is the smallest substring that includes all the + positions common to [s] and [s'] or [None] if there are no + such positions. Note that the overlap substring may be empty. + + @raise Invalid_argument if [s] and [s'] are not on the same base + string according to physical equality. *) + + (** {1:append Appending substrings} *) + + val append : sub -> sub -> sub + (** [append s s'] is like {!String.append}. The substrings can be + on different bases and the result is on a base string that holds + exactly the appended bytes. *) + + val concat : ?sep:sub -> sub list -> sub + (** [concat ~sep ss] is like {!String.concat}. The substrings can + all be on different bases and the result is on a base string that + holds exactly the concatenated bytes. *) + + (** {1:pred Predicates} *) + + val is_empty : sub -> bool + (** [is_empty s] is [length s = 0]. *) + + val is_prefix : affix:sub -> sub -> bool + (** [is_prefix] is like {!String.is_prefix}. Only bytes + are compared, [affix] can be on a different base string. *) + + val is_infix : affix:sub -> sub -> bool + (** [is_infix] is like {!String.is_infix}. Only bytes + are compared, [affix] can be on a different base string. *) + + val is_suffix : affix:sub -> sub -> bool + (** [is_suffix] is like {!String.is_suffix}. Only bytes + are compared, [affix] can be on a different base string. *) + + val for_all : (char -> bool) -> sub -> bool + (** [for_all] is like {!String.for_all} on the substring. *) + + val exists : (char -> bool) -> sub -> bool + (** [exists] is like {!String.exists} on the substring. *) + + val same_base : sub -> sub -> bool + (** [same_base s s'] is [true] iff the substrings [s] and [s'] + have the same base string according to physical equality. *) + + val equal_bytes : sub -> sub -> bool + (** [equal_bytes s s'] is [true] iff the substrings [s] and [s'] have + exactly the same bytes. The substrings can be on a different + base string. *) + + val compare_bytes : sub -> sub -> int + (** [compare_bytes s s'] compares the bytes of [s] and [s]' in + lexicographical order. The substrings can be on a different + base string. *) + + val equal : sub -> sub -> bool + (** [equal s s'] is [true] iff [s] and [s'] have the same positions. + + @raise Invalid_argument if [s] and [s'] are not on the same base + string according to physical equality. *) + + val compare : sub -> sub -> int + (** [compare s s'] compares the positions of [s] and [s'] in + lexicographical order. + + @raise Invalid_argument if [s] and [s'] are not on the same base + string according to physical equality. *) + + (** {1:extract Extracting substrings} + + Extracted substrings are always on the same base string as the + substring [s] acted upon. *) + + val with_range : ?first:int -> ?len:int -> sub -> sub + (** [with_range] is like {!String.sub_with_range}. The indices are the + substring's zero-based ones, not those in the base string. *) + + val with_index_range : ?first:int -> ?last:int -> sub -> sub + (** [with_index_range] is like {!String.sub_with_index_range}. The + indices are the substring's zero-based ones, not those in the + base string. *) + + val trim : ?drop:(char -> bool) -> sub -> sub + (** [trim] is like {!String.trim}. If all bytes are dropped returns + an empty string located in the middle of the argument. *) + + val span : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> + sub -> (sub * sub) + (** [span] is like {!String.span}. For a substring [s] a left + empty span is [start s] and a right empty span is [stop s]. *) + + val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> + sub -> sub + (** [take] is like {!String.take}. *) + + val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> + sub -> sub + (** [drop] is like {!String.drop}. *) + + val cut : ?rev:bool -> sep:sub -> sub -> (sub * sub) option + (** [cut] is like {!String.cut}. [sep] can be on a different base string *) + + val cuts : ?rev:bool -> ?empty:bool -> sep:sub -> sub -> sub list + (** [cuts] is like {!String.cuts}. [sep] can be on a different base + string *) + + val fields : ?empty:bool -> ?is_sep:(char -> bool) -> sub -> sub list + (** [fields] is like {!String.fields}. *) + + (** {1:traverse Traversing substrings} *) + + val find : ?rev:bool -> (char -> bool) -> sub -> sub option + (** [find ~rev sat s] is the substring of [s] (if any) that spans the + first byte that satisfies [sat] in [s] after position [start s] + ([rev] is [false], default) or before [stop s] ([rev] is [true]). + [None] is returned if there is no matching byte in [s]. *) + + val find_sub :?rev:bool -> sub:sub -> sub -> sub option + (** [find_sub ~rev ~sub s] is the substring of [s] (if any) that + spans the first match of [sub] in [s] after position [start s] + ([rev] is [false], default) or before [stop s] ([rev] is + [true]). Only bytes are compared and [sub] can be on a + different base string. [None] is returned if there is no match of + [sub] in [s]. *) + + val filter : (char -> bool) -> sub -> sub + (** [filter sat s] is like {!String.filter}. The result is on a + base string that holds only the filtered bytes. *) + + val filter_map : (char -> char option) -> sub -> sub + (** [filter_map f s] is like {!String.filter_map}. The result is on a + base string that holds only the filtered bytes. *) + + val map : (char -> char) -> sub -> sub + (** [map] is like {!String.map}. The result is on a base string that + holds only the mapped bytes. *) + + val mapi : (int -> char -> char) -> sub -> sub + (** [mapi] is like {!String.mapi}. The result is on a base string that + holds only the mapped bytes. The indices are the substring's + zero-based ones, not those in the base string. *) + + val fold_left : ('a -> char -> 'a) -> 'a -> sub -> 'a + (** [fold_left] is like {!String.fold_left}. *) + + val fold_right : (char -> 'a -> 'a) -> sub -> 'a -> 'a + (** [fold_right] is like {!String.fold_right}. *) + + val iter : (char -> unit) -> sub -> unit + (** [iter] is like {!String.iter}. *) + + val iteri : (int -> char -> unit) -> sub -> unit + (** [iteri] is like {!String.iteri}. The indices are the + substring's zero-based ones, not those in the base string. *) + + (** {1:pp Pretty printing} *) + + val pp : Format.formatter -> sub -> unit + (** [pp ppf s] prints [s]'s bytes on [ppf]. *) + + val dump : Format.formatter -> sub -> unit + (** [dump ppf s] prints [s] as a syntactically valid OCaml string + on [ppf] using {!Ascii.escape_string}. *) + + val dump_raw : Format.formatter -> sub -> unit + (** [dump_raw ppf s] prints an unspecified raw internal + representation of [s] on ppf. *) + + (** {1:convert OCaml base type conversions} *) + + val of_char : char -> sub + (** [of_char c] is a string that contains the byte [c]. *) + + val to_char : sub -> char option + (** [to_char s] is the single byte in [s] or [None] if there is no byte + or more than one in [s]. *) + + val of_bool : bool -> sub + (** [of_bool b] is a string representation for [b]. Relies on + {!Stdlib.string_of_bool}. *) + + val to_bool : sub -> bool option + (** [to_bool s] is a [bool] from [s], if any. Relies on + {!Stdlib.bool_of_string}. *) + + val of_int : int -> sub + (** [of_int i] is a string representation for [i]. Relies on + {!Stdlib.string_of_int}. *) + + val to_int : sub -> int option + (** [to_int] is an [int] from [s], if any. Relies on + {!Stdlib.int_of_string}. *) + + val of_nativeint : nativeint -> sub + (** [of_nativeint i] is a string representation for [i]. Relies on + {!Nativeint.of_string}. *) + + val to_nativeint : sub -> nativeint option + (** [to_nativeint] is an [nativeint] from [s], if any. Relies on + {!Nativeint.to_string}. *) + + val of_int32 : int32 -> sub + (** [of_int32 i] is a string representation for [i]. Relies on + {!Int32.of_string}. *) + + val to_int32 : sub -> int32 option + (** [to_int32] is an [int32] from [s], if any. Relies on + {!Int32.to_string}. *) + + val of_int64 : int64 -> sub + (** [of_int64 i] is a string representation for [i]. Relies on + {!Int64.of_string}. *) + + val to_int64 : sub -> int64 option + (** [to_int64] is an [int64] from [s], if any. Relies on + {!Int64.to_string}. *) + + val of_float : float -> sub + (** [of_float f] is a string representation for [f]. Relies on + {!Stdlib.string_of_float}. *) + + val to_float : sub -> float option + (** [to_float s] is a [float] from [s], if any. Relies + on {!Stdlib.float_of_string}. *) + + (** {1:fig Substring stretching graphical guide} + +{v ++---+---+---+---+---+---+---+---+---+---+---+ +| R | e | v | o | l | t | | n | o | w | ! | ++---+---+---+---+---+---+---+---+---+---+---+ + |---------------| a + | start a + | stop a + |-----------| tail a + |-----------| tail ~rev:true a + |-----------------------------------| extend a +|-----------------------| extend ~rev:true a +|-------------------------------------------| base a +|-----------| b +| start b + | stop b + |-------| tail b +|-------| tail ~rev:true b +|-------------------------------------------| extend b +|-----------| extend ~rev:true b +|-------------------------------------------| base b +|-----------------------| extent a b + |---| overlap a b + | c + | start c + | stop c + | tail c + | tail ~rev:true c + |---------------| extend c +|---------------------------| extend ~rev:true c +|-------------------------------------------| base c + |-------------------| extent a c + None overlap a c + |---------------| d + | start d + | stop d + |-----------| tail d + |-----------| tail ~rev:true d + |---------------| extend d +|-------------------------------------------| extend ~rev:true d +|-------------------------------------------| base d + |---------------| extent d c + | overlap d c +v} *) + end + + (** {1:traverse Traversing strings} *) + + val find : ?rev:bool -> ?start:int -> (char -> bool) -> string -> int option + (** [find ~rev ~start sat s] is: + {ul + {- If [rev] is [false] (default). The smallest index [i], if any, + greater or equal to [start] such that [sat s.[i]] is [true]. + [start] defaults to [0].} + {- If [rev] is [true]. The greatest index [i], if any, smaller or equal + to [start] such that [sat s.[i]] is [true]. + [start] defaults to [String.length s - 1].}} + Note that [start] can be any integer. *) + + val find_sub :?rev:bool -> ?start:int -> sub:string -> string -> int option + (** [find_sub ~rev ~start ~sub s] is: + {ul + {- If [rev] is [false] (default). The smallest index [i], if any, + greater or equal to [start] such that [sub] can be found starting + at [i] in [s] that is [s.[i] = sub.[0]], [s.[i+1] = sub.[1]], ... + [start] defaults to [0].} + {- If [rev] is [true]. The greatest index [i], if any, smaller + or equal to [start] such that [sub] can be found starting at + [i] in [s] that is [s.[i] = sub.[0]], [s.[i+1] = sub.[1]], ... + [start] defaults to [String.length s - 1].}} + Note that [start] can be any integer. *) + + val filter : (char -> bool) -> string -> string + (** [filter sat s] is the string made of the bytes of [s] that satisfy [sat], + in the same order. *) + + val filter_map : (char -> char option) -> string -> string + (** [filter_map f s] is the string made of the bytes of [s] as mapped by + [f], in the same order. *) + + val map : (char -> char) -> string -> string + (** [map f s] is [s'] with [s'.[i] = f s.[i]] for all indices [i] + of [s]. [f] is invoked in increasing index order. *) + + val mapi : (int -> char -> char) -> string -> string + (** [mapi f s] is [s'] with [s'.[i] = f i s.[i]] for all indices [i] + of [s]. [f] is invoked in increasing index order. *) + + val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a + (** [fold_left f acc s] is + [f (]...[(f (f acc s.[0]) s.[1])]...[) s.[m]] + with [m = String.length s - 1]. *) + + val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a + (** [fold_right f s acc] is + [f s.[0] (f s.[1] (]...[(f s.[m] acc) )]...[)] + with [m = String.length s - 1]. *) + + val iter : (char -> unit) -> string -> unit + (** [iter f s] is [f s.[0]; f s.[1];] ... + [f s.[m]] with [m = String.length s - 1]. *) + + val iteri : (int -> char -> unit) -> string -> unit + (** [iteri f s] is [f 0 s.[0]; f 1 s.[1];] ... + [f m s.[m]] with [m = String.length s - 1]. *) + + (** {1:unique Uniqueness} *) + + val uniquify : string list -> string list + (** [uniquify ss] is [ss] without duplicates, the list order is + preserved. *) + + (** {1:ascii Strings as US-ASCII character sequences} *) + + (** US-ASCII string support. + + {b References.} + {ul + {- Vint Cerf. + {{:http://tools.ietf.org/html/rfc20} + {e ASCII format for Network Interchange}}. RFC 20, 1969.}} *) + module Ascii : sig + + (** {1:pred Predicates} *) + + val is_valid : string -> bool + (** [is_valid s] is [true] iff only for all indices [i] of [s], + [s.[i]] is an US-ASCII character, i.e. a byte in the range + \[[0x00];[0x7F]\]. *) + + (** {1:case Casing transforms} + + The following functions act only on US-ASCII code points that + is on bytes in range \[[0x00];[0x7F]\], leaving any other byte + intact. The functions can be safely used on UTF-8 encoded + strings; they will of course only deal with US-ASCII + casings. *) + + val uppercase : string -> string + (** [uppercase s] is [s] with US-ASCII characters ['a'] to ['z'] mapped + to ['A'] to ['Z']. *) + + val lowercase : string -> string + (** [lowercase s] is [s] with US-ASCII characters ['A'] to ['Z'] mapped + to ['a'] to ['z']. *) + + val capitalize : string -> string + (** [capitalize s] is like {!uppercase} but performs the map only + on [s.[0]]. *) + + val uncapitalize : string -> string + (** [uncapitalize s] is like {!lowercase} but performs the map only + on [s.[0]]. *) + + (** {1:esc Escaping to printable US-ASCII} *) + + val escape : string -> string + (** [escape s] is [s] with: + {ul + {- Any ['\\'] ([0x5C]) escaped to the sequence + ["\\\\"] ([0x5C],[0x5C]).} + {- Any byte in the ranges \[[0x00];[0x1F]\] and + \[[0x7F];[0xFF]\] escaped by an {e hexadecimal} ["\xHH"] + escape with [H] a capital hexadecimal number. These bytes + are the US-ASCII control characters and non US-ASCII bytes.} + {- Any other byte is left unchanged.}} *) + + val unescape : string -> string option + (** [unescape s] unescapes what {!escape} did. The letters of hex + escapes can be upper, lower or mixed case, and any two letter + hex escape is decoded to its corresponding byte. Any other + escape not defined by {!escape} or truncated escape makes the + function return [None]. + + The invariant [unescape (escape s) = Some s] holds. *) + + val escape_string : string -> string + (** [escape_string s] is like {!escape} except it escapes [s] + according to OCaml's lexical conventions for strings with: + {ul + {- Any ['\b'] ([0x08]) escaped to the sequence ["\\b"] ([0x5C,0x62]).} + {- Any ['\t'] ([0x09]) escaped to the sequence ["\\t"] ([0x5C,0x74]).} + {- Any ['\n'] ([0x0A]) escaped to the sequence ["\\n"] ([0x5C,0x6E]).} + {- Any ['\r'] ([0x0D]) escaped to the sequence ["\\r"] ([0x5C,0x72]).} + {- Any ['\"'] ([0x22]) escaped to the sequence ["\\\""] ([0x5C,0x22]).} + {- Any other byte follows the rules of {!escape}}} *) + + val unescape_string : string -> string option + (** [unescape_string] is to {!escape_string} what {!unescape} + is to {!escape} and also additionally unescapes + the sequence ["\\'"] ([0x5C,0x27]) to ["'"] ([0x27]). *) + end + + (** {1:pp Pretty printing} *) + + val pp : Format.formatter -> string -> unit + (** [pp ppf s] prints [s]'s bytes on [ppf]. *) + + val dump : Format.formatter -> string -> unit + (** [dump ppf s] prints [s] as a syntactically valid OCaml string on + [ppf] using {!Ascii.escape_string}. *) + + (** {1 String sets and maps} *) + + type set + (** The type for string sets. *) + + (** String sets. *) + module Set : sig + + (** {1 String sets} *) + + include Set.S with type elt := string + and type t := set + + type t = set + + val min_elt : set -> string option + (** Exception safe {!Set.S.min_elt}. *) + + val get_min_elt : set -> string + (** [get_min_elt] is like {!min_elt} but @raise Invalid_argument + on the empty set. *) + + val max_elt : set -> string option + (** Exception safe {!Set.S.max_elt}. *) + + val get_max_elt : set -> string + (** [get_max_elt] is like {!max_elt} but @raise Invalid_argument + on the empty set. *) + + val choose : set -> string option + (** Exception safe {!Set.S.choose}. *) + + val get_any_elt : set -> string + (** [get_any_elt] is like {!choose} but @raise Invalid_argument on the + empty set. *) + + val find : string -> set -> string option + (** Exception safe {!Set.S.find}. *) + + val get : string -> set -> string + (** [get] is like {!Set.S.find} but @raise Invalid_argument if + [elt] is not in [s]. *) + + val of_list : string list -> set + (** [of_list ss] is a set from the list [ss]. *) + + val of_stdlib_set : Set.Make(String).t -> set + (** [of_stdlib_set s] is a set from the stdlib-compatible set [s]. *) + + val to_stdlib_set : set -> Set.Make(String).t + (** [to_stdlib_set s] is the stdlib-compatible set equivalent to [s]. *) + + val pp : ?sep:(Format.formatter -> unit -> unit) -> + (Format.formatter -> string -> unit) -> + Format.formatter -> set -> unit + (** [pp ~sep pp_elt ppf ss] formats the elements of [ss] on + [ppf]. Each element is formatted with [pp_elt] and elements + are separated by [~sep] (defaults to + {!Format.pp_print_cut}. If the set is empty leaves [ppf] + untouched. *) + + val dump : Format.formatter -> set -> unit + (** [dump ppf ss] prints an unspecified representation of [ss] on + [ppf]. *) + end + + (** String maps. *) + module Map : sig + + (** {1 String maps} *) + + include Map.S with type key := string + + val min_binding : 'a t -> (string * 'a) option + (** Exception safe {!Map.S.min_binding}. *) + + val get_min_binding : 'a t -> (string * 'a) + (** [get_min_binding] is like {!min_binding} but @raise Invalid_argument + on the empty map. *) + + val max_binding : 'a t -> (string * 'a) option + (** Exception safe {!Map.S.max_binding}. *) + + val get_max_binding : 'a t -> string * 'a + (** [get_max_binding] is like {!max_binding} but @raise Invalid_argument + on the empty map. *) + + val choose : 'a t -> (string * 'a) option + (** Exception safe {!Map.S.choose}. *) + + val get_any_binding : 'a t -> (string * 'a) + (** [get_any_binding] is like {!choose} but @raise Invalid_argument + on the empty map. *) + + val find : string -> 'a t -> 'a option + (** Exception safe {!Map.S.find}. *) + + val get : string -> 'a t -> 'a + (** [get k m] is like {!Map.S.find} but raises [Invalid_argument] if + [k] is not bound in [m]. *) + + val dom : 'a t -> set + (** [dom m] is the domain of [m]. *) + + val of_list : (string * 'a) list -> 'a t + (** [of_list bs] is [List.fold_left (fun m (k, v) -> add k v m) empty + bs]. *) + + val of_stdlib_map : 'a Map.Make(String).t -> 'a t + (** [of_stdlib_map m] is a map from the stdlib-compatible map [m]. *) + + val to_stdlib_map : 'a t -> 'a Map.Make(String).t + (** [to_stdlib_map m] is the stdlib-compatible map equivalent to [m]. *) + + val pp : ?sep:(Format.formatter -> unit -> unit) -> + (Format.formatter -> string * 'a -> unit) -> Format.formatter -> + 'a t -> unit + (** [pp ~sep pp_binding ppf m] formats the bindings of [m] on + [ppf]. Each binding is formatted with [pp_binding] and + bindings are separated by [sep] (defaults to + {!Format.pp_print_cut}). If the map is empty leaves [ppf] + untouched. *) + + val dump : (Format.formatter -> 'a -> unit) -> Format.formatter -> + 'a t -> unit + (** [dump pp_v ppf m] prints an unspecified representation of [m] on + [ppf] using [pp_v] to print the map codomain elements. *) + + val dump_string_map : Format.formatter -> string t -> unit + (** [dump_string_map ppf m] prints an unspecified representation of the + string map [m] on [ppf]. *) + end + + type +'a map = 'a Map.t + (** The type for maps from strings to values of type 'a. *) + + (** {1:convert OCaml base type conversions} *) + + val of_char : char -> string + (** [of_char c] is a string that contains the byte [c]. *) + + val to_char : string -> char option + (** [to_char s] is the single byte in [s] or [None] if there is no byte + or more than one in [s]. *) + + val of_bool : bool -> string + (** [of_bool b] is a string representation for [b]. Relies on + {!Stdlib.string_of_bool}. *) + + val to_bool : string -> bool option + (** [to_bool s] is a [bool] from [s], if any. Relies on + {!Stdlib.bool_of_string}. *) + + val of_int : int -> string + (** [of_int i] is a string representation for [i]. Relies on + {!Stdlib.string_of_int}. *) + + val to_int : string -> int option + (** [to_int] is an [int] from [s], if any. Relies on + {!Stdlib.int_of_string}. *) + + val of_nativeint : nativeint -> string + (** [of_nativeint i] is a string representation for [i]. Relies on + {!Nativeint.of_string}. *) + + val to_nativeint : string -> nativeint option + (** [to_nativeint] is an [nativeint] from [s], if any. Relies on + {!Nativeint.to_string}. *) + + val of_int32 : int32 -> string + (** [of_int32 i] is a string representation for [i]. Relies on + {!Int32.of_string}. *) + + val to_int32 : string -> int32 option + (** [to_int32] is an [int32] from [s], if any. Relies on + {!Int32.to_string}. *) + + val of_int64 : int64 -> string + (** [of_int64 i] is a string representation for [i]. Relies on + {!Int64.of_string}. *) + + val to_int64 : string -> int64 option + (** [to_int64] is an [int64] from [s], if any. Relies on + {!Int64.to_string}. *) + + val of_float : float -> string + (** [of_float f] is a string representation for [f]. Relies on + {!Stdlib.string_of_float}. *) + + val to_float : string -> float option + (** [to_float s] is a [float] from [s], if any. Relies + on {!Stdlib.float_of_string}. *) +end + +(** {1:diff Differences with the OCaml [String] module} + + First note that it is not a goal of {!Astring} to maintain + compatibility with the OCaml {{!Stdlib.String}[String]} module. + + In [Astring]: + {ul + {- Strings are assumed to be immutable.} + {- Deprecated functions are not included.} + {- Some rarely used functions are dropped, some signatures and names + are altered, a few often needed functions are added.} + {- Scanning functions are not doubled for supporting forward and + reverse directions. Both directions are supported via a single + function and an optional [rev] argument.} + {- Functions do not raise [Not_found]. They return [option] values + instead.} + {- Functions escaping bytes to printable US-ASCII characters use + capital hexadecimal escapes rather than decimal ones.} + {- US-ASCII string support is collected in the {!Char.Ascii} and + {!String.Ascii} submodules. The functions make sure to operate + only on the US-ASCII code points (rather than + {{:http://www.ecma-international.org/publications/standards/Ecma-094.htm}ISO/IEC + 8859-1} code points). This means they can safely be used on + UTF-8 encoded strings, they will of course only deal with the + US-ASCII subset U+0000 to U+007F of + {{:http://unicode.org/glossary/#unicode_scalar_value} Unicode + scalar values}.} + {- The module has pre-applied exception safe {!String.Set} + and {!String.Map} submodules.}} + + {1:port Porting guide} + + Opening [Astring] at the top of a module that uses the OCaml + standard library in a project that compiles with [-safe-string] + will either result in typing errors or compatible behaviour except + for uses of the {!String.trim} function, {{!porttrim}see below}. + + If for some reason you can't compile your project with + [-safe-string] this {b may} not be a problem. However you have to + make sure that your code does not depend on fresh strings being + returned by functions of the [String] module. The functions of + {!Astring.String} assume strings to be immutable and thus do not + always allocate fresh strings for their results. This is the case + for example for the {!( ^ )} operator redefinition: no string is + allocated whenever one of its arguments is an empty string. That + being said it is still better to first make your project compile + with [-safe-string] and then port to [Astring]. + + The + {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/String.html#VALsub}[String.sub]} function + is renamed to {!String.with_range}. If you are working with + {!String.find} you may find it easier to use + {!String.with_index_range} which takes indices as arguments and is thus + directly usable with the result of {!String.find}. But in general + index based string processing should be frowned upon and replaced + by {{!String.extract} substring extraction} combinators. + + {2:porttrim Porting [String.trim] usages} + + The standard OCaml [String.trim] function only trims the + characters [' '], ['\t'], ['\n'], ['\012'], ['\r']. In + [Astring] the {{!Char.Ascii.is_white}default set} adds + vertical tab ([0x0B]) to the set to match the behaviour of + the C [isspace(3)] function. + + If you want to preserve the behaviour of the original function you + can replace any use of [String.trim] with the following + [std_ocaml_trim] function: +{[ +let std_ocaml_trim s = + let drop = function + | ' ' | '\n' | '\012' | '\r' | '\t' -> true + | _ -> false + in + String.trim ~drop s +]} + + {1:examples Examples} + + We show how to use {{!String.Sub}substrings} to quickly devise LL(1) + parsers. To keep it simple we do not implement precise error + report, but note that it would be easy to add it by replacing the + [raise Exit] calls by an exception with more information: we have + everything at hand at these call points to report good error + messages. + + The first example parses version numbers structured as follows: +{[ +[v|V]major.minor[.patch][(+|-)info] +]} + an unreadable {!Str} regular expression for this would be: +{[ + "[vV]?\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?\\([+-]\\(.*\\)\\)?" +]} +Using substrings is certainly less terse but note that the parser is +made of reusable sub-functions. +{[ +let parse_version : string -> (int * int * int * string option) option = +fun s -> try + let parse_opt_v s = match String.Sub.head s with + | Some ('v'|'V') -> String.Sub.tail s + | Some _ -> s + | None -> raise Exit + in + let parse_dot s = match String.Sub.head s with + | Some '.' -> String.Sub.tail s + | Some _ | None -> raise Exit + in + let parse_int s = + match String.Sub.span ~min:1 ~sat:Char.Ascii.is_digit s with + | (i, _) when String.Sub.is_empty i -> raise Exit + | (i, s) -> + match String.Sub.to_int i with + | None -> raise Exit | Some i -> i, s + in + let maj, s = parse_int (parse_opt_v (String.sub s)) in + let min, s = parse_int (parse_dot s) in + let patch, s = match String.Sub.head s with + | Some '.' -> parse_int (parse_dot s) + | _ -> 0, s + in + let info = match String.Sub.head s with + | Some ('+' | '-') -> Some (String.Sub.(to_string (tail s))) + | Some _ -> raise Exit + | None -> None + in + Some (maj, min, patch, info) +with Exit -> None +]} + +The second example parses space separated key-value bindings +environments of the form: +{[ +key0 = value0 key2 = value2 ...]} +To support values with spaces, values can be quoted between two +['"'] characters. If they are quoted then any ["\\\""] subsequence +([0x2F],[0x22]) is interpreted as the character ['"'] ([0x22]) and +["\\\\"] ([0x2F],[0x2F]) is interpreted as the character ['\\'] +([0x22]). + +{[ +let parse_env : string -> string String.map option = +fun s -> try + let skip_white s = String.Sub.drop ~sat:Char.Ascii.is_white s in + let parse_key s = + let id_char c = Char.Ascii.is_letter c || c = '_' in + match String.Sub.span ~min:1 ~sat:id_char s with + | (key, _) when String.Sub.is_empty key -> raise Exit + | (key, rem) -> (String.Sub.to_string key), rem + in + let parse_eq s = match String.Sub.head s with + | Some '=' -> String.Sub.tail s + | Some _ | None -> raise Exit + in + let parse_value s = match String.Sub.head s with + | Some '"' -> (* quoted *) + let is_data = function '\\' | '"' -> false | _ -> true in + let rec loop acc s = + let data, rem = String.Sub.span ~sat:is_data s in + match String.Sub.head rem with + | Some '"' -> + let acc = List.rev (data :: acc) in + String.Sub.(to_string @@ concat acc), (String.Sub.tail rem) + | Some '\\' -> + let rem = String.Sub.tail rem in + begin match String.Sub.head rem with + | Some ('"' | '\\' as c) -> + let acc = String.(sub (of_char c)) :: data :: acc in + loop acc (String.Sub.tail rem) + | Some _ | None -> raise Exit + end + | None | Some _ -> raise Exit + in + loop [] (String.Sub.tail s) + | Some _ -> + let is_data c = not (Char.Ascii.is_white c) in + let data, rem = String.Sub.span ~sat:is_data s in + String.Sub.to_string data, rem + | None -> "", s + in + let rec parse_bindings acc s = + if String.Sub.is_empty s then acc else + let key, s = parse_key s in + let value, s = s |> skip_white |> parse_eq |> skip_white |> parse_value in + parse_bindings (String.Map.add key value acc) (skip_white s) + in + Some (String.sub s |> skip_white |> parse_bindings String.Map.empty) +with Exit -> None +]} + +*) + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring.mllib b/unikernel/duniverse/astring/src/astring.mllib new file mode 100644 index 00000000..2487aded --- /dev/null +++ b/unikernel/duniverse/astring/src/astring.mllib @@ -0,0 +1,7 @@ +Astring_unsafe +Astring_base +Astring_escape +Astring_char +Astring_sub +Astring_string +Astring diff --git a/unikernel/duniverse/astring/src/astring_base.ml b/unikernel/duniverse/astring/src/astring_base.ml new file mode 100644 index 00000000..bad96984 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_base.ml @@ -0,0 +1,98 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Commonalities for strings and substrings *) + +open Astring_unsafe + +let strf = Format.asprintf + +(* Errors *) + +let err_empty_string = "the string is empty" +let err_empty_sep = "~sep is an empty string" +let err_neg_max max = strf "negative ~max (%d)" max +let err_neg_min max = strf "negative ~min (%d)" max +let err_neg_len len = strf "negative length (%d)" len +let err_max_string_len = "Sys.max_string_length exceeded" + +(* Base *) + +let empty = "" + +(* Predicates *) + +let for_all sat s ~first ~last = + let rec loop i = + if i > last then true else + if sat (string_unsafe_get s i) then loop (i + 1) else false + in + loop first + +let exists sat s ~first ~last = + let rec loop i = + if i > last then false else + if sat (string_unsafe_get s i) then true else loop (i + 1) + in + loop first + +(* Traversing *) + +let fold_left f acc s ~first ~last = + let rec loop acc i = + if i > last then acc else + loop (f acc (string_unsafe_get s i)) (i + 1) + in + loop acc first + +let fold_right f s acc ~first ~last = + let rec loop i acc = + if i < first then acc else + loop (i - 1) (f (string_unsafe_get s i) acc) + in + loop last acc + +(* OCaml conversions *) + +let of_char c = + let b = Bytes.create 1 in + bytes_unsafe_set b 0 c; + bytes_unsafe_to_string b + +let to_char s = match string_length s with +| 0 -> None +| 1 -> Some (string_unsafe_get s 0) +| _ -> None + +let of_bool = string_of_bool +let to_bool s = + try Some (bool_of_string s) with Invalid_argument (* good joke *) _ -> None + +let of_int = string_of_int +let to_int s = try Some (int_of_string s) with Failure _ -> None +let of_nativeint = Nativeint.to_string +let to_nativeint s = try Some (Nativeint.of_string s) with Failure _ -> None +let of_int32 = Int32.to_string +let to_int32 s = try Some (Int32.of_string s) with Failure _ -> None +let of_int64 = Int64.to_string +let to_int64 s = try Some (Int64.of_string s) with Failure _ -> None +let of_float = string_of_float +let to_float s = try Some (float_of_string s) with Failure _ -> None + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring_char.ml b/unikernel/duniverse/astring/src/astring_char.ml new file mode 100644 index 00000000..39f5d405 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_char.ml @@ -0,0 +1,99 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let err_byte b = Printf.sprintf "%d is not a byte" b + +(* Bytes *) + +type t = char + +let unsafe_of_byte = Astring_unsafe.char_unsafe_of_byte + +let of_byte b = + if b < 0 || b > 255 then invalid_arg (err_byte b) else unsafe_of_byte b + +let of_int b = + if b < 0 || b > 255 then None else (Some (unsafe_of_byte b)) + +let to_int = Astring_unsafe.char_to_byte + +let hash c = Hashtbl.hash c + +(* Predicates *) + +let equal : t -> t -> bool = fun c0 c1 -> c0 = c1 +let compare : t -> t -> int = fun c0 c1 -> compare c0 c1 + +(* Bytes as US-ASCII characters *) + +module Ascii = struct + let max_ascii = '\x7F' + + let is_valid : t -> bool = fun c -> c <= max_ascii + + let is_digit = function '0' .. '9' -> true | _ -> false + + let is_hex_digit = function + | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> true + | _ -> false + + let is_upper = function 'A' .. 'Z' -> true | _ -> false + + let is_lower = function 'a' .. 'z' -> true | _ -> false + + let is_letter = function 'A' .. 'Z' | 'a' .. 'z' -> true | _ -> false + + let is_alphanum = function + | '0' .. '9' | 'A' .. 'Z' | 'a' .. 'z' -> true + | _ -> false + + let is_white = function ' ' | '\t' .. '\r' -> true | _ -> false + + let is_blank = function ' ' | '\t' -> true | _ -> false + + let is_graphic = function '!' .. '~' -> true | _ -> false + + let is_print = function ' ' .. '~' -> true | _ -> false + + let is_control = function '\x00' .. '\x1F' | '\x7F' -> true | _ -> false + + let uppercase = function + | 'a' .. 'z' as c -> unsafe_of_byte @@ to_int c - 0x20 + | c -> c + + let lowercase = function + | 'A' .. 'Z' as c -> unsafe_of_byte @@ to_int c + 0x20 + | c -> c + + (* Escaping *) + + let escape = Astring_escape.char_escape + let escape_char = Astring_escape.char_escape_char +end + +(* Pretty printing *) + +let pp = Format.pp_print_char +let dump ppf c = + Format.pp_print_char ppf '\''; + Format.pp_print_string ppf (Ascii.escape_char c); + Format.pp_print_char ppf '\''; + () + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring_escape.ml b/unikernel/duniverse/astring/src/astring_escape.ml new file mode 100644 index 00000000..adff2584 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_escape.ml @@ -0,0 +1,192 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring_unsafe + +let hex_digit = + [|'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'A';'B';'C';'D';'E';'F'|] + +let hex_escape b k c = + let byte = char_to_byte c in + let hi = byte / 16 in + let lo = byte mod 16 in + bytes_unsafe_set b (k ) '\\'; + bytes_unsafe_set b (k + 1) 'x'; + bytes_unsafe_set b (k + 2) (array_unsafe_get hex_digit hi); + bytes_unsafe_set b (k + 3) (array_unsafe_get hex_digit lo); + () + +let letter_escape b k letter = + bytes_unsafe_set b (k ) '\\'; + bytes_unsafe_set b (k + 1) letter; + () + +(* Character escapes *) + +let char_escape = function +| '\\' -> "\\\\" +| '\x20' .. '\x7E' as c -> + let b = Bytes.create 1 in + bytes_unsafe_set b 0 c; + bytes_unsafe_to_string b +| c (* hex escape *) -> + let b = Bytes.create 4 in + hex_escape b 0 c; + bytes_unsafe_to_string b + +let char_escape_char = function +| '\\' -> "\\\\" +| '\'' -> "\\'" +| '\b' -> "\\b" +| '\t' -> "\\t" +| '\n' -> "\\n" +| '\r' -> "\\r" +| '\x20' .. '\x7E' as c -> + let b = Bytes.create 1 in + bytes_unsafe_set b 0 c; + bytes_unsafe_to_string b +| c (* hex escape *) -> + let b = Bytes.create 4 in + hex_escape b 0 c; + bytes_unsafe_to_string b + +(* String escapes *) + +let escape s = + let max_idx = string_length s - 1 in + let rec escaped_len i l = + if i > max_idx then l else + match string_unsafe_get s i with + | '\\' -> escaped_len (i + 1) (l + 2) + | '\x20' .. '\x7E' -> escaped_len (i + 1) (l + 1) + | _ (* hex escape *) -> escaped_len (i + 1) (l + 4) + in + let escaped_len = escaped_len 0 0 in + if escaped_len = string_length s then s else + let b = Bytes.create escaped_len in + let rec loop i k = + if i > max_idx then bytes_unsafe_to_string b else + match string_unsafe_get s i with + | '\\' -> + letter_escape b k '\\'; loop (i + 1) (k + 2) + | '\x20' .. '\x7E' as c -> + bytes_unsafe_set b k c; loop (i + 1) (k + 1) + | c -> + hex_escape b k c; loop (i + 1) (k + 4) + in + loop 0 0 + +let escape_string s = + let max_idx = string_length s - 1 in + let rec escaped_len i l = + if i > max_idx then l else + match string_unsafe_get s i with + | '\b' | '\t' | '\n' | '\r' | '\"' | '\\' -> + escaped_len (i + 1) (l + 2) + | '\x20' .. '\x7E' -> + escaped_len (i + 1) (l + 1) + | _ (* hex escape *) -> + escaped_len (i + 1) (l + 4) + in + let escaped_len = escaped_len 0 0 in + if escaped_len = string_length s then s else + let b = Bytes.create escaped_len in + let rec loop i k = + if i > max_idx then bytes_unsafe_to_string b else + match string_unsafe_get s i with + | '\b' -> letter_escape b k 'b'; loop (i + 1) (k + 2) + | '\t' -> letter_escape b k 't'; loop (i + 1) (k + 2) + | '\n' -> letter_escape b k 'n'; loop (i + 1) (k + 2) + | '\r' -> letter_escape b k 'r'; loop (i + 1) (k + 2) + | '\"' -> letter_escape b k '"'; loop (i + 1) (k + 2) + | '\\' -> letter_escape b k '\\'; loop (i + 1) (k + 2) + | '\x20' .. '\x7E' as c -> + bytes_unsafe_set b k c; loop (i + 1) (k + 1) + | c -> + hex_escape b k c; loop (i + 1) (k + 4) + in + loop 0 0 + +(* Unescaping *) + +let is_hex_digit = function +| '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> true +| _ -> false + +let hex_value = function +| '0' .. '9' as c -> char_to_byte c - 0x30 +| 'A' .. 'F' as c -> 10 + (char_to_byte c - 0x41) +| 'a' .. 'f' as c -> 10 + (char_to_byte c - 0x61) +| _ -> assert false + +let unescaped_len ~ocaml s = (* derives length and checks syntax validity *) + let max_idx = string_length s - 1 in + let rec loop i l = + if i > max_idx then Some l else + if string_unsafe_get s i <> '\\' then loop (i + 1) (l + 1) else + let i = i + 1 in + if i > max_idx then None (* truncated escape *) else + match string_unsafe_get s i with + | '\\' -> loop (i + 1) (l + 1) + | 'x' -> + let i = i + 2 in + if i > max_idx then None (* truncated escape *) else + if not (is_hex_digit (string_unsafe_get s (i - 1)) && + is_hex_digit (string_unsafe_get s (i ))) + then None (* invalid escape *) + else loop (i + 1) (l + 1) + | ('b' | 't' | 'n' | 'r' | '"' | '\'') when ocaml -> loop (i + 1) (l + 1) + | c -> None (* invalid escape *) + in + loop 0 0 + +let _unescape ~ocaml s = match unescaped_len ~ocaml s with +| None -> None +| Some l when l = string_length s -> Some s +| Some l -> + let b = Bytes.create l in + let max_idx = string_length s - 1 in + let rec loop i k = + if i > max_idx then Some (bytes_unsafe_to_string b) else + let c = string_unsafe_get s i in + if c <> '\\' then (bytes_unsafe_set b k c; loop (i + 1) (k + 1)) else + let i = i + 1 (* validity checked by unescaped_len *) in + match string_unsafe_get s i with + | '\\' -> bytes_unsafe_set b k '\\'; loop (i + 1) (k + 1) + | 'x' -> + let i = i + 2 (* validity checked by unescaped_len *) in + let hi = hex_value @@ string_unsafe_get s (i - 1) in + let lo = hex_value @@ string_unsafe_get s (i ) in + let c = char_unsafe_of_byte @@ (hi lsl 4) + lo in + bytes_unsafe_set b k c; loop (i + 1) (k + 1) + (* The following cases are never reached for ~ocaml:false *) + | 'b' -> bytes_unsafe_set b k '\b'; loop (i + 1) (k + 1) + | 't' -> bytes_unsafe_set b k '\t'; loop (i + 1) (k + 1) + | 'n' -> bytes_unsafe_set b k '\n'; loop (i + 1) (k + 1) + | 'r' -> bytes_unsafe_set b k '\r'; loop (i + 1) (k + 1) + | '"' -> bytes_unsafe_set b k '\"'; loop (i + 1) (k + 1) + | '\'' -> bytes_unsafe_set b k '\''; loop (i + 1) (k + 1) + | c -> assert false (* because of unescaped_len *) + in + loop 0 0 + +let unescape s = _unescape ~ocaml:false s +let unescape_string s = _unescape ~ocaml:true s + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring_string.ml b/unikernel/duniverse/astring/src/astring_string.ml new file mode 100644 index 00000000..595183f9 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_string.ml @@ -0,0 +1,785 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring_unsafe + +let strf = Format.asprintf + +(* String *) + +type t = string + +let empty = Astring_base.empty +let v ~len f = + let b = Bytes.create len in + for i = 0 to len - 1 do bytes_unsafe_set b i (f i) done; + bytes_unsafe_to_string b + +let length = string_length +let get = string_safe_get +let get_byte s i = char_to_byte (get s i) +let unsafe_get = string_unsafe_get +let unsafe_get_byte s i = char_to_byte (unsafe_get s i) + +let head ?(rev = false) s = + let len = length s in + if len = 0 then None else + Some (string_unsafe_get s (if rev then len - 1 else 0)) + +let get_head ?(rev = false) s = + let len = length s in + if len = 0 then invalid_arg Astring_base.err_empty_string else + string_unsafe_get s (if rev then len - 1 else 0) + +let hash c = Hashtbl.hash c + +(* Appending strings *) + +let append s0 s1 = + let l0 = length s0 in + if l0 = 0 then s1 else + let l1 = length s1 in + if l1 = 0 then s0 else + let b = Bytes.create (l0 + l1) in + bytes_unsafe_blit_string s0 0 b 0 l0; + bytes_unsafe_blit_string s1 0 b l0 l1; + bytes_unsafe_to_string b + +let concat ?(sep = empty) = function +| [] -> empty +| [s] -> s +| s :: ss -> + let s_len = length s in + let sep_len = length sep in + let rec cat_len sep_count l ss = + if l < 0 then l else + match ss with + | s :: ss -> cat_len (sep_count + 1) (l + length s) ss + | [] -> + if sep_len = 0 then l else + let max_sep_count = Sys.max_string_length / sep_len in + if sep_count < 0 || sep_count > max_sep_count then -1 else + sep_count * sep_len + l + in + let cat_len = cat_len 0 s_len ss in + if cat_len < 0 then invalid_arg Astring_base.err_max_string_len else + let b = Bytes.create cat_len in + bytes_unsafe_blit_string s 0 b 0 s_len; + let rec loop i = function + | [] -> bytes_unsafe_to_string b + | str :: ss -> + let sep_first = i in + let str_first = i + sep_len in + let str_len = length str in + bytes_unsafe_blit_string sep 0 b sep_first sep_len; + bytes_unsafe_blit_string str 0 b str_first str_len; + loop (str_first + str_len) ss + in + loop s_len ss + +(* Predicates *) + +let is_empty s = length s = 0 + +let is_prefix ~affix s = + let len_a = length affix in + let len_s = length s in + if len_a > len_s then false else + let max_idx_a = len_a - 1 in + let rec loop i = + if i > max_idx_a then true else + if unsafe_get affix i <> unsafe_get s i then false else loop (i + 1) + in + loop 0 + +let is_infix ~affix s = + let len_a = length affix in + let len_s = length s in + if len_a > len_s then false else + let max_idx_a = len_a - 1 in + let max_idx_s = len_s - len_a in + let rec loop i k = + if i > max_idx_s then false else + if k > max_idx_a then true else + if k > 0 then + if unsafe_get affix k = unsafe_get s (i + k) + then loop i (k + 1) else loop (i + 1) 0 + else + if unsafe_get affix 0 = unsafe_get s i + then loop i 1 else loop (i + 1) 0 + in + loop 0 0 + +let is_suffix ~affix s = + let max_idx_a = length affix - 1 in + let max_idx_s = length s - 1 in + if max_idx_a > max_idx_s then false else + let rec loop i = + if i > max_idx_a then true else + if unsafe_get affix (max_idx_a - i) <> unsafe_get s (max_idx_s - i) + then false + else loop (i + 1) + in + loop 0 + +let for_all sat s = Astring_base.for_all sat s ~first:0 ~last:(length s - 1) +let exists sat s = Astring_base.exists sat s ~first:0 ~last:(length s - 1) +let equal = string_equal +let compare = string_compare + +(* Extracting substrings *) + +let with_range ?(first = 0) ?(len = max_int) s = + if len < 0 then invalid_arg (Astring_base.err_neg_len len) else + if len = 0 then empty else + let s_len = length s in + let max_idx = s_len - 1 in + let last = match len with + | len when len = max_int -> max_idx + | len -> + let last = first + len - 1 in + if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first > max_idx || last < 0 || first > last then empty else + if first = 0 && last = max_idx then s else + unsafe_string_sub s first (last + 1 - first) + +let with_index_range ?(first = 0) ?last s = + let s_len = length s in + let max_idx = s_len - 1 in + let last = match last with + | None -> max_idx + | Some last -> if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first > max_idx || last < 0 || first > last then empty else + if first = 0 && last = max_idx then s else + unsafe_string_sub s first (last + 1 - first) + +let trim ?(drop = Astring_char.Ascii.is_white) s = + let len = length s in + if len = 0 then s else + let max_idx = len - 1 in + let rec left_pos i = + if i > max_idx then len else + if drop (unsafe_get s i) then left_pos (i + 1) else i + in + let rec right_pos i = + if i < 0 then 0 else + if drop (unsafe_get s i) then right_pos (i - 1) else (i + 1) + in + let left = left_pos 0 in + if left = len then empty else + let right = right_pos max_idx in + if left = 0 && right = len then s else + unsafe_string_sub s left (right - left) + +let fspan ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then (empty, s) else + let len = length s in + let max_idx = len - 1 in + let max_idx = let k = max - 1 in (if k > max_idx then max_idx else k) in + let need_idx = min in + let rec loop i = + if i <= max_idx && sat (unsafe_get s i) then loop (i + 1) else + if i < need_idx || i = 0 then (empty, s) else + if i = len then (s, empty) else + unsafe_string_sub s 0 i, unsafe_string_sub s i (len - i) + in + loop 0 + +let rspan ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then (s, empty) else + let len = length s in + let max_idx = len - 1 in + let min_idx = let k = len - max in (if k < 0 then 0 else k) in + let need_idx = max_idx - min in + let rec loop i = + if i >= min_idx && sat (unsafe_get s i) then loop (i - 1) else + if i > need_idx || i = max_idx then (s, empty) else + if i = -1 then (empty, s) else + let cut = i + 1 in + unsafe_string_sub s 0 cut, unsafe_string_sub s cut (len - cut) + in + loop max_idx + +let span ?(rev = false) ?min ?max ?sat s = match rev with +| true -> rspan ?min ?max ?sat s +| false -> fspan ?min ?max ?sat s + +(* N.B. c&p of fspan *) +let ftake ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then empty else + let len = length s in + let max_idx = len - 1 in + let max_idx = let k = max - 1 in (if k > max_idx then max_idx else k) in + let need_idx = min in + let rec loop i = + if i <= max_idx && sat (unsafe_get s i) then loop (i + 1) else + if i < need_idx || i = 0 then empty else + if i = len then s else + unsafe_string_sub s 0 i + in + loop 0 + +(* N.B. c&p of rspan *) +let rtake ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then empty else + let len = length s in + let max_idx = len - 1 in + let min_idx = let k = len - max in (if k < 0 then 0 else k) in + let need_idx = max_idx - min in + let rec loop i = + if i >= min_idx && sat (unsafe_get s i) then loop (i - 1) else + if i > need_idx || i = max_idx then empty else + if i = -1 then s else + let cut = i + 1 in + unsafe_string_sub s cut (len - cut) + in + loop max_idx + +let take ?(rev = false) ?min ?max ?sat s = match rev with +| true -> rtake ?min ?max ?sat s +| false -> ftake ?min ?max ?sat s + +(* N.B. c&p of fspan *) +let fdrop ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then s else + let len = length s in + let max_idx = len - 1 in + let max_idx = let k = max - 1 in (if k > max_idx then max_idx else k) in + let need_idx = min in + let rec loop i = + if i <= max_idx && sat (unsafe_get s i) then loop (i + 1) else + if i < need_idx || i = 0 then s else + if i = len then empty else + unsafe_string_sub s i (len - i) + in + loop 0 + +(* N.B. c&p of rspan *) +let rdrop ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then s else + let len = length s in + let max_idx = len - 1 in + let min_idx = let k = len - max in (if k < 0 then 0 else k) in + let need_idx = max_idx - min in + let rec loop i = + if i >= min_idx && sat (unsafe_get s i) then loop (i - 1) else + if i > need_idx || i = max_idx then s else + if i = -1 then empty else + let cut = i + 1 in + unsafe_string_sub s 0 cut + in + loop max_idx + +let drop ?(rev = false) ?min ?max ?sat s = match rev with +| true -> rdrop ?min ?max ?sat s +| false -> fdrop ?min ?max ?sat s + +let fcut ~sep s = + let sep_len = length sep in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let s_len = length s in + let max_sep_idx = sep_len - 1 in + let max_s_idx = s_len - sep_len in + let rec check_sep i k = + if k > max_sep_idx then + let r_start = i + sep_len in + Some (unsafe_string_sub s 0 i, + unsafe_string_sub s r_start (s_len - r_start)) + else + if unsafe_get s (i + k) = unsafe_get sep k + then check_sep i (k + 1) + else scan (i + 1) + and scan i = + if i > max_s_idx then None else + if unsafe_get s i = unsafe_get sep 0 then check_sep i 1 else scan (i + 1) + in + scan 0 + +let rcut ~sep s = + let sep_len = length sep in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let s_len = length s in + let max_sep_idx = sep_len - 1 in + let max_s_idx = s_len - 1 in + let rec check_sep i k = + if k > max_sep_idx then + let r_start = i + sep_len in + Some (unsafe_string_sub s 0 i, + unsafe_string_sub s r_start (s_len - r_start)) + else + if unsafe_get s (i + k) = unsafe_get sep k + then check_sep i (k + 1) + else rscan (i - 1) + and rscan i = + if i < 0 then None else + if unsafe_get s i = unsafe_get sep 0 then check_sep i 1 else rscan (i - 1) + in + rscan (max_s_idx - max_sep_idx) + +let cut ?(rev = false) ~sep s = if rev then rcut ~sep s else fcut ~sep s + +let add_sub ~no_empty s ~start ~stop acc = + if start = stop then (if no_empty then acc else empty :: acc) else + unsafe_string_sub s start (stop - start) :: acc + +let fcuts ~no_empty ~sep s = + let sep_len = length sep in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let s_len = length s in + let max_sep_idx = sep_len - 1 in + let max_s_idx = s_len - sep_len in + let rec check_sep start i k acc = + if k > max_sep_idx then + let new_start = i + sep_len in + scan new_start new_start (add_sub ~no_empty s ~start ~stop:i acc) + else + if unsafe_get s (i + k) = unsafe_get sep k + then check_sep start i (k + 1) acc + else scan start (i + 1) acc + and scan start i acc = + if i > max_s_idx then + if start = 0 then (if no_empty && s_len = 0 then [] else [s]) else + List.rev (add_sub ~no_empty s ~start ~stop:s_len acc) + else + if unsafe_get s i = unsafe_get sep 0 + then check_sep start i 1 acc + else scan start (i + 1) acc + in + scan 0 0 [] + +let rcuts ~no_empty ~sep s = + let sep_len = length sep in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let s_len = length s in + let max_sep_idx = sep_len - 1 in + let max_s_idx = s_len - 1 in + let rec check_sep stop i k acc = + if k > max_sep_idx then + let start = i + sep_len in + rscan i (i - sep_len) (add_sub ~no_empty s ~start ~stop acc) + else if unsafe_get s (i + k) = unsafe_get sep k + then check_sep stop i (k + 1) acc + else rscan stop (i - 1) acc + and rscan stop i acc = + if i < 0 then + if stop = s_len then (if no_empty && s_len = 0 then [] else [s]) else + add_sub ~no_empty s ~start:0 ~stop:stop acc + else if unsafe_get s i = unsafe_get sep 0 + then check_sep stop i 1 acc + else rscan stop (i - 1) acc + in + rscan s_len (max_s_idx - max_sep_idx) [] + +let cuts ?(rev = false) ?(empty = true) ~sep s = match rev with +| true -> rcuts ~no_empty:(not empty) ~sep s +| false -> fcuts ~no_empty:(not empty) ~sep s + +let fields ?(empty = true) ?(is_sep = Astring_char.Ascii.is_white) s = + let no_empty = not empty in + let max_pos = length s in + let rec loop i end_pos acc = + if i < 0 then begin + if end_pos = max_pos + then (if no_empty && max_pos = 0 then [] else [s]) + else add_sub ~no_empty s ~start:0 ~stop:end_pos acc + end else begin + if not (is_sep (unsafe_get s i)) then loop (i - 1) end_pos acc else + loop (i - 1) i (add_sub ~no_empty s ~start:(i + 1) ~stop:end_pos acc) + end + in + loop (max_pos - 1) max_pos [] + +(* Substrings *) + +type sub = Astring_sub.t + +module Sub = Astring_sub + +let sub = Sub.v +let sub_with_range = Sub.of_string_with_range +let sub_with_index_range = Sub.of_string_with_index_range + +(* Traversing *) + +let ffind ?start sat s = + let max_idx = length s - 1 in + let rec loop i = + if i > max_idx then None else + if sat (unsafe_get s i) then Some i else loop (i + 1) + in + match start with + | None -> loop 0 + | Some i when i < 0 -> loop 0 + | Some i -> loop i + +let rfind ?start sat s = + let max_idx = length s - 1 in + let rec loop i = + if i < 0 then None else + if sat (unsafe_get s i) then Some i else loop (i - 1) + in + match start with + | None -> loop max_idx + | Some i when i > max_idx -> loop max_idx + | Some i -> loop i + +let find ?(rev = false) ?start sat s = match rev with +| false -> ffind ?start sat s +| true -> rfind ?start sat s + +let ffind_sub ?start ~sub s = + let len_sub = length sub in + let len_s = length s in + let max_idx_sub = len_sub - 1 in + let max_idx_s = if len_sub <> 0 then len_s - len_sub else len_s - 1 in + let rec loop i k = + if i > max_idx_s then None else + if k > max_idx_sub then Some i else + if k > 0 then + if unsafe_get sub k = unsafe_get s (i + k) + then loop i (k + 1) else loop (i + 1) 0 + else + if unsafe_get sub 0 = unsafe_get s i + then loop i 1 else loop (i + 1) 0 + in + match start with + | None -> loop 0 0 + | Some i when i < 0 -> loop 0 0 + | Some i -> loop i 0 + +let rfind_sub ?start ~sub s = + let len_sub = length sub in + let len_s = length s in + let max_idx_sub = len_sub - 1 in + let max_idx_s = if len_sub <> 0 then len_s - len_sub else len_s - 1 in + let rec loop i k = + if i < 0 then None else + if k > max_idx_sub then Some i else + if k > 0 then + if unsafe_get sub k = unsafe_get s (i + k) + then loop i (k + 1) else loop (i - 1) 0 + else + if unsafe_get sub 0 = unsafe_get s i + then loop i 1 else loop (i - 1) 0 + in + match start with + | None -> loop max_idx_s 0 + | Some i when i > max_idx_s -> loop max_idx_s 0 + | Some i -> loop i 0 + +let find_sub ?(rev = false) ?start ~sub s = match rev with +| false -> ffind_sub ?start ~sub s +| true -> rfind_sub ?start ~sub s + +let filter sat s = + let max_idx = length s - 1 in + let rec with_buf b k i = (* k is the write index in b *) + if i > max_idx then Bytes.sub_string b 0 k else + let c = unsafe_get s i in + if sat c then (bytes_unsafe_set b k c; with_buf b (k + 1) (i + 1)) else + with_buf b k (i + 1) + in + let rec try_no_alloc i = + if i > max_idx then s else + if (sat (unsafe_get s i)) then try_no_alloc (i + 1) else + if i = max_idx then unsafe_string_sub s 0 i else + let b = Bytes.of_string s in (* copy and overwrite starting from i *) + with_buf b i (i + 1) + in + try_no_alloc 0 + +let filter_map f s = + let max_idx = length s - 1 in + let rec with_buf b k i = (* k is the write index in b *) + if i > max_idx then + (if k > max_idx then bytes_unsafe_to_string b else Bytes.sub_string b 0 k) + else + match f (unsafe_get s i) with + | None -> with_buf b k (i + 1) + | Some c -> bytes_unsafe_set b k c; with_buf b (k + 1) (i + 1) + in + let rec try_no_alloc i = + if i > max_idx then s else + let c = unsafe_get s i in + match f c with + | None -> + if i = max_idx then unsafe_string_sub s 0 i else + let b = Bytes.of_string s in + with_buf b i (i + 1) + | Some cm when cm <> c -> + let b = Bytes.of_string s in + bytes_unsafe_set b i cm; + with_buf b (i + 1) (i + 1) + | Some _ -> + try_no_alloc (i + 1) + in + try_no_alloc 0 + +let map f s = + let max_idx = length s - 1 in + let rec with_buf b i = + if i > max_idx then bytes_unsafe_to_string b else + (bytes_unsafe_set b i (f (unsafe_get s i)); with_buf b (i + 1)) + in + let rec try_no_alloc i = + if i > max_idx then s else + let c = unsafe_get s i in + match f c with + | cm when cm <> c -> + let b = Bytes.of_string s in + bytes_unsafe_set b i cm; + with_buf b (i + 1) + | _ -> + try_no_alloc (i + 1) + in + try_no_alloc 0 + +let mapi f s = + let max_idx = length s - 1 in + let rec with_buf b i = + if i > max_idx then bytes_unsafe_to_string b else + (bytes_unsafe_set b i (f i (unsafe_get s i)); with_buf b (i + 1)) + in + let rec try_no_alloc i = + if i > max_idx then s else + let c = unsafe_get s i in + match f i c with + | cm when cm <> c -> + let b = Bytes.of_string s in + bytes_unsafe_set b i cm; + with_buf b (i + 1) + | _ -> + try_no_alloc (i + 1) + in + try_no_alloc 0 + +let fold_left f acc s = + Astring_base.fold_left f acc s ~first:0 ~last:(length s - 1) + +let fold_right f s acc = + Astring_base.fold_right f s acc ~first:0 ~last:(length s - 1) + +let iter f s = for i = 0 to length s - 1 do f (unsafe_get s i) done +let iteri f s = for i = 0 to length s - 1 do f i (unsafe_get s i) done + +(* Strings as US-ASCII code point sequences *) + +module Ascii = struct + + let is_valid s = + let max_idx = length s - 1 in + let rec loop i = + if i > max_idx then true else + if unsafe_get s i > Astring_char.Ascii.max_ascii then false else + loop (i + 1) + in + loop 0 + + (* Casing transforms *) + + let caseify is_not_case to_case s = + let max_idx = length s - 1 in + let caseify b i = + for k = i to max_idx do + bytes_unsafe_set b k (to_case (unsafe_get s k)) + done; + bytes_unsafe_to_string b + in + let rec try_no_alloc i = + if i > max_idx then s else + if is_not_case (unsafe_get s i) then caseify (Bytes.of_string s) i else + try_no_alloc (i + 1) + in + try_no_alloc 0 + + let uppercase s = + caseify Astring_char.Ascii.is_lower Astring_char.Ascii.uppercase s + + let lowercase s = + caseify Astring_char.Ascii.is_upper Astring_char.Ascii.lowercase s + + let caseify_first is_not_case to_case s = + if length s = 0 then s else + let c = unsafe_get s 0 in + if not (is_not_case c) then s else + let b = Bytes.of_string s in + bytes_unsafe_set b 0 (to_case c); + bytes_unsafe_to_string b + + let capitalize s = + caseify_first Astring_char.Ascii.is_lower Astring_char.Ascii.uppercase s + + let uncapitalize s = + caseify_first Astring_char.Ascii.is_upper Astring_char.Ascii.lowercase s + + (* Escape *) + + let escape = Astring_escape.escape + let unescape = Astring_escape.unescape + let escape_string = Astring_escape.escape_string + let unescape_string = Astring_escape.unescape_string +end + +(* Pretty printing *) + +let pp = Format.pp_print_string +let dump ppf s = + Format.pp_print_char ppf '"'; + Format.pp_print_string ppf (Ascii.escape_string s); + Format.pp_print_char ppf '"'; + () + +(* String sets and maps *) + +module Set = struct + include Set.Make (String) + + let pp ?sep:(pp_sep = Format.pp_print_cut) pp_elt ppf ss = + let pp_elt elt is_first = + if is_first then () else pp_sep ppf (); + pp_elt ppf elt; false + in + ignore (fold pp_elt ss true) + + let dump_str = dump + let dump ppf ss = + let pp_elt elt is_first = + if is_first then () else Format.fprintf ppf "@ "; + Format.fprintf ppf "%a" dump_str elt; + false + in + Format.fprintf ppf "@[<1>{"; + ignore (fold pp_elt ss true); + Format.fprintf ppf "}@]"; + () + + let err_empty () = invalid_arg "empty set" + let err_absent s ss = + invalid_arg (strf "%a not in set %a" dump_str s dump ss) + + let get_min_elt ss = try min_elt ss with Not_found -> err_empty () + let min_elt ss = try Some (min_elt ss) with Not_found -> None + + let get_max_elt ss = try max_elt ss with Not_found -> err_empty () + let max_elt ss = try Some (max_elt ss) with Not_found -> None + + let get_any_elt ss = try choose ss with Not_found -> err_empty () + let choose ss = try Some (choose ss) with Not_found -> None + + let get s ss = try find s ss with Not_found -> err_absent s ss + let find s ss = try Some (find s ss) with Not_found -> None + + let of_list = List.fold_left (fun acc s -> add s acc) empty + + let of_stdlib_set s = s + let to_stdlib_set s = s +end + +module Map = struct + include Map.Make (String) + + let err_empty () = invalid_arg "empty map" + let err_absent s = invalid_arg (strf "%a is not bound in map" dump s) + + let get_min_binding m = try min_binding m with Not_found -> err_empty () + let min_binding m = try Some (min_binding m) with Not_found -> None + + let get_max_binding m = try max_binding m with Not_found -> err_empty () + let max_binding m = try Some (max_binding m) with Not_found -> None + + let get_any_binding m = try choose m with Not_found -> err_empty () + let choose m = try Some (choose m) with Not_found -> None + + let get k s = try find k s with Not_found -> err_absent k + let find k m = try Some (find k m) with Not_found -> None + + let dom m = fold (fun k _ acc -> Set.add k acc) m Set.empty + + let of_list bs = List.fold_left (fun m (k,v) -> add k v m) empty bs + + let of_stdlib_map m = m + let to_stdlib_map m = m + + let pp ?sep:(pp_sep = Format.pp_print_cut) pp_binding ppf (m : 'a t) = + let pp_binding k v is_first = + if is_first then () else pp_sep ppf (); + pp_binding ppf (k, v); false + in + ignore (fold pp_binding m true) + + let dump_str = dump + let dump pp_v ppf m = + let pp_binding k v is_first = + if is_first then () else Format.fprintf ppf "@ "; + Format.fprintf ppf "@[<1>(@[%a@],@ @[%a@])@]" dump k pp_v v; + false + in + Format.fprintf ppf "@[<1>{"; + ignore (fold pp_binding m true); + Format.fprintf ppf "}@]"; + () + + let dump_string_map ppf m = dump dump_str ppf m +end + +type set = Set.t +type 'a map = 'a Map.t + +(* Uniqueness *) + +let uniquify ss = + let add (seen, ss as acc) v = + if Set.mem v seen then acc else (Set.add v seen, v :: ss) + in + List.rev (snd (List.fold_left add (Set.empty, []) ss)) + +(* OCaml base type conversions *) + +let of_char = Astring_base.of_char +let to_char = Astring_base.to_char +let of_bool = Astring_base.of_bool +let to_bool = Astring_base.to_bool +let of_int = Astring_base.of_int +let to_int = Astring_base.to_int +let of_nativeint = Astring_base.of_nativeint +let to_nativeint = Astring_base.to_nativeint +let of_int32 = Astring_base.of_int32 +let to_int32 = Astring_base.to_int32 +let of_int64 = Astring_base.of_int64 +let to_int64 = Astring_base.to_int64 +let of_float = Astring_base.of_float +let to_float = Astring_base.to_float + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring_sub.ml b/unikernel/duniverse/astring/src/astring_sub.ml new file mode 100644 index 00000000..f8110a9f --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_sub.ml @@ -0,0 +1,712 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring_unsafe + +let sunsafe_get = string_unsafe_get + +(* Errors *) + +let strf = Format.asprintf +let err_base = "not on the same base string" +let err_empty_sub pos = strf "empty substring [%d;%d]" pos pos +let err_pos_range start stop len = + strf "invalid start:%d stop:%d for position range [0;%d]" start stop len + +(* From strings *) + +let v ?(start = 0) ?stop s = + let s_len = string_length s in + let stop = match stop with None -> s_len | Some stop -> stop in + if start < 0 || stop > s_len || stop < start + then invalid_arg (err_pos_range start stop s_len) + else (s, start, stop) + +let of_string_with_range ?(first = 0) ?(len = max_int) s = + if len < 0 then invalid_arg (Astring_base.err_neg_len len) else + let s_len = string_length s in + let max_idx = s_len - 1 in + let empty = function + | first when first < 0 -> (s, 0, 0) + | first when first > max_idx -> (s, s_len, s_len) + | first -> (s, first, first) + in + if len = 0 then empty first else + let last (* index *) = match len with + | len when len = max_int -> max_idx + | len -> + let last = first + len - 1 in + if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first > max_idx || last < 0 || first > last then empty first else + (s, first, last + 1 (* position *)) + +let of_string_with_index_range ?(first = 0) ? last s = + let s_len = string_length s in + let max_idx = s_len - 1 in + let empty = function + | first when first < 0 -> (s, 0, 0) + | first when first > max_idx -> (s, s_len, s_len) + | first -> (s, first, first) + in + let last (* index *) = match last with + | None -> max_idx + | Some last -> if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first > max_idx || last < 0 || first > last then empty first else + (s, first, last + 1 (* position *)) + +(* Substrings *) + +type t = string * int * int + +let empty = (Astring_base.empty, 0, 0) +let start_pos (_, start, _) = start +let stop_pos (_, _, stop) = stop +let base_string (s, _, _) = s +let length (_, start, stop) = stop - start +let get (s, start, _) i = string_safe_get s (start + i) +let get_byte s i = char_to_byte (get s i) +let unsafe_get (s, start, _) i = string_unsafe_get s (start + i) +let unsafe_get_byte s i = char_to_byte (unsafe_get s i) + +let head ?(rev = false) (s, start, stop) = + if start = stop then None else + Some (string_unsafe_get s (if rev then stop - 1 else start)) + +let get_head ?(rev = false) (s, start, stop) = + if start = stop then invalid_arg (err_empty_sub start) else + string_unsafe_get s (if rev then stop - 1 else start) + +let of_string s = v s +let to_string (s, start, stop) = + if start = stop then Astring_base.empty else + if start = 0 && stop = string_length s then s else + unsafe_string_sub s start (stop - start) + +let rebase (_, start, stop as sub) = (to_string sub, 0, stop - start) +let hash s = Hashtbl.hash s + +(* Stretching substrings *) + +let start (s, start, _) = (s, start, start) +let stop (s, _, stop) = (s, stop, stop) +let base (s, _, _) = (s, 0, string_length s) + +let tail ?(rev = false) (s, start, stop as sub) = + if start = stop then sub else + if rev then (s, start, stop - 1) else (s, start + 1, stop) + +let fextend ?max ~sat (s, start, stop) = + let max_idx = string_length s - 1 in + let max_idx = match max with + | None -> max_idx + | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max) + | Some max -> let i = stop + max - 1 in if i > max_idx then max_idx else i + in + let rec loop i = + if i > max_idx then (s, start, i) else + if sat (string_unsafe_get s i) then loop (i + 1) else + (s, start, i) + in + loop stop + +let rextend ?max ~sat (s, start, stop) = + let min_idx = match max with + | None -> 0 + | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max) + | Some max -> let i = start - max in if i < 0 then 0 else i + in + let rec loop i = + if i < min_idx then (s, min_idx, stop) else + if sat (string_unsafe_get s i) then loop (i - 1) else + (s, i + 1, stop) + in + loop (start - 1) + +let extend ?(rev = false) ?max ?(sat = (fun _ -> true)) sub = match rev with +| true -> rextend ?max ~sat sub +| false -> fextend ?max ~sat sub + +let freduce ?max ~sat (s, start, stop as sub) = + if start = stop then sub else + let min_idx = match max with + | None -> start + | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max) + | Some max -> let i = stop - max in if i < start then start else i + in + let rec loop i = + if i < min_idx then (s, start, min_idx) else + if sat (string_unsafe_get s i) then loop (i - 1) else + (s, start, i + 1) + in + loop (stop - 1) + +let rreduce ?max ~sat (s, start, stop as sub) = + if start = stop then sub else + let max_idx = stop - 1 in + let max_idx = match max with + | None -> max_idx + | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max) + | Some max -> let i = start + max - 1 in if i > max_idx then max_idx else i + in + let rec loop i = + if i > max_idx then (s, i, stop) else + if sat (string_unsafe_get s i) then loop (i + 1) else + (s, i, stop) + in + loop start + +let reduce ?(rev = false) ?max ?(sat = (fun _ -> true)) sub = match rev with +| true -> rreduce ?max ~sat sub +| false -> freduce ?max ~sat sub + +let extent (s0, start0, stop0) (s1, start1, stop1) = + if s0 != s1 then invalid_arg err_base else + let start = if start0 < start1 then start0 else start1 in + let stop = if stop0 < stop1 then stop1 else stop0 in + (s0, start, stop) + +let overlap (s0, start0, stop0) (s1, start1, stop1) = + if s0 != s1 then invalid_arg err_base else + if not (start0 <= stop1 && start1 <= stop0) then None else + let start = if start0 < start1 then start1 else start0 in + let stop = if stop0 < stop1 then stop0 else stop1 in + Some (s0, start, stop) + +(* Appending substrings *) + +let append (s0, start0, _ as sub0) (s1, start1, _ as sub1) = + let l0 = length sub0 in + if l0 = 0 then rebase sub1 else + let l1 = length sub1 in + if l1 = 0 then rebase sub0 else + let len = l0 + l1 in + let b = Bytes.create len in + bytes_unsafe_blit_string s0 start0 b 0 l0; + bytes_unsafe_blit_string s1 start1 b l0 l1; + (bytes_unsafe_to_string b, 0, len) + +let concat ?sep:(sep, sep_start, _ as sep_sub = empty) = function +| [] -> empty +| [s] -> rebase s +| (s, start, _ as sub) :: ss -> + let sub_len = length sub in + let sep_len = length sep_sub in + let rec cat_len sep_count l ss = + if l < 0 then l else + match ss with + | s :: ss -> cat_len (sep_count + 1) (l + length s) ss + | [] -> + if sep_len = 0 then l else + let max_sep_count = Sys.max_string_length / sep_len in + if sep_count < 0 || sep_count > max_sep_count then -1 else + sep_count * sep_len + l + in + let cat_len = cat_len 0 sub_len ss in + if cat_len < 0 then invalid_arg Astring_base.err_max_string_len else + let b = Bytes.create cat_len in + bytes_unsafe_blit_string s start b 0 sub_len; + let rec loop i = function + | [] -> bytes_unsafe_to_string b + | (str, str_start, _ as str_sub) :: ss -> + let sep_pos = i in + let str_pos = i + sep_len in + let str_len = length str_sub in + bytes_unsafe_blit_string sep sep_start b sep_pos sep_len; + bytes_unsafe_blit_string str str_start b str_pos str_len; + loop (str_pos + str_len) ss + in + (loop sub_len ss, 0, cat_len) + +(* Predicates *) + +let is_empty (_, start, stop) = stop - start = 0 + +let is_prefix ~affix:(affix, astart, _ as affix_sub) (s, sstart, _ as s_sub) = + let len_a = length affix_sub in + let len_s = length s_sub in + if len_a > len_s then false else + let max_zidx (* zero based idx *) = len_a - 1 in + let rec loop i = + if i > max_zidx then true else + if sunsafe_get affix (astart + i) <> sunsafe_get s (sstart + i) + then false + else loop (i + 1) + in + loop 0 + +let is_infix ~affix:(affix, astart, _ as affix_sub) (s, sstart, _ as s_sub) = + let len_a = length affix_sub in + let len_s = length s_sub in + if len_a > len_s then false else + let max_zidx_a (* zero based idx *) = len_a - 1 in + let max_zidx_s (* zero based idx *) = len_s - len_a in + let rec loop i k = + if i > max_zidx_s then false else + if k > max_zidx_a then true else + if k > 0 then + if sunsafe_get affix (astart + k) = sunsafe_get s (sstart + i + k) + then loop i (k + 1) + else loop (i + 1) 0 + else if sunsafe_get affix astart = sunsafe_get s (sstart + i) + then loop i 1 + else loop (i + 1) 0 + in + loop 0 0 + +let is_suffix ~affix:(affix, _, astop as affix_sub) (s, _, sstop as s_sub) = + let len_a = length affix_sub in + let len_s = length s_sub in + if len_a > len_s then false else + let max_zidx (* zero based idx *) = len_a - 1 in + let max_idx_a = astop - 1 in + let max_idx_s = sstop - 1 in + let rec loop i = + if i > max_zidx then true else + if sunsafe_get affix (max_idx_a - i) <> sunsafe_get s (max_idx_s - i) + then false + else loop (i + 1) + in + loop 0 + +let for_all sat (s, start, stop) = + Astring_base.for_all sat s ~first:start ~last:(stop - 1) + +let exists sat (s, start, stop) = + Astring_base.exists sat s ~first:start ~last:(stop - 1) + +let same_base (s0, _, _) (s1, _, _) = s0 == s1 + +let equal_bytes (s0, start0, stop0) (s1, start1, stop1) = + if s0 == s1 && start0 = start1 && stop0 = stop1 then true else + let len0 = stop0 - start0 in + let len1 = stop1 - start1 in + if len0 <> len1 then false else + let max_zidx = len0 - 1 in + let rec loop i = + if i > max_zidx then true else + if sunsafe_get s0 (start0 + i) <> sunsafe_get s1 (start1 + i) + then false + else loop (i + 1) + in + loop 0 + +let compare_bytes (s0, start0, stop0) (s1, start1, stop1) = + if s0 == s1 && start0 = start1 && stop0 = stop1 then 0 else + let len0 = stop0 - start0 in + let len1 = stop1 - start1 in + let min_len = if len0 < len1 then len0 else len1 in + let max_i = min_len - 1 in + let rec loop i = + if i > max_i then compare len0 len1 else + let c0 = sunsafe_get s0 (start0 + i) in + let c1 = sunsafe_get s1 (start1 + i) in + let cmp = compare c0 c1 in + if cmp <> 0 then cmp else + loop (i + 1) + in + loop 0 + +let eq_pos : int -> int -> bool = fun p0 p1 -> p0 = p1 +let equal (s0, start0, stop0) (s1, start1, stop1) = + if s0 != s1 then invalid_arg err_base else + eq_pos start0 start1 && eq_pos stop0 stop1 + +let compare_pos : int -> int -> int = compare +let compare (s0, start0, stop0) (s1, start1, stop1) = + if s0 != s1 then invalid_arg err_base else + let c = compare_pos start0 start1 in + if c <> 0 then c else + compare_pos stop0 stop1 + +(* Extracting substrings *) + +let with_range ?(first = 0) ?(len = max_int) (s, start, stop) = + if len < 0 then invalid_arg (Astring_base.err_neg_len len) else + let s_len = stop - start in + let max_idx = s_len - 1 in + let empty = function + | first when first < 0 -> (s, start, start) + | first when first > max_idx -> (s, stop, stop) + | first -> (s, start + first, start + first) + in + if len = 0 then empty first else + let last (* index *) = match len with + | len when len = max_int -> max_idx + | len -> + let last = first + len - 1 in + if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first > max_idx || last < 0 || first > last then empty first else + (s, start + first, start + last + 1 (* position *)) + +let with_index_range ?(first = 0) ? last (s, start, stop) = + let s_len = stop - start in + let max_idx = s_len - 1 in + let empty = function + | first when first < 0 -> (s, start, start) + | first when first > max_idx -> (s, stop, stop) + | first -> (s, start + first, start + first) + in + let last (* index *) = match last with + | None -> max_idx + | Some last -> if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first > max_idx || last < 0 || first > last then empty first else + (s, start + first, start + last + 1 (* position *)) + +let trim ?(drop = Astring_char.Ascii.is_white) (s, start, stop as sub) = + let len = stop - start in + if len = 0 then sub else + let max_pos = stop in + let max_idx = stop - 1 in + let rec left_pos i = + if i > max_idx then max_pos else + if drop (sunsafe_get s i) then left_pos (i + 1) else i + in + let rec right_pos i = + if i < start then start else + if drop (sunsafe_get s i) then right_pos (i - 1) else (i + 1) + in + let left = left_pos start in + if left = max_pos then (s, (start + stop) / 2, (start + stop) / 2) else + let right = right_pos max_idx in + if left = start && right = max_pos then sub else + (s, left, right) + +let fspan ~min ~max ~sat (s, start, stop as sub) = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then ((s, start, start), sub) else + let max_idx = stop - 1 in + let max_idx = + let k = start + max - 1 in (if k > max_idx || k < 0 then max_idx else k) + in + let need_idx = start + min in + let rec loop i = + if i <= max_idx && sat (sunsafe_get s i) then loop (i + 1) else + if i < need_idx || i = 0 then ((s, start, start), sub) else + if i = stop then (sub, (s, stop, stop)) else + (s, start, i), (s, i, stop) + in + loop start + +let rspan ~min ~max ~sat (s, start, stop as sub) = + if min < 0 then invalid_arg (Astring_base.err_neg_min min) else + if max < 0 then invalid_arg (Astring_base.err_neg_max max) else + if min > max || max = 0 then (sub, (s, stop, stop)) else + let max_idx = stop - 1 in + let min_idx = let k = stop - max in if k < start then start else k in + let need_idx = stop - min - 1 in + let rec loop i = + if i >= min_idx && sat (sunsafe_get s i) then loop (i - 1) else + if i > need_idx || i = max_idx then (sub, (s, stop, stop)) else + if i = start - 1 then ((s, start, start), sub) else + (s, start, i + 1), (s, i + 1, stop) + in + loop max_idx + +let span ?(rev = false) ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) sub = + match rev with + | true -> rspan ~min ~max ~sat sub + | false -> fspan ~min ~max ~sat sub + +let take ?(rev = false) ?min ?max ?sat s = + (if rev then snd else fst) @@ span ~rev ?min ?max ?sat s + +let drop ?(rev = false) ?min ?max ?sat s = + (if rev then fst else snd) @@ span ~rev ?min ?max ?sat s + +let fcut ~sep:(sep, sep_start, sep_stop) (s, start, stop) = + let sep_len = sep_stop - sep_start in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let max_sep_zidx = sep_len - 1 in + let max_s_idx = stop - sep_len in + let rec check_sep i k = + if k > max_sep_zidx then Some ((s, start, i), (s, i + sep_len, stop)) + else if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k) + then check_sep i (k + 1) + else scan (i + 1) + and scan i = + if i > max_s_idx then None else + if sunsafe_get s i = sunsafe_get sep sep_start + then check_sep i 1 + else scan (i + 1) + in + scan start + +let rcut ~sep:(sep, sep_start, sep_stop) (s, start, stop) = + let sep_len = sep_stop - sep_start in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let max_sep_zidx = sep_len - 1 in + let max_s_idx = stop - 1 in + let rec check_sep i k = + if k > max_sep_zidx then Some ((s, start, i), (s, i + sep_len, stop)) + else if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k) + then check_sep i (k + 1) + else rscan (i - 1) + and rscan i = + if i < start then None else + if sunsafe_get s i = sunsafe_get sep sep_start + then check_sep i 1 + else rscan (i - 1) + in + rscan (max_s_idx - max_sep_zidx) + +let cut ?(rev = false) ~sep s = match rev with +| true -> rcut ~sep s +| false -> fcut ~sep s + +let add_sub ~no_empty s ~start ~stop acc = + if start = stop then (if no_empty then acc else (s, start, start) :: acc) else + (s, start, stop) :: acc + +let fcuts ~no_empty ~sep:(sep, sep_start, sep_stop) (s, start, stop as sub) = + let sep_len = sep_stop - sep_start in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let s_len = stop - start in + let max_sep_zidx = sep_len - 1 in + let max_s_idx = stop - sep_len in + let rec check_sep sstart i k acc = + if k > max_sep_zidx then + let new_start = i + sep_len in + scan new_start new_start (add_sub ~no_empty s ~start:sstart ~stop:i acc) + else + if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k) + then check_sep sstart i (k + 1) acc + else scan sstart (i + 1) acc + and scan sstart i acc = + if i > max_s_idx then + if sstart = start then (if no_empty && s_len = 0 then [] else [sub]) else + List.rev (add_sub ~no_empty s ~start:sstart ~stop acc) + else + if sunsafe_get s i = sunsafe_get sep sep_start + then check_sep sstart i 1 acc + else scan sstart (i + 1) acc + in + scan start start [] + +let rcuts ~no_empty ~sep:(sep, sep_start, sep_stop) (s, start, stop as sub) = + let sep_len = sep_stop - sep_start in + if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else + let s_len = stop - start in + let max_sep_zidx = sep_len - 1 in + let max_s_idx = stop - 1 in + let rec check_sep sstop i k acc = + if k > max_sep_zidx then + let start = i + sep_len in + rscan i (i - sep_len) (add_sub ~no_empty s ~start ~stop:sstop acc) + else + if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k) + then check_sep sstop i (k + 1) acc + else rscan sstop (i - 1) acc + and rscan sstop i acc = + if i < start then + if sstop = stop then (if no_empty && s_len = 0 then [] else [sub]) else + add_sub ~no_empty s ~start ~stop:sstop acc + else + if sunsafe_get s i = sunsafe_get sep sep_start + then check_sep sstop i 1 acc + else rscan sstop (i - 1) acc + in + rscan stop (max_s_idx - max_sep_zidx) [] + +let cuts ?(rev = false) ?(empty = true) ~sep s = match rev with +| true -> rcuts ~no_empty:(not empty) ~sep s +| false -> fcuts ~no_empty:(not empty) ~sep s + +let fields + ?(empty = false) ?(is_sep = Astring_char.Ascii.is_white) + (s, start, stop as sub) + = + let no_empty = not empty in + let max_pos = stop in + let rec loop i end_pos acc = + if i < start then begin + if end_pos = max_pos + then (if no_empty && max_pos = start then [] else [sub]) + else add_sub ~no_empty s ~start ~stop:end_pos acc + end else begin + if not (is_sep (sunsafe_get s i)) then loop (i - 1) end_pos acc else + loop (i - 1) i (add_sub ~no_empty s ~start:(i + 1) ~stop:end_pos acc) + end + in + loop (max_pos - 1) max_pos [] + +(* Traversing *) + +let ffind sat (s, start, stop) = + let max_idx = stop - 1 in + let rec loop i = + if i > max_idx then None else + if sat (sunsafe_get s i) then Some (s, i, i + 1) else loop (i + 1) + in + loop start + +let rfind sat (s, start, stop) = + let rec loop i = + if i < start then None else + if sat (sunsafe_get s i) then Some (s, i, i + 1) else loop (i - 1) + in + loop (stop - 1) + +let find ?(rev = false) sat sub = match rev with +| true -> rfind sat sub +| false -> ffind sat sub + +let ffind_sub ~sub:(sub, sub_start, sub_stop) (s, start, stop) = + let len_sub = sub_stop - sub_start in + let len_s = stop - start in + if len_sub > len_s then None else + let max_zidx_sub = len_sub - 1 in + let max_idx_s = start + len_s - len_sub in + let rec loop i k = + if i > max_idx_s then None else + if k > max_zidx_sub then Some (s, i, i + len_sub) else + if k > 0 then + if sunsafe_get sub (sub_start + k) = sunsafe_get s (i + k) + then loop i (k + 1) + else loop (i + 1) 0 + else if sunsafe_get sub sub_start = sunsafe_get s i then loop i 1 else + loop (i + 1) 0 + in + loop start 0 + +let rfind_sub ~sub:(sub, sub_start, sub_stop) (s, start, stop) = + let len_sub = sub_stop - sub_start in + let len_s = stop - start in + if len_sub > len_s then None else + let max_zidx_sub = len_sub - 1 in + let rec loop i k = + if i < start then None else + if k > max_zidx_sub then Some (s, i, i + len_sub) else + if k > 0 then + if sunsafe_get sub (sub_start + k) = sunsafe_get s (i + k) + then loop i (k + 1) + else loop (i - 1) 0 + else if sunsafe_get sub sub_start = sunsafe_get s i then loop i 1 else + loop (i - 1) 0 + in + loop (stop - len_sub) 0 + +let find_sub ?(rev = false) ~sub start = match rev with +| true -> rfind_sub ~sub start +| false -> ffind_sub ~sub start + +let filter sat (s, start, stop) = + let len = stop - start in + if len = 0 then empty else + let b = Bytes.create len in + let max_idx = stop - 1 in + let rec loop b k i = (* k is the write index in b *) + if i > max_idx then + ((if k = len then bytes_unsafe_to_string b else Bytes.sub_string b 0 k), + 0, k) + else + let c = sunsafe_get s i in + if sat c then (bytes_unsafe_set b k c; loop b (k + 1) (i + 1)) else + loop b k (i + 1) + in + loop b 0 start + +let filter_map f (s, start, stop) = + let len = stop - start in + if len = 0 then empty else + let b = Bytes.create len in + let max_idx = stop - 1 in + let rec loop b k i = (* k is the write index in b *) + if i > max_idx then + ((if k = len then bytes_unsafe_to_string b else Bytes.sub_string b 0 k), + 0, k) + else + match f (sunsafe_get s i) with + | None -> loop b k (i + 1) + | Some c -> bytes_unsafe_set b k c; loop b (k + 1) (i + 1) + in + loop b 0 start + +let map f (s, start, stop) = + let len = stop - start in + if len = 0 then empty else + let b = Bytes.create len in + for i = 0 to len - 1 do + bytes_unsafe_set b i (f (sunsafe_get s (start + i))) + done; + (bytes_unsafe_to_string b, 0, len) + +let mapi f (s, start, stop) = + let len = stop - start in + if len = 0 then empty else + let b = Bytes.create len in + for i = 0 to len - 1 do + bytes_unsafe_set b i (f i (sunsafe_get s (start + i))) + done; + (bytes_unsafe_to_string b, 0, len) + +let fold_left f acc (s, start, stop) = + Astring_base.fold_left f acc s ~first:start ~last:(stop - 1) + +let fold_right f (s, start, stop) acc = + Astring_base.fold_right f s acc ~first:start ~last:(stop - 1) + +let iter f (s, start, stop) = + for i = start to stop - 1 do f (sunsafe_get s i) done + +let iteri f (s, start, stop) = + for i = start to stop - 1 do f (i - start) (sunsafe_get s i) done + +(* Pretty printing *) + +let pp ppf s = + Format.pp_print_string ppf (to_string s) + +let dump ppf s = + Format.pp_print_char ppf '"'; + Format.pp_print_string ppf (Astring_escape.escape_string (to_string s)); + Format.pp_print_char ppf '"'; + () + +let dump_raw ppf (s, start, stop) = + Format.fprintf ppf "@[<1>(@[<1>(base@ \"%s\")@]@ @[<1>(start@ %d)@]@ \ + @[(stop@ %d)@])@]" + (Astring_escape.escape_string s) start stop + +(* OCaml base type conversions *) + +let of_char c = v (Astring_base.of_char c) +let to_char s = Astring_base.to_char (to_string s) +let of_bool b = v (Astring_base.of_bool b) +let to_bool s = Astring_base.to_bool (to_string s) +let of_int i = v (Astring_base.of_int i) +let to_int s = Astring_base.to_int (to_string s) +let of_nativeint i = v (Astring_base.of_nativeint i) +let to_nativeint s = Astring_base.to_nativeint (to_string s) +let of_int32 i = v (Astring_base.of_int32 i) +let to_int32 s = Astring_base.to_int32 (to_string s) +let of_int64 i = v (Astring_base.of_int64 i) +let to_int64 s = Astring_base.to_int64 (to_string s) +let of_float f = v (Astring_base.of_float f) +let to_float s = Astring_base.to_float (to_string s) + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring_top.ml b/unikernel/duniverse/astring/src/astring_top.ml new file mode 100644 index 00000000..167d3659 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_top.ml @@ -0,0 +1,22 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let () = ignore (Toploop.use_file Format.err_formatter "astring_top_init.ml") + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring_top.mllib b/unikernel/duniverse/astring/src/astring_top.mllib new file mode 100644 index 00000000..388f5cae --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_top.mllib @@ -0,0 +1 @@ +Astring_top \ No newline at end of file diff --git a/unikernel/duniverse/astring/src/astring_top_init.ml b/unikernel/duniverse/astring/src/astring_top_init.ml new file mode 100644 index 00000000..b0a59c57 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_top_init.ml @@ -0,0 +1,28 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring;; + +#install_printer Char.dump;; +#install_printer String.dump;; +#install_printer String.Sub.dump;; +#install_printer String.Set.dump;; +#install_printer String.Map.dump_string_map;; + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/astring_unsafe.ml b/unikernel/duniverse/astring/src/astring_unsafe.ml new file mode 100644 index 00000000..e7a1d816 --- /dev/null +++ b/unikernel/duniverse/astring/src/astring_unsafe.ml @@ -0,0 +1,45 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Unsafe string and byte manipulations. If you don't believe the + author's invariants, replacing with safe versions makes everything + safe in the library. He won't be upset. *) + +let array_unsafe_get = Array.unsafe_get + +external char_unsafe_of_byte : int -> char = "%identity" +external char_to_byte : char -> int = "%identity" + +let bytes_unsafe_set = Bytes.unsafe_set +let bytes_unsafe_to_string = Bytes.unsafe_to_string +let bytes_unsafe_blit_string s sfirst d dfirst len = + Bytes.(unsafe_blit (unsafe_of_string s) sfirst d dfirst len) + +external string_length : string -> int = "%string_length" +external string_equal : string -> string -> bool = "caml_string_equal" +external string_compare : string -> string -> int = "caml_string_compare" +external string_safe_get : string -> int -> char = "%string_safe_get" +external string_unsafe_get : string -> int -> char = "%string_unsafe_get" + +let unsafe_string_sub s first len = + let b = Bytes.create len in + bytes_unsafe_blit_string s first b 0 len; + Bytes.unsafe_to_string b + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/src/dune b/unikernel/duniverse/astring/src/dune new file mode 100644 index 00000000..81518ff5 --- /dev/null +++ b/unikernel/duniverse/astring/src/dune @@ -0,0 +1,14 @@ +(library + (name astring) + (public_name astring) + (modules astring_unsafe astring_base astring_escape astring_char astring_sub + astring_string astring) + (flags :standard -w -27) + (wrapped false)) + +(library + (name astring_top) + (public_name astring.top) + (libraries compiler-libs.toplevel) + (modules astring_top) + (wrapped false)) diff --git a/unikernel/duniverse/astring/test/examples.ml b/unikernel/duniverse/astring/test/examples.ml new file mode 100644 index 00000000..aea66d74 --- /dev/null +++ b/unikernel/duniverse/astring/test/examples.ml @@ -0,0 +1,87 @@ +(* This code is in the public domain *) + +open Astring + +(* Version number (v|V).major.minor[.patch][(+|-)info] *) + +let parse_version : string -> (int * int * int * string option) option = +fun s -> try + let parse_opt_v s = match String.Sub.head s with + | Some ('v'|'V') -> String.Sub.tail s + | Some _ -> s + | None -> raise Exit + in + let parse_dot s = match String.Sub.head s with + | Some '.' -> String.Sub.tail s + | Some _ | None -> raise Exit + in + let parse_int s = + match String.Sub.span ~min:1 ~sat:Char.Ascii.is_digit s with + | (i, _) when String.Sub.is_empty i -> raise Exit + | (i, s) -> + match String.Sub.to_int i with + | None -> raise Exit | Some i -> i, s + in + let maj, s = parse_int (parse_opt_v (String.sub s)) in + let min, s = parse_int (parse_dot s) in + let patch, s = match String.Sub.head s with + | Some '.' -> parse_int (parse_dot s) + | _ -> 0, s + in + let info = match String.Sub.head s with + | Some ('+' | '-') -> Some (String.Sub.(to_string (tail s))) + | Some _ -> raise Exit + | None -> None + in + Some (maj, min, patch, info) +with Exit -> None + +(* Key value bindings *) + +let parse_env : string -> string String.map option = +fun s -> try + let skip_white s = String.Sub.drop ~sat:Char.Ascii.is_white s in + let parse_key s = + let id_char c = Char.Ascii.is_letter c || c = '_' in + match String.Sub.span ~min:1 ~sat:id_char s with + | (key, _) when String.Sub.is_empty key -> raise Exit + | (key, rem) -> (String.Sub.to_string key), rem + in + let parse_eq s = match String.Sub.head s with + | Some '=' -> String.Sub.tail s + | Some _ | None -> raise Exit + in + let parse_value s = match String.Sub.head s with + | Some '"' -> (* quoted *) + let is_data = function '\\' | '"' -> false | _ -> true in + let rec loop acc s = + let data, rem = String.Sub.span ~sat:is_data s in + match String.Sub.head rem with + | Some '"' -> + let acc = List.rev (data :: acc) in + String.Sub.(to_string @@ concat acc), (String.Sub.tail rem) + | Some '\\' -> + let rem = String.Sub.tail rem in + begin match String.Sub.head rem with + | Some ('"' | '\\' as c) -> + let acc = String.(sub (of_char c)) :: data :: acc in + loop acc (String.Sub.tail rem) + | Some _ | None -> raise Exit + end + | None | Some _ -> raise Exit + in + loop [] (String.Sub.tail s) + | Some _ -> + let is_data c = not (Char.Ascii.is_white c) in + let data, rem = String.Sub.span ~sat:is_data s in + String.Sub.to_string data, rem + | None -> "", s + in + let rec parse_bindings acc s = + if String.Sub.is_empty s then acc else + let key, s = parse_key s in + let value, s = s |> skip_white |> parse_eq |> skip_white |> parse_value in + parse_bindings (String.Map.add key value acc) (skip_white s) + in + Some (String.sub s |> skip_white |> parse_bindings String.Map.empty) +with Exit -> None diff --git a/unikernel/duniverse/astring/test/test.ml b/unikernel/duniverse/astring/test/test.ml new file mode 100644 index 00000000..85df91de --- /dev/null +++ b/unikernel/duniverse/astring/test/test.ml @@ -0,0 +1,29 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let tests () = Testing.run + [ Test_char.suite; + Test_string.suite; + Test_sub.suite; ] + +let run () = tests (); Testing.log_results () + +let () = if run () then exit 0 else exit 1 + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/test/test_char.ml b/unikernel/duniverse/astring/test/test_char.ml new file mode 100644 index 00000000..1e8bf9d0 --- /dev/null +++ b/unikernel/duniverse/astring/test/test_char.ml @@ -0,0 +1,130 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Testing +open Astring + +let eq = eq ~pp:Char.dump +let eq_opt = eq_option ~pp:Char.dump ~eq:Char.equal +let invalid = app_invalid ~pp:Char.dump + +let misc = test "Char.{of_byte,of_int,to_int}" @@ fun () -> + invalid Char.of_byte (-1); + invalid Char.of_byte (256); + eq_opt (Char.of_int (-1)) None; + eq_opt (Char.of_int 256) None; + for i = 0 to 0xFF do + let of_int = Char.of_int $ pp_int @-> ret_get_option Char.dump in + eq_int (Char.to_int (of_int i)) i + done; + () + +let predicates = test "Char.{equal,compare}" @@ fun () -> + eq_bool (Char.equal ' ' ' ') true; + eq_bool (Char.equal ' ' 'a') false; + eq_int (Char.compare ' ' 'a') (-1); + eq_int (Char.compare ' ' ' ') (0); + eq_int (Char.compare 'a' ' ') (1); + eq_int (Char.compare '\x00' ' ') (-1); + () + +let ascii_predicates = test "Char.Ascii.is_*" @@ fun () -> + let pp_int ppf i = Format.fprintf ppf "%X" i in + let test_pred p pi i = + let pred p i = p (Char.of_byte i) in + (pred p $ pp_int @-> ret_eq ~eq:(=) pp_bool (pi i)) i + in + let test p pi = for i = 0 to 255 do ignore (test_pred p pi i) done in + test Char.Ascii.is_valid (fun i -> i <= 0x7F); + test Char.Ascii.is_digit (fun i -> 0x30 <= i && i <= 0x39); + test Char.Ascii.is_hex_digit (fun i -> (0x30 <= i && i <= 0x39) || + (0x41 <= i && i <= 0x46) || + (0x61 <= i && i <= 0x66)); + test Char.Ascii.is_upper (fun i -> 0x41 <= i && i <= 0x5A); + test Char.Ascii.is_lower (fun i -> 0x61 <= i && i <= 0x7A); + test Char.Ascii.is_letter (fun i -> (0x41 <= i && i <= 0x5A) || + (0x61 <= i && i <= 0x7A)); + test Char.Ascii.is_alphanum (fun i -> (0x30 <= i && i <= 0x39) || + (0x41 <= i && i <= 0x5A) || + (0x61 <= i && i <= 0x7A)); + test Char.Ascii.is_white (fun i -> (0x09 <= i && i <= 0x0D) || i = 0x20); + test Char.Ascii.is_blank (fun i -> (i = 0x20 || i = 0x09)); + test Char.Ascii.is_graphic (fun i -> (0x21 <= i && i <= 0x7E)); + test Char.Ascii.is_print (fun i -> (0x21 <= i && i <= 0x7E) || i = 0x20); + test Char.Ascii.is_control (fun i -> (0x00 <= i && i <= 0x1F) || i = 0x7F); + () + +let ascii_transforms = test "Char.Ascii.{uppercase,lowercase}" @@ fun () -> + for i = 0 to 255 do + if (0x61 <= i && i <= 0x7A) + then eq_char Char.(Ascii.uppercase @@ of_byte i) (Char.of_byte (i - 32)) + else eq_char Char.(Ascii.uppercase @@ of_byte i) (Char.of_byte i) + done; + for i = 0 to 255 do + if (0x41 <= i && i <= 0x5A) + then eq_char Char.(Ascii.lowercase @@ of_byte i) (Char.of_byte (i + 32)) + else eq_char Char.(Ascii.lowercase @@ of_byte i) (Char.of_byte i) + done; + () + +let ascii_escape = test "Char.Ascii.{escape,escape_char}" @@ fun () -> + for i = 0 to 255 do + let c = Char.of_byte i in + let esc = Char.Ascii.escape c in + begin match String.Ascii.unescape esc with + | None -> fail "could not unescape"; + | Some unesc -> + eq_int (String.length unesc) 1; + eq_char unesc.[0] (Char.of_byte i); + end; + if (0x00 <= i && i <= 0x1F) || (0x7F <= i && i <= 0xFF) + then eq_str esc (Printf.sprintf "\\x%02X" i) + else if (i = 0x5C) + then eq_str esc "\\\\" + else eq_str esc (Printf.sprintf "%c" c) + done; + for i = 0 to 255 do + let c = Char.of_byte i in + let esc = Char.Ascii.escape_char c in + begin match String.Ascii.unescape_string esc with + | None -> fail "could not unescape"; + | Some unesc -> + eq_int (String.length unesc) 1; + eq_char unesc.[0] (Char.of_byte i); + end; + if (i = 0x08) then eq_str esc "\\b" else + if (i = 0x09) then eq_str esc "\\t" else + if (i = 0x0A) then eq_str esc "\\n" else + if (i = 0x0D) then eq_str esc "\\r" else + if (i = 0x27) then eq_str esc "\\'" else + if (i = 0x5C) then eq_str esc "\\\\" else + if (0x00 <= i && i <= 0x1F) || (0x7F <= i && i <= 0xFF) + then eq_str esc (Printf.sprintf "\\x%02X" i) + else eq_str esc (Printf.sprintf "%c" c) + done; + () + +let suite = suite "Char functions" + [ misc; + predicates; + ascii_predicates; + ascii_transforms; + ascii_escape; ] + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/test/test_string.ml b/unikernel/duniverse/astring/test/test_string.ml new file mode 100644 index 00000000..1bc1747b --- /dev/null +++ b/unikernel/duniverse/astring/test/test_string.ml @@ -0,0 +1,1226 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Testing +open Astring + +let pp_pair ppf (a, b) = + Format.fprintf ppf "@[<1>(%a,%a)@]" String.dump a String.dump b + +let misc = test "Misc. base functions" @@ fun () -> + eq_str String.empty ""; + app_invalid ~pp:pp_str (String.v ~len:(-1)) (fun i -> 'a'); + app_invalid ~pp:pp_str (String.v ~len:(Sys.max_string_length + 1)) + (fun i -> 'a'); + eq_int (String.length "") 0; + eq_int (String.length "1") 1; + eq_int (String.length "12") 2; + eq_char (String.get "12" 0) '1'; + eq_char (String.get "12" 1) '2'; + app_invalid ~pp:pp_char (String.get "12") 3; + app_invalid ~pp:pp_char (String.get "12") (-1); + eq_int (String.get_byte "12" 0) 0x31; + eq_int (String.get_byte "12" 1) 0x32; + app_invalid ~pp:pp_int (String.get_byte "12") 3; + app_invalid ~pp:pp_int (String.get_byte "12") (-1); + eq_str (String.v ~len:3 (fun i -> Char.of_byte (0x30 + i))) "012"; + eq_str (String.v ~len:0 (fun i -> Char.of_byte (0x30 + i))) ""; + () + +let head = test "String.[get_]head" @@ fun () -> + let eq_ochar = eq_option ~eq:(=) ~pp:pp_char in + eq_ochar (String.head "") None; + eq_ochar (String.head ~rev:true "") None; + eq_ochar (String.head "bc") (Some 'b'); + eq_ochar (String.head ~rev:true "bc") (Some 'c'); + eq_char (String.get_head "bc") 'b'; + eq_char (String.get_head ~rev:true "bc") 'c'; + app_invalid ~pp:pp_char String.get_head ""; + () + +(* Appending strings *) + +let append = test "String.append" @@ fun () -> + let no_allocl s s' = eq_bool (s ^ s' == s) true in + let no_allocr s s' = eq_bool (s ^ s' == s') true in + no_allocl String.empty String.empty; + no_allocr String.empty String.empty; + no_allocl "bla" ""; + no_allocr "" "bli"; + eq_str (String.append "a" "") "a"; + eq_str (String.append "" "a") "a"; + eq_str (String.append "ab" "") "ab"; + eq_str (String.append "" "ab") "ab"; + eq_str (String.append "ab" "cd") "abcd"; + eq_str (String.append "cd" "ab") "cdab"; + () + +let concat = test "String.concat" @@ fun () -> + let no_alloc ~sep s = eq_bool (String.concat ~sep [s] == s) true in + no_alloc ~sep:"" ""; + no_alloc ~sep:"-" ""; + no_alloc ~sep:"" "abc"; + no_alloc ~sep:"-" "abc"; + eq_str (String.concat ~sep:"" []) ""; + eq_str (String.concat ~sep:"" [""]) ""; + eq_str (String.concat ~sep:"" ["";""]) ""; + eq_str (String.concat ~sep:"" ["a";"b";]) "ab"; + eq_str (String.concat ~sep:"" ["a";"b";"";"c"]) "abc"; + eq_str (String.concat ~sep:"-" []) ""; + eq_str (String.concat ~sep:"-" [""]) ""; + eq_str (String.concat ~sep:"-" ["a"]) "a"; + eq_str (String.concat ~sep:"-" ["a";""]) "a-"; + eq_str (String.concat ~sep:"-" ["";"a"]) "-a"; + eq_str (String.concat ~sep:"-" ["";"a";""]) "-a-"; + eq_str (String.concat ~sep:"-" ["a";"b";"c"]) "a-b-c"; + eq_str (String.concat ~sep:"--" ["a";"b";"c"]) "a--b--c"; + eq_str (String.concat ~sep:"ab" ["a";"b";"c"]) "aabbabc"; + eq_str (String.concat ["a";"b";""; "c"]) "abc"; + () + +(* Predicates *) + +let is_empty = test "String.is_empty" @@ fun () -> + eq_bool (String.is_empty "") true; + eq_bool (String.is_empty "heyho") false; + () + +let is_prefix = test "String.is_prefix" @@ fun () -> + eq_bool (String.is_prefix ~affix:"" "") true; + eq_bool (String.is_prefix ~affix:"" "habla") true; + eq_bool (String.is_prefix ~affix:"ha" "") false; + eq_bool (String.is_prefix ~affix:"ha" "h") false; + eq_bool (String.is_prefix ~affix:"ha" "ha") true; + eq_bool (String.is_prefix ~affix:"ha" "hab") true; + eq_bool (String.is_prefix ~affix:"ha" "habla") true; + eq_bool (String.is_prefix ~affix:"ha" "abla") false; + () + +let is_infix = test "String.is_infix" @@ fun () -> + eq_bool (String.is_infix ~affix:"" "") true; + eq_bool (String.is_infix ~affix:"" "habla") true; + eq_bool (String.is_infix ~affix:"ha" "") false; + eq_bool (String.is_infix ~affix:"ha" "h") false; + eq_bool (String.is_infix ~affix:"ha" "ha") true; + eq_bool (String.is_infix ~affix:"ha" "hab") true; + eq_bool (String.is_infix ~affix:"ha" "hub") false; + eq_bool (String.is_infix ~affix:"ha" "hubhab") true; + eq_bool (String.is_infix ~affix:"ha" "hubh") false; + eq_bool (String.is_infix ~affix:"ha" "hubha") true; + eq_bool (String.is_infix ~affix:"ha" "hubhb") false; + eq_bool (String.is_infix ~affix:"ha" "abla") false; + eq_bool (String.is_infix ~affix:"ha" "ablah") false; + () + +let is_suffix = test "String.is_suffix" @@ fun () -> + eq_bool (String.is_suffix ~affix:"" "") true; + eq_bool (String.is_suffix ~affix:"" "adsf") true; + eq_bool (String.is_suffix ~affix:"ha" "") false; + eq_bool (String.is_suffix ~affix:"ha" "a") false; + eq_bool (String.is_suffix ~affix:"ha" "h") false; + eq_bool (String.is_suffix ~affix:"ha" "ah") false; + eq_bool (String.is_suffix ~affix:"ha" "ha") true; + eq_bool (String.is_suffix ~affix:"ha" "aha") true; + eq_bool (String.is_suffix ~affix:"ha" "haha") true; + eq_bool (String.is_suffix ~affix:"ha" "hahb") false; + () + +let for_all = test "String.for_all" @@ fun () -> + eq_bool (String.for_all (fun _ -> false) "") true; + eq_bool (String.for_all (fun _ -> true) "") true; + eq_bool (String.for_all (fun c -> Char.to_int c < 0x34) "123") true; + eq_bool (String.for_all (fun c -> Char.to_int c < 0x34) "412") false; + eq_bool (String.for_all (fun c -> Char.to_int c < 0x34) "142") false; + eq_bool (String.for_all (fun c -> Char.to_int c < 0x34) "124") false; + () + +let exists = test "String.exists" @@ fun () -> + eq_bool (String.exists (fun _ -> false) "") false; + eq_bool (String.exists (fun _ -> true) "") false; + eq_bool (String.exists (fun c -> Char.to_int c < 0x34) "541") true; + eq_bool (String.exists (fun c -> Char.to_int c < 0x34) "541") true; + eq_bool (String.exists (fun c -> Char.to_int c < 0x34) "154") true; + eq_bool (String.exists (fun c -> Char.to_int c < 0x34) "654") false; + () + +let equal = test "String.equal" @@ fun () -> + eq_bool (String.equal "" "") true; + eq_bool (String.equal "" "a") false; + eq_bool (String.equal "a" "") false; + eq_bool (String.equal "ab" "ab") true; + eq_bool (String.equal "cd" "ab") false; + () + +let compare = test "String.compare" @@ fun () -> + eq_int (String.compare "" "ab") (-1); + eq_int (String.compare "" "") (0); + eq_int (String.compare "ab" "") (1); + eq_int (String.compare "ab" "abc") (-1); + () + +(* Extracting substrings *) + +let with_range = test "String.with_range" @@ fun () -> + let no_alloc ?first ?len s = + eq_bool (String.with_range s ?first ?len == s || + String.(equal empty s)) true + in + let is_empty ?first ?len s = + let s = String.with_range ?first ?len s in + eq_str s String.empty; + eq_bool (s == String.empty) true; + in + let invalid ?first ?len s = + app_invalid ~pp:pp_str (String.with_range ?first ?len) s + in + let eq_range ?first ?len s s' = eq_str (String.with_range ?first ?len s) s' in + no_alloc ""; + invalid "" ~len:(-1); + no_alloc "" ~len:0; + no_alloc "" ~len:1; + no_alloc "" ~len:2; + no_alloc "" ~first:(-1); + no_alloc "" ~first:0; + no_alloc "" ~first:1; + invalid "" ~first:(-1) ~len:(-1); + no_alloc "" ~first:(-1) ~len:0; + no_alloc "" ~first:(-1) ~len:1; + invalid "" ~first:0 ~len:(-1); + no_alloc "" ~first:0 ~len:0; + no_alloc "" ~first:0 ~len:1; + invalid "" ~first:1 ~len:(-1); + no_alloc "" ~first:1 ~len:0; + no_alloc "" ~first:1 ~len:1; + no_alloc "a"; + invalid "a" ~len:(-1); + is_empty "a" ~len:0; + no_alloc "a" ~len:1; + no_alloc "a" ~len:2; + no_alloc "a" ~first:(-1); + no_alloc "a" ~first:0; + is_empty "a" ~first:1; + invalid "a" ~first:(-1) ~len:(-1); + is_empty "a" ~first:(-1) ~len:0; + is_empty "a" ~first:(-1) ~len:1; + no_alloc "a" ~first:(-1) ~len:2; + no_alloc "a" ~first:(-1) ~len:3; + invalid "a" ~first:0 ~len:(-1); + is_empty "a" ~first:0 ~len:0; + no_alloc "a" ~first:0 ~len:1; + no_alloc "a" ~first:0 ~len:2; + no_alloc "a" ~first:0 ~len:3; + invalid "a" ~first:1 ~len:(-1); + is_empty "a" ~first:1 ~len:0; + is_empty "a" ~first:1 ~len:1; + is_empty "a" ~first:1 ~len:2; + is_empty "a" ~first:1 ~len:3; + no_alloc "ab"; + invalid "ab" ~len:(-1); + is_empty "ab" ~len:0; + eq_range "ab" ~len:1 "a"; + no_alloc "ab" ~len:2; + no_alloc "ab" ~len:3; + no_alloc "ab" ~first:(-1); + no_alloc "ab" ~first:0; + eq_range "ab" ~first:1 "b"; + is_empty "ab" ~first:2; + invalid "ab" ~first:(-1) ~len:(-1); + is_empty "ab" ~first:(-1) ~len:0; + is_empty "ab" ~first:(-1) ~len:1; + eq_range "ab" ~first:(-1) ~len:2 "a"; + no_alloc "ab" ~first:(-1) ~len:3; + no_alloc "ab" ~first:(-1) ~len:4; + invalid "ab" ~first:0 ~len:(-1); + is_empty "ab" ~first:0 ~len:0; + eq_range "ab" ~first:0 ~len:1 "a"; + no_alloc "ab" ~first:0 ~len:2; + no_alloc "ab" ~first:0 ~len:3; + no_alloc "ab" ~first:0 ~len:4; + invalid "ab" ~first:1 ~len:(-1); + is_empty "ab" ~first:1 ~len:0; + eq_range "ab" ~first:1 ~len:1 "b"; + eq_range "ab" ~first:1 ~len:2 "b"; + eq_range "ab" ~first:1 ~len:3 "b"; + eq_range "ab" ~first:1 ~len:4 "b"; + invalid "ab" ~first:2 ~len:(-1); + is_empty "ab" ~first:2 ~len:0; + is_empty "ab" ~first:2 ~len:1; + is_empty "ab" ~first:2 ~len:2; + is_empty "ab" ~first:2 ~len:3; + is_empty "ab" ~first:2 ~len:4; + no_alloc "abc"; + invalid "abc" ~len:(-1); + is_empty "abc" ~len:0; + eq_range "abc" ~len:1 "a"; + eq_range "abc" ~len:2 "ab"; + no_alloc "abc" ~len:3; + no_alloc "abc" ~len:4; + no_alloc "abc" ~first:(-1); + no_alloc "abc" ~first:0; + eq_range "abc" ~first:1 "bc"; + eq_range "abc" ~first:2 "c"; + is_empty "abc" ~first:3; + invalid "abc" ~first:(-1) ~len:(-1); + is_empty "abc" ~first:(-1) ~len:0; + is_empty "abc" ~first:(-1) ~len:1; + eq_range "abc" ~first:(-1) ~len:2 "a"; + eq_range "abc" ~first:(-1) ~len:3 "ab"; + eq_range "abc" ~first:(-1) ~len:4 "abc"; + no_alloc "abc" ~first:(-1) ~len:5; + invalid "abc" ~first:0 ~len:(-1); + is_empty "abc" ~first:0 ~len:0; + eq_range "abc" ~first:0 ~len:1 "a"; + eq_range "abc" ~first:0 ~len:2 "ab"; + no_alloc "abc" ~first:0 ~len:3; + no_alloc "abc" ~first:0 ~len:4; + no_alloc "abc" ~first:0 ~len:5; + invalid "abc" ~first:1 ~len:(-1); + is_empty "abc" ~first:1 ~len:0; + eq_range "abc" ~first:1 ~len:1 "b"; + eq_range "abc" ~first:1 ~len:2 "bc"; + eq_range "abc" ~first:1 ~len:3 "bc"; + eq_range "abc" ~first:1 ~len:4 "bc"; + eq_range "abc" ~first:1 ~len:5 "bc"; + invalid "abc" ~first:2 ~len:(-1); + is_empty "abc" ~first:2 ~len:0; + eq_range "abc" ~first:2 ~len:1 "c"; + eq_range "abc" ~first:2 ~len:2 "c"; + eq_range "abc" ~first:2 ~len:3 "c"; + eq_range "abc" ~first:2 ~len:4 "c"; + eq_range "abc" ~first:2 ~len:5 "c"; + invalid "abc" ~first:3 ~len:(-1); + is_empty "abc" ~first:3 ~len:0; + is_empty "abc" ~first:3 ~len:1; + is_empty "abc" ~first:3 ~len:2; + is_empty "abc" ~first:3 ~len:3; + is_empty "abc" ~first:3 ~len:4; + is_empty "abc" ~first:3 ~len:5; + () + +let with_index_range = test "String.with_index_range" @@ fun () -> + let no_alloc ?first ?last s = + eq_bool (String.with_index_range s ?first ?last == s || + String.(equal empty s)) true + in + let is_empty ?first ?last s = + let s = String.with_index_range ?first ?last s in + eq_str s String.empty; + eq_bool (s == String.empty) true; + in + let eq_range ?first ?last s s' = + eq_str (String.with_index_range ?first ?last s) s' + in + no_alloc ""; + no_alloc "" ~first:(-1); + no_alloc "" ~first:0; + no_alloc "" ~first:1; + no_alloc "" ~first:2; + no_alloc "" ~last:(-1); + no_alloc "" ~last:0; + no_alloc "" ~last:1; + no_alloc "" ~last:2; + no_alloc "" ~first:(-1) ~last:(-1); + no_alloc "" ~first:(-1) ~last:0; + no_alloc "" ~first:(-1) ~last:1; + no_alloc "" ~first:0 ~last:(-1); + no_alloc "" ~first:0 ~last:0; + no_alloc "" ~first:0 ~last:1; + no_alloc "" ~first:1 ~last:(-1); + no_alloc "" ~first:1 ~last:0; + no_alloc "" ~first:1 ~last:1; + no_alloc "a"; + no_alloc "a" ~first:(-1); + no_alloc "a" ~first:0; + is_empty "a" ~first:1; + is_empty "a" ~first:2; + is_empty "a" ~last:(-1); + no_alloc "a" ~last:0; + no_alloc "a" ~last:1; + no_alloc "a" ~last:2; + is_empty "a" ~first:(-1) ~last:(-1); + no_alloc "a" ~first:(-1) ~last:0; + no_alloc "a" ~first:(-1) ~last:1; + no_alloc "a" ~first:(-1) ~last:2; + no_alloc "a" ~first:(-1) ~last:3; + is_empty "a" ~first:0 ~last:(-1); + no_alloc "a" ~first:0 ~last:0; + no_alloc "a" ~first:0 ~last:1; + no_alloc "a" ~first:0 ~last:2; + no_alloc "a" ~first:0 ~last:3; + is_empty "a" ~first:1 ~last:(-1); + is_empty "a" ~first:1 ~last:0; + is_empty "a" ~first:1 ~last:1; + is_empty "a" ~first:1 ~last:2; + is_empty "a" ~first:1 ~last:3; + no_alloc "ab"; + no_alloc "ab" ~first:(-1); + no_alloc "ab" ~first:0; + eq_range "ab" ~first:1 "b"; + is_empty "ab" ~first:2; + is_empty "ab" ~last:(-1); + eq_range "ab" ~last:0 "a"; + no_alloc "ab" ~last:1; + no_alloc "ab" ~last:2; + no_alloc "ab" ~last:3; + is_empty "ab" ~first:(-1) ~last:(-1); + eq_range "ab" ~first:(-1) ~last:0 "a"; + no_alloc "ab" ~first:(-1) ~last:1; + no_alloc "ab" ~first:(-1) ~last:2; + no_alloc "ab" ~first:(-1) ~last:3; + no_alloc "ab" ~first:(-1) ~last:4; + is_empty "ab" ~first:0 ~last:(-1); + eq_range "ab" ~first:0 ~last:0 "a"; + no_alloc "ab" ~first:0 ~last:1; + no_alloc "ab" ~first:0 ~last:2; + no_alloc "ab" ~first:0 ~last:3; + no_alloc "ab" ~first:0 ~last:4; + is_empty "ab" ~first:1 ~last:(-1); + is_empty "ab" ~first:1 ~last:0; + eq_range "ab" ~first:1 ~last:1 "b"; + eq_range "ab" ~first:1 ~last:2 "b"; + eq_range "ab" ~first:1 ~last:3 "b"; + eq_range "ab" ~first:1 ~last:4 "b"; + is_empty "ab" ~first:2 ~last:(-1); + is_empty "ab" ~first:2 ~last:0; + is_empty "ab" ~first:2 ~last:1; + is_empty "ab" ~first:2 ~last:2; + is_empty "ab" ~first:2 ~last:3; + is_empty "ab" ~first:2 ~last:4; + no_alloc "abc"; + no_alloc "abc" ~first:(-1); + no_alloc "abc" ~first:0; + eq_range "abc" ~first:1 "bc"; + eq_range "abc" ~first:2 "c"; + is_empty "abc" ~first:3; + is_empty "abc" ~last:(-1); + eq_range "abc" ~last:0 "a"; + eq_range "abc" ~last:1 "ab"; + no_alloc "abc" ~last:2; + no_alloc "abc" ~last:3; + no_alloc "abc" ~last:4; + is_empty "abc" ~first:(-1) ~last:(-1); + eq_range "abc" ~first:(-1) ~last:0 "a"; + eq_range "abc" ~first:(-1) ~last:1 "ab"; + no_alloc "abc" ~first:(-1) ~last:2; + no_alloc "abc" ~first:(-1) ~last:3; + no_alloc "abc" ~first:(-1) ~last:4; + no_alloc "abc" ~first:(-1) ~last:5; + is_empty "abc" ~first:0 ~last:(-1); + eq_range "abc" ~first:0 ~last:0 "a"; + eq_range "abc" ~first:0 ~last:1 "ab"; + no_alloc "abc" ~first:0 ~last:2; + no_alloc "abc" ~first:0 ~last:3; + no_alloc "abc" ~first:0 ~last:4; + no_alloc "abc" ~first:0 ~last:5; + is_empty "abc" ~first:1 ~last:(-1); + is_empty "abc" ~first:1 ~last:0; + eq_range "abc" ~first:1 ~last:1 "b"; + eq_range "abc" ~first:1 ~last:2 "bc"; + eq_range "abc" ~first:1 ~last:3 "bc"; + eq_range "abc" ~first:1 ~last:4 "bc"; + eq_range "abc" ~first:1 ~last:5 "bc"; + is_empty "abc" ~first:2 ~last:(-1); + is_empty "abc" ~first:2 ~last:0; + is_empty "abc" ~first:2 ~last:1; + eq_range "abc" ~first:2 ~last:2 "c"; + eq_range "abc" ~first:2 ~last:3 "c"; + eq_range "abc" ~first:2 ~last:4 "c"; + eq_range "abc" ~first:2 ~last:5 "c"; + is_empty "abc" ~first:3 ~last:(-1); + is_empty "abc" ~first:3 ~last:0; + is_empty "abc" ~first:3 ~last:1; + is_empty "abc" ~first:3 ~last:2; + is_empty "abc" ~first:3 ~last:3; + is_empty "abc" ~first:3 ~last:4; + is_empty "abc" ~first:3 ~last:5; + () + +let trim = test "String.trim" @@ fun () -> + let drop_a c = c = 'a' in + let no_alloc ?drop s = eq_bool (String.trim ?drop s == s) true in + no_alloc ""; + no_alloc ~drop:drop_a ""; + no_alloc "bc"; + no_alloc ~drop:drop_a "bc"; + eq_str (String.trim "\t abcd \r ") "abcd"; + no_alloc ~drop:drop_a "\x00 abcd \x1F "; + no_alloc "aaaabcdaaaa"; + eq_str (String.trim ~drop:drop_a "aaaabcdaaaa") "bcd"; + eq_str (String.trim ~drop:drop_a "aaaabcd") "bcd"; + eq_str (String.trim ~drop:drop_a "bcdaaaa") "bcd"; + eq_str (String.trim ~drop:drop_a "aaaa") ""; + eq_str (String.trim " ") ""; + () + +let span = test "String.{span,take,drop}" @@ fun () -> + let eq_pair (l0, r0) (l1, r1) = String.equal l0 l1 && String.equal r0 r1 in + let eq_pair = eq ~eq:eq_pair ~pp:pp_pair in + let eq ?(rev = false) ?min ?max ?sat s (sl, sr as spec) = + let (l, r as pair) = String.span ~rev ?min ?max ?sat s in + let t = String.take ~rev ?min ?max ?sat s in + let d = String.drop ~rev ?min ?max ?sat s in + eq_pair pair spec; + eq_str t (if rev then sr else sl); + eq_str d (if rev then sl else sr); + if sl = "" then begin + eq_bool (l == String.empty) true; + eq_bool (r == s) true; + eq_bool ((if rev then d else t) == String.empty) true; + end; + if sr = "" then begin + eq_bool (r == String.empty) true; + eq_bool (l == s) true; + eq_bool ((if rev then t else d) == String.empty) true; + end + in + let invalid ?rev ?min ?max ?sat s = + app_invalid ~pp:pp_pair (String.span ?rev ?min ?max ?sat) s + in + invalid ~rev:false ~min:(-1) ""; + invalid ~rev:true ~min:(-1) ""; + invalid ~rev:false ~max:(-1) ""; + invalid ~rev:true ~max:(-1) ""; + eq ~rev:false String.empty ("",""); + eq ~rev:true String.empty ("",""); + eq ~rev:false ~min:0 ~max:0 String.empty ("",""); + eq ~rev:true ~min:0 ~max:0 String.empty ("",""); + eq ~rev:false ~min:1 ~max:0 String.empty ("",""); + eq ~rev:true ~min:1 ~max:0 String.empty ("",""); + eq ~rev:false ~max:0 "ab_cd" ("","ab_cd"); + eq ~rev:true ~max:0 "ab_cd" ("ab_cd",""); + eq ~rev:false ~max:2 "ab_cd" ("ab", "_cd"); + eq ~rev:true ~max:2 "ab_cd" ("ab_", "cd"); + eq ~rev:false ~min:6 "ab_cd" ("", "ab_cd"); + eq ~rev:true ~min:6 "ab_cd" ("ab_cd", ""); + eq ~rev:false "ab_cd" ("ab_cd", ""); + eq ~rev:true "ab_cd" ("", "ab_cd"); + eq ~rev:false ~max:30 "ab_cd" ("ab_cd", ""); + eq ~rev:true ~max:30 "ab_cd" ("", "ab_cd"); + eq ~rev:false ~sat:Char.Ascii.is_white "ab_cd" ("","ab_cd"); + eq ~rev:true ~sat:Char.Ascii.is_white "ab_cd" ("ab_cd",""); + eq ~rev:false ~sat:Char.Ascii.is_letter "ab_cd" ("ab", "_cd"); + eq ~rev:true ~sat:Char.Ascii.is_letter "ab_cd" ("ab_", "cd"); + eq ~rev:false ~sat:Char.Ascii.is_letter ~max:0 "ab_cd" ("", "ab_cd"); + eq ~rev:true ~sat:Char.Ascii.is_letter ~max:0 "ab_cd" ("ab_cd", ""); + eq ~rev:false ~sat:Char.Ascii.is_letter ~max:1 "ab_cd" ("a", "b_cd"); + eq ~rev:true ~sat:Char.Ascii.is_letter ~max:1 "ab_cd" ("ab_c", "d"); + eq ~rev:false ~sat:Char.Ascii.is_letter ~min:2 ~max:1 "ab_cd" ("", "ab_cd"); + eq ~rev:true ~sat:Char.Ascii.is_letter ~min:2 ~max:1 "ab_cd" ("ab_cd", ""); + eq ~rev:false ~sat:Char.Ascii.is_letter ~min:3 "ab_cd" ("", "ab_cd"); + eq ~rev:true ~sat:Char.Ascii.is_letter ~min:3 "ab_cd" ("ab_cd", ""); + () + +let cut = test "String.cut" @@ fun () -> + let ppp = pp_option pp_pair in + let eqo = eq_option ~eq:(=) ~pp:pp_pair in + app_invalid ~pp:ppp (String.cut ~sep:"") ""; + app_invalid ~pp:ppp (String.cut ~sep:"") "123"; + eqo (String.cut "," "") None; + eqo (String.cut "," ",") (Some ("", "")); + eqo (String.cut "," ",,") (Some ("", ",")); + eqo (String.cut "," ",,,") (Some ("", ",,")); + eqo (String.cut "," "123") None; + eqo (String.cut "," ",123") (Some ("", "123")); + eqo (String.cut "," "123,") (Some ("123", "")); + eqo (String.cut "," "1,2,3") (Some ("1", "2,3")); + eqo (String.cut "," " 1,2,3") (Some (" 1", "2,3")); + eqo (String.cut "<>" "") None; + eqo (String.cut "<>" "<>") (Some ("", "")); + eqo (String.cut "<>" "<><>") (Some ("", "<>")); + eqo (String.cut "<>" "<><><>") (Some ("", "<><>")); + eqo (String.cut ~rev:true ~sep:"<>" "1") None; + eqo (String.cut "<>" "123") None; + eqo (String.cut "<>" "<>123") (Some ("", "123")); + eqo (String.cut "<>" "123<>") (Some ("123", "")); + eqo (String.cut "<>" "1<>2<>3") (Some ("1", "2<>3")); + eqo (String.cut "<>" " 1<>2<>3") (Some (" 1", "2<>3")); + eqo (String.cut "<>" ">>><>>>><>>>><>>>>") (Some (">>>", ">>><>>>><>>>>")); + eqo (String.cut "<->" "<->>->") (Some ("", ">->")); + eqo (String.cut ~rev:true ~sep:"<->" "<-") None; + eqo (String.cut "aa" "aa") (Some ("", "")); + eqo (String.cut "aa" "aaa") (Some ("", "a")); + eqo (String.cut "aa" "aaaa") (Some ("", "aa")); + eqo (String.cut "aa" "aaaaa") (Some ("", "aaa";)); + eqo (String.cut "aa" "aaaaaa") (Some ("", "aaaa")); + eqo (String.cut ~sep:"ab" "faaaa") None; + let rev = true in + app_invalid ~pp:ppp (String.cut ~rev ~sep:"") ""; + app_invalid ~pp:ppp (String.cut ~rev ~sep:"") "123"; + eqo (String.cut ~rev ~sep:"," "") None; + eqo (String.cut ~rev ~sep:"," ",") (Some ("", "")); + eqo (String.cut ~rev ~sep:"," ",,") (Some (",", "")); + eqo (String.cut ~rev ~sep:"," ",,,") (Some (",,", "")); + eqo (String.cut ~rev ~sep:"," "123") None; + eqo (String.cut ~rev ~sep:"," ",123") (Some ("", "123")); + eqo (String.cut ~rev ~sep:"," "123,") (Some ("123", "")); + eqo (String.cut ~rev ~sep:"," "1,2,3") (Some ("1,2", "3")); + eqo (String.cut ~rev ~sep:"," "1,2,3 ") (Some ("1,2", "3 ")); + eqo (String.cut ~rev ~sep:"<>" "") None; + eqo (String.cut ~rev ~sep:"<>" "<>") (Some ("", "")); + eqo (String.cut ~rev ~sep:"<>" "<><>") (Some ("<>", "")); + eqo (String.cut ~rev ~sep:"<>" "<><><>") (Some ("<><>", "")); + eqo (String.cut ~rev ~sep:"<>" "1") None; + eqo (String.cut ~rev ~sep:"<>" "123") None; + eqo (String.cut ~rev ~sep:"<>" "<>123") (Some ("", "123")); + eqo (String.cut ~rev ~sep:"<>" "123<>") (Some ("123", "")); + eqo (String.cut ~rev ~sep:"<>" "1<>2<>3") (Some ("1<>2", "3")); + eqo (String.cut ~rev ~sep:"<>" "1<>2<>3 ") (Some ("1<>2", "3 ")); + eqo (String.cut ~rev ~sep:"<>" ">>><>>>><>>>><>>>>") + (Some (">>><>>>><>>>>", ">>>")); + eqo (String.cut ~rev ~sep:"<->" "<->>->") (Some ("", ">->")); + eqo (String.cut ~rev ~sep:"<->" "<-") None; + eqo (String.cut ~rev ~sep:"aa" "aa") (Some ("", "")); + eqo (String.cut ~rev ~sep:"aa" "aaa") (Some ("a", "")); + eqo (String.cut ~rev ~sep:"aa" "aaaa") (Some ("aa", "")); + eqo (String.cut ~rev ~sep:"aa" "aaaaa") (Some ("aaa", "";)); + eqo (String.cut ~rev ~sep:"aa" "aaaaaa") (Some ("aaaa", "")); + eqo (String.cut ~rev ~sep:"ab" "afaaaa") None; + () + +let cuts = test "String.cuts" @@ fun () -> + let ppl = pp_list String.dump in + let eql = eq_list ~eq:String.equal ~pp:String.dump in + let no_alloc ?rev ~sep s = + eq_bool (List.hd (String.cuts ?rev ~sep s) == s) true + in + app_invalid ~pp:ppl (String.cuts ~sep:"") ""; + app_invalid ~pp:ppl (String.cuts ~sep:"") "123"; + no_alloc ~sep:"," ""; + no_alloc ~sep:"," "abcd"; + eql (String.cuts ~empty:true ~sep:"," "") [""]; + eql (String.cuts ~empty:false ~sep:"," "") []; + eql (String.cuts ~empty:true ~sep:"," ",") [""; ""]; + eql (String.cuts ~empty:false ~sep:"," ",") []; + eql (String.cuts ~empty:true ~sep:"," ",,") [""; ""; ""]; + eql (String.cuts ~empty:false ~sep:"," ",,") []; + eql (String.cuts ~empty:true ~sep:"," ",,,") [""; ""; ""; ""]; + eql (String.cuts ~empty:false ~sep:"," ",,,") []; + eql (String.cuts ~empty:true ~sep:"," "123") ["123"]; + eql (String.cuts ~empty:false ~sep:"," "123") ["123"]; + eql (String.cuts ~empty:true ~sep:"," ",123") [""; "123"]; + eql (String.cuts ~empty:false ~sep:"," ",123") ["123"]; + eql (String.cuts ~empty:true ~sep:"," "123,") ["123"; ""]; + eql (String.cuts ~empty:false ~sep:"," "123,") ["123";]; + eql (String.cuts ~empty:true ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (String.cuts ~empty:false ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (String.cuts ~empty:true ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~empty:false ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~empty:true ~sep:"," ",1,2,,3,") [""; "1"; "2"; ""; "3"; ""]; + eql (String.cuts ~empty:false ~sep:"," ",1,2,,3,") ["1"; "2"; "3";]; + eql (String.cuts ~empty:true ~sep:"," ", 1, 2,, 3,") + [""; " 1"; " 2"; ""; " 3"; ""]; + eql (String.cuts ~empty:false ~sep:"," ", 1, 2,, 3,") [" 1"; " 2";" 3";]; + eql (String.cuts ~empty:true ~sep:"<>" "") [""]; + eql (String.cuts ~empty:false ~sep:"<>" "") []; + eql (String.cuts ~empty:true ~sep:"<>" "<>") [""; ""]; + eql (String.cuts ~empty:false ~sep:"<>" "<>") []; + eql (String.cuts ~empty:true ~sep:"<>" "<><>") [""; ""; ""]; + eql (String.cuts ~empty:false ~sep:"<>" "<><>") []; + eql (String.cuts ~empty:true ~sep:"<>" "<><><>") [""; ""; ""; ""]; + eql (String.cuts ~empty:false ~sep:"<>" "<><><>") []; + eql (String.cuts ~empty:true ~sep:"<>" "123") [ "123" ]; + eql (String.cuts ~empty:false ~sep:"<>" "123") [ "123" ]; + eql (String.cuts ~empty:true ~sep:"<>" "<>123") [""; "123"]; + eql (String.cuts ~empty:false ~sep:"<>" "<>123") ["123"]; + eql (String.cuts ~empty:true ~sep:"<>" "123<>") ["123"; ""]; + eql (String.cuts ~empty:false ~sep:"<>" "123<>") ["123"]; + eql (String.cuts ~empty:true ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (String.cuts ~empty:false ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (String.cuts ~empty:true ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~empty:false ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~empty:true ~sep:"<>" "<>1<>2<><>3<>") + [""; "1"; "2"; ""; "3"; ""]; + eql (String.cuts ~empty:false ~sep:"<>" "<>1<>2<><>3<>") ["1"; "2";"3";]; + eql (String.cuts ~empty:true ~sep:"<>" "<> 1<> 2<><> 3<>") + [""; " 1"; " 2"; ""; " 3";""]; + eql (String.cuts ~empty:false ~sep:"<>" "<> 1<> 2<><> 3<>")[" 1"; " 2"; " 3"]; + eql (String.cuts ~empty:true ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (String.cuts ~empty:false ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (String.cuts ~empty:true ~sep:"<->" "<->>->") [""; ">->"]; + eql (String.cuts ~empty:false ~sep:"<->" "<->>->") [">->"]; + eql (String.cuts ~empty:true ~sep:"aa" "aa") [""; ""]; + eql (String.cuts ~empty:false ~sep:"aa" "aa") []; + eql (String.cuts ~empty:true ~sep:"aa" "aaa") [""; "a"]; + eql (String.cuts ~empty:false ~sep:"aa" "aaa") ["a"]; + eql (String.cuts ~empty:true ~sep:"aa" "aaaa") [""; ""; ""]; + eql (String.cuts ~empty:false ~sep:"aa" "aaaa") []; + eql (String.cuts ~empty:true ~sep:"aa" "aaaaa") [""; ""; "a"]; + eql (String.cuts ~empty:false ~sep:"aa" "aaaaa") ["a"]; + eql (String.cuts ~empty:true ~sep:"aa" "aaaaaa") [""; ""; ""; ""]; + eql (String.cuts ~empty:false ~sep:"aa" "aaaaaa") []; + let rev = true in + app_invalid ~pp:ppl (String.cuts ~rev ~sep:"") ""; + app_invalid ~pp:ppl (String.cuts ~rev ~sep:"") "123"; + no_alloc ~rev ~sep:"," ""; + no_alloc ~rev ~sep:"," "abcd"; + eql (String.cuts ~rev ~empty:true ~sep:"," "") [""]; + eql (String.cuts ~rev ~empty:false ~sep:"," "") []; + eql (String.cuts ~rev ~empty:true ~sep:"," ",") [""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"," ",") []; + eql (String.cuts ~rev ~empty:true ~sep:"," ",,") [""; ""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"," ",,") []; + eql (String.cuts ~rev ~empty:true ~sep:"," ",,,") [""; ""; ""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"," ",,,") []; + eql (String.cuts ~rev ~empty:true ~sep:"," "123") ["123"]; + eql (String.cuts ~rev ~empty:false ~sep:"," "123") ["123"]; + eql (String.cuts ~rev ~empty:true ~sep:"," ",123") [""; "123"]; + eql (String.cuts ~rev ~empty:false ~sep:"," ",123") ["123"]; + eql (String.cuts ~rev ~empty:true ~sep:"," "123,") ["123"; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"," "123,") ["123";]; + eql (String.cuts ~rev ~empty:true ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (String.cuts ~rev ~empty:false ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (String.cuts ~rev ~empty:true ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~rev ~empty:false ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~rev ~empty:true ~sep:"," ",1,2,,3,") + [""; "1"; "2"; ""; "3"; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"," ",1,2,,3,") ["1"; "2"; "3"]; + eql (String.cuts ~rev ~empty:true ~sep:"," ", 1, 2,, 3,") + [""; " 1"; " 2"; ""; " 3"; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"," ", 1, 2,, 3,") [" 1"; " 2"; " 3"]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "") [""]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "") []; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "<>") [""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "<>") []; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "<><>") [""; ""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "<><>") []; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "<><><>") [""; ""; ""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "<><><>") []; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "123") [ "123" ]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "123") [ "123" ]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "<>123") [""; "123"]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "<>123") ["123"]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "123<>") ["123"; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "123<>") ["123";]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "<>1<>2<><>3<>") + [""; "1"; "2"; ""; "3"; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "<>1<>2<><>3<>") + ["1"; "2"; "3"]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" "<> 1<> 2<><> 3<>") + [""; " 1"; " 2"; ""; " 3";""]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" "<> 1<> 2<><> 3<>") + [" 1"; " 2"; " 3";]; + eql (String.cuts ~rev ~empty:true ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (String.cuts ~rev ~empty:false ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (String.cuts ~rev ~empty:true ~sep:"<->" "<->>->") [""; ">->"]; + eql (String.cuts ~rev ~empty:false ~sep:"<->" "<->>->") [">->"]; + eql (String.cuts ~rev ~empty:true ~sep:"aa" "aa") [""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"aa" "aa") []; + eql (String.cuts ~rev ~empty:true ~sep:"aa" "aaa") ["a"; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"aa" "aaa") ["a"]; + eql (String.cuts ~rev ~empty:true ~sep:"aa" "aaaa") [""; ""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"aa" "aaaa") []; + eql (String.cuts ~rev ~empty:true ~sep:"aa" "aaaaa") ["a"; ""; "";]; + eql (String.cuts ~rev ~empty:false ~sep:"aa" "aaaaa") ["a";]; + eql (String.cuts ~rev ~empty:true ~sep:"aa" "aaaaaa") [""; ""; ""; ""]; + eql (String.cuts ~rev ~empty:false ~sep:"aa" "aaaaaa") []; + () + +let fields = test "String.fields" @@ fun () -> + let eql = eq_list ~eq:String.equal ~pp:String.dump in + let no_alloc ?empty ?is_sep s = + eq_bool (List.hd (String.fields ?empty ?is_sep s) == s) true + in + let is_a c = c = 'a' in + no_alloc ~empty:true "a"; + no_alloc ~empty:false "a"; + no_alloc ~empty:true "abc"; + no_alloc ~empty:false "abc"; + no_alloc ~empty:true ~is_sep:is_a "bcdf"; + no_alloc ~empty:false ~is_sep:is_a "bcdf"; + eql (String.fields ~empty:true "") [""]; + eql (String.fields ~empty:false "") []; + eql (String.fields ~empty:true "\n\r") ["";"";""]; + eql (String.fields ~empty:false "\n\r") []; + eql (String.fields ~empty:true " \n\rabc") ["";"";"";"abc"]; + eql (String.fields ~empty:false " \n\rabc") ["abc"]; + eql (String.fields ~empty:true " \n\racd de") ["";"";"";"acd";"de"]; + eql (String.fields ~empty:false " \n\racd de") ["acd";"de"]; + eql (String.fields ~empty:true " \n\racd de ") ["";"";"";"acd";"de";""]; + eql (String.fields ~empty:false " \n\racd de ") ["acd";"de"]; + eql (String.fields ~empty:true "\n\racd\nde \r") ["";"";"acd";"de";"";""]; + eql (String.fields ~empty:false "\n\racd\nde \r") ["acd";"de"]; + eql (String.fields ~empty:true ~is_sep:is_a "") [""]; + eql (String.fields ~empty:false ~is_sep:is_a "") []; + eql (String.fields ~empty:true ~is_sep:is_a "abaac aaa") + ["";"b";"";"c ";"";"";""]; + eql (String.fields ~empty:false ~is_sep:is_a "abaac aaa") ["b"; "c "]; + eql (String.fields ~empty:true ~is_sep:is_a "aaaa") ["";"";"";"";""]; + eql (String.fields ~empty:false ~is_sep:is_a "aaaa") []; + eql (String.fields ~empty:true ~is_sep:is_a "aaaa ") ["";"";"";"";" "]; + eql (String.fields ~empty:false ~is_sep:is_a "aaaa ") [" "]; + eql (String.fields ~empty:true ~is_sep:is_a "aaaab") ["";"";"";"";"b"]; + eql (String.fields ~empty:false ~is_sep:is_a "aaaab") ["b"]; + eql (String.fields ~empty:true ~is_sep:is_a "baaaa") ["b";"";"";"";""]; + eql (String.fields ~empty:false ~is_sep:is_a "baaaa") ["b"]; + eql (String.fields ~empty:true ~is_sep:is_a "abaaaa") ["";"b";"";"";"";""]; + eql (String.fields ~empty:false ~is_sep:is_a "abaaaa") ["b"]; + eql (String.fields ~empty:true ~is_sep:is_a "aba") ["";"b";""]; + eql (String.fields ~empty:false ~is_sep:is_a "aba") ["b"]; + eql (String.fields ~empty:false "tokenize me please") + ["tokenize"; "me"; "please"]; + () + +(* Traversing strings *) + +let find = test "String.find" @@ fun () -> + let eq = eq_option ~eq:(=) ~pp:pp_int in + let a c = c = 'a' in + eq (String.find ~rev:false a "") None; + eq (String.find ~rev:false ~start:(-1) a "") None; + eq (String.find ~rev:false ~start:0 a "") None; + eq (String.find ~rev:false ~start:1 a "") None; + eq (String.find ~rev:true a "") None; + eq (String.find ~rev:true ~start:(-1) a "") None; + eq (String.find ~rev:true ~start:0 a "") None; + eq (String.find ~rev:true ~start:1 a "") None; + eq (String.find ~rev:false ~start:(-1) a "a") (Some 0); + eq (String.find ~rev:false ~start:0 a "a") (Some 0); + eq (String.find ~rev:false ~start:1 a "a") None; + eq (String.find ~rev:true ~start:(-1) a "a") None; + eq (String.find ~rev:true ~start:0 a "a") (Some 0); + eq (String.find ~rev:true ~start:1 a "a") (Some 0); + eq (String.find ~rev:false ~start:(-1) a "ba") (Some 1); + eq (String.find ~rev:false ~start:0 a "ba") (Some 1); + eq (String.find ~rev:false ~start:1 a "ba") (Some 1); + eq (String.find ~rev:false ~start:2 a "ba") None; + eq (String.find ~rev:true ~start:(-1) a "ba") None; + eq (String.find ~rev:true ~start:0 a "ba") None; + eq (String.find ~rev:true ~start:1 a "ba") (Some 1); + eq (String.find ~rev:true ~start:2 a "ba") (Some 1); + eq (String.find ~rev:true ~start:3 a "ba") (Some 1); + eq (String.find ~rev:false a "aba") (Some 0); + eq (String.find ~rev:false ~start:(-1) a "aba") (Some 0); + eq (String.find ~rev:false ~start:0 a "aba") (Some 0); + eq (String.find ~rev:false ~start:1 a "aba") (Some 2); + eq (String.find ~rev:false ~start:2 a "aba") (Some 2); + eq (String.find ~rev:false ~start:3 a "aba") None; + eq (String.find ~rev:false ~start:4 a "aba") None; + eq (String.find ~rev:true a "aba") (Some 2); + eq (String.find ~rev:true ~start:(-1) a "aba") None; + eq (String.find ~rev:true ~start:0 a "aba") (Some 0); + eq (String.find ~rev:true ~start:1 a "aba") (Some 0); + eq (String.find ~rev:true ~start:2 a "aba") (Some 2); + eq (String.find ~rev:true ~start:3 a "aba") (Some 2); + eq (String.find ~rev:true ~start:4 a "aba") (Some 2); + eq (String.find ~rev:false a "bab") (Some 1); + eq (String.find ~rev:false ~start:(-1) a "bab") (Some 1); + eq (String.find ~rev:false ~start:0 a "bab") (Some 1); + eq (String.find ~rev:false ~start:1 a "bab") (Some 1); + eq (String.find ~rev:false ~start:2 a "bab") None; + eq (String.find ~rev:false ~start:3 a "bab") None; + eq (String.find ~rev:false ~start:4 a "bab") None; + eq (String.find ~rev:true a "bab") (Some 1); + eq (String.find ~rev:true ~start:(-1) a "bab") None; + eq (String.find ~rev:true ~start:0 a "bab") None; + eq (String.find ~rev:true ~start:1 a "bab") (Some 1); + eq (String.find ~rev:true ~start:2 a "bab") (Some 1); + eq (String.find ~rev:true ~start:3 a "bab") (Some 1); + eq (String.find ~rev:true ~start:4 a "bab") (Some 1); + eq (String.find ~rev:false a "baab") (Some 1); + eq (String.find ~rev:false ~start:(-1) a "baab") (Some 1); + eq (String.find ~rev:false ~start:0 a "baab") (Some 1); + eq (String.find ~rev:false ~start:1 a "baab") (Some 1); + eq (String.find ~rev:false ~start:2 a "baab") (Some 2); + eq (String.find ~rev:false ~start:3 a "baab") None; + eq (String.find ~rev:false ~start:4 a "baab") None; + eq (String.find ~rev:false ~start:5 a "baab") None; + eq (String.find ~rev:true ~start:(-1) a "baab") None; + eq (String.find ~rev:true ~start:0 a "baab") None; + eq (String.find ~rev:true ~start:1 a "baab") (Some 1); + eq (String.find ~rev:true ~start:2 a "baab") (Some 2); + eq (String.find ~rev:true ~start:3 a "baab") (Some 2); + eq (String.find ~rev:true ~start:4 a "baab") (Some 2); + eq (String.find ~rev:true ~start:5 a "baab") (Some 2); + () + +let find_sub = test "String.find_sub" @@ fun () -> + let eq = eq_option ~eq:(=) ~pp:pp_int in + eq (String.find_sub ~rev:false ~sub:"" "ab") (Some 0); + eq (String.find_sub ~rev:false ~start:(-1) ~sub:"" "ab") (Some 0); + eq (String.find_sub ~rev:false ~start:0 ~sub:"" "ab") (Some 0); + eq (String.find_sub ~rev:false ~start:1 ~sub:"" "ab") (Some 1); + eq (String.find_sub ~rev:false ~start:2 ~sub:"" "ab") None; + eq (String.find_sub ~rev:true ~sub:"" "ab") (Some 1); + eq (String.find_sub ~rev:true ~start:(-1) ~sub:"" "ab") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"" "ab") (Some 0); + eq (String.find_sub ~rev:true ~start:1 ~sub:"" "ab") (Some 1); + eq (String.find_sub ~rev:true ~start:2 ~sub:"" "ab") (Some 1); + eq (String.find_sub ~rev:false ~sub:"" "") None; + eq (String.find_sub ~rev:false ~start:(-1) ~sub:"" "") None; + eq (String.find_sub ~rev:false ~start:0 ~sub:"" "") None; + eq (String.find_sub ~rev:false ~start:1 ~sub:"" "") None; + eq (String.find_sub ~rev:true ~sub:"" "") None; + eq (String.find_sub ~rev:true ~start:(-1) ~sub:"" "") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"" "") None; + eq (String.find_sub ~rev:true ~start:1 ~sub:"" "") None; + eq (String.find_sub ~rev:false ~sub:"ab" "") None; + eq (String.find_sub ~rev:false ~start:(-1) ~sub:"ab" "") None; + eq (String.find_sub ~rev:false ~start:0 ~sub:"ab" "") None; + eq (String.find_sub ~rev:false ~start:1 ~sub:"ab" "") None; + eq (String.find_sub ~rev:true ~sub:"ab" "") None; + eq (String.find_sub ~rev:true ~start:(-1) ~sub:"ab" "") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"ab" "") None; + eq (String.find_sub ~rev:true ~start:1 ~sub:"ab" "") None; + eq (String.find_sub ~rev:false ~sub:"ab" "a") None; + eq (String.find_sub ~rev:false ~start:0 ~sub:"ab" "a") None; + eq (String.find_sub ~rev:false ~start:1 ~sub:"ab" "a") None; + eq (String.find_sub ~rev:false ~start:2 ~sub:"ab" "a") None; + eq (String.find_sub ~rev:true ~sub:"ab" "a") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"ab" "a") None; + eq (String.find_sub ~rev:true ~start:1 ~sub:"ab" "a") None; + eq (String.find_sub ~rev:true ~start:2 ~sub:"ab" "a") None; + eq (String.find_sub ~rev:false ~start:(-1) ~sub:"ab" "ab") (Some 0); + eq (String.find_sub ~rev:false ~start:0 ~sub:"ab" "ab") (Some 0); + eq (String.find_sub ~rev:false ~start:1 ~sub:"ab" "ab") None; + eq (String.find_sub ~rev:false ~start:2 ~sub:"ab" "ab") None; + eq (String.find_sub ~rev:true ~sub:"ab" "ab") (Some 0); + eq (String.find_sub ~rev:true ~start:(-1) ~sub:"ab" "ab") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"ab" "ab") (Some 0); + eq (String.find_sub ~rev:true ~start:1 ~sub:"ab" "ab") (Some 0); + eq (String.find_sub ~rev:true ~start:2 ~sub:"ab" "ab") (Some 0); + eq (String.find_sub ~rev:true ~start:3 ~sub:"ab" "ab") (Some 0); + eq (String.find_sub ~rev:false ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:false ~start:(-1) ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:false ~start:0 ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:false ~start:1 ~sub:"ab" "aba") None; + eq (String.find_sub ~rev:false ~start:2 ~sub:"ab" "aba") None; + eq (String.find_sub ~rev:false ~start:3 ~sub:"ab" "aba") None; + eq (String.find_sub ~rev:false ~start:4 ~sub:"ab" "aba") None; + eq (String.find_sub ~rev:true ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:true ~start:(-1) ~sub:"ab" "aba") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:true ~start:1 ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:true ~start:2 ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:true ~start:3 ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:true ~start:4 ~sub:"ab" "aba") (Some 0); + eq (String.find_sub ~rev:false ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:false ~start:(-1) ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:false ~start:0 ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:false ~start:1 ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:false ~start:2 ~sub:"ab" "bab") None; + eq (String.find_sub ~rev:false ~start:3 ~sub:"ab" "bab") None; + eq (String.find_sub ~rev:false ~start:4 ~sub:"ab" "bab") None; + eq (String.find_sub ~rev:true ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:true ~start:(-1) ~sub:"ab" "bab") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"ab" "bab") None; + eq (String.find_sub ~rev:true ~start:1 ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:true ~start:2 ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:true ~start:3 ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:true ~start:4 ~sub:"ab" "bab") (Some 1); + eq (String.find_sub ~rev:false ~sub:"ab" "abab") (Some 0); + eq (String.find_sub ~rev:false ~start:(-1) ~sub:"ab" "abab") (Some 0); + eq (String.find_sub ~rev:false ~start:0 ~sub:"ab" "abab") (Some 0); + eq (String.find_sub ~rev:false ~start:1 ~sub:"ab" "abab") (Some 2); + eq (String.find_sub ~rev:false ~start:2 ~sub:"ab" "abab") (Some 2); + eq (String.find_sub ~rev:false ~start:3 ~sub:"ab" "abab") None; + eq (String.find_sub ~rev:false ~start:4 ~sub:"ab" "abab") None; + eq (String.find_sub ~rev:false ~start:5 ~sub:"ab" "abab") None; + eq (String.find_sub ~rev:true ~sub:"ab" "abab") (Some 2); + eq (String.find_sub ~rev:true ~start:(-1) ~sub:"ab" "abab") None; + eq (String.find_sub ~rev:true ~start:0 ~sub:"ab" "abab") (Some 0); + eq (String.find_sub ~rev:true ~start:1 ~sub:"ab" "abab") (Some 0); + eq (String.find_sub ~rev:true ~start:2 ~sub:"ab" "abab") (Some 2); + eq (String.find_sub ~rev:true ~start:3 ~sub:"ab" "abab") (Some 2); + eq (String.find_sub ~rev:true ~start:4 ~sub:"ab" "abab") (Some 2); + eq (String.find_sub ~rev:true ~start:5 ~sub:"ab" "abab") (Some 2); + () + +let filter = test "String.filter[_map]" @@ fun () -> + let no_alloc k f s = eq_bool (k f s == s) true in + no_alloc String.filter (fun _ -> true) ""; + no_alloc String.filter (fun _ -> true) "abcd"; + no_alloc String.filter_map (fun c -> Some c) ""; + no_alloc String.filter_map (fun c -> Some c) "abcd"; + let gen_filter : + 'a. ('a -> string -> string) -> 'a -> unit = + fun filter a -> + no_alloc filter a ""; + no_alloc filter a "a"; + no_alloc filter a "aa"; + no_alloc filter a "aaa"; + eq_str (filter a "ab") "a"; + eq_str (filter a "ba") "a"; + eq_str (filter a "abc") "a"; + eq_str (filter a "bac") "a"; + eq_str (filter a "bca") "a"; + eq_str (filter a "aba") "aa"; + eq_str (filter a "aab") "aa"; + eq_str (filter a "baa") "aa"; + eq_str (filter a "aabc") "aa"; + eq_str (filter a "abac") "aa"; + eq_str (filter a "abca") "aa"; + eq_str (filter a "baca") "aa"; + eq_str (filter a "bcaa") "aa"; + in + gen_filter String.filter (fun c -> c = 'a'); + gen_filter String.filter_map (fun c -> if c = 'a' then Some c else None); + let subst_a = function 'a' -> Some 'z' | c -> Some c in + no_alloc String.filter_map subst_a ""; + no_alloc String.filter_map subst_a "b"; + no_alloc String.filter_map subst_a "bcd"; + eq_str (String.filter_map subst_a "a") "z"; + eq_str (String.filter_map subst_a "aa") "zz"; + eq_str (String.filter_map subst_a "aaa") "zzz"; + eq_str (String.filter_map subst_a "ab") "zb"; + eq_str (String.filter_map subst_a "ba") "bz"; + eq_str (String.filter_map subst_a "abc") "zbc"; + eq_str (String.filter_map subst_a "bac") "bzc"; + eq_str (String.filter_map subst_a "bca") "bcz"; + eq_str (String.filter_map subst_a "aba") "zbz"; + eq_str (String.filter_map subst_a "aab") "zzb"; + eq_str (String.filter_map subst_a "baa") "bzz"; + eq_str (String.filter_map subst_a "aabc") "zzbc"; + eq_str (String.filter_map subst_a "abac") "zbzc"; + eq_str (String.filter_map subst_a "abca") "zbcz"; + eq_str (String.filter_map subst_a "baca") "bzcz"; + eq_str (String.filter_map subst_a "bcaa") "bczz"; + let subst_a_del_b = function 'a' -> Some 'z' | 'b' -> None | c -> Some c in + no_alloc String.filter_map subst_a_del_b ""; + no_alloc String.filter_map subst_a_del_b "c"; + no_alloc String.filter_map subst_a_del_b "cd"; + eq_str (String.filter_map subst_a_del_b "a") "z"; + eq_str (String.filter_map subst_a_del_b "aa") "zz"; + eq_str (String.filter_map subst_a_del_b "aaa") "zzz"; + eq_str (String.filter_map subst_a_del_b "ab") "z"; + eq_str (String.filter_map subst_a_del_b "ba") "z"; + eq_str (String.filter_map subst_a_del_b "abc") "zc"; + eq_str (String.filter_map subst_a_del_b "bac") "zc"; + eq_str (String.filter_map subst_a_del_b "bca") "cz"; + eq_str (String.filter_map subst_a_del_b "aba") "zz"; + eq_str (String.filter_map subst_a_del_b "aab") "zz"; + eq_str (String.filter_map subst_a_del_b "baa") "zz"; + eq_str (String.filter_map subst_a_del_b "aabc") "zzc"; + eq_str (String.filter_map subst_a_del_b "abac") "zzc"; + eq_str (String.filter_map subst_a_del_b "abca") "zcz"; + eq_str (String.filter_map subst_a_del_b "baca") "zcz"; + eq_str (String.filter_map subst_a_del_b "bcaa") "czz"; + () + +let map = test "String.map[i]" @@ fun () -> + let next_letter c = Char.(of_byte @@ to_int c + 1) in + let no_alloc map f s = eq_bool (map f s == s) true in + no_alloc String.map (fun c -> c) String.empty; + no_alloc String.map (fun c -> c) "abcd"; + eq_str (String.map (fun c -> fail "invoked"; c) "") ""; + eq_str (String.map next_letter "abcd") "bcde"; + no_alloc String.mapi (fun _ c -> c) String.empty; + no_alloc String.mapi (fun _ c -> c) "abcd"; + eq_str (String.mapi (fun _ c -> fail "invoked"; c) "") ""; + eq_str (String.mapi (fun i c -> Char.(of_byte @@ to_int c + i)) "abcd") + "aceg"; + () + +let fold = test "String.fold_{left,right}" @@ fun () -> + let eql = eq_list ~eq:(=) ~pp:pp_char in + String.fold_left (fun _ _ -> fail "invoked") () ""; + eql (String.fold_left (fun acc c -> c :: acc) [] "") []; + eql (String.fold_left (fun acc c -> c :: acc) [] "abc") ['c';'b';'a']; + String.fold_right (fun _ _ -> fail "invoked") "" (); + eql (String.fold_right (fun c acc -> c :: acc) "" []) []; + eql (String.fold_right (fun c acc -> c :: acc) "abc" []) ['a';'b';'c']; + () + +let iter = test "String.iter[i]" @@ fun () -> + let s = "abcd" in + String.iter (fun _ -> fail "invoked") ""; + String.iteri (fun _ _ -> fail "invoked") ""; + (let i = ref 0 in String.iter (fun c -> eq_char s.[!i] c; incr i) s); + String.iteri (fun i c -> eq_char s.[i] c) s; + () + +(* Ascii support *) + +let ascii_is_valid = test "String.Ascii.is_valid" @@ fun () -> + eq_bool (String.Ascii.is_valid "") true; + eq_bool (String.Ascii.is_valid "a") true; + eq_bool (String.(Ascii.is_valid (v ~len:(0x7F + 1) + (fun i -> Char.of_byte i)))) true; + () + +let ascii_casing = + test "String.Ascii.{uppercase,lowercase,capitalize,uncapitalize}" + @@ fun () -> + let no_alloc f s = eq_bool (f s == s) true in + no_alloc String.Ascii.uppercase ""; + no_alloc String.Ascii.uppercase "HEHEY \x7F\xFF\x00\x0A"; + eq_str (String.Ascii.uppercase "HeHey \x7F\xFF\x00\x0A") + "HEHEY \x7F\xFF\x00\x0A"; + eq_str (String.Ascii.uppercase "abcdefghijklmnopqrstuvwxyz") + "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + no_alloc String.Ascii.lowercase ""; + no_alloc String.Ascii.lowercase "hehey \x7F\xFF\x00\x0A"; + eq_str (String.Ascii.lowercase "hEhEY \x7F\xFF\x00\x0A") + "hehey \x7F\xFF\x00\x0A"; + eq_str (String.Ascii.lowercase "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + "abcdefghijklmnopqrstuvwxyz"; + no_alloc String.Ascii.capitalize ""; + no_alloc String.Ascii.capitalize "Hehey"; + no_alloc String.Ascii.capitalize "\x00hehey"; + eq_str (String.Ascii.capitalize "hehey") "Hehey"; + no_alloc String.Ascii.uncapitalize ""; + no_alloc String.Ascii.uncapitalize "hehey"; + no_alloc String.Ascii.uncapitalize "\x00hehey"; + eq_str (String.Ascii.uncapitalize "Hehey") "hehey"; + () + +let ascii_escapes = test "String.Ascii.escape[_string]" @@ fun () -> + let no_alloc s = eq_bool ((String.Ascii.escape s) == s) true in + no_alloc ""; + no_alloc "abcd"; + no_alloc "~"; + no_alloc " "; + eq_str (String.Ascii.escape "\x00abc") "\\x00abc"; + eq_str (String.Ascii.escape "\nabc") "\\x0Aabc"; + eq_str (String.Ascii.escape "\nab\xFFc") "\\x0Aab\\xFFc"; + eq_str (String.Ascii.escape "\nab\xFF") "\\x0Aab\\xFF"; + eq_str (String.Ascii.escape "\nab\\") "\\x0Aab\\\\"; + eq_str (String.Ascii.escape "\\") "\\\\"; + eq_str (String.Ascii.escape "\\\x00\x1F\x7F\xFF") "\\\\\\x00\\x1F\\x7F\\xFF"; + let no_alloc s = + eq_bool ((String.Ascii.escape_string s) == s) true + in + no_alloc ""; + no_alloc "abcd"; + no_alloc "~"; + no_alloc " "; + eq_str (String.Ascii.escape_string "\x00abc") "\\x00abc"; + eq_str (String.Ascii.escape_string "\nabc") "\\nabc"; + eq_str (String.Ascii.escape_string "\nab\xFFc") "\\nab\\xFFc"; + eq_str (String.Ascii.escape_string "\nab\xFF") "\\nab\\xFF"; + eq_str (String.Ascii.escape_string "\nab\\") "\\nab\\\\"; + eq_str (String.Ascii.escape_string "\\") "\\\\"; + eq_str (String.Ascii.escape_string "\b\t\n\r\"\\\x00\x1F\x7F\xFF") + "\\b\\t\\n\\r\\\"\\\\\\x00\\x1F\\x7F\\xFF"; + () + +let ascii_unescapes = test "String.Ascii.unescape[_string]" @@ fun () -> + let no_alloc unescape s = match unescape s with + | None -> fail "expected (Some %S)" s + | Some s' -> eq_bool (s == s') true + in + let eq_o = eq_option ~eq:String.equal ~pp:pp_str in + no_alloc String.Ascii.unescape ""; + no_alloc String.Ascii.unescape "abcd"; + no_alloc String.Ascii.unescape "~"; + no_alloc String.Ascii.unescape " "; + eq_o (String.Ascii.unescape "\\x00abc") (Some "\x00abc"); + eq_o (String.Ascii.unescape "\\x0Aabc") (Some "\nabc"); + eq_o (String.Ascii.unescape "\\x0Aab\\xFFc") (Some "\nab\xFFc"); + eq_o (String.Ascii.unescape "\\x0Aab\\xFF") (Some "\nab\xFF"); + eq_o (String.Ascii.unescape "\\x0Aab\\\\") (Some "\nab\\"); + eq_o (String.Ascii.unescape "a\\\\") (Some "a\\"); + eq_o (String.Ascii.unescape "\\\\") (Some "\\"); + eq_o (String.Ascii.unescape "a\\\\\\x00\\x1F\\x7F\\xFF") + (Some "a\\\x00\x1F\x7F\xFF"); + eq_o (String.Ascii.unescape "\\x61") (Some "a"); + eq_o (String.Ascii.unescape "\\x20") (Some " "); + eq_o (String.Ascii.unescape "\\x2") None; + eq_o (String.Ascii.unescape "\\x") None; + eq_o (String.Ascii.unescape "\\") None; + eq_o (String.Ascii.unescape "a\\b") None; + eq_o (String.Ascii.unescape "a\\t") None; + eq_o (String.Ascii.unescape "b\\n") None; + eq_o (String.Ascii.unescape "b\\r") None; + eq_o (String.Ascii.unescape "b\\\"") None; + eq_o (String.Ascii.unescape "b\\z") None; + eq_o (String.Ascii.unescape "b\\1") None; + no_alloc String.Ascii.unescape_string ""; + no_alloc String.Ascii.unescape_string "abcd"; + no_alloc String.Ascii.unescape_string "~"; + no_alloc String.Ascii.unescape_string " "; + eq_o (String.Ascii.unescape_string "\\x00abc") (Some "\x00abc"); + eq_o (String.Ascii.unescape_string "\\nabc") (Some "\nabc"); + eq_o (String.Ascii.unescape_string "\\nab\\xFFc") (Some "\nab\xFFc"); + eq_o (String.Ascii.unescape_string "\\nab\\xFF") (Some "\nab\xFF"); + eq_o (String.Ascii.unescape_string "\\nab\\\\") (Some "\nab\\"); + eq_o (String.Ascii.unescape_string "a\\\\") (Some "a\\"); + eq_o (String.Ascii.unescape_string "\\\\") (Some "\\"); + eq_o (String.Ascii.unescape_string + "\\b\\t\\n\\r\\\"\\\\\\x00\\x1F\\x7F\\xFF") + (Some "\b\t\n\r\"\\\x00\x1F\x7F\xFF"); + eq_o (String.Ascii.unescape_string "\\x61") (Some "a"); + eq_o (String.Ascii.unescape_string "\\x20") (Some " "); + eq_o (String.Ascii.unescape_string "\\x2") None; + eq_o (String.Ascii.unescape_string "\\x") None; + eq_o (String.Ascii.unescape_string "\\") None; + eq_o (String.Ascii.unescape_string "a\\b") (Some "a\b"); + eq_o (String.Ascii.unescape_string "a\\t") (Some "a\t"); + eq_o (String.Ascii.unescape_string "b\\n") (Some "b\n"); + eq_o (String.Ascii.unescape_string "b\\r") (Some "b\r"); + eq_o (String.Ascii.unescape_string "b\\\"") (Some "b\""); + eq_o (String.Ascii.unescape_string "b\\\'") (Some "b'"); + eq_o (String.Ascii.unescape_string "b\\z") None; + eq_o (String.Ascii.unescape_string "b\\1") None; + () + +(* Uniqueness *) + +let uniquify = test "String.uniquify" @@ fun () -> + let eq = eq_list ~eq:(=) ~pp:pp_str in + eq (String.uniquify []) []; + eq (String.uniquify ["a";"b";"c"]) ["a";"b";"c"]; + eq (String.uniquify ["a";"a";"b";"c"]) ["a";"b";"c"]; + eq (String.uniquify ["a";"b";"a";"c"]) ["a";"b";"c"]; + eq (String.uniquify ["a";"b";"c";"a"]) ["a";"b";"c"]; + eq (String.uniquify ["b";"a";"b";"c"]) ["b";"a";"c"]; + eq (String.uniquify ["a";"b";"b";"c"]) ["a";"b";"c"]; + eq (String.uniquify ["a";"b";"c";"b"]) ["a";"b";"c"]; + () + +let suite = suite "String functions" + [ misc; + head; + append; + concat; + is_empty; + is_prefix; + is_infix; + is_suffix; + for_all; + exists; + equal; + compare; + with_range; + with_index_range; + trim; + span; + cut; + cuts; + fields; + find; + find_sub; + filter; + map; + iter; + fold; + ascii_is_valid; + ascii_casing; + ascii_escapes; + ascii_unescapes; + uniquify; ] + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/test/test_sub.ml b/unikernel/duniverse/astring/test/test_sub.ml new file mode 100644 index 00000000..d7c6b48e --- /dev/null +++ b/unikernel/duniverse/astring/test/test_sub.ml @@ -0,0 +1,1184 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Testing +open Astring + +let pp_str_pair ppf (a, b) = + Format.fprintf ppf "@[<1>(%a,%a)@]" String.dump a String.dump b + +let pp_pair ppf (a, b) = + Format.fprintf ppf "@[<1>(%a,%a)@]" String.Sub.dump a String.Sub.dump b + +let eq_pair (l0, r0) (l1, r1) = + String.Sub.equal l0 l1 && String.Sub.equal r0 r1 + +let eq_sub = eq ~eq:String.Sub.equal ~pp:String.Sub.dump +let eq_sub_raw = eq ~eq:String.Sub.equal ~pp:String.Sub.dump_raw + +let eqs sub s = eq_str (String.Sub.to_string sub) s +let eqb sub s = eq_str (String.Sub.base_string sub) s +let eqs_opt sub os = + let sub_to_str = function + | Some sub -> Some (String.Sub.to_string sub) + | None -> None + in + eq_option ~eq:(=) ~pp:pp_str (sub_to_str sub) os + +let eqs_pair_opt subs_pair pair = + let subs_to_str = function + | None -> None + | Some (sub, sub') -> + Some (String.Sub.to_string sub, String.Sub.to_string sub') + in + eq_option ~eq:(=) ~pp:pp_str_pair (subs_to_str subs_pair) pair + +let empty_pos s pos = + eq_int (String.Sub.length s) 0; + eq_int (String.Sub.start_pos s) pos + +(* Base functions *) + +let misc = test "String.Sub misc. base functions" @@ fun () -> + eqs String.Sub.empty ""; + eqs (String.Sub.v "abc") "abc"; + eqs (String.Sub.v ~start:0 ~stop:1 "abc") "a"; + eqs (String.Sub.v ~start:1 ~stop:2 "abc") "b"; + eqs (String.Sub.v ~start:1 ~stop:3 "abc") "bc"; + eqs (String.Sub.v ~start:2 ~stop:3 "abc") "c"; + eqs (String.Sub.v ~start:3 ~stop:3 "abc") ""; + let sub = String.Sub.v ~start:2 ~stop:3 "abc" in + eq_int (String.Sub.start_pos sub) 2; + eq_int (String.Sub.stop_pos sub) 3; + eq_int (String.Sub.length sub) 1; + app_invalid ~pp:pp_char (String.Sub.get sub) 3; + app_invalid ~pp:pp_char (String.Sub.get sub) 2; + app_invalid ~pp:pp_char (String.Sub.get sub) 1; + eq_char (String.Sub.get sub 0) 'c'; + eq_int (String.Sub.get_byte sub 0) 0x63; + eqb (String.Sub.(rebase (v ~stop:2 "abc"))) "ab"; + () + +let head = test "String.[get_]head" @@ fun () -> + let empty = String.Sub.v ~start:2 ~stop:2 "abc" in + let bc = String.Sub.v ~start:1 ~stop:3 "abc" in + let eq_ochar = eq_option ~eq:(=) ~pp:pp_char in + eq_ochar (String.Sub.head empty) None; + eq_ochar (String.Sub.head ~rev:true empty) None; + eq_ochar (String.Sub.head bc) (Some 'b'); + eq_ochar (String.Sub.head ~rev:true bc) (Some 'c'); + eq_char (String.Sub.get_head bc) 'b'; + eq_char (String.Sub.get_head ~rev:true bc) 'c'; + app_invalid ~pp:pp_char String.Sub.get_head empty; + () + +let to_string = test "String.Sub.to_string" @@ fun () -> + let no_alloc s = + let r = String.Sub.to_string s in + eq_bool (r == (String.Sub.base_string s) || r == String.empty) true + in + no_alloc (String.Sub.v ~start:0 ~stop:0 "abc"); + eq_str (String.Sub.(to_string (v ~start:0 ~stop:1 "abc"))) "a"; + eq_str (String.Sub.(to_string (v ~start:0 ~stop:2 "abc"))) "ab"; + no_alloc (String.Sub.v ~start:0 ~stop:3 "abc"); + no_alloc (String.Sub.v ~start:1 ~stop:1 "abc"); + eq_str (String.Sub.(to_string (v ~start:1 ~stop:2 "abc"))) "b"; + eq_str (String.Sub.(to_string (v ~start:1 ~stop:3 "abc"))) "bc"; + no_alloc (String.Sub.v ~start:2 ~stop:2 "abc"); + eq_str (String.Sub.(to_string (v ~start:2 ~stop:3 "abc"))) "c"; + no_alloc (String.Sub.v ~start:3 ~stop:3 "abc"); + () + +(* Stretching substrings *) + +let start = test "String.Sub.start" @@ fun () -> + empty_pos String.Sub.(start @@ v "") 0; + empty_pos String.Sub.(start @@ v ~start:0 ~stop:0 "abc") 0; + empty_pos String.Sub.(start @@ v ~start:0 ~stop:1 "abc") 0; + empty_pos String.Sub.(start @@ v ~start:0 ~stop:2 "abc") 0; + empty_pos String.Sub.(start @@ v ~start:0 ~stop:3 "abc") 0; + empty_pos String.Sub.(start @@ v ~start:1 ~stop:1 "abc") 1; + empty_pos String.Sub.(start @@ v ~start:1 ~stop:2 "abc") 1; + empty_pos String.Sub.(start @@ v ~start:1 ~stop:3 "abc") 1; + empty_pos String.Sub.(start @@ v ~start:2 ~stop:2 "abc") 2; + empty_pos String.Sub.(start @@ v ~start:2 ~stop:3 "abc") 2; + empty_pos String.Sub.(start @@ v ~start:3 ~stop:3 "abc") 3; + () + +let stop = test "String.Sub.stop" @@ fun () -> + empty_pos String.Sub.(stop @@ v "") 0; + empty_pos String.Sub.(stop @@ v ~start:0 ~stop:0 "abc") 0; + empty_pos String.Sub.(stop @@ v ~start:0 ~stop:1 "abc") 1; + empty_pos String.Sub.(stop @@ v ~start:0 ~stop:2 "abc") 2; + empty_pos String.Sub.(stop @@ v ~start:0 ~stop:3 "abc") 3; + empty_pos String.Sub.(stop @@ v ~start:1 ~stop:1 "abc") 1; + empty_pos String.Sub.(stop @@ v ~start:1 ~stop:2 "abc") 2; + empty_pos String.Sub.(stop @@ v ~start:1 ~stop:3 "abc") 3; + empty_pos String.Sub.(stop @@ v ~start:2 ~stop:2 "abc") 2; + empty_pos String.Sub.(stop @@ v ~start:2 ~stop:3 "abc") 3; + empty_pos String.Sub.(stop @@ v ~start:3 ~stop:3 "abc") 3; + () + +let tail = test "String.Sub.tail" @@ fun () -> + empty_pos String.Sub.(tail @@ v "") 0; + empty_pos String.Sub.(tail @@ v ~start:0 ~stop:0 "abc") 0; + empty_pos String.Sub.(tail @@ v ~start:0 ~stop:1 "abc") 1; + eqs String.Sub.(tail @@ v ~start:0 ~stop:2 "abc") "b"; + eqs String.Sub.(tail @@ v ~start:0 ~stop:3 "abc") "bc"; + empty_pos String.Sub.(tail @@ v ~start:1 ~stop:1 "abc") 1; + empty_pos String.Sub.(tail @@ v ~start:1 ~stop:2 "abc") 2; + eqs String.Sub.(tail @@ v ~start:1 ~stop:3 "abc") "c"; + empty_pos String.Sub.(tail @@ v ~start:2 ~stop:2 "abc") 2; + empty_pos String.Sub.(tail @@ v ~start:2 ~stop:3 "abc") 3; + empty_pos String.Sub.(tail @@ v ~start:3 ~stop:3 "abc") 3; + () + +let base = test "String.Sub.base" @@ fun () -> + eqs String.Sub.(base @@ v "") ""; + eqs String.Sub.(base @@ v ~start:0 ~stop:0 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:0 ~stop:1 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:0 ~stop:2 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:0 ~stop:3 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:1 ~stop:1 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:1 ~stop:2 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:1 ~stop:3 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:2 ~stop:2 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:2 ~stop:3 "abc") "abc"; + eqs String.Sub.(base @@ v ~start:3 ~stop:3 "abc") "abc"; + () + +let extend = test "String.Sub.extend" @@ fun () -> + let empty = String.Sub.v ~start:2 ~stop:2 "abcdefg" in + let abcd = String.Sub.v ~start:0 ~stop:4 "abcdefg" in + let cd = String.Sub.v ~start:2 ~stop:4 "abcdefg" in + app_invalid ~pp:String.Sub.pp (fun s -> String.Sub.extend ~max:(-1) s) abcd; + eqs (String.Sub.extend empty) "cdefg"; + eqs (String.Sub.extend ~rev:true empty) "ab"; + eqs (String.Sub.extend ~max:2 empty) "cd"; + eqs (String.Sub.extend ~sat:(fun c -> c < 'f') empty) "cde"; + eqs (String.Sub.extend ~rev:true ~max:1 empty) "b"; + eqs (String.Sub.extend abcd) "abcdefg"; + eqs (String.Sub.extend ~max:2 abcd) "abcdef"; + eqs (String.Sub.extend ~max:2 ~sat:(fun c -> c < 'e') abcd) "abcd"; + eqs (String.Sub.extend ~max:2 ~sat:(fun c -> c < 'f') abcd) "abcde"; + eqs (String.Sub.extend ~max:2 ~sat:(fun c -> c < 'g') abcd) "abcdef"; + eqs (String.Sub.extend ~rev:true abcd) "abcd"; + eqs (String.Sub.extend ~rev:true ~max:2 ~sat:(fun c -> c > 'a') cd) "bcd"; + eqs (String.Sub.extend ~rev:true ~max:2 ~sat:(fun c -> c >= 'a') cd) "abcd"; + eqs (String.Sub.extend ~rev:true ~max:1 ~sat:(fun c -> c >= 'a') cd) "bcd"; + eqs (String.Sub.extend ~max:2 ~sat:(fun c -> c >= 'a') cd) "cdef"; + eqs (String.Sub.extend ~sat:(fun c -> c >= 'a') cd) "cdefg"; + () + +let reduce = test "String.Sub.reduce" @@ fun () -> + let empty = String.Sub.v ~start:2 ~stop:2 "abcdefg" in + let abcd = String.Sub.v ~start:0 ~stop:4 "abcdefg" in + let cd = String.Sub.v ~start:2 ~stop:4 "abcdefg" in + app_invalid ~pp:String.Sub.pp (fun s -> String.Sub.reduce ~max:(-1) s) abcd; + empty_pos (String.Sub.reduce ~rev:false empty) 2; + empty_pos (String.Sub.reduce ~rev:true empty) 2; + empty_pos (String.Sub.reduce ~rev:false ~max:2 empty) 2; + empty_pos (String.Sub.reduce ~rev:true ~max:2 empty) 2; + empty_pos (String.Sub.reduce ~rev:false ~sat:(fun c -> c < 'f') empty) 2; + empty_pos (String.Sub.reduce ~rev:true ~sat:(fun c -> c < 'f') empty) 2; + empty_pos (String.Sub.reduce ~rev:false ~max:1 empty) 2; + empty_pos (String.Sub.reduce ~rev:true ~max:1 empty) 2; + empty_pos (String.Sub.reduce ~rev:false abcd) 0; + empty_pos (String.Sub.reduce ~rev:true abcd) 4; + eqs (String.Sub.reduce ~rev:false ~max:0 abcd) "abcd"; + eqs (String.Sub.reduce ~rev:true ~max:0 abcd) "abcd"; + eqs (String.Sub.reduce ~rev:false ~max:0 abcd) "abcd"; + eqs (String.Sub.reduce ~rev:true ~max:0 abcd) "abcd"; + eqs (String.Sub.reduce ~rev:false ~max:2 abcd) "ab"; + eqs (String.Sub.reduce ~rev:true ~max:2 abcd) "cd"; + eqs (String.Sub.reduce ~rev:false ~max:2 ~sat:(fun c -> c < 'c') abcd) "abcd"; + eqs (String.Sub.reduce ~rev:true ~max:2 ~sat:(fun c -> c < 'c') abcd) "cd"; + eqs (String.Sub.reduce ~rev:false ~max:2 ~sat:(fun c -> c > 'b') abcd) "ab"; + eqs (String.Sub.reduce ~rev:true ~max:2 ~sat:(fun c -> c < 'b') abcd) "bcd"; + eqs (String.Sub.reduce ~rev:false ~max:2 ~sat:(fun c -> c > 'a') abcd) "ab"; + eqs (String.Sub.reduce ~rev:true ~max:2 ~sat:(fun c -> c < 'a') abcd) "abcd"; + empty_pos (String.Sub.reduce ~rev:false ~max:2 ~sat:(fun c -> c > 'a') cd) 2; + empty_pos (String.Sub.reduce ~rev:true ~max:2 ~sat:(fun c -> c > 'a') cd) 4; + eqs (String.Sub.reduce ~rev:false ~max:2 ~sat:(fun c -> c >= 'd') cd) "c"; + eqs (String.Sub.reduce ~rev:true ~max:2 ~sat:(fun c -> c >= 'd') cd) "cd"; + eqs (String.Sub.reduce ~rev:false ~max:1 ~sat:(fun c -> c > 'c') cd) "c"; + eqs (String.Sub.reduce ~rev:true ~max:1 ~sat:(fun c -> c > 'c') cd) "cd"; + eqs (String.Sub.reduce ~rev:false ~sat:(fun c -> c > 'c') cd) "c"; + eqs (String.Sub.reduce ~rev:true ~sat:(fun c -> c > 'c') cd) "cd"; + () + +let extent = test "String.Sub.extent" @@ fun () -> + app_invalid ~pp:String.Sub.dump_raw + String.Sub.(extent (v "a")) (String.Sub.(v "b")); + let abcd = "abcd" in + let e0 = String.Sub.v ~start:0 ~stop:0 abcd in + let a = String.Sub.v ~start:0 ~stop:1 abcd in + let ab = String.Sub.v ~start:0 ~stop:2 abcd in + let abc = String.Sub.v ~start:0 ~stop:3 abcd in + let _abcd = String.Sub.v ~start:0 ~stop:4 abcd in + let e1 = String.Sub.v ~start:1 ~stop:1 abcd in + let b = String.Sub.v ~start:1 ~stop:2 abcd in + let bc = String.Sub.v ~start:1 ~stop:3 abcd in + let bcd = String.Sub.v ~start:1 ~stop:4 abcd in + let e2 = String.Sub.v ~start:2 ~stop:2 abcd in + let c = String.Sub.v ~start:2 ~stop:3 abcd in + let cd = String.Sub.v ~start:2 ~stop:4 abcd in + let e3 = String.Sub.v ~start:3 ~stop:3 abcd in + let d = String.Sub.v ~start:3 ~stop:4 abcd in + let e4 = String.Sub.v ~start:4 ~stop:4 abcd in + empty_pos (String.Sub.extent e0 e0) 0; + eqs (String.Sub.extent e0 e1) "a"; + eqs (String.Sub.extent e1 e0) "a"; + eqs (String.Sub.extent e0 e2) "ab"; + eqs (String.Sub.extent e2 e0) "ab"; + eqs (String.Sub.extent e0 e3) "abc"; + eqs (String.Sub.extent e3 e0) "abc"; + eqs (String.Sub.extent e0 e4) "abcd"; + eqs (String.Sub.extent e4 e0) "abcd"; + empty_pos (String.Sub.extent e1 e1) 1; + eqs (String.Sub.extent e1 e2) "b"; + eqs (String.Sub.extent e2 e1) "b"; + eqs (String.Sub.extent e1 e3) "bc"; + eqs (String.Sub.extent e3 e1) "bc"; + eqs (String.Sub.extent e1 e4) "bcd"; + eqs (String.Sub.extent e4 e1) "bcd"; + empty_pos (String.Sub.extent e2 e2) 2; + eqs (String.Sub.extent e2 e3) "c"; + eqs (String.Sub.extent e3 e2) "c"; + eqs (String.Sub.extent e2 e4) "cd"; + eqs (String.Sub.extent e4 e2) "cd"; + empty_pos (String.Sub.extent e3 e3) 3; + eqs (String.Sub.extent e3 e4) "d"; + eqs (String.Sub.extent e4 e3) "d"; + empty_pos (String.Sub.extent e4 e4) 4; + eqs (String.Sub.extent a d) "abcd"; + eqs (String.Sub.extent d a) "abcd"; + eqs (String.Sub.extent b d) "bcd"; + eqs (String.Sub.extent d b) "bcd"; + eqs (String.Sub.extent c cd) "cd"; + eqs (String.Sub.extent cd c) "cd"; + eqs (String.Sub.extent e0 _abcd) "abcd"; + eqs (String.Sub.extent _abcd e0) "abcd"; + eqs (String.Sub.extent ab c) "abc"; + eqs (String.Sub.extent c ab) "abc"; + eqs (String.Sub.extent bc c) "bc"; + eqs (String.Sub.extent c bc) "bc"; + eqs (String.Sub.extent abc d) "abcd"; + eqs (String.Sub.extent d abc) "abcd"; + eqs (String.Sub.extent d bcd) "bcd"; + eqs (String.Sub.extent bcd d) "bcd"; + () + +let overlap = test "String.Sub.overlap" @@ fun () -> + let empty_pos sub pos = match sub with + | None -> fail "no sub" | Some sub -> empty_pos sub pos + in + app_invalid ~pp:String.Sub.dump_raw + String.Sub.(extent (v "a")) (String.Sub.(v "b")); + let abcd = "abcd" in + let e0 = String.Sub.v ~start:0 ~stop:0 abcd in + let a = String.Sub.v ~start:0 ~stop:1 abcd in + let ab = String.Sub.v ~start:0 ~stop:2 abcd in + let abc = String.Sub.v ~start:0 ~stop:3 abcd in + let _abcd = String.Sub.v ~start:0 ~stop:4 abcd in + let e1 = String.Sub.v ~start:1 ~stop:1 abcd in + let b = String.Sub.v ~start:1 ~stop:2 abcd in + let bc = String.Sub.v ~start:1 ~stop:3 abcd in + let bcd = String.Sub.v ~start:1 ~stop:4 abcd in + let e2 = String.Sub.v ~start:2 ~stop:2 abcd in + let c = String.Sub.v ~start:2 ~stop:3 abcd in + let cd = String.Sub.v ~start:2 ~stop:4 abcd in + let e3 = String.Sub.v ~start:3 ~stop:3 abcd in + let d = String.Sub.v ~start:3 ~stop:4 abcd in + let e4 = String.Sub.v ~start:4 ~stop:4 abcd in + empty_pos (String.Sub.overlap e0 a) 0; + empty_pos (String.Sub.overlap a e0) 0; + eqs_opt (String.Sub.overlap e0 b) None; + eqs_opt (String.Sub.overlap b e0) None; + empty_pos (String.Sub.overlap a b) 1; + empty_pos (String.Sub.overlap b a) 1; + eqs_opt (String.Sub.overlap a a) (Some "a"); + eqs_opt (String.Sub.overlap a ab) (Some "a"); + eqs_opt (String.Sub.overlap ab ab) (Some "ab"); + eqs_opt (String.Sub.overlap ab abc) (Some "ab"); + eqs_opt (String.Sub.overlap abc ab) (Some "ab"); + eqs_opt (String.Sub.overlap b abc) (Some "b"); + eqs_opt (String.Sub.overlap abc b) (Some "b"); + empty_pos (String.Sub.overlap abc e3) 3; + empty_pos (String.Sub.overlap e3 abc) 3; + eqs_opt (String.Sub.overlap ab bc) (Some "b"); + eqs_opt (String.Sub.overlap bc ab) (Some "b"); + eqs_opt (String.Sub.overlap bcd bc) (Some "bc"); + eqs_opt (String.Sub.overlap bc bcd) (Some "bc"); + eqs_opt (String.Sub.overlap bcd d) (Some "d"); + eqs_opt (String.Sub.overlap d bcd) (Some "d"); + eqs_opt (String.Sub.overlap bcd cd) (Some "cd"); + eqs_opt (String.Sub.overlap cd bcd) (Some "cd"); + eqs_opt (String.Sub.overlap bcd c) (Some "c"); + eqs_opt (String.Sub.overlap c bcd) (Some "c"); + empty_pos (String.Sub.overlap e2 bcd) 2; + empty_pos (String.Sub.overlap bcd e2) 2; + empty_pos (String.Sub.overlap bcd e3) 3; + empty_pos (String.Sub.overlap e3 bcd) 3; + empty_pos (String.Sub.overlap bcd e4) 4; + empty_pos (String.Sub.overlap e4 bcd) 4; + empty_pos (String.Sub.overlap e1 e1) 1; + eqs_opt (String.Sub.overlap e0 bcd) None; + () + +(* Appending substrings. *) + +let append = test "String.Sub.append" @@ fun () -> + let no_allocl s s' = + eq_bool (String.Sub.(base_string @@ append s s') == + String.Sub.(base_string s)) true + in + let no_allocr s s' = + eq_bool (String.Sub.(base_string @@ append s s') == + String.Sub.(base_string s')) true + in + no_allocl String.Sub.empty String.Sub.empty; + no_allocr String.Sub.empty String.Sub.empty; + no_allocl (String.Sub.v "bla") (String.Sub.v ~start:0 ~stop:0 "abcd"); + no_allocr (String.Sub.v ~start:1 ~stop:1 "b") (String.Sub.v "bli"); + let a = String.sub_with_index_range ~first:0 ~last:0 "abcd" in + let ab = String.sub_with_index_range ~first:0 ~last:1 "abcd" in + let cd = String.sub_with_index_range ~first:2 ~last:3 "abcd" in + let empty = String.Sub.v ~start:4 ~stop:4 "abcd" in + eqb (String.Sub.append a empty) "a"; + eqb (String.Sub.append empty a) "a"; + eqb (String.Sub.append ab empty) "ab"; + eqb (String.Sub.append empty ab) "ab"; + eqb (String.Sub.append ab cd) "abcd"; + eqb (String.Sub.append cd ab) "cdab"; + () + +let concat = test "String.Sub.concat" @@ fun () -> + let dash = String.sub_with_range ~first:2 ~len:1 "ab-d" in + let ddash = String.sub_with_range ~first:1 ~len:2 "a--d" in + let empty = String.sub_with_range ~first:2 ~len:0 "ab-d" in + let no_alloc ?sep s = + let r = String.Sub.(base_string (concat ?sep [s])) in + eq_bool (r == String.Sub.base_string s || r == String.empty) true + in + no_alloc empty; + no_alloc (String.Sub.v "hey"); + no_alloc ~sep:empty empty; + no_alloc ~sep:dash empty; + no_alloc ~sep:empty (String.Sub.v "abc"); + no_alloc ~sep:dash (String.Sub.v "abc"); + let sempty = String.Sub.v ~start:2 ~stop:2 "abc" in + let a = String.Sub.v ~start:2 ~stop:3 "kka" in + let b = String.Sub.v ~start:1 ~stop:2 "ubd" in + let c = String.Sub.v ~start:0 ~stop:1 "cdd" in + let ab = String.Sub.v ~start:1 ~stop:3 "gabi" in + let abc = String.Sub.v ~start:5 ~stop:8 "zuuuuabcbb" in + eqb (String.Sub.concat ~sep:empty []) ""; + eqb (String.Sub.concat ~sep:empty [sempty]) ""; + eqb (String.Sub.concat ~sep:empty [sempty;sempty]) ""; + eqb (String.Sub.concat ~sep:empty [a;b;]) "ab"; + eqb (String.Sub.concat ~sep:empty [a;b;sempty;c]) "abc"; + eqb (String.Sub.concat ~sep:dash []) ""; + eqb (String.Sub.concat ~sep:dash [sempty]) ""; + eqb (String.Sub.concat ~sep:dash [a]) "a"; + eqb (String.Sub.concat ~sep:dash [a;sempty]) "a-"; + eqb (String.Sub.concat ~sep:dash [sempty;a]) "-a"; + eqb (String.Sub.concat ~sep:dash [sempty;a;sempty]) "-a-"; + eqb (String.Sub.concat ~sep:dash [a;b;c]) "a-b-c"; + eqb (String.Sub.concat ~sep:ddash [a;b;c]) "a--b--c"; + eqb (String.Sub.concat ~sep:ab [a;b;c]) "aabbabc"; + eqb (String.Sub.concat ~sep:ab [abc;b;c]) "abcabbabc"; + () + +(* Predicates *) + +let is_empty = test "String.Sub.is_empty" @@ fun () -> + eq_bool (String.Sub.is_empty (String.Sub.v "")) true; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:4 ~stop:4 "abcd")) true; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:0 ~stop:0 "huiy")) true; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:0 ~stop:1 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:0 ~stop:2 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:0 ~stop:3 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:0 ~stop:4 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:1 ~stop:1 "abcd")) true; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:1 ~stop:2 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:1 ~stop:3 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:1 ~stop:4 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:2 ~stop:2 "abcd")) true; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:2 ~stop:3 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:3 ~stop:3 "abcd")) true; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:3 ~stop:4 "huiy")) false; + eq_bool (String.Sub.is_empty (String.Sub.v ~start:4 ~stop:4 "huiy")) true; + () + +let is_prefix = test "String.Sub.is_prefix" @@ fun () -> + let empty = String.sub_with_range ~first:3 ~len:0 "ugoadfj" in + let sempty = String.sub_with_range ~first:4 ~len:0 "dfkdjf" in + let habla = String.sub_with_range ~first:2 ~len:5 "abhablablu" in + let h = String.sub_with_range ~first:0 ~len:1 "hadfdffdf" in + let ha = String.sub_with_range ~first:0 ~len:2 "hadfdffdf" in + let hab = String.sub_with_range ~first:3 ~len:3 "hadhabdffdf" in + let abla = String.sub_with_range ~first:1 ~len:4 "iabla" in + eqs empty ""; eqs sempty ""; eqs habla "habla"; eqs h "h"; eqs ha "ha"; + eqs hab "hab"; eqs abla "abla"; + eq_bool (String.Sub.is_prefix ~affix:empty sempty) true; + eq_bool (String.Sub.is_prefix ~affix:empty habla) true; + eq_bool (String.Sub.is_prefix ~affix:ha sempty) false; + eq_bool (String.Sub.is_prefix ~affix:ha h) false; + eq_bool (String.Sub.is_prefix ~affix:ha ha) true; + eq_bool (String.Sub.is_prefix ~affix:ha hab) true; + eq_bool (String.Sub.is_prefix ~affix:ha habla) true; + eq_bool (String.Sub.is_prefix ~affix:ha abla) false; + () + +let is_infix = test "String.Sub.is_infix" @@ fun () -> + let empty = String.sub_with_range ~first:1 ~len:0 "ugoadfj" in + let sempty = String.sub_with_range ~first:2 ~len:0 "dfkdjf" in + let asdf = String.sub_with_range ~first:1 ~len:4 "aasdflablu" in + let a = String.sub_with_range ~first:2 ~len:1 "cda" in + let h = String.sub_with_range ~first:0 ~len:1 "h" in + let ha = String.sub_with_range ~first:1 ~len:2 "uhadfdffdf" in + let ah = String.sub_with_range ~first:0 ~len:2 "ah" in + let aha = String.sub_with_range ~first:2 ~len:3 "aaaha" in + let haha = String.sub_with_range ~first:1 ~len:4 "ahaha" in + let hahb = String.sub_with_range ~first:0 ~len:4 "hahbdfdf" in + let blhahb = String.sub_with_range ~first:0 ~len:6 "blhahbdfdf" in + let blha = String.sub_with_range ~first:1 ~len:4 "fblhahbdfdf" in + let blh = String.sub_with_range ~first:1 ~len:3 "fblhahbdfdf" in + eqs asdf "asdf"; eqs ha "ha"; eqs h "h"; eqs a "a"; eqs aha "aha"; + eqs haha "haha"; eqs hahb "hahb"; eqs blhahb "blhahb"; eqs blha "blha"; + eqs blh "blh"; + eq_bool (String.Sub.is_infix ~affix:empty sempty) true; + eq_bool (String.Sub.is_infix ~affix:empty asdf) true; + eq_bool (String.Sub.is_infix ~affix:empty ha) true; + eq_bool (String.Sub.is_infix ~affix:ha sempty) false; + eq_bool (String.Sub.is_infix ~affix:ha a) false; + eq_bool (String.Sub.is_infix ~affix:ha h) false; + eq_bool (String.Sub.is_infix ~affix:ha ah) false; + eq_bool (String.Sub.is_infix ~affix:ha ha) true; + eq_bool (String.Sub.is_infix ~affix:ha aha) true; + eq_bool (String.Sub.is_infix ~affix:ha haha) true; + eq_bool (String.Sub.is_infix ~affix:ha hahb) true; + eq_bool (String.Sub.is_infix ~affix:ha blhahb) true; + eq_bool (String.Sub.is_infix ~affix:ha blha) true; + eq_bool (String.Sub.is_infix ~affix:ha blh) false; + () + +let is_suffix = test "String.Sub.is_suffix" @@ fun () -> + let empty = String.sub_with_range ~first:1 ~len:0 "ugoadfj" in + let sempty = String.sub_with_range ~first:2 ~len:0 "dfkdjf" in + let asdf = String.sub_with_range ~first:1 ~len:4 "aasdflablu" in + let ha = String.sub_with_range ~first:1 ~len:2 "uhadfdffdf" in + let h = String.sub_with_range ~first:0 ~len:1 "h" in + let a = String.sub_with_range ~first:2 ~len:1 "cda" in + let ah = String.sub_with_range ~first:0 ~len:2 "ah" in + let aha = String.sub_with_range ~first:2 ~len:3 "aaaha" in + let haha = String.sub_with_range ~first:1 ~len:4 "ahaha" in + let hahb = String.sub_with_range ~first:0 ~len:4 "hahbdfdf" in + eqs asdf "asdf"; eqs ha "ha"; eqs h "h"; eqs a "a"; eqs aha "aha"; + eqs haha "haha"; eqs hahb "hahb"; + eq_bool (String.Sub.is_suffix ~affix:empty sempty) true; + eq_bool (String.Sub.is_suffix ~affix:empty asdf) true; + eq_bool (String.Sub.is_suffix ~affix:ha sempty) false; + eq_bool (String.Sub.is_suffix ~affix:ha a) false; + eq_bool (String.Sub.is_suffix ~affix:ha h) false; + eq_bool (String.Sub.is_suffix ~affix:ha ah) false; + eq_bool (String.Sub.is_suffix ~affix:ha ha) true; + eq_bool (String.Sub.is_suffix ~affix:ha aha) true; + eq_bool (String.Sub.is_suffix ~affix:ha haha) true; + eq_bool (String.Sub.is_suffix ~affix:ha hahb) false; + () + +let for_all = test "String.Sub.for_all" @@ fun () -> + let empty = String.Sub.v ~start:3 ~stop:3 "asldfksaf" in + let s123 = String.Sub.v ~start:2 ~stop:5 "sf123df" in + let s412 = String.Sub.v "412" in + let s142 = String.Sub.v ~start:3 "aaa142" in + let s124 = String.Sub.v ~start:3 "aad124" in + eqs empty ""; eqs s123 "123"; eqs s412 "412"; eqs s142 "142"; eqs s124 "124"; + eq_bool (String.Sub.for_all (fun _ -> false) empty) true; + eq_bool (String.Sub.for_all (fun _ -> true) empty) true; + eq_bool (String.Sub.for_all (fun c -> Char.to_int c < 0x34) s123) true; + eq_bool (String.Sub.for_all (fun c -> Char.to_int c < 0x34) s412) false; + eq_bool (String.Sub.for_all (fun c -> Char.to_int c < 0x34) s142) false; + eq_bool (String.Sub.for_all (fun c -> Char.to_int c < 0x34) s124) false; + () + +let exists = test "String.Sub.exists" @@ fun () -> + let empty = String.Sub.v ~start:3 ~stop:3 "asldfksaf" in + let s541 = String.sub_with_index_range ~first:1 ~last:3 "a541" in + let s154 = String.sub_with_index_range ~first:1 "a154" in + let s654 = String.sub_with_index_range ~last:2 "654adf" in + eqs s541 "541"; eqs s154 "154"; eqs s654 "654"; + eq_bool (String.Sub.exists (fun _ -> false) empty) false; + eq_bool (String.Sub.exists (fun _ -> true) empty) false; + eq_bool (String.Sub.exists (fun c -> Char.to_int c < 0x34) s541) true; + eq_bool (String.Sub.exists (fun c -> Char.to_int c < 0x34) s541) true; + eq_bool (String.Sub.exists (fun c -> Char.to_int c < 0x34) s154) true; + eq_bool (String.Sub.exists (fun c -> Char.to_int c < 0x34) s654) false; + () + +let same_base = test "String.Sub.same_base" @@ fun () -> + let abcd = "abcd" in + let a = String.sub_with_index_range ~first:0 ~last:0 abcd in + let ab = String.sub_with_index_range ~first:0 ~last:1 abcd in + let abce = String.sub_with_index_range ~first:0 ~last:1 "abce" in + eq_bool (String.Sub.same_base a ab) true; + eq_bool (String.Sub.same_base ab a) true; + eq_bool (String.Sub.same_base abce a) false; + eq_bool (String.Sub.same_base abce a) false; + () + +let equal_bytes = test "String.Sub.equal_bytes" @@ fun () -> + let a = String.sub_with_index_range ~first:0 ~last:0 "abcd" in + let ab = String.sub_with_index_range ~first:0 ~last:1 "abcd" in + let ab' = String.sub_with_index_range ~first:2 ~last:3 "cdab" in + let cd = String.sub_with_index_range ~first:2 ~last:3 "abcd" in + let empty = String.Sub.v ~start:4 ~stop:4 "abcd" in + eq_bool (String.Sub.equal_bytes empty empty) true; + eq_bool (String.Sub.equal_bytes empty a) false; + eq_bool (String.Sub.equal_bytes a empty) false; + eq_bool (String.Sub.equal_bytes a a) true; + eq_bool (String.Sub.equal_bytes ab ab') true; + eq_bool (String.Sub.equal_bytes cd ab) false; + () + +let compare_bytes = test "String.Sub.compare_bytes" @@ fun () -> + let empty = String.Sub.v "" in + let ab = String.sub_with_index_range ~first:0 ~last:1 "abcd" in + let ab' = String.sub_with_index_range ~first:2 ~last:3 "cdab" in + let abc = String.Sub.v ~start:3 ~stop:5 "adabcdd" in + eq_int (String.Sub.compare_bytes empty ab) (-1); + eq_int (String.Sub.compare_bytes empty empty) (0); + eq_int (String.Sub.compare_bytes ab ab') (0); + eq_int (String.Sub.compare_bytes ab empty) (1); + eq_int (String.Sub.compare_bytes ab abc) (-1); + () + +let equal = test "String.Sub.equal" @@ fun () -> + app_invalid ~pp:pp_bool (String.Sub.(equal (v "b"))) (String.Sub.v "a"); + let base = "abcd" in + let a = String.Sub.v ~start:0 ~stop:1 base in + let empty = String.Sub.v ~start:4 ~stop:4 base in + let ab = String.sub_with_index_range ~first:0 ~last:1 base in + let cd = String.sub_with_index_range ~first:2 ~last:3 base in + eq_bool (String.Sub.equal empty empty) true; + eq_bool (String.Sub.equal empty a) false; + eq_bool (String.Sub.equal a empty) false; + eq_bool (String.Sub.equal a a) true; + eq_bool (String.Sub.equal ab ab) true; + eq_bool (String.Sub.equal cd ab) false; + eq_bool (String.Sub.equal ab cd) false; + eq_bool (String.Sub.equal cd cd) true; + () + +let compare = test "String.Sub.compare" @@ fun () -> + app_invalid ~pp:pp_bool (String.Sub.(equal (v "b"))) (String.Sub.v "a"); + let base = "abcd" in + let a = String.Sub.v ~start:0 ~stop:1 base in + let empty = String.Sub.v ~start:4 ~stop:4 base in + let ab = String.sub_with_index_range ~first:0 ~last:1 base in + let cd = String.sub_with_index_range ~first:2 ~last:3 base in + eq_int (String.Sub.compare empty empty) 0; + eq_int (String.Sub.compare empty a) 1; + eq_int (String.Sub.compare a empty) (-1); + eq_int (String.Sub.compare a a) 0; + eq_int (String.Sub.compare ab ab) 0; + eq_int (String.Sub.compare cd ab) 1; + eq_int (String.Sub.compare ab cd) (-1); + eq_int (String.Sub.compare cd cd) 0; + () + +(* Extracting substrings *) + +let with_range = test "String.Sub.with_range" @@ fun () -> + let invalid ?first ?len s = + app_invalid ~pp:String.Sub.pp (String.Sub.with_range ?first ?len) s + in + let empty_pos ?first ?len s pos = + empty_pos (String.Sub.with_range ?first ?len s) pos + in + let base = "00abc1234" in + let abc = String.sub ~start:2 ~stop:5 base in + let a = String.sub ~start:2 ~stop:3 base in + let empty = String.sub ~start:2 ~stop:2 base in + empty_pos empty ~first:1 ~len:0 2; + empty_pos empty ~first:1 ~len:0 2; + empty_pos empty ~first:0 ~len:1 2; + empty_pos empty ~first:(-1) ~len:1 2; + invalid empty ~first:0 ~len:(-1); + eqs (String.Sub.with_range a ~first:0 ~len:0) ""; + eqs (String.Sub.with_range a ~first:1 ~len:0) ""; + empty_pos a ~first:1 ~len:1 3; + empty_pos a ~first:(-1) ~len:1 2; + eqs (String.Sub.with_range ~first:1 abc) "bc"; + eqs (String.Sub.with_range ~first:2 abc) "c"; + eqs (String.Sub.with_range ~first:3 abc) ""; + empty_pos ~first:4 abc 5; + eqs (String.Sub.with_range abc ~first:0 ~len:0) ""; + eqs (String.Sub.with_range abc ~first:0 ~len:1) "a"; + eqs (String.Sub.with_range abc ~first:0 ~len:2) "ab"; + eqs (String.Sub.with_range abc ~first:0 ~len:4) "abc"; + eqs (String.Sub.with_range abc ~first:1 ~len:0) ""; + eqs (String.Sub.with_range abc ~first:1 ~len:1) "b"; + eqs (String.Sub.with_range abc ~first:1 ~len:2) "bc"; + eqs (String.Sub.with_range abc ~first:1 ~len:3) "bc"; + eqs (String.Sub.with_range abc ~first:2 ~len:0) ""; + eqs (String.Sub.with_range abc ~first:2 ~len:1) "c"; + eqs (String.Sub.with_range abc ~first:2 ~len:2) "c"; + eqs (String.Sub.with_range abc ~first:3 ~len:0) ""; + eqs (String.Sub.with_range abc ~first:1 ~len:4) "bc"; + empty_pos abc ~first:(-1) ~len:1 2; + () + +let with_index_range = test "String.Sub.with_index_range" @@ fun () -> + let empty_pos ?first ?last s pos = + empty_pos (String.Sub.with_index_range ?first ?last s) pos + in + let base = "00abc1234" in + let abc = String.sub ~start:2 ~stop:5 base in + let a = String.sub ~start:2 ~stop:3 base in + let empty = String.sub ~start:2 ~stop:2 base in + empty_pos empty 2; + empty_pos empty ~first:0 ~last:0 2; + empty_pos empty ~first:1 ~last:0 2; + empty_pos empty ~first:0 ~last:1 2; + empty_pos empty ~first:(-1) ~last:1 2; + empty_pos empty ~first:0 ~last:(-1) 2; + eqs (String.Sub.with_index_range ~first:0 ~last:2 a) "a"; + empty_pos a ~first:0 ~last:(-1) 2; + eqs (String.Sub.with_index_range ~first:0 ~last:2 a) "a"; + eqs (String.Sub.with_index_range ~first:(-1) ~last:0 a) "a"; + eqs (String.Sub.with_index_range ~first:1 abc) "bc"; + eqs (String.Sub.with_index_range ~first:2 abc) "c"; + empty_pos ~first:3 abc 5; + empty_pos ~first:4 abc 5; + eqs (String.Sub.with_index_range abc ~first:0 ~last:0) "a"; + eqs (String.Sub.with_index_range abc ~first:0 ~last:1) "ab"; + eqs (String.Sub.with_index_range abc ~first:0 ~last:3) "abc"; + eqs (String.Sub.with_index_range abc ~first:1 ~last:1) "b"; + eqs (String.Sub.with_index_range abc ~first:1 ~last:2) "bc"; + empty_pos abc ~first:1 ~last:0 3; + eqs (String.Sub.with_index_range abc ~first:1 ~last:3) "bc"; + eqs (String.Sub.with_index_range abc ~first:2 ~last:2) "c"; + empty_pos abc ~first:2 ~last:0 4; + empty_pos abc ~first:2 ~last:1 4; + eqs (String.Sub.with_index_range abc ~first:2 ~last:3) "c"; + empty_pos abc ~first:3 ~last:0 5; + empty_pos abc ~first:3 ~last:1 5; + empty_pos abc ~first:3 ~last:2 5; + empty_pos abc ~first:3 ~last:3 5; + eqs (String.Sub.with_index_range abc ~first:(-1) ~last:0) "a"; + () + +let span = test "String.Sub.{span,take,drop}" @@ fun () -> + let eq_pair (l0, r0) (l1, r1) = String.Sub.(equal l0 l1 && equal r0 r1) in + let eq_pair = eq ~eq:eq_pair ~pp:pp_pair in + let eq ?(rev = false) ?min ?max ?sat s (sl, sr as spec) = + let (l, r as pair) = String.Sub.span ~rev ?min ?max ?sat s in + let t = String.Sub.take ~rev ?min ?max ?sat s in + let d = String.Sub.drop ~rev ?min ?max ?sat s in + eq_pair pair spec; + eq_sub t (if rev then sr else sl); + eq_sub d (if rev then sl else sr); + in + let invalid ?rev ?min ?max ?sat s = + app_invalid ~pp:pp_pair (String.Sub.span ?rev ?min ?max ?sat) s + in + let base = "0ab cd0" in + let empty = String.sub ~start:3 ~stop:3 base in + let ab_cd = String.sub ~start:1 ~stop:6 base in + let ab = String.sub ~start:1 ~stop:3 base in + let _cd = String.sub ~start:3 ~stop:6 base in + let cd = String.sub ~start:4 ~stop:6 base in + let ab_ = String.sub ~start:1 ~stop:4 base in + let a = String.sub ~start:1 ~stop:2 base in + let b_cd = String.sub ~start:2 ~stop:6 base in + let b = String.sub ~start:2 ~stop:3 base in + let d = String.sub ~start:5 ~stop:6 base in + let ab_c = String.sub ~start:1 ~stop:5 base in + eq ~rev:false ~min:1 ~max:0 ab_cd (String.Sub.start ab_cd, ab_cd); + eq ~rev:true ~min:1 ~max:0 ab_cd (ab_cd, String.Sub.stop ab_cd); + eq ~sat:Char.Ascii.is_white ab_cd (String.Sub.start ab_cd, ab_cd); + eq ~sat:Char.Ascii.is_letter ab_cd (ab, _cd); + eq ~max:1 ~sat:Char.Ascii.is_letter ab_cd (a, b_cd); + eq ~max:0 ~sat:Char.Ascii.is_letter ab_cd (String.Sub.start ab_cd, ab_cd); + eq ~rev:true ~sat:Char.Ascii.is_white ab_cd (ab_cd, String.Sub.stop ab_cd); + eq ~rev:true ~sat:Char.Ascii.is_letter ab_cd (ab_, cd); + eq ~rev:true ~max:1 ~sat:Char.Ascii.is_letter ab_cd (ab_c, d); + eq ~rev:true ~max:0 ~sat:Char.Ascii.is_letter ab_cd (ab_cd, + String.Sub.stop ab_cd); + eq ~sat:Char.Ascii.is_letter ab (ab, String.Sub.stop ab); + eq ~max:1 ~sat:Char.Ascii.is_letter ab (a, b); + eq ~sat:Char.Ascii.is_letter b (b, empty); + eq ~rev:true ~max:1 ~sat:Char.Ascii.is_letter ab (a, b); + eq ~max:1 ~sat:Char.Ascii.is_white ab (String.Sub.start ab, ab); + eq ~rev:true ~sat:Char.Ascii.is_white empty (empty, empty); + eq ~sat:Char.Ascii.is_white empty (empty, empty); + invalid ~rev:false ~min:(-1) empty; + invalid ~rev:true ~min:(-1) empty; + invalid ~rev:false ~max:(-1) empty; + invalid ~rev:true ~max:(-1) empty; + eq ~rev:false empty (empty,empty); + eq ~rev:true empty (empty,empty); + eq ~rev:false ~min:0 ~max:0 empty (empty,empty); + eq ~rev:true ~min:0 ~max:0 empty (empty,empty); + eq ~rev:false ~min:1 ~max:0 empty (empty,empty); + eq ~rev:true ~min:1 ~max:0 empty (empty,empty); + eq ~rev:false ~max:0 ab_cd (String.Sub.start ab_cd, ab_cd); + eq ~rev:true ~max:0 ab_cd (ab_cd, String.Sub.stop ab_cd); + eq ~rev:false ~max:2 ab_cd (ab, _cd); + eq ~rev:true ~max:2 ab_cd (ab_, cd); + eq ~rev:false ~min:6 ab_cd (String.Sub.start ab_cd, ab_cd); + eq ~rev:true ~min:6 ab_cd (ab_cd, String.Sub.stop ab_cd); + eq ~rev:false ab_cd (ab_cd, String.Sub.stop ab_cd); + eq ~rev:true ab_cd (String.Sub.start ab_cd, ab_cd); + eq ~rev:false ~max:30 ab_cd (ab_cd, String.Sub.stop ab_cd); + eq ~rev:true ~max:30 ab_cd (String.Sub.start ab_cd, ab_cd); + eq ~rev:false ~sat:Char.Ascii.is_white ab_cd (String.Sub.start ab_cd,ab_cd); + eq ~rev:true ~sat:Char.Ascii.is_white ab_cd (ab_cd,String.Sub.stop ab_cd); + eq ~rev:false ~sat:Char.Ascii.is_letter ab_cd (ab, _cd); + eq ~rev:true ~sat:Char.Ascii.is_letter ab_cd (ab_, cd); + eq ~rev:false ~sat:Char.Ascii.is_letter ~max:0 ab_cd (String.Sub.start ab_cd, + ab_cd); + eq ~rev:true ~sat:Char.Ascii.is_letter ~max:0 ab_cd (ab_cd, + String.Sub.stop ab_cd); + eq ~rev:false ~sat:Char.Ascii.is_letter ~max:1 ab_cd (a, b_cd); + eq ~rev:true ~sat:Char.Ascii.is_letter ~max:1 ab_cd (ab_c, d); + eq ~rev:false ~sat:Char.Ascii.is_letter ~min:2 ~max:1 ab_cd + (String.Sub.start ab_cd, ab_cd); + eq ~rev:true ~sat:Char.Ascii.is_letter ~min:2 ~max:1 ab_cd + (ab_cd, String.Sub.stop ab_cd); + eq ~rev:false ~sat:Char.Ascii.is_letter ~min:3 ab_cd + (String.Sub.start ab_cd, ab_cd); + eq ~rev:true ~sat:Char.Ascii.is_letter ~min:3 ab_cd + (ab_cd, String.Sub.stop ab_cd); + () + +let trim = test "String.Sub.trim" @@ fun () -> + let drop_a c = c = 'a' in + let base = "00aaaabcdaaaa00" in + let aaaabcdaaaa = String.sub ~start:2 ~stop:13 base in + let aaaabcd = String.sub ~start:2 ~stop:9 base in + let bcdaaaa = String.sub ~start:6 ~stop:13 base in + let aaaa = String.sub ~start:2 ~stop:6 base in + eqs (String.Sub.trim (String.sub "\t abcd \r ")) "abcd"; + eqs (String.Sub.trim aaaabcdaaaa) "aaaabcdaaaa"; + eqs (String.Sub.trim ~drop:drop_a aaaabcdaaaa) "bcd"; + eqs (String.Sub.trim ~drop:drop_a aaaabcd) "bcd"; + eqs (String.Sub.trim ~drop:drop_a bcdaaaa) "bcd"; + empty_pos (String.Sub.trim ~drop:drop_a aaaa) 4; + empty_pos (String.Sub.trim (String.sub " ")) 2; + () + +let cut = test "String.Sub.cut" @@ fun () -> + let ppp = pp_option pp_pair in + let eqo = eqs_pair_opt in + let s s = + String.sub ~start:1 ~stop:(1 + (String.length s)) (strf "\x00%s\x00" s) + in + let cut ?rev ~sep str = String.Sub.cut ?rev ~sep:(s sep) (s str) in + app_invalid ~pp:ppp (cut ~sep:"") ""; + app_invalid ~pp:ppp (cut ~sep:"") "123"; + eqo (cut "," "") None; + eqo (cut "," ",") (Some ("", "")); + eqo (cut "," ",,") (Some ("", ",")); + eqo (cut "," ",,,") (Some ("", ",,")); + eqo (cut "," "123") None; + eqo (cut "," ",123") (Some ("", "123")); + eqo (cut "," "123,") (Some ("123", "")); + eqo (cut "," "1,2,3") (Some ("1", "2,3")); + eqo (cut "," " 1,2,3") (Some (" 1", "2,3")); + eqo (cut "<>" "") None; + eqo (cut "<>" "<>") (Some ("", "")); + eqo (cut "<>" "<><>") (Some ("", "<>")); + eqo (cut "<>" "<><><>") (Some ("", "<><>")); + eqo (cut ~rev:true ~sep:"<>" "1") None; + eqo (cut "<>" "123") None; + eqo (cut "<>" "<>123") (Some ("", "123")); + eqo (cut "<>" "123<>") (Some ("123", "")); + eqo (cut "<>" "1<>2<>3") (Some ("1", "2<>3")); + eqo (cut "<>" " 1<>2<>3") (Some (" 1", "2<>3")); + eqo (cut "<>" ">>><>>>><>>>><>>>>") (Some (">>>", ">>><>>>><>>>>")); + eqo (cut "<->" "<->>->") (Some ("", ">->")); + eqo (cut ~rev:true ~sep:"<->" "<-") None; + eqo (cut "aa" "aa") (Some ("", "")); + eqo (cut "aa" "aaa") (Some ("", "a")); + eqo (cut "aa" "aaaa") (Some ("", "aa")); + eqo (cut "aa" "aaaaa") (Some ("", "aaa";)); + eqo (cut "aa" "aaaaaa") (Some ("", "aaaa")); + eqo (cut ~sep:"ab" "faaaa") None; + eqo (String.Sub.cut ~sep:(String.sub "/") (String.sub ~start:2 "a/b/c")) + (Some ("b", "c")); + let rev = true in + app_invalid ~pp:ppp (cut ~rev ~sep:"") ""; + app_invalid ~pp:ppp (cut ~rev ~sep:"") "123"; + eqo (cut ~rev ~sep:"," "") None; + eqo (cut ~rev ~sep:"," ",") (Some ("", "")); + eqo (cut ~rev ~sep:"," ",,") (Some (",", "")); + eqo (cut ~rev ~sep:"," ",,,") (Some (",,", "")); + eqo (cut ~rev ~sep:"," "123") None; + eqo (cut ~rev ~sep:"," ",123") (Some ("", "123")); + eqo (cut ~rev ~sep:"," "123,") (Some ("123", "")); + eqo (cut ~rev ~sep:"," "1,2,3") (Some ("1,2", "3")); + eqo (cut ~rev ~sep:"," "1,2,3 ") (Some ("1,2", "3 ")); + eqo (cut ~rev ~sep:"<>" "") None; + eqo (cut ~rev ~sep:"<>" "<>") (Some ("", "")); + eqo (cut ~rev ~sep:"<>" "<><>") (Some ("<>", "")); + eqo (cut ~rev ~sep:"<>" "<><><>") (Some ("<><>", "")); + eqo (cut ~rev ~sep:"<>" "1") None; + eqo (cut ~rev ~sep:"<>" "123") None; + eqo (cut ~rev ~sep:"<>" "<>123") (Some ("", "123")); + eqo (cut ~rev ~sep:"<>" "123<>") (Some ("123", "")); + eqo (cut ~rev ~sep:"<>" "1<>2<>3") (Some ("1<>2", "3")); + eqo (cut ~rev ~sep:"<>" "1<>2<>3 ") (Some ("1<>2", "3 ")); + eqo (cut ~rev ~sep:"<>" ">>><>>>><>>>><>>>>") + (Some (">>><>>>><>>>>", ">>>")); + eqo (cut ~rev ~sep:"<->" "<->>->") (Some ("", ">->")); + eqo (cut ~rev ~sep:"<->" "<-") None; + eqo (cut ~rev ~sep:"aa" "aa") (Some ("", "")); + eqo (cut ~rev ~sep:"aa" "aaa") (Some ("a", "")); + eqo (cut ~rev ~sep:"aa" "aaaa") (Some ("aa", "")); + eqo (cut ~rev ~sep:"aa" "aaaaa") (Some ("aaa", "";)); + eqo (cut ~rev ~sep:"aa" "aaaaaa") (Some ("aaaa", "")); + eqo (cut ~rev ~sep:"ab" "afaaaa") None; + eqo (String.Sub.cut ~sep:(String.sub "/") (String.sub ~stop:3 "a/b/c")) + (Some ("a", "b")); + () + +let cuts = test "String.Sub.cuts" @@ fun () -> + let ppl = pp_list String.Sub.dump in + let eql subs l = + let subs = List.map String.Sub.to_string subs in + eq_list ~eq:String.equal ~pp:String.dump subs l + in + let s s = + String.sub ~start:1 ~stop:(1 + (String.length s)) (strf "\x00%s\x00" s) + in + let cuts ?rev ?empty ~sep str = + String.Sub.cuts ?rev ?empty ~sep:(s sep) (s str) + in + app_invalid ~pp:ppl (cuts ~sep:"") ""; + app_invalid ~pp:ppl (cuts ~sep:"") "123"; + eql (cuts ~empty:true ~sep:"," "") [""]; + eql (cuts ~empty:false ~sep:"," "") []; + eql (cuts ~empty:true ~sep:"," ",") [""; ""]; + eql (cuts ~empty:false ~sep:"," ",") []; + eql (cuts ~empty:true ~sep:"," ",,") [""; ""; ""]; + eql (cuts ~empty:false ~sep:"," ",,") []; + eql (cuts ~empty:true ~sep:"," ",,,") [""; ""; ""; ""]; + eql (cuts ~empty:false ~sep:"," ",,,") []; + eql (cuts ~empty:true ~sep:"," "123") ["123"]; + eql (cuts ~empty:false ~sep:"," "123") ["123"]; + eql (cuts ~empty:true ~sep:"," ",123") [""; "123"]; + eql (cuts ~empty:false ~sep:"," ",123") ["123"]; + eql (cuts ~empty:true ~sep:"," "123,") ["123"; ""]; + eql (cuts ~empty:false ~sep:"," "123,") ["123";]; + eql (cuts ~empty:true ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (cuts ~empty:false ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (cuts ~empty:true ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (cuts ~empty:false ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (cuts ~empty:true ~sep:"," ",1,2,,3,") [""; "1"; "2"; ""; "3"; ""]; + eql (cuts ~empty:false ~sep:"," ",1,2,,3,") ["1"; "2"; "3";]; + eql (cuts ~empty:true ~sep:"," ", 1, 2,, 3,") + [""; " 1"; " 2"; ""; " 3"; ""]; + eql (cuts ~empty:false ~sep:"," ", 1, 2,, 3,") [" 1"; " 2";" 3";]; + eql (cuts ~empty:true ~sep:"<>" "") [""]; + eql (cuts ~empty:false ~sep:"<>" "") []; + eql (cuts ~empty:true ~sep:"<>" "<>") [""; ""]; + eql (cuts ~empty:false ~sep:"<>" "<>") []; + eql (cuts ~empty:true ~sep:"<>" "<><>") [""; ""; ""]; + eql (cuts ~empty:false ~sep:"<>" "<><>") []; + eql (cuts ~empty:true ~sep:"<>" "<><><>") [""; ""; ""; ""]; + eql (cuts ~empty:false ~sep:"<>" "<><><>") []; + eql (cuts ~empty:true ~sep:"<>" "123") [ "123" ]; + eql (cuts ~empty:false ~sep:"<>" "123") [ "123" ]; + eql (cuts ~empty:true ~sep:"<>" "<>123") [""; "123"]; + eql (cuts ~empty:false ~sep:"<>" "<>123") ["123"]; + eql (cuts ~empty:true ~sep:"<>" "123<>") ["123"; ""]; + eql (cuts ~empty:false ~sep:"<>" "123<>") ["123"]; + eql (cuts ~empty:true ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (cuts ~empty:false ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (cuts ~empty:true ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (cuts ~empty:false ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (cuts ~empty:true ~sep:"<>" "<>1<>2<><>3<>") + [""; "1"; "2"; ""; "3"; ""]; + eql (cuts ~empty:false ~sep:"<>" "<>1<>2<><>3<>") ["1"; "2";"3";]; + eql (cuts ~empty:true ~sep:"<>" "<> 1<> 2<><> 3<>") + [""; " 1"; " 2"; ""; " 3";""]; + eql (cuts ~empty:false ~sep:"<>" "<> 1<> 2<><> 3<>")[" 1"; " 2"; " 3"]; + eql (cuts ~empty:true ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (cuts ~empty:false ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (cuts ~empty:true ~sep:"<->" "<->>->") [""; ">->"]; + eql (cuts ~empty:false ~sep:"<->" "<->>->") [">->"]; + eql (cuts ~empty:true ~sep:"aa" "aa") [""; ""]; + eql (cuts ~empty:false ~sep:"aa" "aa") []; + eql (cuts ~empty:true ~sep:"aa" "aaa") [""; "a"]; + eql (cuts ~empty:false ~sep:"aa" "aaa") ["a"]; + eql (cuts ~empty:true ~sep:"aa" "aaaa") [""; ""; ""]; + eql (cuts ~empty:false ~sep:"aa" "aaaa") []; + eql (cuts ~empty:true ~sep:"aa" "aaaaa") [""; ""; "a"]; + eql (cuts ~empty:false ~sep:"aa" "aaaaa") ["a"]; + eql (cuts ~empty:true ~sep:"aa" "aaaaaa") [""; ""; ""; ""]; + eql (cuts ~empty:false ~sep:"aa" "aaaaaa") []; + let rev = true in + app_invalid ~pp:ppl (cuts ~rev ~sep:"") ""; + app_invalid ~pp:ppl (cuts ~rev ~sep:"") "123"; + eql (cuts ~rev ~empty:true ~sep:"," "") [""]; + eql (cuts ~rev ~empty:false ~sep:"," "") []; + eql (cuts ~rev ~empty:true ~sep:"," ",") [""; ""]; + eql (cuts ~rev ~empty:false ~sep:"," ",") []; + eql (cuts ~rev ~empty:true ~sep:"," ",,") [""; ""; ""]; + eql (cuts ~rev ~empty:false ~sep:"," ",,") []; + eql (cuts ~rev ~empty:true ~sep:"," ",,,") [""; ""; ""; ""]; + eql (cuts ~rev ~empty:false ~sep:"," ",,,") []; + eql (cuts ~rev ~empty:true ~sep:"," "123") ["123"]; + eql (cuts ~rev ~empty:false ~sep:"," "123") ["123"]; + eql (cuts ~rev ~empty:true ~sep:"," ",123") [""; "123"]; + eql (cuts ~rev ~empty:false ~sep:"," ",123") ["123"]; + eql (cuts ~rev ~empty:true ~sep:"," "123,") ["123"; ""]; + eql (cuts ~rev ~empty:false ~sep:"," "123,") ["123";]; + eql (cuts ~rev ~empty:true ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (cuts ~rev ~empty:false ~sep:"," "1,2,3") ["1"; "2"; "3"]; + eql (cuts ~rev ~empty:true ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (cuts ~rev ~empty:false ~sep:"," "1, 2, 3") ["1"; " 2"; " 3"]; + eql (cuts ~rev ~empty:true ~sep:"," ",1,2,,3,") + [""; "1"; "2"; ""; "3"; ""]; + eql (cuts ~rev ~empty:false ~sep:"," ",1,2,,3,") ["1"; "2"; "3"]; + eql (cuts ~rev ~empty:true ~sep:"," ", 1, 2,, 3,") + [""; " 1"; " 2"; ""; " 3"; ""]; + eql (cuts ~rev ~empty:false ~sep:"," ", 1, 2,, 3,") [" 1"; " 2"; " 3"]; + eql (cuts ~rev ~empty:true ~sep:"<>" "") [""]; + eql (cuts ~rev ~empty:false ~sep:"<>" "") []; + eql (cuts ~rev ~empty:true ~sep:"<>" "<>") [""; ""]; + eql (cuts ~rev ~empty:false ~sep:"<>" "<>") []; + eql (cuts ~rev ~empty:true ~sep:"<>" "<><>") [""; ""; ""]; + eql (cuts ~rev ~empty:false ~sep:"<>" "<><>") []; + eql (cuts ~rev ~empty:true ~sep:"<>" "<><><>") [""; ""; ""; ""]; + eql (cuts ~rev ~empty:false ~sep:"<>" "<><><>") []; + eql (cuts ~rev ~empty:true ~sep:"<>" "123") [ "123" ]; + eql (cuts ~rev ~empty:false ~sep:"<>" "123") [ "123" ]; + eql (cuts ~rev ~empty:true ~sep:"<>" "<>123") [""; "123"]; + eql (cuts ~rev ~empty:false ~sep:"<>" "<>123") ["123"]; + eql (cuts ~rev ~empty:true ~sep:"<>" "123<>") ["123"; ""]; + eql (cuts ~rev ~empty:false ~sep:"<>" "123<>") ["123";]; + eql (cuts ~rev ~empty:true ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (cuts ~rev ~empty:false ~sep:"<>" "1<>2<>3") ["1"; "2"; "3"]; + eql (cuts ~rev ~empty:true ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (cuts ~rev ~empty:false ~sep:"<>" "1<> 2<> 3") ["1"; " 2"; " 3"]; + eql (cuts ~rev ~empty:true ~sep:"<>" "<>1<>2<><>3<>") + [""; "1"; "2"; ""; "3"; ""]; + eql (cuts ~rev ~empty:false ~sep:"<>" "<>1<>2<><>3<>") + ["1"; "2"; "3"]; + eql (cuts ~rev ~empty:true ~sep:"<>" "<> 1<> 2<><> 3<>") + [""; " 1"; " 2"; ""; " 3";""]; + eql (cuts ~rev ~empty:false ~sep:"<>" "<> 1<> 2<><> 3<>") + [" 1"; " 2"; " 3";]; + eql (cuts ~rev ~empty:true ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (cuts ~rev ~empty:false ~sep:"<>" ">>><>>>><>>>><>>>>") + [">>>"; ">>>"; ">>>"; ">>>" ]; + eql (cuts ~rev ~empty:true ~sep:"<->" "<->>->") [""; ">->"]; + eql (cuts ~rev ~empty:false ~sep:"<->" "<->>->") [">->"]; + eql (cuts ~rev ~empty:true ~sep:"aa" "aa") [""; ""]; + eql (cuts ~rev ~empty:false ~sep:"aa" "aa") []; + eql (cuts ~rev ~empty:true ~sep:"aa" "aaa") ["a"; ""]; + eql (cuts ~rev ~empty:false ~sep:"aa" "aaa") ["a"]; + eql (cuts ~rev ~empty:true ~sep:"aa" "aaaa") [""; ""; ""]; + eql (cuts ~rev ~empty:false ~sep:"aa" "aaaa") []; + eql (cuts ~rev ~empty:true ~sep:"aa" "aaaaa") ["a"; ""; "";]; + eql (cuts ~rev ~empty:false ~sep:"aa" "aaaaa") ["a";]; + eql (cuts ~rev ~empty:true ~sep:"aa" "aaaaaa") [""; ""; ""; ""]; + eql (cuts ~rev ~empty:false ~sep:"aa" "aaaaaa") []; + () + +let fields = test "String.Sub.fields" @@ fun () -> + let eql subs l = + let subs = List.map String.Sub.to_string subs in + eq_list ~eq:String.equal ~pp:String.dump subs l + in + let s s = + String.sub ~start:1 ~stop:(1 + (String.length s)) (strf "\x00%s\x00" s) + in + let fields ?empty ?is_sep str = String.Sub.fields ?empty ?is_sep (s str) in + let is_a c = c = 'a' in + eql (fields ~empty:true "a") ["a"]; + eql (fields ~empty:false "a") ["a"]; + eql (fields ~empty:true "abc") ["abc"]; + eql (fields ~empty:false "abc") ["abc"]; + eql (fields ~empty:true ~is_sep:is_a "bcdf") ["bcdf"]; + eql (fields ~empty:false ~is_sep:is_a "bcdf") ["bcdf"]; + eql (fields ~empty:true "") [""]; + eql (fields ~empty:false "") []; + eql (fields ~empty:true "\n\r") ["";"";""]; + eql (fields ~empty:false "\n\r") []; + eql (fields ~empty:true " \n\rabc") ["";"";"";"abc"]; + eql (fields ~empty:false " \n\rabc") ["abc"]; + eql (fields ~empty:true " \n\racd de") ["";"";"";"acd";"de"]; + eql (fields ~empty:false " \n\racd de") ["acd";"de"]; + eql (fields ~empty:true " \n\racd de ") ["";"";"";"acd";"de";""]; + eql (fields ~empty:false " \n\racd de ") ["acd";"de"]; + eql (fields ~empty:true "\n\racd\nde \r") ["";"";"acd";"de";"";""]; + eql (fields ~empty:false "\n\racd\nde \r") ["acd";"de"]; + eql (fields ~empty:true ~is_sep:is_a "") [""]; + eql (fields ~empty:false ~is_sep:is_a "") []; + eql (fields ~empty:true ~is_sep:is_a "abaac aaa") + ["";"b";"";"c ";"";"";""]; + eql (fields ~empty:false ~is_sep:is_a "abaac aaa") ["b"; "c "]; + eql (fields ~empty:true ~is_sep:is_a "aaaa") ["";"";"";"";""]; + eql (fields ~empty:false ~is_sep:is_a "aaaa") []; + eql (fields ~empty:true ~is_sep:is_a "aaaa ") ["";"";"";"";" "]; + eql (fields ~empty:false ~is_sep:is_a "aaaa ") [" "]; + eql (fields ~empty:true ~is_sep:is_a "aaaab") ["";"";"";"";"b"]; + eql (fields ~empty:false ~is_sep:is_a "aaaab") ["b"]; + eql (fields ~empty:true ~is_sep:is_a "baaaa") ["b";"";"";"";""]; + eql (fields ~empty:false ~is_sep:is_a "baaaa") ["b"]; + eql (fields ~empty:true ~is_sep:is_a "abaaaa") ["";"b";"";"";"";""]; + eql (fields ~empty:false ~is_sep:is_a "abaaaa") ["b"]; + eql (fields ~empty:true ~is_sep:is_a "aba") ["";"b";""]; + eql (fields ~empty:false ~is_sep:is_a "aba") ["b"]; + eql (fields ~empty:false "tokenize me please") + ["tokenize"; "me"; "please"]; + () + +(* Traversing *) + +let find = test "String.Sub.find" @@ fun () -> + let abcbd = "abcbd" in + let empty = String.sub ~start:3 ~stop:3 abcbd in + let a = String.sub ~start:0 ~stop:1 abcbd in + let ab = String.sub ~start:0 ~stop:2 abcbd in + let c = String.sub ~start:2 ~stop:3 abcbd in + let b0 = String.sub ~start:1 ~stop:2 abcbd in + let b1 = String.sub ~start:3 ~stop:4 abcbd in + let abcbd = String.sub abcbd in + let eq = eq_option ~eq:String.Sub.equal ~pp:String.Sub.dump_raw in + eq (String.Sub.find (fun c -> c = 'b') empty) None; + eq (String.Sub.find ~rev:true (fun c -> c = 'b') empty) None; + eq (String.Sub.find (fun c -> c = 'b') a) None; + eq (String.Sub.find ~rev:true (fun c -> c = 'b') a) None; + eq (String.Sub.find (fun c -> c = 'b') c) None; + eq (String.Sub.find ~rev:true (fun c -> c = 'b') c) None; + eq (String.Sub.find (fun c -> c = 'b') abcbd) (Some b0); + eq (String.Sub.find ~rev:true (fun c -> c = 'b') abcbd) (Some b1); + eq (String.Sub.find (fun c -> c = 'b') ab) (Some b0); + eq (String.Sub.find ~rev:true (fun c -> c = 'b') ab) (Some b0); + () + +let find_sub = test "String.Sub.find_sub" @@ fun () -> + let abcbd = "abcbd" in + let empty = String.sub ~start:3 ~stop:3 abcbd in + let ab = String.sub ~start:0 ~stop:2 abcbd in + let b0 = String.sub ~start:1 ~stop:2 abcbd in + let b1 = String.sub ~start:3 ~stop:4 abcbd in + let abcbd = String.sub abcbd in + let eq = eq_option ~eq:String.Sub.equal ~pp:String.Sub.dump_raw in + eq (String.Sub.find_sub ~sub:ab empty) None; + eq (String.Sub.find_sub ~rev:true ~sub:ab empty) None; + eq (String.Sub.find_sub ~sub:(String.sub "") empty) (Some empty); + eq (String.Sub.find_sub ~rev:true ~sub:(String.sub "") empty) (Some empty); + eq (String.Sub.find_sub ~sub:ab abcbd) (Some ab); + eq (String.Sub.find_sub ~rev:true ~sub:ab abcbd) (Some ab); + eq (String.Sub.find_sub ~sub:empty abcbd) (Some (String.Sub.start abcbd)); + eq (String.Sub.find_sub ~rev:true ~sub:empty abcbd) + (Some (String.Sub.stop abcbd)); + eq (String.Sub.find_sub ~sub:(String.sub "b") abcbd) (Some b0); + eq (String.Sub.find_sub ~rev:true ~sub:(String.sub "b") abcbd) (Some b1); + eq (String.Sub.find_sub ~sub:b1 ab) (Some b0); + eq (String.Sub.find_sub ~rev:true ~sub:b1 ab) (Some b0); + () + +let map = test "String.Sub.map[i]" @@ fun () -> + let next_letter c = Char.(of_byte @@ to_int c + 1) in + let base = "i34abcdbbb" in + let abcd = String.Sub.v ~start:3 ~stop:7 base in + let empty = String.Sub.v ~start:2 ~stop:2 base in + eqs (String.Sub.map (fun c -> fail "invoked"; c) empty) ""; + eqs (String.Sub.map (fun c -> c) abcd) "abcd"; + eqs (String.Sub.map next_letter abcd) "bcde"; + eq_str String.Sub.(base_string (map next_letter abcd)) "bcde"; + eqs (String.Sub.mapi (fun _ c -> fail "invoked"; c) empty) ""; + eqs (String.Sub.mapi (fun i c -> Char.(of_byte @@ to_int c + i)) abcd) "aceg"; + () + +let fold = test "String.Sub.fold_{left,right}" @@ fun () -> + let empty = String.Sub.v ~start:2 ~stop:2 "ab" in + let abc = String.Sub.v ~start:3 ~stop:6 "i34abcdbbb" in + let eql = eq_list ~eq:(=) ~pp:pp_char in + String.Sub.fold_left (fun _ _ -> fail "invoked") () empty; + eql (String.Sub.fold_left (fun acc c -> c :: acc) [] empty) []; + eql (String.Sub.fold_left (fun acc c -> c :: acc) [] abc) ['c';'b';'a']; + String.Sub.fold_right (fun _ _ -> fail "invoked") empty (); + eql (String.Sub.fold_right (fun c acc -> c :: acc) empty []) []; + eql (String.Sub.fold_right (fun c acc -> c :: acc) abc []) ['a';'b';'c']; + () + +let iter = test "String.Sub.iter[i]" @@ fun () -> + let empty = String.Sub.v ~start:2 ~stop:2 "ab" in + let abc = String.Sub.v ~start:3 ~stop:6 "i34abcdbbb" in + String.Sub.iter (fun _ -> fail "invoked") empty; + String.Sub.iteri (fun _ _ -> fail "invoked") empty; + (let i = ref 0 in + String.Sub.iter (fun c -> eq_char (String.Sub.get abc !i) c; incr i) abc); + String.Sub.iteri (fun i c -> eq_char (String.Sub.get abc i) c) abc; + () + +(* Suite *) + +let suite = suite "Base String functions" + [ misc; + head; + to_string; + start; + stop; + tail; + base; + extend; + reduce; + extent; + overlap; + append; + concat; + is_empty; + is_prefix; + is_infix; + is_suffix; + for_all; + exists; + same_base; + equal_bytes; + compare_bytes; + equal; + compare; + with_range; + with_index_range; + span; + trim; + cut; + cuts; + fields; + find; + find_sub; + map; + fold; + iter; ] + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/test/testing.ml b/unikernel/duniverse/astring/test/testing.ml new file mode 100644 index 00000000..bdd2db66 --- /dev/null +++ b/unikernel/duniverse/astring/test/testing.ml @@ -0,0 +1,257 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Value equality and pretty printing *) + +type 'a eq = 'a -> 'a -> bool +type 'a pp = Format.formatter -> 'a -> unit + +(* Pretty printers *) + +let pp = Format.fprintf +let pp_exn ppf v = pp ppf "%s" (Printexc.to_string v) +let pp_bool ppf v = pp ppf "%b" v +let pp_char ppf v = pp ppf "%C" v +let pp_str ppf v = pp ppf "%S" v +let pp_int = Format.pp_print_int +let pp_float ppf v = pp ppf "%.10f" (* bof... *) v +let pp_int32 ppf v = pp ppf "%ld" v +let pp_int64 ppf v = pp ppf "%Ld" v +let pp_text = Format.pp_print_text +let pp_list pp_v ppf l = + let pp_sep ppf () = pp ppf ";@," in + pp ppf "@[<1>[%a]@]" (Format.pp_print_list ~pp_sep pp_v) l + +let pp_option pp_v ppf = function +| None -> Format.fprintf ppf "None" +| Some v -> Format.fprintf ppf "Some %a" pp_v v + +let pp_slot_loc ppf l = + pp ppf "%s:%d.%d-%d:" + l.Printexc.filename l.Printexc.line_number + l.Printexc.start_char l.Printexc.end_char + +let pp_bt ppf bt = match Printexc.backtrace_slots bt with +| None -> pp ppf "@,@[%a@]" pp_text "No backtrace. Did you compile with -g ?" +| Some slots -> + let rec loop = function + | [] -> assert false + | s :: ss -> + begin match Printexc.Slot.location s with + | None -> () + | Some l when l.Printexc.filename = "test/testing.ml" || + l.Printexc.filename = "test/test.ml" -> () + | Some l -> pp ppf "@,%a" pp_slot_loc l + end; + if ss <> [] then (loop ss) else () + in + loop (Array.to_list slots) + +(* Assertion counters *) + +let fail_count = ref 0 +let pass_count = ref 0 + +(* Logging *) + +let log_part fmt = Format.printf fmt +let log ?header fmt = match header with +| Some h -> Format.printf ("[%s] " ^^ fmt ^^ "@.") h +| None -> Format.printf (fmt ^^ "@.") + +let log_results () = + let total = !pass_count + !fail_count in + match !fail_count with + | 0 -> log ~header:"OK" "All %d assertions succeeded !@." total; true + | 1 -> log ~header:"FAIL" "1 failure out of %d assertions" total; false + | n -> log ~header:"FAIL" "%d failures out of %d assertions" + !fail_count total; false + +let log_fail msg bt = + log ~header:"FAIL" "@[@[%a@]%a@]" pp_text msg pp_bt bt + +let log_unexpected_exn ~header exn bt = + log ~header:"SUITE" "@[@[ABORTED: unexpected exception:@]@,%a%a@]" + pp_exn exn pp_bt bt + +(* Testing scopes *) + +exception Fail +exception Fail_handled + +let block f = try f () with +| Fail | Fail_handled -> () +| exn -> + let bt = Printexc.get_raw_backtrace () in + incr fail_count; + log_unexpected_exn ~header:"BLOCK" exn bt + +type test = string * (unit -> unit) + +let test n f = n, f +let run_test (n, f) = + log "* %s" n; + try f () with + | Fail | Fail_handled -> + log ~header:"TEST" "ABORTED: a test failure blew the test scope" + | exn -> + let bt = Printexc.get_raw_backtrace () in + incr fail_count; + log_unexpected_exn ~header:"TEST" exn bt + +type suite = string * test list +let suite n ts = n, ts +let run_suite (n, ts) = try log "%s" n; List.iter run_test ts with +| exn -> + let bt = Printexc.get_raw_backtrace () in + incr fail_count; + log_unexpected_exn ~header:"SUITE" exn bt + +let run suites = List.iter run_suite suites + +(* Passing and failing tests *) + +let pass () = incr pass_count +let fail fmt = + let bt = Printexc.get_callstack 10 in + let fail _ = log_fail (Format.flush_str_formatter ()) bt in + (incr fail_count; Format.kfprintf fail Format.str_formatter fmt) + +(* Checking values *) + +let pp_neq pp_v ppf (v, v') = pp ppf "@[%a@]@ <>@ @[%a@]@]" pp_v v pp_v v' + +let fail_eq pp v v' = fail "%a" (pp_neq pp) (v, v') + +let eq ~eq ~pp v v' = if eq v v' then pass () else fail_eq pp v v' +let eq_char = eq ~eq:(=) ~pp:pp_char +let eq_str = eq ~eq:(=) ~pp:pp_str +let eq_bool = eq ~eq:(=) ~pp:Format.pp_print_bool +let eq_int = eq ~eq:(=) ~pp:Format.pp_print_int +let eq_int32 = eq ~eq:(=) ~pp:pp_int32 +let eq_int64 = eq ~eq:(=) ~pp:pp_int64 +let eq_float = eq ~eq:(=) ~pp:pp_float +let eq_nan f = + if f <> f then pass () else fail "@[%a@]@ is@ not a NaN" pp_float f + +let eq_option ~eq:eq_v ~pp = + let eq_opt v v' = match v, v' with + | Some v, Some v' -> eq_v v v' + | None, None -> true + | _ -> false + in + let pp = pp_option pp in + fun v v' -> eq ~eq:eq_opt ~pp v v' + +let eq_some = function +| Some _ -> pass () +| None -> fail "None <> Some _" + +let eq_none ~pp = function +| None -> pass () +| Some v -> fail "@[%a <>@ None@]" pp v + +let eq_list ~eq:eq_v ~pp:pp_v = + let eql l l' = try List.for_all2 eq_v l l' with Invalid_argument _ -> false in + fun l l' -> eq ~eq:eql ~pp:(pp_list pp_v) l l' + +(* Tracing and checking function applications. *) + +type app = (* Gathers information about the application *) + { fail_count : int; (* fail_count checkpoint when the app starts *) + pp_args : Format.formatter -> unit -> unit; } + +let ctx () = { fail_count = -1; pp_args = fun ppf () -> (); } + +let log_app_raised app exn = + log "@[<2>@[%a@]==> raised %a" app.pp_args () pp_exn exn + +let pp_app app pp_v ppf v = + pp ppf "@[<2>@[%a@]==>@ @[%a@]@]" app.pp_args () pp_v v + +let log_app app pp_v v = log "%a" (pp_app app pp_v) v + +let ( $ ) f k = k (ctx ()) f + +let ( @-> ) (pp_v : 'a pp) k app f v = + let pp_args ppf () = app.pp_args ppf (); pp ppf "%a@ " pp_v v in + let fc = if app.fail_count = -1 then !fail_count else app.fail_count in + let app = { fail_count = fc; pp_args } in + try k app (f v) with + | Fail -> + log_app app pp_v v; + raise Fail_handled + | Fail_handled as e -> raise e + | exn -> + log_app_raised app exn; + fail "unexpected exception %a raised" pp_exn exn; + raise Fail_handled + +let ret pp app v = + if !fail_count <> app.fail_count then log_app app pp v; + v + +let ret_eq ~eq pp r app v = + if eq r v then (pass (); ret pp app v) else + (fail "@[%a@,%a@]" (pp_neq pp) (r, v) (pp_app app pp) v; + raise Fail_handled) + +let ret_none pp app v = match v with +| None -> pass (); ret (pp_option pp) app v +| Some _ -> ret_eq ~eq:(=) (pp_option pp) None app v + +let ret_some pp app v = match v with +| Some _ as v -> pass (); ret (pp_option pp) app v +| None as v -> + fail "@[Some _ <> None@,%a@]" (pp_app app (pp_option pp)) v; + raise Fail_handled + +let ret_get_option pp app v = match ret_some pp app v with +| Some v -> v +| None -> assert false + +(* I think we could handle the following functions on app traced ones + by enriching the app type and have alternate functions to $ for + handling these cases. Note that the only place were we can check + for these things are in the @-> combinator *) + +let app_invalid ~pp f v = + try + let r = f v in + fail "%a <> exception Invalid_arg _" pp r + with + | Invalid_argument _ -> pass () + | exn -> fail "exception %a <> exception Invalid_arg _" pp_exn exn + +let app_exn ~pp e f v = + try + let r = f v in + fail "%a <> exception %a" pp r pp_exn e + with + | exn when exn = e -> pass () + | exn -> fail "exception %a <> exception %a_" pp_exn exn pp_exn e + +let app_raises ~pp f v = + try + let r = f v in + fail "%a <> exception _ " pp r + with + | exn -> pass () + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/test/testing.mli b/unikernel/duniverse/astring/test/testing.mli new file mode 100644 index 00000000..c53c4f09 --- /dev/null +++ b/unikernel/duniverse/astring/test/testing.mli @@ -0,0 +1,92 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* {1 Value equality and pretty printing} *) + +type 'a eq = 'a -> 'a -> bool +type 'a pp = Format.formatter -> 'a -> unit + +(* {1 Pretty printers} *) + +val pp_int : int pp +val pp_bool : bool pp +val pp_float : float pp +val pp_char : char pp +val pp_str : string pp +val pp_list : 'a pp -> 'a list pp +val pp_option : 'a pp -> 'a option pp + +(* {1 Logging} *) + +val log_part : ('a, Format.formatter, unit) format -> 'a +val log : ?header:string -> ('a, Format.formatter, unit) format -> 'a +val log_results : unit -> bool + +(* {1 Testing scopes} *) + +type test +type suite + +val block : (unit -> unit) -> unit +val test : string -> (unit -> unit) -> test +val suite : string -> test list -> suite + +val run : suite list -> unit + +(* {1 Passing and failing tests} *) + +val pass : unit -> unit +val fail : ('a, Format.formatter, unit, unit) format4 -> 'a + +(* {1 Checking values} *) + +val eq : eq:'a eq -> pp:'a pp -> 'a -> 'a -> unit +val eq_char : char -> char -> unit +val eq_str : string -> string -> unit +val eq_bool : bool -> bool -> unit +val eq_int : int -> int -> unit +val eq_int32 : int32 -> int32 -> unit +val eq_int64 : int64 -> int64 -> unit +val eq_float : float -> float -> unit +val eq_nan : float -> unit + +val eq_option : eq:'a eq -> pp:'a pp -> 'a option -> 'a option -> unit +val eq_some : 'a option -> unit +val eq_none : pp:'a pp -> 'a option -> unit + +val eq_list : eq:'a eq -> pp:'a pp -> 'a list -> 'a list -> unit + +(* {1 Tracing and checking function applications} *) + +type app (* holds information about the application *) + +val ( $ ) : 'a -> (app -> 'a -> 'b) -> 'b +val ( @-> ) : 'a pp -> (app -> 'b -> 'c) -> app -> ('a -> 'b) -> 'a -> 'c + +val ret : 'a pp -> app -> 'a -> 'a +val ret_eq : eq:'a eq -> 'a pp -> 'a -> app -> 'a -> 'a +val ret_some : 'a pp -> app -> 'a option -> 'a option +val ret_none : 'a pp -> app -> 'a option -> 'a option +val ret_get_option : 'a pp -> app -> 'a option -> 'a + +val app_invalid : pp:'b pp -> ('a -> 'b) -> 'a -> unit +val app_exn : pp:'b pp -> exn -> ('a -> 'b) -> 'a -> unit +val app_raises : pp:'b pp -> ('a -> 'b) -> 'a -> unit + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The astring programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/astring/test/total.ml b/unikernel/duniverse/astring/test/total.ml new file mode 100644 index 00000000..ad80f7f5 --- /dev/null +++ b/unikernel/duniverse/astring/test/total.ml @@ -0,0 +1,20 @@ + +open Astring + +(* Total *) +let find_all p s = + let rec loop acc i = match String.find ~start:i p s with + | None -> List.rev acc + | Some i -> loop (i :: acc) (i + 1) + in + loop [] 0 + +(* Not total *) +let find_all p s = + let rec loop acc i = + if i > String.length s then List.rev acc else + match String.find ~start:i p s with + | None -> List.rev acc + | Some i -> loop (i :: acc) (i + 1) + in + loop [] 0 diff --git a/unikernel/duniverse/base/.github/workflows/workflow.yml b/unikernel/duniverse/base/.github/workflows/workflow.yml new file mode 100644 index 00000000..e8126d9b --- /dev/null +++ b/unikernel/duniverse/base/.github/workflows/workflow.yml @@ -0,0 +1,49 @@ +name: Main workflow + +on: + pull_request: + push: + schedule: + - cron: '0 1 * * SAT' + +concurrency: + group: ci-${{ github.ref }} + cancel-in-progress: true + +jobs: + Tests: + strategy: + fail-fast: false + matrix: + os: [macos-latest, ubuntu-latest, windows-latest] + ocaml: + - ocaml-base-compiler.5.0.0~alpha0 + - 4.14.0 + include: + - {os: ubuntu-latest, ocaml: 4.13.1} + - {os: ubuntu-latest, ocaml: 4.12.1} + - {os: ubuntu-latest, ocaml: 4.11.2} + exclude: + - {os: windows-latest, ocaml: ocaml-base-compiler.5.0.0~alpha0} + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Setup OCaml ${{ matrix.ocaml }} + uses: ocaml/setup-ocaml@v2 + with: + cache-prefix: v1-${{ matrix.os }}-${{ matrix.ocaml }} + dune-cache: true + ocaml-compiler: ${{ matrix.ocaml }} + + - name: Build dependencies + run: opam install . --deps-only --with-test + + - name: Build library + run: opam exec -- dune build + + - name: Run test suite + run: opam exec -- dune runtest diff --git a/unikernel/duniverse/base/.gitignore b/unikernel/duniverse/base/.gitignore new file mode 100644 index 00000000..6c14091b --- /dev/null +++ b/unikernel/duniverse/base/.gitignore @@ -0,0 +1,5 @@ +_build +*.install +*.merlin +_opam + diff --git a/unikernel/duniverse/base/.ocamlformat b/unikernel/duniverse/base/.ocamlformat new file mode 100644 index 00000000..3b217634 --- /dev/null +++ b/unikernel/duniverse/base/.ocamlformat @@ -0,0 +1 @@ +profile=janestreet diff --git a/unikernel/duniverse/base/CHANGES.md b/unikernel/duniverse/base/CHANGES.md new file mode 100644 index 00000000..8dbf9594 --- /dev/null +++ b/unikernel/duniverse/base/CHANGES.md @@ -0,0 +1,522 @@ +## Release v0.17.0 + +Added functionality: +* Add `String.to_sequence` +* Derive `equal` on `Set.Merge_with_duplicates_element.t` +* Add `Queue.drain` +* Add `Or_error.of_option` +* Extend `Hashtbl_intf.Hashtbl` with `capacity`, intended for testing resizing behavior +* Add `Nothing.must_be_*` functions discarding (parts of) inputs with `Nothing.t` as a + type parameter +* Add `Float.log2` +* Add `Random.bits64`, re-exported from `Stdlib.Random` +* Add `String.edit_distance` to compute Levenshtein distance between strings +* Add `Comparator.to_module` and `Comparator.of_module`, converting between `Comparator.t` and `Comparator.Module.t` +* Add `Map.sum`, `unzip`, `of_list_with_key_fold`, and `of_list_with_key_reduce` +* Add `Applicative.Ident`, similar to `Monad.Ident` +* Extend `Uniform_array` with more operations akin to `Array` +* Added `List.singleton` +* Add `Map.merge_disjoint_exn` for merging two disjoint maps of the same key/value types + Raises an exception if there are conflicting keys +* Added `Sequence.Expert.View` to consume sequences more flexibly and efficiently +* Add a `Binary` submodule to `Int`, `Int32`, etc, which provide `to_string` and + `sexp_of_t` with syntax matching the ocaml binary int literal syntax +* Add `List.stable_dedup` and deprecate `Set.stable_dedup_list` +* Add `Queue.enqueue_front` and `Queue.dequeue_back` +* Add `Type_equal.Id.Create*` functors for polymorphic types + +Added unicode support: +* Added `Utf*` submodules to `Bytes`, `Uchar`, and `String` +* Types for `Uchar` and `String` encoding UTF-8, UTF-16LE, UTF-16BE, UTF-32LE, UTF32-BE +* Added conversions, read/write functions, etc + +Changed behavior: +* `Info` has improved parsing of DOS newlines and trailing newlines in backtraces + +Removed definitions that were previously deprecated: +* `Type_equal.equal` type alias now that destructive update is available +* `Map.comparator` and `Set.comparator` type aliases +* `Base.Popcount`, as it is exported via the various `Int*` modules +* `Option` functions from `Container` that are not useful +* `Result.ok_fst`, an alias for `to_either` +* `Sequence.merge`, an alias for `merge_deduped_and_sorted` +* `Info.to_string_hum_deprecated` +* `?trunc_after` flag to `Info.of_list`, no longer used + +Deprecated: +* `Type_equal.Injective`, now that injectivity annotations exist + +Removed without deprecating: +* `Type_equal.Id.Uid.to_string`, `of_string`, and `t_of_sexp`. These were not compatible + with the representation changes needed for the new `Id.Create*` functors + +Interface changes: +* `Container.Generic` now supports two "extra" (non-element) type parameters +* Abstracted some of `Map` into `Dictionary_immutable` interfaces +* Abstracted some of `Hashtbl` into `Dictionary_mutable` interfaces +* Export `Set.Poly.set` type rather than using destructive update + +Bug fixes: +* Indexing was wrong in `Sequence.findi`, now fixed and with a regression test + +Performance improvements: +* Split up and refactored tests in `Base` to reduce build times +* Stop using exceptions for control, primarily to speed up `js_of_ocaml` versions. Affects + `Sequence.compare`, `String.index`, `String.rindex`, `String.index_from`, + `String.rindex_from`, `Map.change`, and `Map.remove` +* Unboxed `Int64.pow` +* Branchless implementation of `Float.clamp_unchecked`, `Int.clamp_unchecked` +* Branchless loop body in `Array.count` and `Array.counti` +* Remove allocation in `List.Assoc.find_exn` +* Reduce allocation of `With_return` under some compiler configurations +* Restore `Array.equal` to zero allocation +* Avoid boxing in `Int64.to_int_exn`, `Int64.hash_fold_t`, `Float.hash_fold_t` +* Inlining annotation on `Float.sign_exn` to avoid boxing +* Add `[@cold]` annotation to `Error.raise` +* Tighten up conditional logic in `Hashtbl.set` and `Hashtbl.remove` +* Reducing redundant computation in various `Map` functions +* Rewrite `Array.min_elt` and `Array.max_elt` to reduce branching and allocation +* Improve `ppx_hash` derived code for enumeration-like variants. +* Moved queue mutation check to a function marked `[@cold]`. +* Rewrite `List.dedup_and_sort` without a final remove-duplicates pass. +* Fix `Info` to avoid blowing up the stack on `force` of the internal `lazy`. +* Make `List.take`, `List.drop`, and `List.split` return the original list when possible. + (issue 153, thanks `@mroch`) +* Adapted `List` functions to take advantage of `[@tail_mod_cons]` where beneficial. +* Use `[@tail_mod_cons]` in `Sequence.to_list` + +Refactoring: +* Update whitespace styling, primarily by no longer using ocp-indent on code +* Use `Stdlib.Sys.Immediate64` in `Int63` instead of hand-written copy +* Properly use loop variable in `List.chunks_of` helper +* Rename internal variable in `Hashtbl.remove` for clarity +* Lift some of `Int_conversions` to `Int_string_conversions` to share elsewhere +* Remove unused `[@tailcall]` attribute in `List.group` +* Use inlined records in `Map` and `Set` internal variant representations +* Reimplement `Map.Build_increasing` to something simpler +* Remove unnecessary helper in `Map.remove` +* Remove unused functions from `String0` +* Use inlining instead of duplication for helpers in `Set` implementation +* Split out `Ocaml_intrinsics_kernel`, used it for some intrinsics in `Base` + +Documentation: +* Fix typo where `Set.union_list` documented itself as `union` +* Various grammar and capitalization fixes (PR 145, thanks `@goodship1`) + +Tests and benchmarks, largely to gain confidence in the changes above: +* Updated allocation expect tests to actually use `let%expect_test` (oops) +* Updated benchmarks for `Float.clamp*`. +* Add benchmarks for `Hashtbl.map_inplace`, `create`, `remove`, `set`, `change`, and + `find_and_remove` +* Add benchmarks for `Map.set`, `remove`, and `change` +* Add `js_of_ocaml`-only benchmarks for `Map.remove` and `Map.change` +* Benchmark `Sequence.compare` and `String.index` +* Benchmark `Set.add`, `find`, and `find_map` +* Tests and benchmarks for `min_elt`, `max_elt`, `count`, and `counti` in `Array` and + `List` + +Windows: +* Fixed the windows build. (PR 152, thanks `@hhugo`) + +Work toward compatibility with OCaml 5.1: +* Update `Random` to use new splittable PRNG +* Other various changes + +Improved support for compiler extensions found at https://github.com/ocaml-flambda/flambda-backend: +* Various updated signatures, definitions, and new functionality to support `local_` mode + and stack allocation +* Added annotations for `[@zero_alloc]` compiler checks + +## Release v0.16.0 + +Changes across many modules: + +* Replaced `Caml` with `Stdlib`. The `Caml` module predated `Stdlib` and has been + redundant for some time. + +* Added support for local allocations. This is a nonstandard OCaml extension available at + . + + Support includes: + - updating functions to accept `[@local]` arguments, especially closures + - local constructors, like `Array.create_local` and `Bytes.create_local` + - new versions of interfaces supporting `local` values, such as `Applicative.S_local` + - `[@@deriving globalize]` on some types, for converting local values to global values + +* Rename `Polymorphic_compare` submodules to `Comparisons`. The former was a misnomer. + While the comparisons for a given type are meant to replace polymorphic compare + operators, they are not polymorphic themselves. + +* Added `Container.S_with_creators` and `Indexed_container.S_with_creators`. Used these in + container modules such as `Array`, `List`, and `String`. These interfaces standardize + functions like `map` and `filter`. Along the way, refactored module types in `Container` + and `Indexed_container`. + +* In signatures for `fold*` functions, renamed accumulator type variables to `'acc` for + improved readability. + +* Added `of_string_opt` to `Int_intf.S`. + +* Added `dequeue_and_ignore_exn` to `Queue_intf.S`. + +Changes to individual modules: + +* `Bool`: added `select`, a primitive using `CMOV` on architectures that support it. + +* `Comparable`: + * Added `'a reversed` and `compare_reversed`, to support deriving inverted comparisons, + e.g.: `[%compare: My_type.t Comparable.reversed]` + * Added `Derived2_phantom`, similar to `Derived_phantom`. + * Made `Derived*.comparator_witness` types injective. + +* `Float`: + * Added hyperbolic trig functions `acosh`, `asinh`, and `atanh` to `Float`. + * Added `Float.of_string_opt`. + +* `Hash_set`: Made `t` injective. + +* `Hashtbl`: + * Added `choose_randomly` and `choose_randomly_exn`. + * Made `Hashtbl.t` injective. + +* `Lazy`: Added `peek`, extracting an already-forced value if present. + +* `Map`: + * Added `split_le_gt`, `split_lt_ge`, and `transpose_keys`. + * Added `Make_applicative_traversals`, allowing some applicatives to improve performance + when operating on maps. + * Corrected documentation of performance for `filter*` functions. + * Refactored module types in `map_intf.ml`. Among other changes, propagated + `~comparator` argument slightly differently to allow expressing type of + `transpose_keys` properly. + +* `Monad`: Documented performance characteristics of `Ident`. + +* `Option`: Deprecated functions from `Container` but not particularly useful for options. + +* `Ppx_compare_lib`: Removed primitive functions; `ppx_compare` now explicitly refers to + these via `Stdlib`. + +* `Sequence`: Changed `Step.t` variant type to use inlined records. + +* `Set`: + * Added `of_tree`, `to_tree`, `split_le_gt`, and `split_lt_ge`. + * Created a single shared `'a Named.t` type to `set_intf.ml`, rather than using a new type + in every instance of `Accessors`. + * Made `Set.t` injective in both type arguments. + * Refactored module types in `set_intf.ml`. + +* `Sexpable`: `Of_stringable` now provides `t_sexp_grammar`. + +* `Sign` and `Sign_or_nan`: Added `to_string_hum`. + +* `Stack`: added `filter`, `filter_inplace`, and `filter_map`. + +* `String`: added `concat_lines`, `pad_left`, `pad_right`, and `unsafe_sub` + +* `Sys`: added `opaque_identity_global`, which forces its argument to be globally + allocated. + +* `Type_equal`: `Id.Uid` now implements `Identifiable.S` + +* `Uniform_array`: add `sort` + +## Old pre-v0.15 changelogs (very likely stale and incomplete) + +## git version + +- Renamed `Result.ok_fst` to `Result.to_either` (old name remains as + deprecated alias). Added analogous `Result.of_either` function. + +- Removed deprecated values `Array.truncate`, `{Obj_array, + Uniform_array}.unsafe_truncate`, `Result.ok_unit`, `{Result, + Or_error}.ignore`. + +- Changed the signature of `Hashtbl.equal` to take the data equality + function first, allowing it to be used with `[%equal: t]`. + +- Remove deprecated function `List.dedup`. + +- Remove deprecated string mutation functions from the `String` module. + +- Removed deprecated function `Monad.all_ignore` in favor of + `Monad.all_unit`. + +- Deprecated `Or_error.ignore` and `Result.ignore` in favor of + `Or_error.ignore_m` and `Result.ignore_m`. + +- `Ordered_collection_common.get_pos_len` now returns an `Or_error.t` + +- Added `Bool.Non_short_circuiting`. + +- Added `Float.square`. + +- Remove module `Or_error.Ok`. + +- module `Ref` doesn't implement `Container.S1` anymore. + +- Rename parameter of `Sequence.merge` from `cmp` to `compare`. + +- Added `Info.of_lazy_t` + +- Added `List.partition_result` function, to partition a list of `Result.t` + values + +- Changed the signature of `equal` from `'a t -> 'a t -> equal:('a -> 'a -> + bool) -> bool` to `('a -> 'a -> bool) -> 'a t -> 'a t -> bool`. + +- Optimized `Lazy.compare` to check physical equality before forcing the lazy + values. + +- Deprecated `Args` in the `Applicative` interface in favor of using `ppx_let`. + +- Deprecated `Array.replace arr i ~f` in favor of using `arr.(i) <- (f (arr.(i)))` + +- Rename collection length parameter of `Ordered_collection_common` functions + from `length` to `total_length`, and add a unit argument to `get_pos_len` and + `get_pos_len_exn`. + +- Removed functions that were deprecated in 2016 from the `Array` and `Set` + modules. + +- `Int.Hex.of_string` and friends no longer silently ignore a suffix + of non-hexadecimal garbage. + +- Added `?backtrace` argument to `Or_error.of_exn_result`. + +- `List.zip` now returns a `List.Or_unequal_lengths.t` instead of an `option`. + +- Remove functions from the `Sequence` module that were deprecated in 2015. + +- `Container.Make` and `Container.Make0` now require callers to either provide a + custom `length` function or request that one be derived from `fold`. + `Container.to_array`'s signature is also changed to accept `length` and `iter` + instead of `fold`. + +- Exposed module `Int_math`. + +## v0.11 + +- Deprecated `Not_found`, people who need it can use `Caml.Not_found`, but its + use isn't recommended. + +- Added the `Sexp.Not_found_s` exception which will replace `Caml.Not_found` as + the default exception in a future release. + +- Document that `Array.find_exn`, `Array.find_map_exn`, and `Array.findi_exn` + may throw `Caml.Not_found` _or_ `Not_found_s`. + +- Document that `Hashtbl.find_exn` may throw `Caml.Not_found` _or_ + `Not_found_s`. + +- Document that `List.find_exn`, and `List.find_map_exn` may throw + `Caml.Not_found` _or_ `Not_found_s`. + +- Document that `List.find_exn` may throw `Caml.Not_found` _or_ `Not_found_s`. + +- Document that `String.lsplit2_exn`, and `String.rsplit2_exn` may throw + `Caml.Not_found` _or_ `Not_found_s`. + +- Added `Sys.backend_type`. + +- Removed unnecessary unit argument from `Hashtbl.create`. + +- Removed deprecated operations from `Hashtbl`. + +- Removed `Hashable.t` constructors from `Hashtbl` and `Hash_set`, instead + favoring the first-class module constructors. + +- Removed `Container` operations from `Either.First` and `Either.Second`. + +- Changed the type of `fold_until` in the `Container` interfaces. Rather than + returning a `Finished_or_stopped_early.t` (which has also been removed), the + function now takes a `finish` function that will be applied the result if `f` + never returned a `Stop _`. + +- Removed the `String_dict` module. + +- Added a `Queue` module that is backed by an `Option_array` for efficient and + (non-allocating) implementations of most operations. + +- Added a `Poly` submodule to `Map` and `Set` that exposes constructors that + use polymorphic compare. + +- Deprecated `all_ignore` in the `Monad` and `Applicative` interfaces in favor + of `all_unit`. + +- Deprecated `Array.replace_all` in favor of `Array.map_inplace`, which is the + standard name for that sort of operation within Base. + +- Document that `List.find_exn`, and `List.find_map_exn` may throw + `Caml.Not_found` _or_ `Not_found_s`. + +- Make `~compare` a required argument to `List.dedup_and_sort`, `List.dedup`, + `List.find_a_dup`, `List.contains_dup`, and `List.find_all_dups`. + +- Removed `List.exn_if_dup`. It is still available in core_kernel. + +- Removed "normalized" index operation `List.slice`. It is still available in + core_kernel. + +- Remove "normalized" index operations from `Array`, which incluced + `Array.normalize`, `Array.slice`, `Array.nget` and `Array.nset`. These + operations are still available in core_kernel. + +- Added `Uniform_array` module that is just like an `Array` except guarantees + that the representation array is not tagged with `Double_array_tag`, the tag + for float arrays. + +- Added `Option_array` module that allows for a compact representation of `'a + optoin array`, which avoids allocating heap objects representing `Some a`. + +- Remove "normalized" index operations from `String`, which incluced + `String.normalize`, `String.slice`, `String.nget` and `String.nset`. These + operations are still available in core_kernel. + +- Added missing conversions between `Int63` and other integer types, + specifically, the versions that return options. + +- Added truncating versions of integer conversions, with a suffix of + `_trunc`. These allow fast conversions via bit arithmetic without + any conditional failure; excess bits beyond the width of the output + type are simply dropped. + +- Added `Sequence.group`, similar to `List.group`. + +- Reimplemented `String.Caseless.compare` so that it does not + allocate. + +- Added `String.is_substring_at string ~pos ~substring`. Used it as + back-end for `is_suffix` and `is_prefix`. + +- Moved all remaining `Replace_polymorphic_compare` submodules from Base + types and consolidated them in one place within `Import0`. + +- Removed `(<=.)` and its friends. + +- Added `Sys.argv`. + +- Added a infix exponentation operator for int. + +- Added a `Formatter` module to reexport the `Format.formatter` type and updated + the deprecation message for `Format`. + +## v0.10 + +(Changes that can break existing programs are marked with a "\*") + +### Bugfixes + +- Generalized the type of `Printf.ifprintf` to reflect OCaml's stdlib. + +- Made `Sequence.fold_m` and `iter_m` respect `Skip` steps and explicitly bind + when they occur. + +- Changed `Float.is_negative` and `is_non_positive` on `NaN` to return `false` + rather than `true`. + +- Fixed the `Validate.protect` function, which was mistakenly raising exceptions. + +### API changes + +- Renamed `Map.add` as `set`, and deprecated `add`. A later feature will add + `add` and `add_exn` in the style of `Hashtbl`. + +- A different hash function is used to implement `Base.Int.hash`. + The old implementation was `Int.abs` but collision resistance is not enough, + we want avalanching as well. + The new function is an adaptation of one of the + [Thomas Wang](http://web.archive.org/web/20071223173210/http://www.concentric.net/~Ttwang/tech/inthash.htm) + hash functions to OCaml (63-bit integers), which results in reasonably good avalanching. + + +- Made `open Base` expose infix float operators (+., -., etc.). + +* Renamed `List.dedup` to `List.dedup_and_sort`, to better reflect its existing behavior. + +- Added `Hashtbl.find_multi` and `Map.find_multi`. + +- Added function `Map.of_increasing_sequence` for constructing a `Map.t` from an + ordered `Sequence.t` + +- Added function `List.chunks_of : 'a t -> length : int -> 'a t t`, for breaking + a list into chunks of equal length. + +- Add to module `Random` numeric functions that take upper and lower inclusive + bounds, e.g. `Random.int_incl : int -> int -> int`. + +* Replaced `Exn.Never_elide_backtrace` with `Backtrace.elide`, a `ref` cell that + determines whether `Backtrace.to_string` and `Backtrace.sexp_of_t` elide + backtraces. + +- Exposed infix operator `Base.( @@ )`. + +- Exposed modules `Base.Continue_or_stop` and `Finished_or_stopped_early`, used + with the `Container.fold_until` function. + +- Exposed module types Base.T, T1, T2, and T3. + +- Added `Sequence.Expert` functions `next_step` and + `delayed_fold_step`, for clients that want to explicitly handle `Skip` steps. + +- Added `Bytes` module. + This includes the submodules `From_string` and `To_string` with blit + functions. + N.B. the signature (and name) of `unsafe_to_string` and `unsafe_of_string` are + different from the one in the standard library (and hopefully more explicit). + +- Add bytes functions to `Buffer`. + Also added `Buffer.content_bytes`, the analog of `contents` but that returns + `bytes` rather than `string`. + +* Enabled `-safe-string`. + +- Added function `Int63.of_int32`, which was missing. + +* Deprecated a number of `String` mutating functions. + +- Added module `Obj_array`, moved in from `Core_kernel`. + +* In module type `Hashtbl.Accessors`, removed deprecated functions, moving them + into a new module type, `Deprecated`. + +- Exported `sexp_*` types that are recognized by `ppx_sexp_*` converters: + `sexp_array`, `sexp_list`, `sexp_opaque`, `sexp_option`. + +* Reworked the `Or_error` module's interface, moving the `Container.S` interface + to an `Ok` submodule, and adding functions `is_ok`, `is_error`, and `ok` to + more closely resemble the interface of the `Result` module. + +- Removed `Int.O.of_int_exn`. + +- Exposed `Base.force` function. + +- Changed the deprecation warning for `mod` to recommend `( % )` rather than + `Caml.( mod )`. + +### Performance related changes + +- Optimized `List.compare`, removing its closure allocation. + +- Optimized `String.mem` to not allocate. + +- Optimized `Float.is_negative`, `is_non_negative`, `is_positive`, and + `is_non_positive` to avoid some boxing. + +- Changed `Hashtbl.merge` to relax its equality check on the input tables' + `Hashable.t` records, checking physical equality componentwise if the records + aren't physically equal. + +- Added `Result.combine_errors`, similar to `Or_error.combine_errors`, with a + slightly different type. + +- Added `Result.combine_errors_unit`, similar to `Or_error.combine_errors_unit`. + +- Optimized the `With_return.return` type by adding the `[@@unboxed]` attribute. + +- Improved a number of deprecation warnings. + + +## v0.9 + +Initial release. diff --git a/unikernel/duniverse/base/CONTRIBUTING.md b/unikernel/duniverse/base/CONTRIBUTING.md new file mode 100644 index 00000000..45e1a22b --- /dev/null +++ b/unikernel/duniverse/base/CONTRIBUTING.md @@ -0,0 +1,67 @@ +This repository contains open source software that is developed and +maintained by [Jane Street][js]. + +Contributions to this project are welcome and should be submitted via +GitHub pull requests. + +Signing contributions +--------------------- + +We require that you sign your contributions. Your signature certifies +that you wrote the patch or otherwise have the right to pass it on as +an open-source patch. The rules are pretty simple: if you can certify +the below (from [developercertificate.org][dco]): + +``` +Developer Certificate of Origin +Version 1.1 + +Copyright (C) 2004, 2006 The Linux Foundation and its contributors. +1 Letterman Drive +Suite D4700 +San Francisco, CA, 94129 + +Everyone is permitted to copy and distribute verbatim copies of this +license document, but changing it is not allowed. + + +Developer's Certificate of Origin 1.1 + +By making a contribution to this project, I certify that: + +(a) The contribution was created in whole or in part by me and I + have the right to submit it under the open source license + indicated in the file; or + +(b) The contribution is based upon previous work that, to the best + of my knowledge, is covered under an appropriate open source + license and I have the right under that license to submit that + work with modifications, whether created in whole or in part + by me, under the same open source license (unless I am + permitted to submit under a different license), as indicated + in the file; or + +(c) The contribution was provided directly to me by some other + person who certified (a), (b) or (c) and I have not modified + it. + +(d) I understand and agree that this project and the contribution + are public and that a record of the contribution (including all + personal information I submit with it, including my sign-off) is + maintained indefinitely and may be redistributed consistent with + this project or the open source license(s) involved. +``` + +Then you just add a line to every git commit message: + +``` +Signed-off-by: Joe Smith +``` + +Use your real name (sorry, no pseudonyms or anonymous contributions.) + +If you set your `user.name` and `user.email` git configs, you can sign +your commit automatically with git commit -s. + +[dco]: http://developercertificate.org/ +[js]: https://opensource.janestreet.com/ diff --git a/unikernel/duniverse/base/LICENSE.md b/unikernel/duniverse/base/LICENSE.md new file mode 100644 index 00000000..364f8190 --- /dev/null +++ b/unikernel/duniverse/base/LICENSE.md @@ -0,0 +1,21 @@ +The MIT License + +Copyright (c) 2016--2024 Jane Street Group, LLC + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/unikernel/duniverse/base/Makefile b/unikernel/duniverse/base/Makefile new file mode 100644 index 00000000..1965878e --- /dev/null +++ b/unikernel/duniverse/base/Makefile @@ -0,0 +1,17 @@ +INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) + +default: + dune build + +install: + dune install $(INSTALL_ARGS) + +uninstall: + dune uninstall $(INSTALL_ARGS) + +reinstall: uninstall install + +clean: + dune clean + +.PHONY: default install uninstall reinstall clean diff --git a/unikernel/duniverse/base/README.org b/unikernel/duniverse/base/README.org new file mode 100644 index 00000000..52656a0b --- /dev/null +++ b/unikernel/duniverse/base/README.org @@ -0,0 +1,212 @@ +* Base + +[[https://github.com/janestreet/base/actions][https://github.com/janestreet/base/actions/workflows/workflow.yml/badge.svg]] + +Base is a standard library for OCaml. It provides a standard set of +general purpose modules that are well-tested, performant, and +fully-portable across any environment that can run OCaml code. Unlike +other standard library projects, Base is meant to be used as a +wholesale replacement of the standard library distributed with the +OCaml compiler. In particular it makes different choices and doesn't +re-export features that are not fully portable such as I/O, which are +left to other libraries. + +You also might want to browse the [[https://ocaml.janestreet.com/ocaml-core/latest/doc/base/index.html][API Documentation]]. + +** Installation + +Install Base via [[https://opam.ocaml.org][OPAM]]: + +#+begin_src +$ opam install base +#+end_src + +Base has no runtime dependencies and is fast to build. Its sole build +dependencies are [[https://github.com/ocaml/dune][dune]], which itself requires nothing more than the +compiler, and [[https://github.com/janestreet/sexplib0][sexplib0]]. + +** Using the OCaml standard library with Base + +Base is intended as a full stdlib replacement. As a result, after an +=open Base=, all the modules, values, types, ... coming from the OCaml +standard library that one normally gets in the default environment are +deprecated. + +In order to access these values, one must use the =Stdlib= library, +which re-exports them all through the toplevel name =Stdlib=: +=Stdlib.String=, =Stdlib.print_string=, ... + +** Differences between Base and the OCaml standard library + +Programmers who are used to the OCaml standard library should read +through this section to understand major differences between the two +libraries that one should be aware of when switching to Base. + +*** Comparison operators + +The comparison operators exposed by the OCaml standard library are +polymorphic: + +#+begin_src ocaml +val compare : 'a -> 'a -> int +val ( <= ) : 'a -> 'a -> bool +... +#+end_src + +What they implement is structural comparison of the runtime +representation of values. Since these are often error-prone, +i.e. they don't correspond to what the user expects, they are not +exposed directly by Base. + +To use polymorphic comparison with Base, one should use the =Poly= +module. The default comparison operators exposed by Base are the +integer ones, just like the default arithmetic operators are the +integer ones. + +The recommended way to compare arbitrary complex data structures is to +use the specific =compare= functions. For instance: + +#+begin_src ocaml +List.compare String.compare x y +#+end_src + +The [[https://github.com/janestreet/ppx_compare][ppx_compare]] rewriter +offers an alternative way to write this: + +#+begin_src ocaml +[%compare: string list] x y +#+end_src + +** Base and ppx code generators + +Base uses a few ppx code generators to implement: + +- Reliable and customizable comparison of OCaml values. +- Reliable and customizable hash of OCaml values. +- Conversions between OCaml values and s-expression. + +However, it doesn't need these code generators to build. What it does +instead is use ppx as a code verification tool during development. It +works in a very similar fashion to +[[https://github.com/janestreet/ppx_expect][expectation tests]]. + +Whenever you see this in the code source: + +#+begin_src ocaml +type t = ... [@@deriving_inline sexp_of] +let sexp_of_t = ... +[@@@end] +#+end_src + +the code between the =[@@deriving_inline]= and the =[@@@end]= is +generated code. The generated code is currently quite big and hard to +read, however we are working on making it look like human-written +code. + +You can put the following elisp code in your =~/.emacs= file to hide +these blocks: + +#+begin_src scheme +(defun deriving-inline-forward-sexp (&optional arg) + (search-forward-regexp "\\[@@@end\\]") nil nil arg) + +(defun setup-hide-deriving-inline () + (inline) + (hs-minor-mode t) + (let ((hs-hide-comments-when-hiding-all nil)) + (hs-hide-all))) + +(require 'hideshow) +(add-to-list 'hs-special-modes-alist + '(tuareg-mode "\\[@@deriving_inline[^]]*\\]" "\\[@@@end\\]" nil + deriving-inline-forward-sexp nil)) +(add-hook 'tuareg-mode-hook 'setup-hide-deriving-inline) +#+end_src + +Things are not yet setup in the git repository to make it convenient +to change types and update the generated code, but they will be setup +soon. + +** Base coding rules + +There are a few coding rules across the code base that are enforced by +lint tools. + +These rules are: + +- Opening the =Stdlib= module is not allowed. Inside Base, the OCaml + stdlib is shadowed and accessible through the =Stdlib= module. We + forbid opening =Stdlib= so that we know exactly where things come + from. +- =Stdlib.Foo= modules cannot be aliased, one must use =Stdlib.Foo= + explicitly. This is to avoid having to remember a list of aliases + at the beginning of each file. +- For some modules that are both in the OCaml stdlib and Base, such as + =String=, we define a module =String0= for common functions that + cannot be defined directly in =Base.String= to avoid creating a + circular dependency. Except for =String= itself, other modules + are not allowed to use =Stdlib.String= and must use either =String= or + =String0= instead. +- Indentation is exactly the one of =ocp-indent=. +- A few other coding style rules enforced by + [[https://github.com/janestreet/ppx_js_style][ppx_js_style]]. + +The Base specific coding rules are checked by =ppx_base_lint=, in the +=lint= subfolder. The indentation rules are checked by a wrapper around +=ocp-indent= and the coding style rules are checked by =ppx_js_style=. + +These checks are currently not run by =dune=, but it will soon get a +=-dev= flag to run them automatically. + +** Sexp (de-)serializers + +Most types in Base have ~sexp_of_t~ and ~t_of_sexp~ functions for converting +between values of that type and their sexp representations. + +One pair of functions deserves special attention: ~String.sexp_of_t~ and +~String.t_of_sexp~. These functions have the same types as ~Sexp.of_string~ and +~Sexp.to_string~ but very different behavior. + +~String.sexp_of_t~ and ~String.t_of_sexp~ are used to encode and decode strings +"embedded" in a sexp representation. On the other hand, ~Sexp.of_string~ and +~Sexp.to_string~ are used to encode and decode the textual form of +s-expressions. + +The following example demonstrates the two pairs of functions in action: + +#+begin_src ocaml + open! Base + open! Stdio + + (* Embed a string in a sexp *) + + let example_sexp : Sexp.t = List.sexp_of_t String.sexp_of_t [ "hello"; "world" ] + + let () = + assert (Sexp.equal example_sexp (Sexp.List [ Sexp.Atom "hello"; Sexp.Atom "world" ])) + ;; + + let () = + assert ( + List.equal + String.equal + [ "hello"; "world" ] + (List.t_of_sexp String.t_of_sexp example_sexp)) + ;; + + (* Embed a sexp in text (string) *) + + let write_sexp_to_file sexp = + Out_channel.write_all "/tmp/file" ~data:(Sexp.to_string example_sexp) + ;; + + (* /tmp/file now contains: + + {v + (hello world) + v} *) + + let () = + assert (Sexp.equal example_sexp (Sexp.of_string (In_channel.read_all "/tmp/file"))) + ;; +#+end_src diff --git a/unikernel/duniverse/base/ROADMAP.md b/unikernel/duniverse/base/ROADMAP.md new file mode 100644 index 00000000..c4631a59 --- /dev/null +++ b/unikernel/duniverse/base/ROADMAP.md @@ -0,0 +1,112 @@ +# Stable Interface (v1.0) + + - [X] Make the entire library `-safe-string` compliant. This will involve + introducing a `Bytes` module, removing all direct mutation on strings from + the `String` module, and "re-typing" string values that require mutation to + `bytes`. + + - [X] Do not export the `\*\_intf` modules from Base. Instead, any signatures + should be exported by the `.ml` and `.mli`s. + + - [X] Only expose the first-class module interface of `Hashtbl`. Accompanying + this should be cleanup of `Hashtbl_intf`, moving anything that's still + required in core_kernel to the appropriate files in that project. + + - [X] Replace `Hashtbl.create (module String) ()` by just + `Hashtbl.create (module String)` + + - [X] Remove `replace` from `Hashtbl_intf.Accessors`. + + - [X] Label one of the arguments of `Hashtbl_intf.merge_into` to indicate the + flow of data. + + - [X] Merge `Hashtbl_intf.Key_common` and `Hashtbl_intf.Key_plain`. + + - [X] Use `Either.t` as the return value for `Map.partition`. + + - [X] Rename `Monad_intf.all_ignore` to `Monad_intf.all_unit`. + + - [ ] Eliminate all uses of `Not_found`, replacing them with descriptive error messages. + + - [X] Move the various private modules to `Base.Base_private` + instead of `Base.Exported_for_specific_uses` and `Base.Not_exposed_properly` + + - [X] Use `compare` rather than `cmp` as the label for comparison functions + throughout. + +# Implementation Cleanup + + - [ ] Remove `ignore` and `(=)` from `Sexp_conv`'s public interface. These + values are hidden from the documentation so their removal won't be + considered a breaking API change. + + - [ ] Do not expose the type equality `Int63_emul.W.t = int64`. + + - [ ] Replace the exception thrown by `Float.of_string` with a named + exception that's more descriptive. + + - [X] Delete the `Hashable` toplevel module. This is a vestige of the previous + `Map` and `Set` implementations and is no longer needed. + + - [ ] Ensure that `Map` operations that are effective NO-OPs return the same + `Map.t` they were provided. Candidate operations include e.g `add`, `remove`, + `filter`. + + - [ ] Simplify the implementation of `Option.value_exn`, if possible. + + - [ ] Eliminate all instances of `open! Polymorphic_compare` + + - [ ] Refactor common blit code in `String.replace_all` and `String.replace_first`. + + - [ ] Delete unused function aliases in `Import0` + + - [ ] Put `Sexp_conv.Exn_converter` into its own file, with only an + alias in Sexp_conv, so that it doesn't get pulled unless used + + - [ ] Create a file with all the basic types and their associated + combinators (`sexp_of_t`, `compare`, `hash`), and expose the + declaration + + - [ ] Put all the exported private modules from + `Base.Exported_for_specific_uses` and `Base.Not_exposed_properly` + in `Base.Base_private` + + - [ ] Decide on a better name for `Polymorphic_compare`. + `Polymorphic_compare_intf` contains interface for comparison + of non-polymorphic types, which is weird. Get rid of it and + inline things in `Comparable_intf` + + - [X] `hashtbl_of_sexp` shouldn't live in Base.Sexp_conv since we + have our own hash tables. Move it to sexplib + +# Performance Improvements + + - [ ] In `Hash_set.diff`, use the size of each set to determine which to iterate + over. + + - [ ] Ensure that the correct `compare` function and other related functions are + exported by all modules. These functions should not be derived from + a functor application, in order to ensure proper inlining. Implementing + this change should also include benchmarks to verify the initial result, + and to maintain it on an ongoing basis. See `bench/bench_int.ml` for + examples. + + - [X] Optimize `Lazy.compare` by performing a `phys_equal` check before + forcing the lazy value. Note that this will also change the semantics of + `compare` and should be documented and rolled out with care. + + - [ ] Conduct a thorough performance review of the `Sequence` module. + +# Documentation + + - [ ] Consolidate documentation the interface and implementation files + related to the `Hash` module. + + - [ ] Add documentation to the `Ref` toplevel module. + + - [ ] Document properly how `String.unescape_gen` handles malformed strings + +# Changes For The Distant Future + + - [ ] Make the various comparison functions return an `Ordering.t` + instead of an `int`. diff --git a/unikernel/duniverse/base/base.opam b/unikernel/duniverse/base/base.opam new file mode 100644 index 00000000..c64f673d --- /dev/null +++ b/unikernel/duniverse/base/base.opam @@ -0,0 +1,35 @@ +opam-version: "2.0" +version: "v0.17.3" +maintainer: "Jane Street developers" +authors: ["Jane Street Group, LLC"] +homepage: "https://github.com/janestreet/base" +bug-reports: "https://github.com/janestreet/base/issues" +dev-repo: "git+https://github.com/janestreet/base.git" +doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/base/index.html" +license: "MIT" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "5.1.0"} + "ocaml_intrinsics_kernel" {>= "v0.17.0" & < "v0.18.0"} + "sexplib0" {>= "v0.17.0" & < "v0.18.0"} + "dune" {>= "3.11.0"} + "dune-configurator" +] +available: arch != "arm32" & arch != "x86_32" +synopsis: "Full standard library replacement for OCaml" +description: " +Full standard library replacement for OCaml + +Base is a complete and portable alternative to the OCaml standard +library. It provides all standard functionalities one would expect +from a language standard library. It uses consistent conventions +across all of its module. + +Base aims to be usable in any context. As a result system dependent +features such as I/O are not offered by Base. They are instead +provided by companion libraries such as stdio: + + https://github.com/janestreet/stdio +" diff --git a/unikernel/duniverse/base/dune-project b/unikernel/duniverse/base/dune-project new file mode 100644 index 00000000..dd91f463 --- /dev/null +++ b/unikernel/duniverse/base/dune-project @@ -0,0 +1 @@ +(lang dune 3.11) diff --git a/unikernel/duniverse/base/generate/dune b/unikernel/duniverse/base/generate/dune new file mode 100644 index 00000000..94a1b6be --- /dev/null +++ b/unikernel/duniverse/base/generate/dune @@ -0,0 +1,5 @@ +(executables + (modes byte exe) + (names generate_pow_overflow_bounds) + (libraries num) + (preprocess no_preprocessing)) diff --git a/unikernel/duniverse/base/generate/generate_pow_overflow_bounds.ml b/unikernel/duniverse/base/generate/generate_pow_overflow_bounds.ml new file mode 100644 index 00000000..c9e7c2f8 --- /dev/null +++ b/unikernel/duniverse/base/generate/generate_pow_overflow_bounds.ml @@ -0,0 +1,194 @@ +(* NB: This needs to be pure OCaml (no Base!), since we need this in order to build + Base. *) + +(* This module generates lookup tables to detect integer overflow when calculating integer + exponents. At index [e], [table.[e]^e] will not overflow, but [(table[e] + 1)^e] + will. *) + +type mode = + | Normal + | Atomic of + { out_fn : string + ; tmp_fn : string + } + +let oc, mode = + match Sys.argv with + | [| _ |] -> stdout, Normal + | [| _; "-o"; out_fn |] | [| _; "-atomic"; "-o"; out_fn |] -> + (* Always produce the file atomically, we just have this option to remember that we + need to do it *) + let tmp_fn, oc = + Filename.open_temp_file + ~temp_dir:(Filename.dirname out_fn) + "generate_pow_overflow_bounds" + ".ml.tmp" + in + oc, Atomic { out_fn; tmp_fn } + | _ -> failwith "bad command line arguments" +;; + +module Big_int = struct + include Big_int + + let ( > ) = gt_big_int + let ( <= ) = le_big_int + let ( ^ ) = power_big_int_positive_int + let ( - ) = sub_big_int + let ( + ) = add_big_int + let one = unit_big_int + let sqrt = sqrt_big_int + let to_string = string_of_big_int +end + +module Array = StdLabels.Array + +type generated_type = + | Int + | Int32 + | Int63 + | Int64 + +let max_big_int_for_bits bits = + let shift = bits - 1 in + (* sign bit *) + Big_int.(shift_left_big_int one shift - one) +;; + +let safe_to_print_as_int = + let int31_max = max_big_int_for_bits 31 in + fun x -> Big_int.(x <= int31_max) +;; + +let format_entry typ b = + let s = Big_int.to_string b in + match typ with + | Int -> + if safe_to_print_as_int b then s else Printf.sprintf "Stdlib.Int64.to_int %sL" s + | Int32 -> s ^ "l" + | Int63 | Int64 -> s ^ "L" +;; + +let bits = function + | Int -> assert false (* architecture dependent *) + | Int32 -> 32 + | Int63 -> 63 + | Int64 -> 64 +;; + +let max_val typ = max_big_int_for_bits (bits typ) + +let name = function + | Int -> "int" + | Int32 -> "int32" + | Int63 -> "int63_on_int64" + | Int64 -> "int64" +;; + +let ocaml_type_name = function + | Int -> "int" + | Int32 -> "int32" + | Int63 | Int64 -> "int64" +;; + +let generate_negative_bounds = function + | Int -> false + | Int32 -> false + | Int63 -> false + | Int64 -> true +;; + +let highest_base exponent max_val = + let open Big_int in + match exponent with + | 0 | 1 -> max_val + | 2 -> sqrt max_val + | _ -> + let rec search possible_base = + if possible_base ^ exponent > max_val + then ( + let res = possible_base - one in + assert (res ^ exponent <= max_val); + res) + else search (possible_base + one) + in + search one +;; + +type sign = + | Pos + | Neg + +let pr fmt = Printf.fprintf oc (fmt ^^ "\n") + +let gen_array ~typ ~bits ~sign ~indent = + let pr fmt = pr ("%*s" ^^ fmt) indent "" in + let max_val = max_big_int_for_bits bits in + let pos_bounds = Array.init 64 ~f:(fun i -> highest_base i max_val) in + let bounds = + match sign with + | Pos -> pos_bounds + | Neg -> Array.map pos_bounds ~f:Big_int.minus_big_int + in + pr "[| %s" (format_entry typ bounds.(0)); + for i = 1 to Array.length bounds - 1 do + pr "; %s" (format_entry typ bounds.(i)) + done; + pr "|]" +;; + +let gen_bounds typ = + pr "let overflow_bound_max_%s_value : %s =" (name typ) (ocaml_type_name typ); + (match typ with + | Int -> pr " (-1) lsr 1" + | _ -> pr " %s" (format_entry typ (max_val typ))); + pr ""; + let array_name typ sign = + Printf.sprintf + "%s_%s_overflow_bounds" + (name typ) + (match sign with + | Pos -> "positive" + | Neg -> "negative") + in + pr "let %s : %s array =" (array_name typ Pos) (ocaml_type_name typ); + (match typ with + | Int -> + pr " match Int_conversions.num_bits_int with"; + pr " | 32 -> Array.map %s ~f:Stdlib.Int32.to_int" (array_name Int32 Pos); + pr " | 63 ->"; + gen_array ~typ ~bits:63 ~sign:Pos ~indent:4; + pr " | 31 ->"; + gen_array ~typ ~bits:31 ~sign:Pos ~indent:4; + pr " | _ -> assert false" + | _ -> gen_array ~typ ~bits:(bits typ) ~sign:Pos ~indent:2); + pr ""; + if generate_negative_bounds typ + then ( + pr "let %s : %s array =" (array_name typ Neg) (ocaml_type_name typ); + gen_array ~typ ~bits:(bits typ) ~sign:Neg ~indent:2) +;; + +let () = + pr "(* This file was autogenerated by %s *)" Sys.argv.(0); + pr ""; + pr "open! Import"; + pr ""; + pr "module Array = Array0"; + pr ""; + pr "(* We have to use Int64.to_int_exn instead of int constants to make"; + pr " sure that file can be preprocessed on 32-bit machines. *)"; + pr ""; + gen_bounds Int32; + gen_bounds Int; + gen_bounds Int63; + gen_bounds Int64 +;; + +let () = + match mode with + | Normal -> () + | Atomic { tmp_fn; out_fn } -> + close_out oc; + Sys.rename tmp_fn out_fn +;; diff --git a/unikernel/duniverse/base/generate/generate_pow_overflow_bounds.mli b/unikernel/duniverse/base/generate/generate_pow_overflow_bounds.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/generate/generate_pow_overflow_bounds.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/hash_types/README.org b/unikernel/duniverse/base/hash_types/README.org new file mode 100644 index 00000000..305bbc5c --- /dev/null +++ b/unikernel/duniverse/base/hash_types/README.org @@ -0,0 +1,4 @@ +#+TITLE: Base_internalhash_types + +This micro-library allows hash states, seeds, and values to be type-equal +between ~Base~ and ~Base_boot~. diff --git a/unikernel/duniverse/base/hash_types/src/base_internalhash_types.ml b/unikernel/duniverse/base/hash_types/src/base_internalhash_types.ml new file mode 100644 index 00000000..df4eef65 --- /dev/null +++ b/unikernel/duniverse/base/hash_types/src/base_internalhash_types.ml @@ -0,0 +1,30 @@ +(** [state] is defined as a subtype of [int] using the [private] keyword. This makes it an + opaque type for most purposes, and tells the compiler that the type is immediate. *) +type state = private int + +type seed = int +type hash_value = int + +external create_seeded : seed -> state = "%identity" [@@noalloc] + +external fold_int64 + : state + -> (int64[@unboxed]) + -> state + = "Base_internalhash_fold_int64" "Base_internalhash_fold_int64_unboxed" + [@@noalloc] + +external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc] + +external fold_float + : state + -> (float[@unboxed]) + -> state + = "Base_internalhash_fold_float" "Base_internalhash_fold_float_unboxed" + [@@noalloc] + +external fold_string : state -> string -> state = "Base_internalhash_fold_string" + [@@noalloc] + +external get_hash_value : state -> hash_value = "Base_internalhash_get_hash_value" + [@@noalloc] diff --git a/unikernel/duniverse/base/hash_types/src/dune b/unikernel/duniverse/base/hash_types/src/dune new file mode 100644 index 00000000..06a31829 --- /dev/null +++ b/unikernel/duniverse/base/hash_types/src/dune @@ -0,0 +1,11 @@ +(library + (foreign_stubs + (language c) + (names internalhash_stubs)) + (name base_internalhash_types) + (public_name base.base_internalhash_types) + (libraries) + (preprocess no_preprocessing) + (js_of_ocaml + (javascript_files runtime.js)) + (install_c_headers internalhash)) diff --git a/unikernel/duniverse/base/hash_types/src/internalhash.h b/unikernel/duniverse/base/hash_types/src/internalhash.h new file mode 100644 index 00000000..b752b91e --- /dev/null +++ b/unikernel/duniverse/base/hash_types/src/internalhash.h @@ -0,0 +1,3 @@ +#include +#include +CAMLexport uint32_t Base_internalhash_fold_blob(uint32_t h, mlsize_t len, uint8_t *s); diff --git a/unikernel/duniverse/base/hash_types/src/internalhash_stubs.c b/unikernel/duniverse/base/hash_types/src/internalhash_stubs.c new file mode 100644 index 00000000..255525ff --- /dev/null +++ b/unikernel/duniverse/base/hash_types/src/internalhash_stubs.c @@ -0,0 +1,111 @@ +#include +#include +#include +#include "internalhash.h" + +/* This pretends that the state of the OCaml internal hash function, which is an + int32, is actually stored in an OCaml int. */ + +CAMLprim value Base_internalhash_fold_int32(value st, value i) +{ + return Val_long(caml_hash_mix_uint32(Long_val(st), Int32_val(i))); +} + +CAMLprim value Base_internalhash_fold_nativeint(value st, value i) +{ + return Val_long(caml_hash_mix_intnat(Long_val(st), Nativeint_val(i))); +} + +CAMLprim value Base_internalhash_fold_int64(value st, value i) +{ + return Val_long(caml_hash_mix_int64(Long_val(st), Int64_val(i))); +} + +CAMLprim value Base_internalhash_fold_int64_unboxed(value st, int64_t i) +{ + return Val_long(caml_hash_mix_int64(Long_val(st), i)); +} + +CAMLprim value Base_internalhash_fold_int(value st, value i) +{ + return Val_long(caml_hash_mix_intnat(Long_val(st), Long_val(i))); +} + +CAMLprim value Base_internalhash_fold_float(value st, value i) +{ + return Val_long(caml_hash_mix_double(Long_val(st), Double_val(i))); +} + +CAMLprim value Base_internalhash_fold_float_unboxed(value st, double i) +{ + return Val_long(caml_hash_mix_double(Long_val(st), i)); +} + +/* This code mimics what hashtbl.hash does in OCaml's hash.c */ +#define FINAL_MIX(h) \ + h ^= h >> 16; \ + h *= 0x85ebca6b; \ + h ^= h >> 13; \ + h *= 0xc2b2ae35; \ + h ^= h >> 16; + +CAMLprim value Base_internalhash_get_hash_value(value st) +{ + uint32_t h = Int_val(st); + FINAL_MIX(h); + return Val_int(h & 0x3FFFFFFFU); /*30 bits*/ +} + +/* Macros copied from hash.c in ocaml distribution */ +#define ROTL32(x,n) ((x) << n | (x) >> (32-n)) + +#define MIX(h,d) \ + d *= 0xcc9e2d51; \ + d = ROTL32(d, 15); \ + d *= 0x1b873593; \ + h ^= d; \ + h = ROTL32(h, 13); \ + h = h * 5 + 0xe6546b64; + +/* Version of [caml_hash_mix_string] from hash.c - adapted for arbitrary char arrays */ +CAMLexport uint32_t Base_internalhash_fold_blob(uint32_t h, mlsize_t len, uint8_t *s) +{ + mlsize_t i; + uint32_t w; + + /* Mix by 32-bit blocks (little-endian) */ + for (i = 0; i + 4 <= len; i += 4) { +#ifdef ARCH_BIG_ENDIAN + w = s[i] + | (s[i+1] << 8) + | (s[i+2] << 16) + | (s[i+3] << 24); +#else + w = *((uint32_t *) &(s[i])); +#endif + MIX(h, w); + } + /* Finish with up to 3 bytes */ + w = 0; + switch (len & 3) { + case 3: w = s[i+2] << 16; /* fallthrough */ + case 2: w |= s[i+1] << 8; /* fallthrough */ + case 1: w |= s[i]; + MIX(h, w); + default: /*skip*/; /* len & 3 == 0, no extra bytes, do nothing */ + } + /* Finally, mix in the length. Ignore the upper 32 bits, generally 0. */ + h ^= (uint32_t) len; + return h; +} + +CAMLprim value Base_internalhash_fold_string(value st, value v_str) +{ + uint32_t h = Long_val(st); + mlsize_t len = caml_string_length(v_str); + uint8_t *s = (uint8_t *) String_val(v_str); + + h = Base_internalhash_fold_blob(h, len, s); + + return Val_long(h); +} diff --git a/unikernel/duniverse/base/hash_types/src/runtime.js b/unikernel/duniverse/base/hash_types/src/runtime.js new file mode 100644 index 00000000..a492036e --- /dev/null +++ b/unikernel/duniverse/base/hash_types/src/runtime.js @@ -0,0 +1,18 @@ +//Provides: Base_internalhash_fold_int64 +//Requires: caml_hash_mix_int64 +var Base_internalhash_fold_int64 = caml_hash_mix_int64; +//Provides: Base_internalhash_fold_int +//Requires: caml_hash_mix_int +var Base_internalhash_fold_int = caml_hash_mix_int; +//Provides: Base_internalhash_fold_float +//Requires: caml_hash_mix_float +var Base_internalhash_fold_float = caml_hash_mix_float; +//Provides: Base_internalhash_fold_string +//Requires: caml_hash_mix_string +var Base_internalhash_fold_string = caml_hash_mix_string; +//Provides: Base_internalhash_get_hash_value +//Requires: caml_hash_mix_final +function Base_internalhash_get_hash_value(seed) { + var h = caml_hash_mix_final(seed); + return h & 0x3FFFFFFF; +} diff --git a/unikernel/duniverse/base/hash_types/test/dune b/unikernel/duniverse/base/hash_types/test/dune new file mode 100644 index 00000000..ef656f2d --- /dev/null +++ b/unikernel/duniverse/base/hash_types/test/dune @@ -0,0 +1,5 @@ +(library + (name base_internalhash_types_test) + (libraries base expect_test_helpers_core stdio) + (preprocess + (pps ppx_jane))) diff --git a/unikernel/duniverse/base/hash_types/test/import.ml b/unikernel/duniverse/base/hash_types/test/import.ml new file mode 100644 index 00000000..8e5146c4 --- /dev/null +++ b/unikernel/duniverse/base/hash_types/test/import.ml @@ -0,0 +1,2 @@ +include Stdio +include Expect_test_helpers_core diff --git a/unikernel/duniverse/base/hash_types/test/test_immediate.ml b/unikernel/duniverse/base/hash_types/test/test_immediate.ml new file mode 100644 index 00000000..9aaea81b --- /dev/null +++ b/unikernel/duniverse/base/hash_types/test/test_immediate.ml @@ -0,0 +1,14 @@ +open! Base +open! Import + +let%expect_test "[Base.Hash.state] is still immediate" = + require_no_allocation [%here] (fun () -> + ignore (Sys.opaque_identity (Base.Hash.create ()))); + [%expect {| |}] +;; + +let%expect_test _ = + print_s + [%sexp (Stdlib.Obj.is_int (Stdlib.Obj.repr (Base.Hash.create ~seed:1 ())) : bool)]; + [%expect {| true |}] +;; diff --git a/unikernel/duniverse/base/hash_types/test/test_immediate.mli b/unikernel/duniverse/base/hash_types/test/test_immediate.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/hash_types/test/test_immediate.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/lint/dune b/unikernel/duniverse/base/lint/dune new file mode 100644 index 00000000..9743c708 --- /dev/null +++ b/unikernel/duniverse/base/lint/dune @@ -0,0 +1,5 @@ +(library + (name ppx_base_lint) + (kind ppx_rewriter) + (libraries compiler-libs.common base ppxlib ppx_cold) + (preprocess no_preprocessing)) diff --git a/unikernel/duniverse/base/lint/ppx_base_lint.ml b/unikernel/duniverse/base/lint/ppx_base_lint.ml new file mode 100644 index 00000000..e0502492 --- /dev/null +++ b/unikernel/duniverse/base/lint/ppx_base_lint.ml @@ -0,0 +1,189 @@ +open Ppxlib +open Base + +let error ~loc fmt = Location.raise_errorf ~loc (Stdlib.( ^^ ) "ppx_base_lint:" fmt) + +type suspicious_id = Stdlib_submodule of string + +let rec iter_suspicious (id : Longident.t) ~f = + match id with + | Ldot (Lident "Stdlib", s) + when String.( <> ) s "" + && + match s.[0] with + | 'A' .. 'Z' -> true + | _ -> false -> f (Stdlib_submodule s) + | Ldot (x, _) -> iter_suspicious x ~f + | Lapply (a, b) -> + iter_suspicious a ~f; + iter_suspicious b ~f + | Lident _ -> () +;; + +let zero_modules () = + Stdlib.Sys.readdir "." + |> Array.to_list + |> List.filter ~f:(fun fn -> Stdlib.Filename.check_suffix fn "0.ml") + |> List.map ~f:(fun fn -> + String.capitalize (String.sub fn ~pos:0 ~len:(String.length fn - 4))) + |> Set.of_list (module String) +;; + +let check_open (id : Longident.t Asttypes.loc) = + match id.txt with + | Lident "Stdlib" -> error ~loc:id.loc "you are not allowed to open Stdlib inside Base" + | _ -> () +;; + +let rec is_stdlib_dot_something : Longident.t -> bool = function + | Ldot (Lident "Stdlib", _) -> true + | Ldot (id, _) -> is_stdlib_dot_something id + | _ -> false +;; + +let print_payload ppf = function + | PStr x -> Pprintast.structure ppf x + | PSig x -> Pprintast.signature ppf x + | PTyp x -> Pprintast.core_type ppf x + | PPat (x, None) -> Pprintast.pattern ppf x + | PPat (x, Some w) -> + Stdlib.Format.fprintf ppf "%a@ when@ %a" Pprintast.pattern x Pprintast.expression w +;; + +let remove_loc = + object + inherit Ast_traverse.map + method! location _ = Location.none + method! location_stack _ = [] + end +;; + +let check current_module = + let zero_modules = zero_modules () in + object + inherit Ast_traverse.iter as super + + method! longident_loc { txt = id; loc } = + (* Note: we don't distinguish between module identifiers and constructors names. + Since there is no [Stdlib.String], [Stdlib.Array], ... constructors this is not a + problem. *) + iter_suspicious id ~f:(fun (Stdlib_submodule m) -> + if not (Set.mem zero_modules m) + then (* We are allowed to use Stdlib modules that don't have a Foo0 version *) + () + else if String.equal (m ^ "0") current_module + then () (* Foo0 is allowed to use Stdlib.Foo *) + else ( + match current_module with + | "Import0" | "Base" -> () + | _ -> error ~loc "you cannot use [Stdlib.%s] here, use [%s0] instead" m m)) + + (* We allow references to Stdlib in types. This is primarily to allow ppx-derived code + to refer to Stdlib. *) + method! core_type _ = () + + method! expression e = + super#expression e; + match e.pexp_desc with + | Pexp_open ({ popen_expr = { pmod_desc = Pmod_ident id; _ }; _ }, _) -> + check_open id + | _ -> () + + method! open_description op = + super#open_description op; + check_open op.popen_expr + + method! module_binding mb = + super#module_binding mb; + match current_module with + | "Import0" -> () + | _ -> + (match mb.pmb_expr.pmod_desc with + | Pmod_ident { txt = id; _ } when is_stdlib_dot_something id -> + error + ~loc:mb.pmb_loc + "you cannot alias [Stdlib] sub-modules, use them directly" + | _ -> ()) + + method! attributes attrs = + super#attributes attrs; + let is_cold attr = String.equal attr.attr_name.txt "cold" in + match List.find attrs ~f:is_cold with + | None -> () + | Some attr -> + let expansion = + Ppx_cold.expand_cold_attribute attr + |> List.map ~f:(fun a -> + { a with + attr_name = + { a.attr_name with + txt = + String.chop_prefix a.attr_name.txt ~prefix:"ocaml." + |> Option.value ~default:a.attr_name.txt + } + }) + in + let is_part_of_expansion attr = + List.exists expansion ~f:(fun a -> + String.equal a.attr_name.txt attr.attr_name.txt + || String.equal ("ocaml." ^ a.attr_name.txt) attr.attr_name.txt) + in + let new_attrs = + List.concat_map attrs ~f:(fun a -> + if is_cold a + then a :: expansion + else if is_part_of_expansion a + then [] + else [ a ]) + in + if not + (Poly.equal (remove_loc#attributes attrs) (remove_loc#attributes new_attrs)) + then ( + (* Remove attributes written by the user that correspond to attributes in the + expansion *) + List.iter attrs ~f:(fun a -> + if is_part_of_expansion a + then Driver.register_correction ~loc:a.attr_loc ~repl:""); + let attribute_level = + String.make + (attr.attr_name.loc.loc_start.pos_cnum + - attr.attr_loc.loc_start.pos_cnum + - 1) + '@' + in + let repl = + Stdlib.Format.asprintf + "@[%a@]" + (Stdlib.Format.pp_print_list (fun ppf x -> + Stdlib.Format.fprintf + ppf + "[%s%s@ %a]" + attribute_level + x.attr_name.txt + print_payload + x.attr_payload)) + (attr :: expansion) + in + Driver.register_correction ~loc:attr.attr_loc ~repl) + end +;; + +let module_of_loc (loc : Location.t) = + String.capitalize + (Stdlib.Filename.chop_extension (Stdlib.Filename.basename loc.loc_start.pos_fname)) +;; + +let () = + Ppxlib.Driver.register_transformation + "base_lint" + ~impl:(function + | [] -> [] + | { pstr_loc = loc; _ } :: _ as st -> + (check (module_of_loc loc))#structure st; + st) + ~intf:(function + | [] -> [] + | { psig_loc = loc; _ } :: _ as sg -> + (check (module_of_loc loc))#signature sg; + sg) +;; diff --git a/unikernel/duniverse/base/md5/src/dune b/unikernel/duniverse/base/md5/src/dune new file mode 100644 index 00000000..d92b4764 --- /dev/null +++ b/unikernel/duniverse/base/md5/src/dune @@ -0,0 +1,6 @@ +(library + (name md5_lib) + (public_name base.md5) + (preprocess no_preprocessing) + (libraries) + (js_of_ocaml (javascript_files))) diff --git a/unikernel/duniverse/base/md5/src/md5_lib.ml b/unikernel/duniverse/base/md5/src/md5_lib.ml new file mode 100644 index 00000000..ac522ae6 --- /dev/null +++ b/unikernel/duniverse/base/md5/src/md5_lib.ml @@ -0,0 +1,21 @@ +type t = string + +(* Share the digest of the empty string *) +let empty = Digest.string "" +let make s = if s = empty then empty else s +let compare = compare +let length = 16 +let to_binary s = s +let to_binary_local s = s + +let of_binary_exn s = + assert (String.length s = length); + make s +;; + +let unsafe_of_binary = make +let to_hex = Digest.to_hex +let of_hex_exn s = make (Digest.from_hex s) +let string s = make (Digest.string s) +let bytes s = make (Digest.bytes s) +let subbytes bytes ~pos ~len = make (Digest.subbytes bytes pos len) diff --git a/unikernel/duniverse/base/md5/src/md5_lib.mli b/unikernel/duniverse/base/md5/src/md5_lib.mli new file mode 100644 index 00000000..f215f84d --- /dev/null +++ b/unikernel/duniverse/base/md5/src/md5_lib.mli @@ -0,0 +1,19 @@ +type t + +val compare : t -> t -> int + +(** [length = 16] is the size of the digest in bytes. *) +val length : int + +val to_binary : t -> string +val to_binary_local : t -> string +val of_binary_exn : string -> t + +(** assumes the input is 16 bytes without checking *) +val unsafe_of_binary : string -> t + +val to_hex : t -> string +val of_hex_exn : string -> t +val string : string -> t +val bytes : bytes -> t +val subbytes : bytes -> pos:int -> len:int -> t diff --git a/unikernel/duniverse/base/shadow-stdlib/gen/dune b/unikernel/duniverse/base/shadow-stdlib/gen/dune new file mode 100644 index 00000000..270a2eb7 --- /dev/null +++ b/unikernel/duniverse/base/shadow-stdlib/gen/dune @@ -0,0 +1,8 @@ +(executables + (modes byte exe) + (names gen) + (libraries str compiler-libs.common) + (link_flags -linkall) + (preprocess no_preprocessing)) + +(ocamllex mapper) diff --git a/unikernel/duniverse/base/shadow-stdlib/gen/gen.ml b/unikernel/duniverse/base/shadow-stdlib/gen/gen.ml new file mode 100644 index 00000000..9ddc8c74 --- /dev/null +++ b/unikernel/duniverse/base/shadow-stdlib/gen/gen.ml @@ -0,0 +1,35 @@ +open StdLabels + +let () = + (* -permissive indicates that we should tolerate additions to stdlib. + It's [true] in public-release so that new versions of the stdlib can be compatible + with base, but it should be [false] internally so that we remember to + consider implementing the equivalents in base. *) + let permissive, cmi_fn, oc = + match Sys.argv with + | [| _; "-caml-cmi"; cmi_fn; "-o"; fn |] -> false, cmi_fn, open_out fn + | [| _; "-caml-cmi"; "-permissive"; cmi_fn1; cmi_fn2; "-o"; fn |] -> + let cmi_fn = if Sys.file_exists cmi_fn1 then cmi_fn1 else cmi_fn2 in + true, cmi_fn, open_out fn + | _ -> failwith "bad command line arguments" + in + try + let cmi = Cmi_format.read_cmi cmi_fn in + let buf = Buffer.create 512 in + let pp = Format.formatter_of_buffer buf in + Format.pp_set_margin pp max_int; + (* so we can parse line by line below *) + Format.fprintf pp "%a@." Printtyp.signature cmi.Cmi_format.cmi_sign; + let s = Buffer.contents buf in + let lines = Str.split (Str.regexp "\n") s in + Printf.fprintf oc "[@@@warning \"-3\"]\n\n"; + Mapper.permissive := permissive; + List.iter lines ~f:(fun line -> + let repl = Mapper.line (Lexing.from_string line) in + if repl <> "" then Printf.fprintf oc "%s\n\n" repl); + flush oc + with + | exn -> + Location.report_exception Format.err_formatter exn; + exit 2 +;; diff --git a/unikernel/duniverse/base/shadow-stdlib/gen/gen.mli b/unikernel/duniverse/base/shadow-stdlib/gen/gen.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/shadow-stdlib/gen/gen.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/shadow-stdlib/gen/mapper.mll b/unikernel/duniverse/base/shadow-stdlib/gen/mapper.mll new file mode 100644 index 00000000..06bc1589 --- /dev/null +++ b/unikernel/duniverse/base/shadow-stdlib/gen/mapper.mll @@ -0,0 +1,350 @@ +{ +open StdLabels +open Printf + +let deprecated_msg ~is_exn what = + sprintf + "[%sdeprecated \"\\\n\ + [2016-09] this element comes from the stdlib distributed with OCaml.\n\ + Referring to the stdlib directly is discouraged by Base. You should either\n\ + use the equivalent functionality offered by Base, or if you really want to\n\ + refer to the stdlib, use Stdlib.%s instead\"]" + (if is_exn then "@" else "@@") + what + +let deprecated_msg_no_equivalent ~is_exn what = + sprintf + "[%sdeprecated \"\\\n\ + [2016-09] this element comes from the stdlib distributed with OCaml.\n\ + There is not equivalent functionality in Base or Stdio at the moment,\n\ + so you need to use [Stdlib.%s] instead\"]" + (if is_exn then "@" else "@@") + what + +let deprecated_msg_with_repl_text ~is_exn text = + sprintf + "[%sdeprecated \"\\\n\ + [2016-09] this element comes from the stdlib distributed with OCaml.\n\ + %s.\"]" + (if is_exn then "@" else "@@") + text + +let deprecated_msg_with_repl ~is_exn repl = + deprecated_msg_with_repl_text ~is_exn (sprintf "Use [%s] instead" repl) + +let deprecated_msg_with_approx_repl ~is_exn ~id repl = + sprintf + "[%sdeprecated \"\\\n\ + [2016-09] this element comes from the stdlib distributed with OCaml.\n\ + There is no equivalent functionality in Base or Stdio but you can use\n\ + [%s] instead.\n\ + Alternatively, if you really want to refer the stdlib you can use\n\ + [Stdlib.%s].\"]" + (if is_exn then "@" else "@@") + repl id + +type replacement = + | No_equivalent + | Repl of string + | Repl_text of string + | Approx of string + +let permissive = ref false + +let val_replacement = function + | "( ! )" -> No_equivalent + | "( != )" -> Repl "not (phys_equal ...)" + | "( & )" -> No_equivalent + | "( && )" -> No_equivalent + | "( * )" -> No_equivalent + | "( ** )" -> Repl "**." + | "( *. )" -> No_equivalent + | "( + )" -> No_equivalent + | "( +. )" -> No_equivalent + | "( - )" -> No_equivalent + | "( -. )" -> No_equivalent + | "( / )" -> No_equivalent + | "( /. )" -> No_equivalent + | "( := )" -> No_equivalent + | "( < )" -> No_equivalent + | "( <= )" -> No_equivalent + | "( <> )" -> No_equivalent + | "( = )" -> No_equivalent + | "( == )" -> Repl "phys_equal" + | "( > )" -> No_equivalent + | "( >= )" -> No_equivalent + | "( @ )" -> No_equivalent + | "( @@ )" -> No_equivalent + | "( ^ )" -> No_equivalent + | "( ^^ )" -> No_equivalent + | "( asr )" -> No_equivalent + | "( land )" -> No_equivalent + | "( lor )" -> No_equivalent + | "( lsl )" -> No_equivalent + | "( lsr )" -> No_equivalent + | "( lxor )" -> No_equivalent + | "( mod )" -> Repl_text "Use (%), which has slightly different semantics, or Int.rem which is equivalent" + | "( or )" -> No_equivalent + | "( |> )" -> No_equivalent + | "( || )" -> No_equivalent + | "( ~+ )" -> No_equivalent + | "( ~+. )" -> No_equivalent + | "( ~- )" -> No_equivalent + | "( ~-. )" -> No_equivalent + | "__FILE__" -> No_equivalent + | "__FUNCTION__" -> No_equivalent + | "__LINE__" -> No_equivalent + | "__LINE_OF__" -> No_equivalent + | "__LOC__" -> No_equivalent + | "__LOC_OF__" -> No_equivalent + | "__MODULE__" -> No_equivalent + | "__POS__" -> No_equivalent + | "__POS_OF__" -> No_equivalent + | "abs" -> No_equivalent + | "abs_float" -> No_equivalent + | "acos" -> Repl "Float.acos" + | "acosh" -> Repl "Float.acosh" + | "asinh" -> Repl "Float.asinh" + | "atanh" -> Repl "Float.atanh" + | "asin" -> Repl "Float.asin" + | "at_exit" -> No_equivalent + | "atan" -> Repl "Float.atan" + | "atan2" -> Repl "Float.atan2" + | "bool_of_string" -> Repl "Bool.of_string" + | "bool_of_string_opt" -> No_equivalent + | "ceil" -> Repl "Float.round_up" + | "char_of_int" -> Repl "Char.of_int_exn" + | "classify_float" -> Repl "Float.classify" + | "close_in" -> Repl "Stdio.In_channel.close" + | "close_in_noerr" -> Repl "Stdio.In_channel.close" + | "close_out" -> Repl "Stdio.Out_channel.close" + | "close_out_noerr" -> Repl "Stdio.Out_channel.close" + | "compare" -> No_equivalent + | "copysign" -> Repl "Float.copysign" + | "cos" -> Repl "Float.cos" + | "cosh" -> Repl "Float.cosh" + | "decr" -> Repl "Int.decr" + | "do_at_exit" -> No_equivalent + | "do_domain_local_at_exit" -> No_equivalent + | "epsilon_float" -> Repl "Float.epsilon_float" + | "exit" -> No_equivalent + | "exp" -> Repl "Float.exp" + | "expm1" -> Repl "Float.expm1" + | "failwith" -> No_equivalent + | "float" -> Repl "Float.of_int" + | "float_of_int" -> Repl "Float.of_int" + | "float_of_string" -> Repl "Float.of_string" + | "float_of_string_opt" -> No_equivalent + | "floor" -> Repl "Float.round_down" + | "flush" -> Repl "Stdio.Out_channel.flush" + | "flush_all" -> No_equivalent + | "format_of_string" -> No_equivalent + | "frexp" -> Repl "Float.frexp" + | "fst" -> No_equivalent + | "hypot" -> Repl "Float.hypot" + | "ignore" -> No_equivalent + | "in_channel_length" -> Repl "Stdio.In_channel.length" + | "incr" -> Repl "Int.incr" + | "infinity" -> Repl "Float.infinity" + | "input" -> Repl "Stdio.In_channel.input" + | "input_binary_int" -> Repl "Stdio.In_channel.input_binary_int" + | "input_byte" -> Repl "Stdio.In_channel.input_byte" + | "input_char" -> Repl "Stdio.In_channel.input_char" + | "input_line" -> Repl "Stdio.In_channel.input_line" + | "input_value" -> Repl "Stdio.In_channel.unsafe_input_value" + | "int_of_char" -> Repl "Char.to_int" + | "int_of_float" -> Repl "Int.of_float" + | "int_of_string" -> Repl "Int.of_string" + | "int_of_string_opt" -> No_equivalent + | "invalid_arg" -> No_equivalent + | "ldexp" -> Repl "Float.ldexp" + | "lnot" -> No_equivalent + | "log" -> Repl "Float.log" + | "log10" -> Repl "Float.log10" + | "log1p" -> Repl "Float.log1p" + | "max" -> No_equivalent + | "max_float" -> Repl "Float.max_finite_value" + | "max_int" -> Repl "Int.max_value" + | "min" -> No_equivalent + | "min_float" -> Repl "Float.min_positive_normal_value" + | "min_int" -> Repl "Int.min_value" + | "mod_float" -> Repl "Float.mod_float" + | "modf" -> Repl "Float.modf" + | "nan" -> Repl "Float.nan" + | "neg_infinity" -> Repl "Float.neg_infinity" + | "not" -> No_equivalent + | "open_in" -> Repl "Stdio.In_channel.create" + | "open_in_bin" -> Repl "Stdio.In_channel.create" + | "open_in_gen" -> No_equivalent + | "open_out" -> Repl "Stdio.Out_channel.create" + | "open_out_bin" -> Repl "Stdio.Out_channel.create" + | "open_out_gen" -> No_equivalent + | "out_channel_length" -> Repl "Stdio.Out_channel.length" + | "output" -> Repl "Stdio.Out_channel.output" + | "output_binary_int" -> Repl "Stdio.Out_channel.output_binary_int" + | "output_byte" -> Repl "Stdio.Out_channel.output_byte" + | "output_bytes" -> Repl "Stdio.Out_channel.output_bytes" + | "output_char" -> Repl "Stdio.Out_channel.output_char" + | "output_string" -> Repl "Stdio.Out_channel.output_string" + | "output_substring" -> Repl "Stdio.Out_channel.output" + | "output_value" -> Repl "Stdio.Out_channel.output_value" + | "pos_in" -> Repl "Stdio.In_channel.pos" + | "pos_out" -> Repl "Stdio.Out_channel.pos" + | "pred" -> Repl "Int.pred" + | "prerr_bytes" -> Repl "Stdio.Out_channel.output_bytes Stdio.stderr" + | "prerr_char" -> Repl "Stdio.Out_channel.output_char Stdio.stderr" + | "prerr_endline" -> Repl "Stdio.prerr_endline" + | "prerr_float" -> Repl "Stdio.eprintf \"%f\"" + | "prerr_int" -> Repl "Stdio.eprintf \"%d\"" + | "prerr_newline" -> Repl "Stdio.eprintf \"\n%!\"" + | "prerr_string" -> Repl "Stdio.Out_channel.output_string Stdio.stderr" + | "print_bytes" -> Repl "Stdio.Out_channel.output_bytes Stdio.stdout" + | "print_char" -> Repl "Stdio.Out_channel.output_char Stdio.stdout" + | "print_endline" -> Repl "Stdio.print_endline" + | "print_float" -> Repl "Stdio.eprintf \"%f\"" + | "print_int" -> Repl "Stdio.eprintf \"%d\"" + | "print_newline" -> Repl "Stdio.eprintf \"\n%!\"" + | "print_string" -> Repl "Stdio.Out_channel.output_string Stdio.stdout" + | "raise" -> No_equivalent + | "raise_notrace" -> No_equivalent + | "read_float" -> No_equivalent + | "read_float_opt" -> No_equivalent + | "read_int" -> No_equivalent + | "read_int_opt" -> No_equivalent + | "read_line" -> Repl "Stdio.In_channel.input_line" + | "really_input" -> Repl "Stdio.In_channel.really_input" + | "really_input_string" -> Approx "Stdio.In_channel" + | "ref" -> No_equivalent + | "seek_in" -> Repl "Stdio.In_channel.seek" + | "seek_out" -> Repl "Stdio.Out_channel.seek" + | "set_binary_mode_in" -> Repl "Stdio.In_channel.set_binary_mode" + | "set_binary_mode_out" -> Repl "Stdio.Out_channel.set_binary_mode" + | "sin" -> Repl "Float.sin" + | "sinh" -> Repl "Float.sinh" + | "snd" -> No_equivalent + | "sqrt" -> Repl "Float.sqrt" + | "stderr" -> Repl "Stdio.stderr" + | "stdin" -> Repl "Stdio.stdin" + | "stdout" -> Repl "Stdio.stdout" + | "string_of_bool" -> Repl "Bool.to_string" + | "string_of_float" -> Repl "Float.to_string" + | "string_of_format" -> No_equivalent + | "string_of_int" -> Repl "Int.to_string" + | "succ" -> Repl "Int.succ" + | "tan" -> Repl "Float.tan" + | "tanh" -> Repl "Float.tanh" + | "truncate" -> Repl "Int.of_float" + | "unsafe_really_input" -> No_equivalent + | "valid_float_lexem" -> No_equivalent + | symbol -> + if !permissive then No_equivalent + else + failwith + (sprintf + "Consider adding to [Base] an equivalent for symbol %S defined in stdlib" + symbol) +;; + +let exception_replacement = function + | "Not_found" -> + Some (Repl_text "\ +Instead of raising [Not_found], consider using [raise_s] with an informative error\n\ +message. If code needs to distinguish [Not_found] from other exceptions, please change\n\ +it to handle both [Not_found] and [Not_found_s]. Then, instead of raising [Not_found],\n\ +raise [Not_found_s] with an informative error message") + | _ -> None + +let type_replacement = function + | "in_channel" -> Some (Repl "Stdio.In_channel.t") + | "out_channel" -> Some (Repl "Stdio.Out_channel.t") + | "result" -> Some (Repl "Result.t") + | _ -> None +;; + +let module_replacement = function + | "Format" -> + let repl_text = + "[Base] doesn't export a [Format] module, although the \n\ + [Stdlib.Format.formatter] type is available (as [Formatter.t])\n\ + for interaction with other libraries" + in + Some (Repl_text repl_text) + | "Fun" -> Some (Repl "Fn") + | "Gc" -> Some No_equivalent + | "Printexc" -> Some (Repl_text "Use [Exn] or [Backtrace] instead") + | "Seq" -> Some (Approx "Sequence") + | _ -> None + +let replace ~is_exn id replacement = + match replacement with + | No_equivalent -> deprecated_msg_no_equivalent ~is_exn id + | Repl repl -> deprecated_msg_with_repl ~is_exn repl + | Repl_text text -> deprecated_msg_with_repl_text ~is_exn text + | Approx repl -> deprecated_msg_with_approx_repl ~is_exn repl ~id +;; + +let is_alias = function + | "format" | "format4" | "format6" -> true + | _ -> false +} + +let id_trail = ['a'-'z' 'A'-'Z' '_' '0'-'9']* +let id = ['a'-'z' 'A'-'Z' '_' '0'-'9'] id_trail +let val_id = id | '(' [^ ')']* ')' +let params = ('(' [^')']* ')' | ['+' '-']? '\'' id) " " + +let val_ = "val " | "external " + +rule line = parse + | "module Camlinternal" _* + { "" (* We can't deprecate these *) } + | "module Bigarray" _* { "" (* Don't deprecate it yet *) } + | "type " (params? as params) (id as id) (_* as def) + { sprintf "type nonrec %s%s = %sStdlib.%s%s\n%s" + params id + params id + (if is_alias id then "" else def) + (match type_replacement id with + | Some replacement -> replace ~is_exn:false id replacement + | None -> deprecated_msg ~is_exn:false id) } + + | val_ (val_id as id) _* as line + { sprintf "%s\n%s" line (replace ~is_exn:false id (val_replacement id)) } + + | "module " (id as id) " = Stdlib__" (id as id2) (_* as line) + { + Printf.sprintf "module %s = Stdlib.%s %s\n%s" + id (String.capitalize_ascii id2) line + (match module_replacement id with + | Some replacement -> replace ~is_exn:false id replacement + | None -> deprecated_msg ~is_exn:false id) } + + | "exception " (id as id) _* as line + { match exception_replacement id with + | Some replacement -> sprintf "%s\n%s" line (replace ~is_exn:true id replacement) + | None -> + let predefined_exceptions = + [ "Out_of_memory" + ; "Sys_error" + ; "Failure" + ; "Invalid_argument" + ; "End_of_file" + ; "Division_by_zero" + ; "Not_found" + ; "Match_failure" + ; "Stack_overflow" + ; "Sys_blocked_io" + ; "Assert_failure" + ; "Undefined_recursive_module" ] + in + if List.mem id ~set:predefined_exceptions + then "" + else sprintf "%s\n%s" line (deprecated_msg ~is_exn:true id) + } + | "module " (id as id) _* + { sprintf "module %s = Stdlib.%s\n%s" id id + (match module_replacement id with + | Some replacement -> replace ~is_exn:false id replacement + | None -> deprecated_msg ~is_exn:false id) } + | _* as line + { ksprintf failwith "cannot parse this: %s" line } diff --git a/unikernel/duniverse/base/shadow-stdlib/src/dune b/unikernel/duniverse/base/shadow-stdlib/src/dune new file mode 100644 index 00000000..2855c0eb --- /dev/null +++ b/unikernel/duniverse/base/shadow-stdlib/src/dune @@ -0,0 +1,12 @@ +(library + (name shadow_stdlib) + (public_name base.shadow_stdlib) + (libraries) + (preprocess no_preprocessing)) + +(rule + (targets shadow_stdlib.mli) + (deps %{ocaml_where}/stdlib.cma) + (action + (run ../gen/gen.exe -caml-cmi -permissive %{ocaml_where}/stdlib.cmi + %{ocaml_where}/stdlib.cma -o %{targets}))) diff --git a/unikernel/duniverse/base/shadow-stdlib/src/shadow_stdlib.ml b/unikernel/duniverse/base/shadow-stdlib/src/shadow_stdlib.ml new file mode 100644 index 00000000..bb152748 --- /dev/null +++ b/unikernel/duniverse/base/shadow-stdlib/src/shadow_stdlib.ml @@ -0,0 +1 @@ +include Stdlib diff --git a/unikernel/duniverse/base/src/am_testing.c b/unikernel/duniverse/base/src/am_testing.c new file mode 100644 index 00000000..f2aff468 --- /dev/null +++ b/unikernel/duniverse/base/src/am_testing.c @@ -0,0 +1,6 @@ +#include + +/* The default [Base_am_testing] value is [false]. [ppx_inline_test] overrides + the default by linking against an implementation of [Base_am_testing] that + returns [true]. */ +CAMLprim CAMLweakdef value Base_am_testing() { return Val_false; } diff --git a/unikernel/duniverse/base/src/am_testing.h b/unikernel/duniverse/base/src/am_testing.h new file mode 100644 index 00000000..9f9648c9 --- /dev/null +++ b/unikernel/duniverse/base/src/am_testing.h @@ -0,0 +1,9 @@ +#ifndef BASE_AM_TESTING_H +#define BASE_AM_TESTING_H +#include + +CAMLprim value Base_am_testing(); + +static inline int am_testing() { return Bool_val(Base_am_testing()); } + +#endif diff --git a/unikernel/duniverse/base/src/applicative.ml b/unikernel/duniverse/base/src/applicative.ml new file mode 100644 index 00000000..f6577982 --- /dev/null +++ b/unikernel/duniverse/base/src/applicative.ml @@ -0,0 +1,272 @@ +open! Import +include Applicative_intf +module List = List0 + +(** This module serves mostly as a partial check that [S2] and [S] are in sync, but + actually calling it is occasionally useful. *) +module S_to_S2 (X : S) : S2 with type ('a, 'e) t = 'a X.t = struct + include X + + type ('a, 'e) t = 'a X.t +end + +module S2_to_S (T : T.T) (X : S2) : S with type 'a t = ('a, T.t) X.t = struct + include X + + type 'a t = ('a, T.t) X.t +end + +module S2_to_S3 (X : S2) : S3 with type ('a, 'd, 'e) t = ('a, 'd) X.t = struct + include X + + type ('a, 'd, 'e) t = ('a, 'd) X.t +end + +module S3_to_S2 (T : T.T) (X : S3) : S2 with type ('a, 'd) t = ('a, 'd, T.t) X.t = struct + include X + + type ('a, 'd) t = ('a, 'd, T.t) X.t +end + +module S3_to_S (T1 : T.T) (T2 : T.T) (X : S3) : S with type 'a t = ('a, T1.t, T2.t) X.t = +struct + include X + + type 'a t = ('a, T1.t, T2.t) X.t +end + +module Make3 (X : Basic3) : S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t = struct + include X + + let ( <*> ) = apply + let derived_map t ~f = return f <*> t + + let map = + match X.map with + | `Define_using_apply -> derived_map + | `Custom x -> x + ;; + + let ( >>| ) t f = map t ~f + let map2 ta tb ~f = map ~f ta <*> tb + let map3 ta tb tc ~f = map ~f ta <*> tb <*> tc + let all ts = List.fold_right ts ~init:(return []) ~f:(map2 ~f:(fun x xs -> x :: xs)) + let both ta tb = map2 ta tb ~f:(fun a b -> a, b) + let ( *> ) u v = return (fun () y -> y) <*> u <*> v + let ( <* ) u v = return (fun x () -> x) <*> u <*> v + let all_unit ts = List.fold ts ~init:(return ()) ~f:( *> ) + + module Applicative_infix = struct + let ( <*> ) = ( <*> ) + let ( *> ) = ( *> ) + let ( <* ) = ( <* ) + let ( >>| ) = ( >>| ) + end +end + +module Make2 (X : Basic2) : S2 with type ('a, 'e) t := ('a, 'e) X.t = Make3 (struct + include X + + type ('a, 'd, 'e) t = ('a, 'd) X.t +end) + +module Make (X : Basic) : S with type 'a t := 'a X.t = Make2 (struct + include X + + type ('a, 'e) t = 'a X.t +end) + +module Make_let_syntax3 + (X : For_let_syntax3) (Intf : sig + module type S + end) + (Impl : Intf.S) = +struct + module Let_syntax = struct + include X + + module Let_syntax = struct + include X + module Open_on_rhs = Impl + end + end +end + +module Make_let_syntax2 + (X : For_let_syntax2) (Intf : sig + module type S + end) + (Impl : Intf.S) = + Make_let_syntax3 + (struct + include X + + type ('a, 'd, _) t = ('a, 'd) X.t + end) + (Intf) + (Impl) + +module Make_let_syntax + (X : For_let_syntax) (Intf : sig + module type S + end) + (Impl : Intf.S) = + Make_let_syntax2 + (struct + include X + + type ('a, _) t = 'a X.t + end) + (Intf) + (Impl) + +(** This functor closely resembles [Make3], and indeed it could be implemented + much shorter in terms of [Make3]. However, we implement it by hand so that + the resulting functions are more efficient, e.g. using [map2] directly instead of + defining [apply] in terms of it and then [map2] in terms of that. For most + applicatives this does not matter, but for some (such as Bonsai.Value.t), it has a + larger impact. *) +module Make3_using_map2 (X : Basic3_using_map2) : + S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t = struct + include X + + let apply tf ta = map2 tf ta ~f:(fun f a -> f a) + let ( <*> ) = apply + let derived_map t ~f = return f <*> t + + let map = + match X.map with + | `Define_using_map2 -> derived_map + | `Custom x -> x + ;; + + let ( >>| ) t f = map t ~f + let both ta tb = map2 ta tb ~f:(fun a b -> a, b) + let map3 ta tb tc ~f = map2 (map2 ta tb ~f) tc ~f:(fun fab c -> fab c) + let all ts = List.fold_right ts ~init:(return []) ~f:(map2 ~f:(fun x xs -> x :: xs)) + let ( *> ) u v = map2 u v ~f:(fun () y -> y) + let ( <* ) u v = map2 u v ~f:(fun x () -> x) + let all_unit ts = List.fold ts ~init:(return ()) ~f:( *> ) + + module Applicative_infix = struct + let ( <*> ) = ( <*> ) + let ( *> ) = ( *> ) + let ( <* ) = ( <* ) + let ( >>| ) = ( >>| ) + end +end + +module Make2_using_map2 (X : Basic2_using_map2) : + S2 with type ('a, 'e) t := ('a, 'e) X.t = Make3_using_map2 (struct + include X + + type ('a, 'd, 'e) t = ('a, 'd) X.t +end) + +module Make_using_map2 (X : Basic_using_map2) : S with type 'a t := 'a X.t = +Make2_using_map2 (struct + include X + + type ('a, 'e) t = 'a X.t +end) + +module Make3_using_map2_local (X : Basic3_using_map2_local) : + S3_local with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t = struct + include X + + let apply tf ta = map2 tf ta ~f:(fun f a -> f a) + let ( <*> ) = apply + let derived_map t ~f = map2 ~f:(fun () -> f) (return ()) t [@nontail] + + let map = + match X.map with + | `Define_using_map2 -> derived_map + | `Custom map -> map + ;; + + let ( >>| ) t f = map t ~f + let both ta tb = map2 ta tb ~f:(fun a b -> a, b) + + let map3 ta tb tc ~f = + let res = map2 (both ta tb) tc ~f:(fun (a, b) c -> f a b c) in + res + ;; + + let all ts = List.fold_right ts ~init:(return []) ~f:(map2 ~f:(fun x xs -> x :: xs)) + let ( *> ) u v = map2 u v ~f:(fun () y -> y) + let ( <* ) u v = map2 u v ~f:(fun x () -> x) + let all_unit ts = List.fold ts ~init:(return ()) ~f:( *> ) + + module Applicative_infix = struct + let ( <*> ) = ( <*> ) + let ( *> ) = ( *> ) + let ( <* ) = ( <* ) + let ( >>| ) = ( >>| ) + end +end + +module Make2_using_map2_local (X : Basic2_using_map2_local) : + S2_local with type ('a, 'e) t := ('a, 'e) X.t = Make3_using_map2_local (struct + include X + + type ('a, 'd, 'e) t = ('a, 'd) X.t +end) + +module Make_using_map2_local (X : Basic_using_map2_local) : + S_local with type 'a t := 'a X.t = Make2_using_map2_local (struct + include X + + type ('a, 'e) t = 'a X.t +end) + +module Of_monad2 (M : Monad.S2) : S2 with type ('a, 'e) t := ('a, 'e) M.t = Make2 (struct + type ('a, 'e) t = ('a, 'e) M.t + + let return = M.return + let apply mf mx = M.bind mf ~f:(fun f -> M.map mx ~f) + let map = `Custom M.map +end) + +module Of_monad (M : Monad.S) : S with type 'a t := 'a M.t = Of_monad2 (struct + include M + + type ('a, _) t = 'a M.t +end) + +module Compose (F : S) (G : S) : S with type 'a t = 'a F.t G.t = struct + type 'a t = 'a F.t G.t + + include Make (struct + type nonrec 'a t = 'a t + + let return a = G.return (F.return a) + let apply tf tx = G.apply (G.map ~f:F.apply tf) tx + let custom_map t ~f = G.map ~f:(F.map ~f) t + let map = `Custom custom_map + end) +end + +module Pair (F : S) (G : S) : S with type 'a t = 'a F.t * 'a G.t = struct + type 'a t = 'a F.t * 'a G.t + + include Make (struct + type nonrec 'a t = 'a t + + let return a = F.return a, G.return a + let apply tf tx = F.apply (fst tf) (fst tx), G.apply (snd tf) (snd tx) + let custom_map t ~f = F.map ~f (fst t), G.map ~f (snd t) + let map = `Custom custom_map + end) +end + +module Ident = struct + type 'a t = 'a + + include Make_using_map2_local (struct + type nonrec 'a t = 'a t + + let return = Fn.id + let map2 a b ~f = f a b + let map = `Custom (fun a ~f -> f a) + end) +end diff --git a/unikernel/duniverse/base/src/applicative.mli b/unikernel/duniverse/base/src/applicative.mli new file mode 100644 index 00000000..3a4f2d29 --- /dev/null +++ b/unikernel/duniverse/base/src/applicative.mli @@ -0,0 +1 @@ +include Applicative_intf.Applicative (** @inline *) diff --git a/unikernel/duniverse/base/src/applicative_intf.ml b/unikernel/duniverse/base/src/applicative_intf.ml new file mode 100644 index 00000000..60c49a77 --- /dev/null +++ b/unikernel/duniverse/base/src/applicative_intf.ml @@ -0,0 +1,534 @@ +(** Applicatives model computations in which values computed by subcomputations cannot + affect what subsequent computations will take place. + + Relative to monads, this restriction takes power away from the user of the interface + and gives it to the implementation. In particular, because the structure of the + entire computation is known, one can augment its definition with some description of + that structure. + + For more information, see: + + {v + Applicative Programming with Effects. + Conor McBride and Ross Paterson. + Journal of Functional Programming 18:1 (2008), pages 1-13. + http://staff.city.ac.uk/~ross/papers/Applicative.pdf + v} *) + +open! Import + +module type Basic = sig + type 'a t + + val return : 'a -> 'a t + val apply : ('a -> 'b) t -> 'a t -> 'b t + + (** The following identities ought to hold for every Applicative (for some value of =): + + - identity: [return Fn.id <*> t = t] + - composition: [return Fn.compose <*> tf <*> tg <*> tx = tf <*> (tg <*> tx)] + - homomorphism: [return f <*> return x = return (f x)] + - interchange: [tf <*> return x = return (fun f -> f x) <*> tf] + + Note: <*> is the infix notation for apply. *) + + (** The [map] argument to [Applicative.Make] says how to implement the applicative's + [map] function. [`Define_using_apply] means to define [map t ~f = return f <*> t]. + [`Custom] overrides the default implementation, presumably with something more + efficient. + + Some other functions returned by [Applicative.Make] are defined in terms of [map], + so passing in a more efficient [map] will improve their efficiency as well. *) + val map : [ `Define_using_apply | `Custom of 'a t -> f:('a -> 'b) -> 'b t ] +end + +(** Similar to [Basic], with the same laws, and the additional requirement that ['a t] + can be mapped with a local function. *) +module type Basic_local = sig + type 'a t + + val return : 'a -> 'a t + val apply : ('a -> 'b) t -> 'a t -> 'b t + val map : 'a t -> f:('a -> 'b) -> 'b t +end + +module type Basic_using_map2 = sig + type 'a t + + val return : 'a -> 'a t + val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + val map : [ `Define_using_map2 | `Custom of 'a t -> f:('a -> 'b) -> 'b t ] +end + +module type Basic_using_map2_local = sig + type 'a t + + val return : 'a -> 'a t + val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + val map : [ `Define_using_map2 | `Custom of 'a t -> f:('a -> 'b) -> 'b t ] +end + +module type Applicative_infix_gen = sig + type 'a t + type ('a, 'b) fn + + (** same as [apply] *) + val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t + + val ( <* ) : 'a t -> unit t -> 'a t + val ( *> ) : unit t -> 'a t -> 'a t + val ( >>| ) : 'a t -> ('a -> 'b, 'b t) fn +end + +module type Applicative_infix = Applicative_infix_gen with type ('a, 'b) fn := 'a -> 'b + +module type Applicative_infix_local = + Applicative_infix_gen with type ('a, 'b) fn := 'a -> 'b + +module type For_let_syntax_gen = sig + type 'a t + type ('a, 'b) fn + type ('a, 'b) f_labeled_fn + + val return : 'a -> 'a t + val map : 'a t -> ('a -> 'b, 'b t) f_labeled_fn + val both : 'a t -> 'b t -> ('a * 'b) t + + include Applicative_infix_gen with type 'a t := 'a t and type ('a, 'b) fn := ('a, 'b) fn +end + +module type For_let_syntax = + For_let_syntax_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type For_let_syntax_local = + For_let_syntax_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type S_gen = sig + include For_let_syntax_gen + + type ('a, 'b, 'c) fun2 + type ('a, 'b, 'c, 'd) fun3 + + val apply : ('a -> 'b) t -> 'a t -> 'b t + val map2 : 'a t -> 'b t -> (('a, 'b, 'c) fun2, 'c t) f_labeled_fn + val map3 : 'a t -> 'b t -> 'c t -> (('a, 'b, 'c, 'd) fun3, 'd t) f_labeled_fn + val all : 'a t list -> 'a list t + val all_unit : unit t list -> unit t + + module Applicative_infix : + Applicative_infix_gen with type 'a t := 'a t and type ('a, 'b) fn := ('a, 'b) fn +end + +module type S = + S_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + +module type S_local = + S_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + +module type Let_syntax = sig + type 'a t + + module Open_on_rhs_intf : sig + module type S + end + + module Let_syntax : sig + val return : 'a -> 'a t + + include Applicative_infix with type 'a t := 'a t + + module Let_syntax : sig + val return : 'a -> 'a t + val map : 'a t -> f:('a -> 'b) -> 'b t + val both : 'a t -> 'b t -> ('a * 'b) t + + module Open_on_rhs : Open_on_rhs_intf.S + end + end +end + +module type Basic2 = sig + type ('a, 'e) t + + val return : 'a -> ('a, _) t + val apply : ('a -> 'b, 'e) t -> ('a, 'e) t -> ('b, 'e) t + val map : [ `Define_using_apply | `Custom of ('a, 'e) t -> f:('a -> 'b) -> ('b, 'e) t ] +end + +module type Basic2_local = sig + type ('a, 'e) t + + val return : 'a -> ('a, _) t + val apply : ('a -> 'b, 'e) t -> ('a, 'e) t -> ('b, 'e) t + val map : ('a, 'e) t -> f:('a -> 'b) -> ('b, 'e) t +end + +module type Basic2_using_map2 = sig + type ('a, 'e) t + + val return : 'a -> ('a, _) t + val map2 : ('a, 'e) t -> ('b, 'e) t -> f:('a -> 'b -> 'c) -> ('c, 'e) t + val map : [ `Define_using_map2 | `Custom of ('a, 'e) t -> f:('a -> 'b) -> ('b, 'e) t ] +end + +module type Basic2_using_map2_local = sig + type ('a, 'e) t + + val return : 'a -> ('a, _) t + val map2 : ('a, 'e) t -> ('b, 'e) t -> f:('a -> 'b -> 'c) -> ('c, 'e) t + val map : [ `Define_using_map2 | `Custom of ('a, 'e) t -> f:('a -> 'b) -> ('b, 'e) t ] +end + +module type Applicative_infix2_gen = sig + type ('a, 'e) t + type ('a, 'b) fn + + val ( <*> ) : ('a -> 'b, 'e) t -> ('a, 'e) t -> ('b, 'e) t + val ( <* ) : ('a, 'e) t -> (unit, 'e) t -> ('a, 'e) t + val ( *> ) : (unit, 'e) t -> ('a, 'e) t -> ('a, 'e) t + val ( >>| ) : ('a, 'e) t -> ('a -> 'b, ('b, 'e) t) fn +end + +module type Applicative_infix2 = Applicative_infix2_gen with type ('a, 'b) fn := 'a -> 'b + +module type Applicative_infix2_local = + Applicative_infix2_gen with type ('a, 'b) fn := 'a -> 'b + +module type For_let_syntax2_gen = sig + type ('a, 'e) t + type ('a, 'b) fn + type ('a, 'b) f_labeled_fn + + val return : 'a -> ('a, _) t + val map : ('a, 'e) t -> ('a -> 'b, ('b, 'e) t) f_labeled_fn + val both : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t + + include + Applicative_infix2_gen + with type ('a, 'e) t := ('a, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn +end + +module type For_let_syntax2 = + For_let_syntax2_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type For_let_syntax2_local = + For_let_syntax2_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type S2_gen = sig + include For_let_syntax2_gen + + type ('a, 'b, 'c) fun2 + type ('a, 'b, 'c, 'd) fun3 + + val apply : ('a -> 'b, 'e) t -> ('a, 'e) t -> ('b, 'e) t + val map2 : ('a, 'e) t -> ('b, 'e) t -> (('a, 'b, 'c) fun2, ('c, 'e) t) f_labeled_fn + + val map3 + : ('a, 'e) t + -> ('b, 'e) t + -> ('c, 'e) t + -> (('a, 'b, 'c, 'd) fun3, ('d, 'e) t) f_labeled_fn + + val all : ('a, 'e) t list -> ('a list, 'e) t + val all_unit : (unit, 'e) t list -> (unit, 'e) t + + module Applicative_infix : + Applicative_infix2_gen + with type ('a, 'e) t := ('a, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn +end + +module type S2 = + S2_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + +module type S2_local = + S2_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + +module type Let_syntax2 = sig + type ('a, 'e) t + + module Open_on_rhs_intf : sig + module type S + end + + module Let_syntax : sig + val return : 'a -> ('a, _) t + + include Applicative_infix2 with type ('a, 'e) t := ('a, 'e) t + + module Let_syntax : sig + val return : 'a -> ('a, _) t + val map : ('a, 'e) t -> f:('a -> 'b) -> ('b, 'e) t + val both : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t + + module Open_on_rhs : Open_on_rhs_intf.S + end + end +end + +module type Basic3 = sig + type ('a, 'd, 'e) t + + val return : 'a -> ('a, _, _) t + val apply : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t + + val map + : [ `Define_using_apply + | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t + ] +end + +module type Basic3_using_map2 = sig + type ('a, 'd, 'e) t + + val return : 'a -> ('a, _, _) t + val map2 : ('a, 'd, 'e) t -> ('b, 'd, 'e) t -> f:('a -> 'b -> 'c) -> ('c, 'd, 'e) t + + val map + : [ `Define_using_map2 | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t ] +end + +module type Basic3_using_map2_local = sig + type ('a, 'd, 'e) t + + val return : 'a -> ('a, _, _) t + val map2 : ('a, 'd, 'e) t -> ('b, 'd, 'e) t -> f:('a -> 'b -> 'c) -> ('c, 'd, 'e) t + + val map + : [ `Define_using_map2 | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t ] +end + +module type Applicative_infix3_gen = sig + type ('a, 'd, 'e) t + type ('a, 'b) fn + + val ( <*> ) : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t + val ( <* ) : ('a, 'd, 'e) t -> (unit, 'd, 'e) t -> ('a, 'd, 'e) t + val ( *> ) : (unit, 'd, 'e) t -> ('a, 'd, 'e) t -> ('a, 'd, 'e) t + val ( >>| ) : ('a, 'd, 'e) t -> ('a -> 'b, ('b, 'd, 'e) t) fn +end + +module type Applicative_infix3 = Applicative_infix3_gen with type ('a, 'b) fn := 'a -> 'b + +module type Applicative_infix3_local = + Applicative_infix3_gen with type ('a, 'b) fn := 'a -> 'b + +module type For_let_syntax3_gen = sig + type ('a, 'd, 'e) t + type ('a, 'b) fn + type ('a, 'b) f_labeled_fn + + val return : 'a -> ('a, _, _) t + val map : ('a, 'd, 'e) t -> ('a -> 'b, ('b, 'd, 'e) t) f_labeled_fn + val both : ('a, 'd, 'e) t -> ('b, 'd, 'e) t -> ('a * 'b, 'd, 'e) t + + include + Applicative_infix3_gen + with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn +end + +module type For_let_syntax3 = + For_let_syntax3_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type For_let_syntax3_local = + For_let_syntax3_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type S3_gen = sig + include For_let_syntax3_gen + + type ('a, 'b, 'c) fun2 + type ('a, 'b, 'c, 'd) fun3 + + val apply : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t + + val map2 + : ('a, 'd, 'e) t + -> ('b, 'd, 'e) t + -> (('a, 'b, 'c) fun2, ('c, 'd, 'e) t) f_labeled_fn + + val map3 + : ('a, 'd, 'e) t + -> ('b, 'd, 'e) t + -> ('c, 'd, 'e) t + -> (('a, 'b, 'c, 'result) fun3, ('result, 'd, 'e) t) f_labeled_fn + + val all : ('a, 'd, 'e) t list -> ('a list, 'd, 'e) t + val all_unit : (unit, 'd, 'e) t list -> (unit, 'd, 'e) t + + module Applicative_infix : + Applicative_infix3_gen + with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn +end + +module type S3 = + S3_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + +module type S3_local = + S3_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + +module type Let_syntax3 = sig + type ('a, 'd, 'e) t + + module Open_on_rhs_intf : sig + module type S + end + + module Let_syntax : sig + val return : 'a -> ('a, _, _) t + + include Applicative_infix3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + + module Let_syntax : sig + val return : 'a -> ('a, _, _) t + val map : ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t + val both : ('a, 'd, 'e) t -> ('b, 'd, 'e) t -> ('a * 'b, 'd, 'e) t + + module Open_on_rhs : Open_on_rhs_intf.S + end + end +end + +(** [Lazy_applicative] is an applicative whose structure may be computed on-demand, + instead of being constructed up-front. This is useful when implementing traversals + over large data structures, where otherwise we have to pay O(n) up-front cost both + in time and in memory. *) +module type Lazy_applicative = sig + include S + + val of_thunk : (unit -> 'a t) -> 'a t +end + +module type Applicative = sig + module type Applicative_infix = Applicative_infix + module type Applicative_infix2 = Applicative_infix2 + module type Applicative_infix3 = Applicative_infix3 + module type Applicative_infix_local = Applicative_infix_local + module type Applicative_infix2_local = Applicative_infix2_local + module type Basic = Basic + module type Basic2 = Basic2 + module type Basic3 = Basic3 + module type Basic_local = Basic_local + module type Basic2_local = Basic2_local + module type Basic_using_map2 = Basic_using_map2 + module type Basic2_using_map2 = Basic2_using_map2 + module type Basic3_using_map2 = Basic3_using_map2 + module type Basic_using_map2_local = Basic_using_map2_local + module type Basic2_using_map2_local = Basic2_using_map2_local + module type Basic3_using_map2_local = Basic3_using_map2_local + module type Let_syntax = Let_syntax + module type Let_syntax2 = Let_syntax2 + module type Let_syntax3 = Let_syntax3 + module type S = S + module type S2 = S2 + module type S3 = S3 + module type Lazy_applicative = Lazy_applicative + module type S_local = S_local + module type S2_local = S2_local + + module Ident : S_local with type 'a t = 'a + module S2_to_S (T : T.T) (X : S2) : S with type 'a t = ('a, T.t) X.t + module S_to_S2 (X : S) : S2 with type ('a, 'e) t = 'a X.t + module S3_to_S2 (T : T.T) (X : S3) : S2 with type ('a, 'd) t = ('a, 'd, T.t) X.t + module S3_to_S (T1 : T.T) (T2 : T.T) (X : S3) : S with type 'a t = ('a, T1.t, T2.t) X.t + module S2_to_S3 (X : S2) : S3 with type ('a, 'd, 'e) t = ('a, 'd) X.t + module Make (X : Basic) : S with type 'a t := 'a X.t + module Make2 (X : Basic2) : S2 with type ('a, 'e) t := ('a, 'e) X.t + module Make3 (X : Basic3) : S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t + + module Make_let_syntax + (X : For_let_syntax) (Intf : sig + module type S + end) + (Impl : Intf.S) : + Let_syntax with type 'a t := 'a X.t with module Open_on_rhs_intf := Intf + + module Make_let_syntax2 + (X : For_let_syntax2) (Intf : sig + module type S + end) + (Impl : Intf.S) : + Let_syntax2 with type ('a, 'e) t := ('a, 'e) X.t with module Open_on_rhs_intf := Intf + + module Make_let_syntax3 + (X : For_let_syntax3) (Intf : sig + module type S + end) + (Impl : Intf.S) : + Let_syntax3 + with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t + with module Open_on_rhs_intf := Intf + + module Make_using_map2 (X : Basic_using_map2) : S with type 'a t := 'a X.t + + module Make2_using_map2 (X : Basic2_using_map2) : + S2 with type ('a, 'e) t := ('a, 'e) X.t + + module Make3_using_map2 (X : Basic3_using_map2) : + S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t + + module Make_using_map2_local (X : Basic_using_map2_local) : + S_local with type 'a t := 'a X.t + + module Make2_using_map2_local (X : Basic2_using_map2_local) : + S2_local with type ('a, 'e) t := ('a, 'e) X.t + + module Make3_using_map2_local (X : Basic3_using_map2_local) : + S3_local with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t + + (** The following functors give a sense of what Applicatives one can define. + + Of these, [Of_monad] is likely the most useful. The others are mostly didactic. *) + + (** Every monad is Applicative via: + + {[ + let apply mf mx = + mf >>= fun f -> + mx >>| fun x -> + f x + ]} *) + module Of_monad (M : Monad.S) : S with type 'a t := 'a M.t + + module Of_monad2 (M : Monad.S2) : S2 with type ('a, 'e) t := ('a, 'e) M.t + module Compose (F : S) (G : S) : S with type 'a t = 'a F.t G.t + module Pair (F : S) (G : S) : S with type 'a t = 'a F.t * 'a G.t +end diff --git a/unikernel/duniverse/base/src/array.ml b/unikernel/duniverse/base/src/array.ml new file mode 100644 index 00000000..9f250974 --- /dev/null +++ b/unikernel/duniverse/base/src/array.ml @@ -0,0 +1,929 @@ +open! Import +include Array0 + +type 'a t = 'a array [@@deriving_inline compare ~localize, globalize, sexp, sexp_grammar] + +let compare__local : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_array__local +let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_array + +let globalize : 'a. ('a -> 'a) -> 'a t -> 'a t = + fun (type a__009_) : ((a__009_ -> a__009_) -> a__009_ t -> a__009_ t) -> globalize_array +;; + +let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = array_of_sexp +let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = sexp_of_array + +let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> array_sexp_grammar _'a_sexp_grammar +;; + +[@@@end] + +(* This module implements a new in-place, constant heap sorting algorithm to replace the + one used by the standard libraries. Its only purpose is to be faster (hopefully + strictly faster) than the base sort and stable_sort. + + At a high level the algorithm is: + - pick two pivot points by: + - pick 5 arbitrary elements from the array + - sort them within the array + - take the elements on either side of the middle element of the sort as the pivots + - sort the array with: + - all elements less than pivot1 to the left (range 1) + - all elements >= pivot1 and <= pivot2 in the middle (range 2) + - all elements > pivot2 to the right (range 3) + - if pivot1 and pivot2 are equal, then the middle range is sorted, so ignore it + - recurse into range 1, 2 (if pivot1 and pivot2 are unequal), and 3 + - during recursion there are two inflection points: + - if the size of the current range is small, use insertion sort to sort it + - if the stack depth is large, sort the range with heap-sort to avoid n^2 worst-case + behavior + + See the following for more information: + - "Dual-Pivot Quicksort" by Vladimir Yaroslavskiy. + Available at + http://www.kriche.com.ar/root/programming/spaceTimeComplexity/DualPivotQuicksort.pdf + - "Quicksort is Optimal" by Sedgewick and Bentley. + Slides at http://www.cs.princeton.edu/~rs/talks/QuicksortIsOptimal.pdf + - http://www.sorting-algorithms.com/quick-sort-3-way *) + +module Sorter (S : sig + type 'a t + + val get : 'a t -> int -> 'a + val set : 'a t -> int -> 'a -> unit + val length : 'a t -> int +end) = +struct + include S + + let swap arr i j = + let tmp = get arr i in + set arr i (get arr j); + set arr j tmp + ;; + + module type Sort = sig + val sort + : 'a t + -> compare:('a -> 'a -> int) + -> left:int (* leftmost index of sub-array to sort *) + -> right:int (* rightmost index of sub-array to sort *) + -> unit + end + + (* http://en.wikipedia.org/wiki/Insertion_sort *) + module Insertion_sort : Sort = struct + (* loop invariants: + 1. the subarray arr[left .. i-1] is sorted + 2. the subarray arr[i+1 .. pos] is sorted and contains only elements > v + 3. arr[i] may be thought of as containing v + *) + let rec insert_loop arr ~left ~compare i v = + let i_next = i - 1 in + if i_next >= left && compare (get arr i_next) v > 0 + then ( + set arr i (get arr i_next); + insert_loop arr ~left ~compare i_next v) + else i + ;; + + let sort arr ~compare ~left ~right = + (* loop invariant: + [arr] is sorted from [left] to [pos - 1], inclusive *) + for pos = left + 1 to right do + let v = get arr pos in + let final_pos = insert_loop arr ~left ~compare pos v in + set arr final_pos v + done + ;; + end + + (* http://en.wikipedia.org/wiki/Heapsort *) + module Heap_sort : Sort = struct + (* loop invariant: + root's children are both either roots of max-heaps or > right *) + let rec heapify arr ~compare root ~left ~right = + let relative_root = root - left in + let left_child = (2 * relative_root) + left + 1 in + let right_child = (2 * relative_root) + left + 2 in + let largest = + if left_child <= right && compare (get arr left_child) (get arr root) > 0 + then left_child + else root + in + let largest = + if right_child <= right && compare (get arr right_child) (get arr largest) > 0 + then right_child + else largest + in + if largest <> root + then ( + swap arr root largest; + heapify arr ~compare largest ~left ~right) + ;; + + let build_heap arr ~compare ~left ~right = + (* Elements in the second half of the array are already heaps of size 1. We move + through the first half of the array from back to front examining the element at + hand, and the left and right children, fixing the heap property as we go. *) + for i = (left + right) / 2 downto left do + heapify arr ~compare i ~left ~right + done + ;; + + let sort arr ~compare ~left ~right = + build_heap arr ~compare ~left ~right; + (* loop invariants: + 1. the subarray arr[left ... i] is a max-heap H + 2. the subarray arr[i+1 ... right] is sorted (call it S) + 3. every element of H is less than every element of S *) + for i = right downto left + 1 do + swap arr left i; + heapify arr ~compare left ~left ~right:(i - 1) + done + ;; + end + + (* http://en.wikipedia.org/wiki/Introsort *) + module Intro_sort : sig + include Sort + + val five_element_sort + : 'a t + -> compare:('a -> 'a -> int) + -> int + -> int + -> int + -> int + -> int + -> unit + end = struct + let five_element_sort arr ~(compare : _ -> _ -> _) m1 m2 m3 m4 m5 = + let compare_and_swap i j = + if compare (get arr i) (get arr j) > 0 then swap arr i j + in + (* Optimal 5-element sorting network: + + {v + 1--o-----o-----o--------------1 + | | | + 2--o-----|--o--|-----o--o-----2 + | | | | | + 3--------o--o--|--o--|--o-----3 + | | | + 4-----o--------o--o--|-----o--4 + | | | + 5-----o--------------o-----o--5 + v} *) + compare_and_swap m1 m2; + compare_and_swap m4 m5; + compare_and_swap m1 m3; + compare_and_swap m2 m3; + compare_and_swap m1 m4; + compare_and_swap m3 m4; + compare_and_swap m2 m5; + compare_and_swap m2 m3; + compare_and_swap m4 m5 [@nontail] + ;; + + (* choose pivots for the array by sorting 5 elements and examining the center three + elements. The goal is to choose two pivots that will either: + - break the range up into 3 even partitions + or + - eliminate a commonly appearing element by sorting it into the center partition + by itself + To this end we look at the center 3 elements of the 5 and return pairs of equal + elements or the widest range *) + let choose_pivots arr ~(compare : _ -> _ -> _) ~left ~right = + let sixth = (right - left) / 6 in + let m1 = left + sixth in + let m2 = m1 + sixth in + let m3 = m2 + sixth in + let m4 = m3 + sixth in + let m5 = m4 + sixth in + five_element_sort arr ~compare m1 m2 m3 m4 m5; + let m2_val = get arr m2 in + let m3_val = get arr m3 in + let m4_val = get arr m4 in + if compare m2_val m3_val = 0 + then m2_val, m3_val, true + else if compare m3_val m4_val = 0 + then m3_val, m4_val, true + else m2_val, m4_val, false + ;; + + let dual_pivot_partition arr ~(compare : _ -> _ -> _) ~left ~right = + let pivot1, pivot2, pivots_equal = choose_pivots arr ~compare ~left ~right in + (* loop invariants: + 1. left <= l < r <= right + 2. l <= p <= r + 3. l <= x < p implies arr[x] >= pivot1 + and arr[x] <= pivot2 + 4. left <= x < l implies arr[x] < pivot1 + 5. r < x <= right implies arr[x] > pivot2 *) + let rec loop l p r = + let pv = get arr p in + if compare pv pivot1 < 0 + then ( + swap arr p l; + cont (l + 1) (p + 1) r) + else if compare pv pivot2 > 0 + then ( + (* loop invariants: same as those of the outer loop *) + let rec scan_backwards r = + if r > p && compare (get arr r) pivot2 > 0 then scan_backwards (r - 1) else r + in + let r = scan_backwards r in + swap arr r p; + cont l p (r - 1)) + else cont l (p + 1) r + and cont l p r = if p > r then l, r else loop l p r in + let l, r = cont left left right in + l, r, pivots_equal + ;; + + let rec intro_sort arr ~max_depth ~compare ~left ~right = + let len = right - left + 1 in + (* This takes care of some edge cases, such as left > right or very short arrays, + since Insertion_sort.sort handles these cases properly. Thus we don't need to + make sure that left and right are valid in recursive calls. *) + if len <= 32 + then Insertion_sort.sort arr ~compare ~left ~right + else if max_depth < 0 + then Heap_sort.sort arr ~compare ~left ~right + else ( + let max_depth = max_depth - 1 in + let l, r, middle_sorted = dual_pivot_partition arr ~compare ~left ~right in + intro_sort arr ~max_depth ~compare ~left ~right:(l - 1); + if not middle_sorted then intro_sort arr ~max_depth ~compare ~left:l ~right:r; + intro_sort arr ~max_depth ~compare ~left:(r + 1) ~right) + ;; + + let sort arr ~compare ~left ~right = + let heap_sort_switch_depth = + (* We bail out to heap sort at a recursion depth of 32. GNU introsort uses 2lg(n). + The expected recursion depth for perfect 3-way splits is log_3(n). + + Using 32 means a balanced 3-way split would work up to 3^32 elements (roughly + 2^50 or 10^15). GNU reaches a depth of 32 at 65536 elements. + + For small arrays, this makes us less likely to bail out to heap sort, but the + 32*N cost before we do is not that much. + + For large arrays, this means we are more likely to bail out to heap sort at + some point if we get some bad splits or if the array is huge. But that's only a + constant factor cost in the final stages of recursion. + + All in all, this seems to be a small tradeoff and avoids paying a cost to + compute a logarithm at the start. *) + 32 + in + intro_sort arr ~max_depth:heap_sort_switch_depth ~compare ~left ~right + ;; + end + + let sort ?pos ?len arr ~(compare : _ -> _ -> _) = + let pos, len = + Ordered_collection_common.get_pos_len_exn () ?pos ?len ~total_length:(length arr) + in + Intro_sort.sort arr ~compare ~left:pos ~right:(pos + len - 1) + ;; +end +[@@inline] + +module Sort = Sorter (struct + type nonrec 'a t = 'a t + + let get = unsafe_get + let set = unsafe_set + let length = length +end) + +let sort = Sort.sort +let of_array t = t +let to_array t = t +let is_empty t = length t = 0 + +let is_sorted t ~compare = + let i = ref (length t - 1) in + let result = ref true in + while !i > 0 && !result do + let elt_i = unsafe_get t !i in + let elt_i_minus_1 = unsafe_get t (!i - 1) in + if compare elt_i_minus_1 elt_i > 0 then result := false; + decr i + done; + !result +;; + +let is_sorted_strictly t ~compare = + let i = ref (length t - 1) in + let result = ref true in + while !i > 0 && !result do + let elt_i = unsafe_get t !i in + let elt_i_minus_1 = unsafe_get t (!i - 1) in + if compare elt_i_minus_1 elt_i >= 0 then result := false; + decr i + done; + !result +;; + +let merge a1 a2 ~compare = + let l1 = Array.length a1 in + let l2 = Array.length a2 in + if l1 = 0 + then copy a2 + else if l2 = 0 + then copy a1 + else if compare (unsafe_get a2 0) (unsafe_get a1 (l1 - 1)) >= 0 + then append a1 a2 + else if compare (unsafe_get a1 0) (unsafe_get a2 (l2 - 1)) > 0 + then append a2 a1 + else ( + let len = l1 + l2 in + let merged = create ~len (unsafe_get a1 0) in + let a1_index = ref 0 in + let a2_index = ref 0 in + for i = 0 to len - 1 do + let use_a1 = + if l1 = !a1_index + then false + else if l2 = !a2_index + then true + else compare (unsafe_get a1 !a1_index) (unsafe_get a2 !a2_index) <= 0 + in + if use_a1 + then ( + unsafe_set merged i (unsafe_get a1 !a1_index); + a1_index := !a1_index + 1) + else ( + unsafe_set merged i (unsafe_get a2 !a2_index); + a2_index := !a2_index + 1) + done; + merged) +;; + +let copy_matrix = map ~f:copy + +let folding_map t ~init ~f = + let acc = ref init in + map t ~f:(fun x -> + let new_acc, y = f !acc x in + acc := new_acc; + y) [@nontail] +;; + +let fold_map t ~init ~f = + let acc = ref init in + let result = + map t ~f:(fun x -> + let new_acc, y = f !acc x in + acc := new_acc; + y) + in + !acc, result +;; + +let fold_result t ~init ~f = Container.fold_result ~fold ~init ~f t +let fold_until t ~init ~f ~finish = Container.fold_until ~fold ~init ~f t ~finish +let sum m t ~f = Container.sum ~fold m t ~f + +let[@inline always] extremal_element t ~compare ~keep_left_if = + if is_empty t + then None + else ( + let result = ref (unsafe_get t 0) in + for i = 1 to length t - 1 do + let x = unsafe_get t i in + result := Bool.select ((keep_left_if [@inlined]) (compare x !result)) x !result + done; + Some !result) +;; + +let min_elt t ~compare = + (extremal_element [@inlined]) t ~compare ~keep_left_if:(fun compare_result -> + compare_result < 0) +;; + +let max_elt t ~compare = + (extremal_element [@inlined]) t ~compare ~keep_left_if:(fun compare_result -> + compare_result > 0) +;; + +let foldi t ~init ~f = + let acc = ref init in + for i = 0 to length t - 1 do + acc := f i !acc (unsafe_get t i) + done; + !acc +;; + +let folding_mapi t ~init ~f = + let acc = ref init in + mapi t ~f:(fun i x -> + let new_acc, y = f i !acc x in + acc := new_acc; + y) [@nontail] +;; + +let fold_mapi t ~init ~f = + let acc = ref init in + let result = + mapi t ~f:(fun i x -> + let new_acc, y = f i !acc x in + acc := new_acc; + y) + in + !acc, result +;; + +let count t ~f = + let result = ref 0 in + for i = 0 to Array.length t - 1 do + result := !result + (f (Array.unsafe_get t i) |> Bool.to_int) + done; + !result +;; + +let counti t ~f = + let result = ref 0 in + for i = 0 to Array.length t - 1 do + result := !result + (f i (Array.unsafe_get t i) |> Bool.to_int) + done; + !result +;; + +let concat_map t ~f = concat (to_list (map ~f t)) +let concat_mapi t ~f = concat (to_list (mapi ~f t)) + +let rev_inplace t = + let i = ref 0 in + let j = ref (length t - 1) in + while !i < !j do + swap t !i !j; + incr i; + decr j + done +;; + +let rev t = + let t = copy t in + rev_inplace t; + t +;; + +let of_list_rev l = + match l with + | [] -> [||] + | a :: l -> + let len = 1 + List.length l in + let t = create ~len a in + let r = ref l in + (* We start at [len - 2] because we already put [a] at [t.(len - 1)]. *) + for i = len - 2 downto 0 do + match !r with + | [] -> assert false + | a :: l -> + t.(i) <- a; + r := l + done; + t +;; + +(* [of_list_map] and [of_list_rev_map] are based on functions from the OCaml + distribution. *) + +let of_list_map xs ~f = + match xs with + | [] -> [||] + | hd :: tl -> + let a = create ~len:(1 + List.length tl) (f hd) in + let rec fill i = function + | [] -> a + | hd :: tl -> + unsafe_set a i (f hd); + fill (i + 1) tl + in + fill 1 tl [@nontail] +;; + +let of_list_mapi xs ~f = + match xs with + | [] -> [||] + | hd :: tl -> + let a = create ~len:(1 + List.length tl) (f 0 hd) in + let rec fill a i = function + | [] -> a + | hd :: tl -> + unsafe_set a i (f i hd); + fill a (i + 1) tl + in + fill a 1 tl [@nontail] +;; + +let of_list_rev_map xs ~f = + let t = of_list_map xs ~f in + rev_inplace t; + t +;; + +let of_list_rev_mapi xs ~f = + let t = of_list_mapi xs ~f in + rev_inplace t; + t +;; + +let filter_mapi t ~f = + let r = ref [||] in + let k = ref 0 in + for i = 0 to length t - 1 do + match f i (unsafe_get t i) with + | None -> () + | Some a -> + if !k = 0 then r := create ~len:(length t) a; + unsafe_set !r !k a; + incr k + done; + if !k = length t then !r else if !k > 0 then sub ~pos:0 ~len:!k !r else [||] +;; + +let filter_map t ~f = filter_mapi t ~f:(fun _i a -> f a) [@nontail] +let filter_opt t = filter_map t ~f:Fn.id + +let raise_length_mismatch name n1 n2 = + invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () + [@@cold] [@@inline never] [@@local never] [@@specialise never] +;; + +let check_length2_exn name t1 t2 = + let n1 = length t1 in + let n2 = length t2 in + if n1 <> n2 then raise_length_mismatch name n1 n2 +;; + +let iter2_exn t1 t2 ~f = + check_length2_exn "Array.iter2_exn" t1 t2; + iteri t1 ~f:(fun i x1 -> f x1 (unsafe_get t2 i)) [@nontail] +;; + +let map2_exn t1 t2 ~f = + check_length2_exn "Array.map2_exn" t1 t2; + init (length t1) ~f:(fun i -> f (unsafe_get t1 i) (unsafe_get t2 i)) [@nontail] +;; + +let fold2_exn t1 t2 ~init ~f = + check_length2_exn "Array.fold2_exn" t1 t2; + foldi t1 ~init ~f:(fun i ac x -> f ac x (unsafe_get t2 i)) [@nontail] +;; + +let filter t ~f = filter_map t ~f:(fun x -> if f x then Some x else None) [@nontail] +let filteri t ~f = filter_mapi t ~f:(fun i x -> if f i x then Some x else None) [@nontail] + +let exists t ~f = + let i = ref (length t - 1) in + let result = ref false in + while !i >= 0 && not !result do + if f (unsafe_get t !i) then result := true else decr i + done; + !result +;; + +let existsi t ~f = + let i = ref (length t - 1) in + let result = ref false in + while !i >= 0 && not !result do + if f !i (unsafe_get t !i) then result := true else decr i + done; + !result +;; + +let mem t a ~equal = exists t ~f:(equal a) [@nontail] + +let for_all t ~f = + let i = ref (length t - 1) in + let result = ref true in + while !i >= 0 && !result do + if not (f (unsafe_get t !i)) then result := false else decr i + done; + !result +;; + +let for_alli t ~f = + let length = length t in + let i = ref (length - 1) in + let result = ref true in + while !i >= 0 && !result do + if not (f !i (unsafe_get t !i)) then result := false else decr i + done; + !result +;; + +let exists2_exn t1 t2 ~f = + check_length2_exn "Array.exists2_exn" t1 t2; + let i = ref (length t1 - 1) in + let result = ref false in + while !i >= 0 && not !result do + if f (unsafe_get t1 !i) (unsafe_get t2 !i) then result := true else decr i + done; + !result +;; + +let for_all2_local_exn t1 t2 ~f = + check_length2_exn "Array.for_all2_exn" t1 t2; + let i = ref (length t1 - 1) in + let result = ref true in + while !i >= 0 && !result do + if not (f (unsafe_get t1 !i) (unsafe_get t2 !i)) then result := false else decr i + done; + !result +;; + +let for_all2_exn t1 t2 ~f = for_all2_local_exn t1 t2 ~f +let equal__local equal t1 t2 = length t1 = length t2 && for_all2_local_exn t1 t2 ~f:equal +let equal equal t1 t2 = equal__local equal t1 t2 + +let map_inplace t ~f = + for i = 0 to length t - 1 do + unsafe_set t i (f (unsafe_get t i)) + done +;; + +let[@inline always] findi_internal t ~f ~if_found ~if_not_found = + let length = length t in + if length = 0 + then if_not_found () + else ( + let i = ref 0 in + let found = ref false in + let value_found = ref (unsafe_get t 0) in + while (not !found) && !i < length do + let value = unsafe_get t !i in + if f !i value + then ( + value_found := value; + found := true) + else incr i + done; + if !found then if_found ~i:!i ~value:!value_found else if_not_found ()) +;; + +let findi t ~f = + findi_internal + t + ~f + ~if_found:(fun ~i ~value -> Some (i, value)) + ~if_not_found:(fun () -> None) +;; + +let findi_exn t ~f = + findi_internal + t + ~f + ~if_found:(fun ~i ~value -> i, value) + ~if_not_found:(fun () -> raise (Not_found_s (Atom "Array.findi_exn: not found"))) +;; + +let find_exn t ~f = + findi_internal + t + ~f:(fun _i x -> f x) + ~if_found:(fun ~i:_ ~value -> value) + ~if_not_found:(fun () -> raise (Not_found_s (Atom "Array.find_exn: not found"))) + [@nontail] +;; + +let find t ~f = Option.map (findi t ~f:(fun _i x -> f x)) ~f:(fun (_i, x) -> x) + +let find_map t ~f = + let length = length t in + if length = 0 + then None + else ( + let i = ref 0 in + let value_found = ref None in + while Option.is_none !value_found && !i < length do + let value = unsafe_get t !i in + value_found := f value; + incr i + done; + !value_found) +;; + +let find_map_exn = + let not_found = Not_found_s (Atom "Array.find_map_exn: not found") in + let find_map_exn t ~f = + match find_map t ~f with + | None -> raise not_found + | Some x -> x + in + (* named to preserve symbol in compiled binary *) + find_map_exn +;; + +let find_mapi t ~f = + let length = length t in + if length = 0 + then None + else ( + let i = ref 0 in + let value_found = ref None in + while Option.is_none !value_found && !i < length do + let value = unsafe_get t !i in + value_found := f !i value; + incr i + done; + !value_found) +;; + +let find_mapi_exn = + let not_found = Not_found_s (Atom "Array.find_mapi_exn: not found") in + let find_mapi_exn t ~f = + match find_mapi t ~f with + | None -> raise not_found + | Some x -> x + in + (* named to preserve symbol in compiled binary *) + find_mapi_exn +;; + +let find_consecutive_duplicate t ~equal = + let n = length t in + if n <= 1 + then None + else ( + let result = ref None in + let i = ref 1 in + let prev = ref (unsafe_get t 0) in + while !i < n do + let cur = unsafe_get t !i in + if equal cur !prev + then ( + result := Some (!prev, cur); + i := n) + else ( + prev := cur; + incr i) + done; + !result) +;; + +let reduce t ~f = + if length t = 0 + then None + else ( + let r = ref (unsafe_get t 0) in + for i = 1 to length t - 1 do + r := f !r (unsafe_get t i) + done; + Some !r) +;; + +let reduce_exn t ~f = + match reduce t ~f with + | None -> invalid_arg "Array.reduce_exn" + | Some v -> v +;; + +let permute = Array_permute.permute + +let random_element_exn ?(random_state = Random.State.default) t = + if is_empty t + then failwith "Array.random_element_exn: empty array" + else t.(Random.State.int random_state (length t)) +;; + +let random_element ?(random_state = Random.State.default) t = + try Some (random_element_exn ~random_state t) with + | _ -> None +;; + +let zip t1 t2 = + if length t1 <> length t2 then None else Some (map2_exn t1 t2 ~f:(fun x1 x2 -> x1, x2)) +;; + +let zip_exn t1 t2 = + if length t1 <> length t2 + then failwith "Array.zip_exn" + else map2_exn t1 t2 ~f:(fun x1 x2 -> x1, x2) +;; + +let unzip t = + let n = length t in + if n = 0 + then [||], [||] + else ( + let x, y = t.(0) in + let res1 = create ~len:n x in + let res2 = create ~len:n y in + for i = 1 to n - 1 do + let x, y = t.(i) in + res1.(i) <- x; + res2.(i) <- y + done; + res1, res2) +;; + +let sorted_copy t ~compare = + let t1 = copy t in + sort t1 ~compare; + t1 +;; + +let partition_mapi t ~f = + let (both : _ Either.t t) = mapi t ~f in + let firsts = + filter_map both ~f:(function + | First x -> Some x + | Second _ -> None) + in + let seconds = + filter_map both ~f:(function + | First _ -> None + | Second x -> Some x) + in + firsts, seconds +;; + +let partitioni_tf t ~f = + partition_mapi t ~f:(fun i x -> if f i x then First x else Second x) [@nontail] +;; + +let partition_map t ~f = partition_mapi t ~f:(fun _ x -> f x) [@nontail] +let partition_tf t ~f = partitioni_tf t ~f:(fun _ x -> f x) [@nontail] +let last t = t.(length t - 1) + +(* Convert to a sequence but does not attempt to protect against modification + in the array. *) +let to_sequence_mutable t = + Sequence.unfold_step ~init:0 ~f:(fun i -> + if i >= length t + then Sequence.Step.Done + else Sequence.Step.Yield { value = t.(i); state = i + 1 }) +;; + +let to_sequence t = to_sequence_mutable (copy t) + +let cartesian_product t1 t2 = + if is_empty t1 || is_empty t2 + then [||] + else ( + let n1 = length t1 in + let n2 = length t2 in + let t = create ~len:(n1 * n2) (t1.(0), t2.(0)) in + let r = ref 0 in + for i1 = 0 to n1 - 1 do + for i2 = 0 to n2 - 1 do + t.(!r) <- t1.(i1), t2.(i2); + incr r + done + done; + t) +;; + +let transpose tt = + if length tt = 0 + then Some [||] + else ( + let width = length tt in + let depth = length tt.(0) in + if exists tt ~f:(fun t -> length t <> depth) + then None + else Some (init depth ~f:(fun d -> init width ~f:(fun w -> tt.(w).(d))))) +;; + +let transpose_exn tt = + match transpose tt with + | None -> invalid_arg "Array.transpose_exn" + | Some tt' -> tt' +;; + +include Binary_searchable.Make1 (struct + type nonrec 'a t = 'a t + + let get = get + let length = length +end) + +include Blit.Make1 (struct + type nonrec 'a t = 'a t + + let length = length + + let create_like ~len t = + if len = 0 + then [||] + else ( + assert (length t > 0); + create ~len t.(0)) + ;; + + let unsafe_blit = unsafe_blit +end) + +let invariant invariant_a t = iter t ~f:invariant_a + +module Private = struct + module Sort = Sort + module Sorter = Sorter +end diff --git a/unikernel/duniverse/base/src/array.mli b/unikernel/duniverse/base/src/array.mli new file mode 100644 index 00000000..35e42aaf --- /dev/null +++ b/unikernel/duniverse/base/src/array.mli @@ -0,0 +1,314 @@ +(** Fixed-length, mutable vector of elements with O(1) [get] and [set] operations. *) + +open! Import + +type 'a t = 'a array [@@deriving_inline compare ~localize, globalize, sexp, sexp_grammar] + +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + +val globalize : ('a -> 'a) -> 'a t -> 'a t + +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Binary_searchable.S1 with type 'a t := 'a t +include Indexed_container.S1_with_creators with type 'a t := 'a t +include Invariant.S1 with type 'a t := 'a t + +(** Maximum length of a normal array. The maximum length of a float array is + [max_length/2] on 32-bit machines and [max_length] on 64-bit machines. *) +val max_length : int + +(*_ Declared as externals so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) + +external length : ('a t[@local_opt]) -> int = "%array_length" + +(** [Array.get a n] returns the element number [n] of array [a]. + The first element has number 0. + The last element has number [Array.length a - 1]. + You can also write [a.(n)] instead of [Array.get a n]. + + Raise [Invalid_argument "index out of bounds"] + if [n] is outside the range 0 to [(Array.length a - 1)]. *) +external get : ('a t[@local_opt]) -> (int[@local_opt]) -> 'a = "%array_safe_get" + +(** [Array.set a n x] modifies array [a] in place, replacing + element number [n] with [x]. + You can also write [a.(n) <- x] instead of [Array.set a n x]. + + Raise [Invalid_argument "index out of bounds"] + if [n] is outside the range 0 to [Array.length a - 1]. *) +external set : ('a t[@local_opt]) -> (int[@local_opt]) -> 'a -> unit = "%array_safe_set" + +(** Unsafe version of [get]. Can cause arbitrary behavior when used for an out-of-bounds + array access. *) +external unsafe_get : ('a t[@local_opt]) -> (int[@local_opt]) -> 'a = "%array_unsafe_get" + +(** Unsafe version of [set]. Can cause arbitrary behavior when used for an out-of-bounds + array access. *) +external unsafe_set + : ('a t[@local_opt]) + -> (int[@local_opt]) + -> 'a + -> unit + = "%array_unsafe_set" + +(** [create ~len x] creates an array of length [len] with the value [x] populated in + each element. *) +val create : len:int -> 'a -> 'a t + +(** [create_local ~len x] is like [create]. It allocates the array on the local stack. The + array's elements are still global. *) +val create_local : len:int -> 'a -> 'a t + +(** [create_float_uninitialized ~len] creates a float array of length [len] with + uninitialized elements -- that is, they may contain arbitrary, nondeterministic float + values. This can be significantly faster than using [create], when unboxed float array + representations are enabled. *) +val create_float_uninitialized : len:int -> float t + +(** [Array.make_matrix dimx dimy e] returns a two-dimensional array (an array of arrays) + with first dimension [dimx] and second dimension [dimy]. All the elements of this new + matrix are initially physically equal to [e]. The element ([x,y]) of a matrix [m] is + accessed with the notation [m.(x).(y)]. + + Raise [Invalid_argument] if [dimx] or [dimy] is negative or greater than + [Array.max_length]. + + If the value of [e] is a floating-point number, then the maximum size is only + [Array.max_length / 2]. *) +val make_matrix : dimx:int -> dimy:int -> 'a -> 'a t t + +(** [Array.copy_matrix t] returns a fresh copy of the array of arrays [t]. This is + typically used when [t] is a matrix created by [Array.make_matrix]. *) +val copy_matrix : 'a t t -> 'a t t + +(** Like [Array.append], but concatenates a list of arrays. *) +val concat : 'a t list -> 'a t + +(** [Array.copy a] returns a copy of [a], that is, a fresh array + containing the same elements as [a]. *) +val copy : 'a t -> 'a t + +(** [Array.fill a ofs len x] modifies the array [a] in place, storing [x] in elements + number [ofs] to [ofs + len - 1]. + + Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not designate a valid + subarray of [a]. *) +val fill : 'a t -> pos:int -> len:int -> 'a -> unit + +(** [Array.blit v1 o1 v2 o2 len] copies [len] elements from array [v1], starting at + element number [o1], to array [v2], starting at element number [o2]. It works + correctly even if [v1] and [v2] are the same array, and the source and destination + chunks overlap. + + Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not designate a valid + subarray of [v1], or if [o2] and [len] do not designate a valid subarray of [v2]. + + [int_blit] and [float_blit] provide fast bound-checked blits for immediate + data types. The unsafe versions do not bound-check the arguments. *) +include Blit.S1 with type 'a t := 'a t + +(** [folding_map] is a version of [map] that threads an accumulator through calls to + [f]. *) +val folding_map : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc * 'b) -> 'b t + +val folding_mapi : 'a t -> init:'acc -> f:(int -> 'acc -> 'a -> 'acc * 'b) -> 'b t + +(** [Array.fold_map] is a combination of [Array.fold] and [Array.map] that threads an + accumulator through calls to [f]. *) +val fold_map : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc * 'b) -> 'acc * 'b t + +val fold_mapi : 'a t -> init:'acc -> f:(int -> 'acc -> 'a -> 'acc * 'b) -> 'acc * 'b t + +(** [Array.fold_right f a ~init] computes [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))], + where [n] is the length of the array [a]. *) +val fold_right : 'a t -> f:('a -> 'acc -> 'acc) -> init:'acc -> 'acc + +(** All sort functions in this module sort in increasing order by default. *) + +(** [sort] uses constant heap space. [stable_sort] uses linear heap space. + + To sort only part of the array, specify [pos] to be the index to start sorting from + and [len] indicating how many elements to sort. *) +val sort : ?pos:int -> ?len:int -> 'a t -> compare:('a -> 'a -> int) -> unit + +val stable_sort : 'a t -> compare:('a -> 'a -> int) -> unit +val is_sorted : 'a t -> compare:('a -> 'a -> int) -> bool + +(** [is_sorted_strictly xs ~compare] iff [is_sorted xs ~compare] and no two + consecutive elements in [xs] are equal according to [compare]. *) +val is_sorted_strictly : 'a t -> compare:('a -> 'a -> int) -> bool + +(** Merges two arrays: assuming that [a1] and [a2] are sorted according to the comparison + function [compare], [merge a1 a2 ~compare] will return a sorted array containing all + the elements of [a1] and [a2]. If several elements compare equal, the elements of [a1] + will be before the elements of [a2]. *) +val merge : 'a t -> 'a t -> compare:('a -> 'a -> int) -> 'a t + +val partitioni_tf : 'a t -> f:(int -> 'a -> bool) -> 'a t * 'a t +val cartesian_product : 'a t -> 'b t -> ('a * 'b) t + +(** [transpose] in the sense of a matrix transpose. It returns [None] if the arrays are + not all the same length. *) +val transpose : 'a t t -> 'a t t option + +val transpose_exn : 'a t t -> 'a t t + +(** [filter_opt array] returns a new array where [None] entries are omitted and [Some x] + entries are replaced with [x]. Note that this changes the index at which elements + will appear. *) +val filter_opt : 'a option t -> 'a t + +(** Functions with the 2 suffix raise an exception if the lengths of the two given arrays + aren't the same. *) + +val iter2_exn : 'a t -> 'b t -> f:('a -> 'b -> unit) -> unit +val map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t +val fold2_exn : 'a t -> 'b t -> init:'acc -> f:('acc -> 'a -> 'b -> 'acc) -> 'acc + +(** [for_all2_exn t1 t2 ~f] fails if [length t1 <> length t2]. *) +val for_all2_exn : 'a t -> 'b t -> f:('a -> 'b -> bool) -> bool + +(** [exists2_exn t1 t2 ~f] fails if [length t1 <> length t2]. *) +val exists2_exn : 'a t -> 'b t -> f:('a -> 'b -> bool) -> bool + +(** [swap arr i j] swaps the value at index [i] with that at index [j]. *) +val swap : 'a t -> int -> int -> unit + +(** [rev_inplace t] reverses [t] in place. *) +val rev_inplace : 'a t -> unit + +(** [rev t] returns a reversed copy of [t] *) +val rev : 'a t -> 'a t + +(** [of_list_rev l] converts from list then reverses in place. *) +val of_list_rev : 'a list -> 'a t + +(** [of_list_map l ~f] is the same as [of_list (List.map l ~f)]. *) +val of_list_map : 'a list -> f:('a -> 'b) -> 'b t + +(** [of_list_mapi l ~f] is the same as [of_list (List.mapi l ~f)]. *) +val of_list_mapi : 'a list -> f:(int -> 'a -> 'b) -> 'b t + +(** [of_list_rev_map l ~f] is the same as [of_list (List.rev_map l ~f)]. *) +val of_list_rev_map : 'a list -> f:('a -> 'b) -> 'b t + +(** [of_list_rev_mapi l ~f] is the same as [of_list (List.rev_mapi l ~f)]. *) +val of_list_rev_mapi : 'a list -> f:(int -> 'a -> 'b) -> 'b t + +(** Modifies an array in place, applying [f] to every element of the array *) +val map_inplace : 'a t -> f:('a -> 'a) -> unit + +(** [find_exn f t] returns the first [a] in [t] for which [f t.(i)] is true. It raises + [Stdlib.Not_found] or [Not_found_s] if there is no such [a]. *) +val find_exn : 'a t -> f:('a -> bool) -> 'a + +(** Returns the first evaluation of [f] that returns [Some]. Raises [Stdlib.Not_found] or + [Not_found_s] if [f] always returns [None]. *) +val find_map_exn : 'a t -> f:('a -> 'b option) -> 'b + +(** [findi_exn t f] returns the first index [i] of [t] for which [f i t.(i)] is true. It + raises [Stdlib.Not_found] or [Not_found_s] if there is no such element. *) +val findi_exn : 'a t -> f:(int -> 'a -> bool) -> int * 'a + +(** [find_mapi_exn] is like [find_map_exn] but passes the index as an argument. *) +val find_mapi_exn : 'a t -> f:(int -> 'a -> 'b option) -> 'b + +(** [find_consecutive_duplicate t ~equal] returns the first pair of consecutive elements + [(a1, a2)] in [t] such that [equal a1 a2]. They are returned in the same order as + they appear in [t]. *) +val find_consecutive_duplicate : 'a t -> equal:('a -> 'a -> bool) -> ('a * 'a) option + +(** [reduce f [a1; ...; an]] is [Some (f (... (f (f a1 a2) a3) ...) an)]. Returns [None] + on the empty array. *) +val reduce : 'a t -> f:('a -> 'a -> 'a) -> 'a option + +val reduce_exn : 'a t -> f:('a -> 'a -> 'a) -> 'a + +(** [permute ?random_state ?pos ?len t] randomly permutes [t] in place. + + To permute only part of the array, specify [pos] to be the index to start permuting + from and [len] indicating how many elements to permute. + + [permute] side-effects [random_state] by repeated calls to [Random.State.int]. If + [random_state] is not supplied, [permute] uses [Random.State.default]. *) +val permute : ?random_state:Random.State.t -> ?pos:int -> ?len:int -> 'a t -> unit + +(** [random_element ?random_state t] is [None] if [t] is empty, else it is [Some x] for + some [x] chosen uniformly at random from [t]. + + [random_element] side-effects [random_state] by calling [Random.State.int]. If + [random_state] is not supplied, [random_element] uses [Random.State.default]. *) +val random_element : ?random_state:Random.State.t -> 'a t -> 'a option + +val random_element_exn : ?random_state:Random.State.t -> 'a t -> 'a + +(** [zip] is like [List.zip], but for arrays. *) +val zip : 'a t -> 'b t -> ('a * 'b) t option + +val zip_exn : 'a t -> 'b t -> ('a * 'b) t + +(** [unzip] is like [List.unzip], but for arrays. *) +val unzip : ('a * 'b) t -> 'a t * 'b t + +(** [sorted_copy ar compare] returns a shallow copy of [ar] that is sorted. Similar to + List.sort *) +val sorted_copy : 'a t -> compare:('a -> 'a -> int) -> 'a t + +val last : 'a t -> 'a +val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool +val equal__local : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + +(** The input array is copied internally so that future modifications of it do not change + the sequence. *) +val to_sequence : 'a t -> 'a Sequence.t + +(** The input array is shared with the sequence and modifications of it will result in + modification of the sequence. *) +val to_sequence_mutable : 'a t -> 'a Sequence.t + +(**/**) + +(*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) +module Private : sig + module Sort : sig + module type Sort = sig + val sort : 'a t -> compare:('a -> 'a -> int) -> left:int -> right:int -> unit + end + + module Insertion_sort : Sort + module Heap_sort : Sort + + module Intro_sort : sig + include Sort + + val five_element_sort + : 'a t + -> compare:('a -> 'a -> int) + -> int + -> int + -> int + -> int + -> int + -> unit + end + end + + module Sorter (S : sig + type 'a t + + val get : 'a t -> int -> 'a + val set : 'a t -> int -> 'a -> unit + val length : 'a t -> int + end) : sig + val sort : ?pos:int -> ?len:int -> 'a S.t -> compare:('a -> 'a -> int) -> unit + end +end diff --git a/unikernel/duniverse/base/src/array0.ml b/unikernel/duniverse/base/src/array0.ml new file mode 100644 index 00000000..6acb31e0 --- /dev/null +++ b/unikernel/duniverse/base/src/array0.ml @@ -0,0 +1,156 @@ +(* [Array0] defines array functions that are primitives or can be simply defined in terms + of [Stdlib.Array]. [Array0] is intended to completely express the part of [Stdlib.Array] + that [Base] uses -- no other file in Base other than array0.ml should use [Stdlib.Array]. + [Array0] has few dependencies, and so is available early in Base's build order. All + Base files that need to use arrays and come before [Base.Array] in build order should + do [module Array = Array0]. This includes uses of subscript syntax ([x.(i)], [x.(i) <- + e]), which the OCaml parser desugars into calls to [Array.get] and [Array.set]. + Defining [module Array = Array0] is also necessary because it prevents ocamldep from + mistakenly causing a file to depend on [Base.Array]. *) + +open! Import0 +module Sys = Sys0 + +let invalid_argf = Printf.invalid_argf + +module Array = struct + external create : int -> 'a -> 'a array = "caml_make_vect" + external create_local : int -> 'a -> 'a array = "caml_make_vect" + external create_float_uninitialized : int -> float array = "caml_make_float_vect" + external get : ('a array[@local_opt]) -> (int[@local_opt]) -> 'a = "%array_safe_get" + external length : ('a array[@local_opt]) -> int = "%array_length" + + external set + : ('a array[@local_opt]) + -> (int[@local_opt]) + -> 'a + -> unit + = "%array_safe_set" + + external unsafe_get + : ('a array[@local_opt]) + -> (int[@local_opt]) + -> 'a + = "%array_unsafe_get" + + external unsafe_set + : ('a array[@local_opt]) + -> (int[@local_opt]) + -> 'a + -> unit + = "%array_unsafe_set" + + external unsafe_blit + : src:('a array[@local_opt]) + -> src_pos:int + -> dst:('a array[@local_opt]) + -> dst_pos:int + -> len:int + -> unit + = "caml_array_blit" +end + +include Array + +let max_length = Sys.max_array_length + +let create ~len x = + try create len x with + | Invalid_argument _ -> invalid_argf "Array.create ~len:%d: invalid length" len () +;; + +let create_local ~len x = + try create_local len x with + | Invalid_argument _ -> invalid_argf "Array.create_local ~len:%d: invalid length" len () +;; + +let create_float_uninitialized ~len = + try create_float_uninitialized len with + | Invalid_argument _ -> + invalid_argf "Array.create_float_uninitialized ~len:%d: invalid length" len () +;; + +let append = Stdlib.Array.append +let blit = Stdlib.Array.blit +let concat = Stdlib.Array.concat +let copy = Stdlib.Array.copy +let fill = Stdlib.Array.fill + +let init len ~(f : _ -> _) = + if len = 0 + then [||] + else if len < 0 + then invalid_arg "Array.init" + else ( + let res = create ~len (f 0) in + for i = 1 to Int0.pred len do + unsafe_set res i (f i) + done; + res) +;; + +let make_matrix = Stdlib.Array.make_matrix +let of_list = Stdlib.Array.of_list +let sub = Stdlib.Array.sub +let to_list = Stdlib.Array.to_list + +let fold t ~init ~(f : _ -> _ -> _) = + let r = ref init in + for i = 0 to length t - 1 do + r := f !r (unsafe_get t i) + done; + !r +;; + +let fold_right t ~(f : _ -> _ -> _) ~init = + let r = ref init in + for i = length t - 1 downto 0 do + r := f (unsafe_get t i) !r + done; + !r +;; + +let iter t ~(f : _ -> _) = + for i = 0 to length t - 1 do + f (unsafe_get t i) + done +;; + +let iteri t ~(f : _ -> _ -> _) = + for i = 0 to length t - 1 do + f i (unsafe_get t i) + done +;; + +let map t ~(f : _ -> _) = + let len = length t in + if len = 0 + then [||] + else ( + let r = create ~len (f (unsafe_get t 0)) in + for i = 1 to len - 1 do + unsafe_set r i (f (unsafe_get t i)) + done; + r) +;; + +let mapi t ~(f : _ -> _ -> _) = + let len = length t in + if len = 0 + then [||] + else ( + let r = create ~len (f 0 (unsafe_get t 0)) in + for i = 1 to len - 1 do + unsafe_set r i (f i (unsafe_get t i)) + done; + r) +;; + +let stable_sort t ~compare = Stdlib.Array.stable_sort t ~cmp:compare + +let swap t i j = + let elt_i = t.(i) in + let elt_j = t.(j) in + unsafe_set t i elt_j; + unsafe_set t j elt_i +;; diff --git a/unikernel/duniverse/base/src/array_permute.ml b/unikernel/duniverse/base/src/array_permute.ml new file mode 100644 index 00000000..ea9a521a --- /dev/null +++ b/unikernel/duniverse/base/src/array_permute.ml @@ -0,0 +1,24 @@ +(** An internal-only module factored out due to a circular dependency between core_array + and core_list. Contains code for permuting an array. *) + +open! Import +include Array0 + +let permute ?(random_state = Random.State.default) ?(pos = 0) ?len t = + (* Copied from [Ordered_collection_common0] to avoid allocating a tuple when compiling + without flambda. *) + let total_length = length t in + let len = + match len with + | Some l -> l + | None -> total_length - pos + in + Ordered_collection_common0.check_pos_len_exn ~pos ~len ~total_length; + let num_swaps = len - 1 in + for i = num_swaps downto 1 do + let this_i = pos + i in + (* [random_i] is drawn from [pos,this_i] *) + let random_i = pos + Random.State.int random_state (i + 1) in + swap t this_i random_i + done +;; diff --git a/unikernel/duniverse/base/src/avltree.ml b/unikernel/duniverse/base/src/avltree.ml new file mode 100644 index 00000000..f89f2b06 --- /dev/null +++ b/unikernel/duniverse/base/src/avltree.ml @@ -0,0 +1,509 @@ +(* A few small things copied from other parts of Base because they depend on us, so we + can't use them. *) + +open! Import + +let raise_s = Error.raise_s + +module Int = struct + type t = int + + let max (x : t) y = if x > y then x else y +end + +(* Its important that Empty have no args. It's tempting to make this type a record + (e.g. to hold the compare function), but a lot of memory is saved by Empty being an + immediate, since all unused buckets in the hashtbl don't use any memory (besides the + array cell) *) +type ('k, 'v) t = + | Empty + | Node of + { mutable left : ('k, 'v) t + ; key : 'k + ; mutable value : 'v + ; mutable height : int + ; mutable right : ('k, 'v) t + } + | Leaf of + { key : 'k + ; mutable value : 'v + } + +let empty = Empty + +let is_empty = function + | Empty -> true + | Leaf _ | Node _ -> false +;; + +let height = function + | Empty -> 0 + | Leaf _ -> 1 + | Node { left = _; key = _; value = _; height; right = _ } -> height +;; + +let invariant compare = + let legal_left_key key = function + | Empty -> () + | Leaf { key = left_key; value = _ } + | Node { left = _; key = left_key; value = _; height = _; right = _ } -> + assert (compare left_key key < 0) + in + let legal_right_key key = function + | Empty -> () + | Leaf { key = right_key; value = _ } + | Node { left = _; key = right_key; value = _; height = _; right = _ } -> + assert (compare right_key key > 0) + in + let rec inv = function + | Empty | Leaf _ -> () + | Node { left; key = k; value = _; height = h; right } -> + let hl, hr = height left, height right in + inv left; + inv right; + legal_left_key k left; + legal_right_key k right; + assert (h = Int.max hl hr + 1); + assert (abs (hl - hr) <= 2) + in + inv +;; + +let invariant t ~compare = invariant compare t + +(* In the following comments, + 't is balanced' means that 'invariant t' does not + raise an exception. This implies of course that each node's height field is + correct. + 't is balanceable' means that height of the left and right subtrees of t + differ by at most 3. *) + +(* @pre: left and right subtrees have correct heights + @post: output has the correct height *) +let update_height = function + | Node ({ left; key = _; value = _; height = old_height; right } as x) -> + let new_height = Int.max (height left) (height right) + 1 in + if new_height <> old_height then x.height <- new_height + | Empty | Leaf _ -> assert false +;; + +(* @pre: left and right subtrees are balanced + @pre: tree is balanceable + @post: output is balanced (in particular, height is correct) *) +let balance tree = + match tree with + | Empty | Leaf _ -> tree + | Node ({ left; key = _; value = _; height = _; right } as root_node) -> + let hl = height left + and hr = height right in + (* + 2 is critically important, lowering it to 1 will break the Leaf + assumptions in the code below, and will force us to promote leaf nodes in + the balance routine. It's also faster, since it will balance less often. + Note that the following code is delicate. The update_height calls must + occur in the correct order, since update_height assumes its children have + the correct heights. *) + if hl > hr + 2 + then ( + match left with + (* It cannot be a leaf, because even if right is empty, a leaf + is only height 1 *) + | Empty | Leaf _ -> assert false + | Node + ({ left = left_node_left + ; key = _ + ; value = _ + ; height = _ + ; right = left_node_right + } as left_node) -> + if height left_node_left >= height left_node_right + then ( + root_node.left <- left_node_right; + left_node.right <- tree; + update_height tree; + update_height left; + left) + else ( + (* if right is a leaf, then left must be empty. That means + height is 2. Even if hr is empty we still can't get here. *) + match left_node_right with + | Empty | Leaf _ -> assert false + | Node + ({ left = lr_left; key = _; value = _; height = _; right = lr_right } as + lr_node) -> + left_node.right <- lr_left; + root_node.left <- lr_right; + lr_node.right <- tree; + lr_node.left <- left; + update_height left; + update_height tree; + update_height left_node_right; + left_node_right)) + else if hr > hl + 2 + then ( + (* see above for an explanation of why right cannot be a leaf *) + match right with + | Empty | Leaf _ -> assert false + | Node + ({ left = right_node_left + ; key = _ + ; value = _ + ; height = _ + ; right = right_node_right + } as right_node) -> + if height right_node_right >= height right_node_left + then ( + root_node.right <- right_node_left; + right_node.left <- tree; + update_height tree; + update_height right; + right) + else ( + (* see above for an explanation of why this cannot be a leaf *) + match right_node_left with + | Empty | Leaf _ -> assert false + | Node + ({ left = rl_left; key = _; value = _; height = _; right = rl_right } as + rl_node) -> + right_node.left <- rl_right; + root_node.right <- rl_left; + rl_node.left <- tree; + rl_node.right <- right; + update_height right; + update_height tree; + update_height right_node_left; + right_node_left)) + else ( + update_height tree; + tree) +;; + +(* @pre: t is balanced. + @post: result is balanced, with new node inserted + @post: !added = true iff the shape of the input tree changed. *) +let rec add t ~replace ~compare ~added ~key:k ~data:v = + match t with + | Empty -> + added := true; + Leaf { key = k; value = v } + | Leaf ({ key = k'; value = _ } as r) -> + let c = compare k' k in + (* This compare is reversed on purpose, we are pretending + that the leaf was just inserted instead of the other way + round, that way we only allocate one node. *) + if c = 0 + then ( + added := false; + if replace then r.value <- v; + t) + else ( + added := true; + if c < 0 + then Node { left = t; key = k; value = v; height = 2; right = Empty } + else Node { left = Empty; key = k; value = v; height = 2; right = t }) + | Node ({ left; key = k'; value = _; height = _; right } as r) -> + let c = compare k k' in + if c = 0 + then ( + added := false; + if replace then r.value <- v; + t) + else ( + if c < 0 + then ( + let left' = add left ~replace ~added ~compare ~key:k ~data:v in + if not (phys_equal left' left) then r.left <- left') + else ( + let right' = add right ~replace ~added ~compare ~key:k ~data:v in + if not (phys_equal right' right) then r.right <- right'); + if !added then balance t else t) +;; + +let rec first t = + match t with + | Empty -> None + | Leaf { key = k; value = v } + | Node { left = Empty; key = k; value = v; height = _; right = _ } -> Some (k, v) + | Node { left = l; key = _; value = _; height = _; right = _ } -> first l +;; + +let rec last t = + match t with + | Empty -> None + | Leaf { key = k; value = v } + | Node { left = _; key = k; value = v; height = _; right = Empty } -> Some (k, v) + | Node { left = _; key = _; value = _; height = _; right = r } -> last r +;; + +let[@inline always] rec findi_and_call_impl + t + ~compare + k + arg1 + arg2 + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found + = + match t with + | Empty -> call_if_not_found ~if_not_found k arg1 arg2 + | Leaf { key = k'; value = v } -> + if compare k k' = 0 + then call_if_found ~if_found ~key:k' ~data:v arg1 arg2 + else call_if_not_found ~if_not_found k arg1 arg2 + | Node { left; key = k'; value = v; height = _; right } -> + let c = compare k k' in + if c = 0 + then call_if_found ~if_found ~key:k' ~data:v arg1 arg2 + else + findi_and_call_impl + (if c < 0 then left else right) + ~compare + k + arg1 + arg2 + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found +;; + +let find_and_call = + let call_if_found ~if_found ~key:_ ~data () () = if_found data in + let call_if_not_found ~if_not_found key () () = if_not_found key in + fun t ~compare k ~if_found ~if_not_found -> + findi_and_call_impl + t + ~compare + k + () + () + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found +;; + +let findi_and_call = + let call_if_found ~if_found ~key ~data () () = if_found ~key ~data in + let call_if_not_found ~if_not_found key () () = if_not_found key in + fun t ~compare k ~if_found ~if_not_found -> + findi_and_call_impl + t + ~compare + k + () + () + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found +;; + +let find_and_call1 = + let call_if_found ~if_found ~key:_ ~data arg () = if_found data arg in + let call_if_not_found ~if_not_found key arg () = if_not_found key arg in + fun t ~compare k ~a ~if_found ~if_not_found -> + findi_and_call_impl + t + ~compare + k + a + () + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found +;; + +let findi_and_call1 = + let call_if_found ~if_found ~key ~data arg () = if_found ~key ~data arg in + let call_if_not_found ~if_not_found key arg () = if_not_found key arg in + fun t ~compare k ~a ~if_found ~if_not_found -> + findi_and_call_impl + t + ~compare + k + a + () + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found +;; + +let find_and_call2 = + let call_if_found ~if_found ~key:_ ~data arg1 arg2 = if_found data arg1 arg2 in + let call_if_not_found ~if_not_found key arg1 arg2 = if_not_found key arg1 arg2 in + fun t ~compare k ~a ~b ~if_found ~if_not_found -> + findi_and_call_impl + t + ~compare + k + a + b + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found +;; + +let findi_and_call2 = + let call_if_found ~if_found ~key ~data arg1 arg2 = if_found ~key ~data arg1 arg2 in + let call_if_not_found ~if_not_found key arg1 arg2 = if_not_found key arg1 arg2 in + fun t ~compare k ~a ~b ~if_found ~if_not_found -> + findi_and_call_impl + t + ~compare + k + a + b + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found +;; + +let find = + let if_found v = Some v in + let if_not_found _ = None in + fun t ~compare k -> find_and_call t ~compare k ~if_found ~if_not_found +;; + +let mem = + let if_found _ = true in + let if_not_found _ = false in + fun t ~compare k -> find_and_call t ~compare k ~if_found ~if_not_found +;; + +let rec remove = + let rec min_elt tree = + match tree with + | Empty -> Empty + | Leaf _ -> tree + | Node { left = Empty; key = _; value = _; height = _; right = _ } -> tree + | Node { left; key = _; value = _; height = _; right = _ } -> min_elt left + in + let rec remove_min_elt tree = + match tree with + | Empty -> assert false + | Leaf _ -> Empty + | Node { left = Empty; key = _; value = _; height = _; right } -> right + | Node { left = Leaf _; key = k; value = v; height = _; right = Empty } -> + Leaf { key = k; value = v } + | Node ({ left; key = _; value = _; height = _; right = _ } as r) -> + r.left <- remove_min_elt left; + balance tree + in + let merge t1 t2 = + match t1, t2 with + | Empty, t -> t + | t, Empty -> t + | _, _ -> + let tree = min_elt t2 in + balance + (match tree with + | Empty -> assert false + | Leaf { key = k; value = v } -> + let t2 = remove_min_elt t2 in + Node + { left = t1 + ; key = k + ; value = v + ; height = Int.max (height t1) (height t2) + 1 + ; right = t2 + } + | Node r -> + r.right <- remove_min_elt t2; + r.left <- t1; + tree) + in + fun t ~removed ~compare k -> + match t with + | Empty -> + removed := false; + Empty + | Leaf { key = k'; value = _ } -> + if compare k k' = 0 + then ( + removed := true; + Empty) + else ( + removed := false; + t) + | Node ({ left; key = k'; value = _; height = _; right } as r) -> + let c = compare k k' in + if c = 0 + then ( + removed := true; + merge left right) + else ( + if c < 0 + then ( + let left' = remove left ~removed ~compare k in + if not (phys_equal left' left) then r.left <- left') + else ( + let right' = remove right ~removed ~compare k in + if not (phys_equal right' right) then r.right <- right'); + if !removed then balance t else t) +;; + +let rec fold t ~init ~f = + match t with + | Empty -> init + | Leaf { key; value = data } -> f ~key ~data init + | Node + { left = Leaf { key = lkey; value = ldata } + ; key + ; value = data + ; height = _ + ; right = Leaf { key = rkey; value = rdata } + } -> f ~key:rkey ~data:rdata (f ~key ~data (f ~key:lkey ~data:ldata init)) + | Node + { left = Leaf { key = lkey; value = ldata } + ; key + ; value = data + ; height = _ + ; right = Empty + } -> f ~key ~data (f ~key:lkey ~data:ldata init) + | Node + { left = Empty + ; key + ; value = data + ; height = _ + ; right = Leaf { key = rkey; value = rdata } + } -> f ~key:rkey ~data:rdata (f ~key ~data init) + | Node + { left; key; value = data; height = _; right = Leaf { key = rkey; value = rdata } } + -> f ~key:rkey ~data:rdata (f ~key ~data (fold left ~init ~f)) + | Node + { left = Leaf { key = lkey; value = ldata }; key; value = data; height = _; right } + -> fold right ~init:(f ~key ~data (f ~key:lkey ~data:ldata init)) ~f + | Node { left; key; value = data; height = _; right } -> + fold right ~init:(f ~key ~data (fold left ~init ~f)) ~f +;; + +let rec iter t ~f = + match t with + | Empty -> () + | Leaf { key; value = data } -> f ~key ~data + | Node { left; key; value = data; height = _; right } -> + iter left ~f; + f ~key ~data; + iter right ~f +;; + +let rec mapi_inplace t ~f = + match t with + | Empty -> () + | Leaf ({ key; value } as t) -> t.value <- f ~key ~data:value + | Node ({ left; key; value; height = _; right } as t) -> + mapi_inplace ~f left; + t.value <- f ~key ~data:value; + mapi_inplace ~f right +;; + +let choose_exn = function + | Empty -> raise_s (Sexp.message "[Avltree.choose_exn] of empty hashtbl" []) + | Leaf { key; value; _ } | Node { key; value; _ } -> key, value +;; diff --git a/unikernel/duniverse/base/src/avltree.mli b/unikernel/duniverse/base/src/avltree.mli new file mode 100644 index 00000000..293410f3 --- /dev/null +++ b/unikernel/duniverse/base/src/avltree.mli @@ -0,0 +1,172 @@ +(** A low-level, mutable AVL tree. + + It is not intended to be used directly by casual users. It is used for implementing + other data structures. The interface is somewhat ugly, and it's that way for a + reason: the goal of this module is minimum memory overhead and maximum performance. + + {2 Caveats} + + 1. [compare] is passed to every function where it is used. If you pass a different + [compare] to functions on the same tree, then behavior is indeterminate. Why? Because + otherwise we'd need a top-level record to store [compare], and when building a hash + table, or other structure, that little [t] is a block that increases memory + overhead. However, if an empty tree is just a constructor [Empty], then it's just a + number, and uses no extra memory beyond the array bucket that holds it. That's the + first secret of how Hashtbl's memory overhead isn't higher than INRIA's, even though + it uses a tree instead of a list for buckets. + + 2. But if it's mutable, why do all the "mutators" return [t]? Answer: it is mutable, + but the root node might change due to balancing. Since we have no top-level record to + hold the current root node (see point 1), you have to do it. If you fail to do it, and + use an old root node, you're responsible for the (sure to be nasty) consequences. + + 3. What on earth is up with the [~removed] argument to some functions? See point 1: + since there is no top-level node, it isn't possible to keep track of how many nodes + are in the tree unless each mutator tells you whether or not it added or removed a + node (vs. replacing an existing one). If you intend to keep a count (as you must in a + hash table), then you will need to pay attention to this flag. + + After all this, you're probably asking yourself whether all these hacks are worth + it. Yes! They are! With them, we built a hash table that is faster than INRIA's (no + small feat) with the same memory overhead, sane add semantics (the add semantics they + used were a performance hack), and worst-case log(N) insertion, lookup, and + removal. *) + +open! Import + +(** We expose [t] to allow an optimization in Hashtbl that makes iter and fold more than + twice as fast. We keep the type private to reduce opportunities for external code to + violate avltree invariants. *) +type ('k, 'v) t = private + | Empty + | Node of + { mutable left : ('k, 'v) t + ; key : 'k + ; mutable value : 'v + ; mutable height : int + ; mutable right : ('k, 'v) t + } + | Leaf of + { key : 'k + ; mutable value : 'v + } + +val empty : ('k, 'v) t +val is_empty : _ t -> bool + +(** Checks invariants, raising an exception if any invariants fail. *) +val invariant : ('k, 'v) t -> compare:('k -> 'k -> int) -> unit + +(** Adds the specified key and data to the tree destructively (previous [t]'s are no + longer valid) using the specified comparison function. O(log(N)) time, O(1) space. + + The returned [t] is the new root node of the tree, and should be used on all further + calls to any other function in this module. The bool [ref], added, will be set to + [true] if a new node is added to the tree, or [false] if an existing node is replaced + (in the case that the key already exists). + + If [replace] (default true) is true then [add] will overwrite any existing mapping for + [key]. If [replace] is false, and there is an existing mapping for key, then [add] has + no effect. *) +val add + : ('k, 'v) t + -> replace:bool + -> compare:('k -> 'k -> int) + -> added:bool ref + -> key:'k + -> data:'v + -> ('k, 'v) t + +(** Returns the first (leftmost) or last (rightmost) element in the tree. *) + +val first : ('k, 'v) t -> ('k * 'v) option +val last : ('k, 'v) t -> ('k * 'v) option + +(** If the specified key exists in the tree, returns the corresponding value. O(log(N)) + time and O(1) space. *) +val find : ('k, 'v) t -> compare:('k -> 'k -> int) -> 'k -> 'v option + +(** [find_and_call t ~compare k ~if_found ~if_not_found] + + is equivalent to: + + [match find t ~compare k with Some v -> if_found v | None -> if_not_found k] + + except that it doesn't allocate the option. *) +val find_and_call + : ('k, 'v) t + -> compare:('k -> 'k -> int) + -> 'k + -> if_found:('v -> 'a) + -> if_not_found:('k -> 'a) + -> 'a + +val find_and_call1 + : ('k, 'v) t + -> compare:('k -> 'k -> int) + -> 'k + -> a:'a + -> if_found:('v -> 'a -> 'b) + -> if_not_found:('k -> 'a -> 'b) + -> 'b + +val find_and_call2 + : ('k, 'v) t + -> compare:('k -> 'k -> int) + -> 'k + -> a:'a + -> b:'b + -> if_found:('v -> 'a -> 'b -> 'c) + -> if_not_found:('k -> 'a -> 'b -> 'c) + -> 'c + +val findi_and_call + : ('k, 'v) t + -> compare:('k -> 'k -> int) + -> 'k + -> if_found:(key:'k -> data:'v -> 'a) + -> if_not_found:('k -> 'a) + -> 'a + +val findi_and_call1 + : ('k, 'v) t + -> compare:('k -> 'k -> int) + -> 'k + -> a:'a + -> if_found:(key:'k -> data:'v -> 'a -> 'b) + -> if_not_found:('k -> 'a -> 'b) + -> 'b + +val findi_and_call2 + : ('k, 'v) t + -> compare:('k -> 'k -> int) + -> 'k + -> a:'a + -> b:'b + -> if_found:(key:'k -> data:'v -> 'a -> 'b -> 'c) + -> if_not_found:('k -> 'a -> 'b -> 'c) + -> 'c + +(** Returns true if key is present in the tree, and false otherwise. *) +val mem : ('k, 'v) t -> compare:('k -> 'k -> int) -> 'k -> bool + +(** Removes key destructively from the tree if it exists, returning the new root node. + Previous root nodes are not usable anymore; do so at your peril. The [removed] ref + will be set to true if a node was actually removed, and false otherwise. *) +val remove + : ('k, 'v) t + -> removed:bool ref + -> compare:('k -> 'k -> int) + -> 'k + -> ('k, 'v) t + +(** Folds over the tree. *) +val fold : ('k, 'v) t -> init:'acc -> f:(key:'k -> data:'v -> 'acc -> 'acc) -> 'acc + +(** Iterates over the tree. *) +val iter : ('k, 'v) t -> f:(key:'k -> data:'v -> unit) -> unit + +(** Map over the the tree, changing the data in place. *) +val mapi_inplace : ('k, 'v) t -> f:(key:'k -> data:'v -> 'v) -> unit + +val choose_exn : ('k, 'v) t -> 'k * 'v diff --git a/unikernel/duniverse/base/src/backtrace.ml b/unikernel/duniverse/base/src/backtrace.ml new file mode 100644 index 00000000..abe60674 --- /dev/null +++ b/unikernel/duniverse/base/src/backtrace.ml @@ -0,0 +1,48 @@ +open! Import +module Sys = Sys0 + +type t = Stdlib.Printexc.raw_backtrace + +let elide = ref false +let elided_message = "" + +let get ?(at_most_num_frames = Int.max_value) () = + Stdlib.Printexc.get_callstack at_most_num_frames +;; + +let to_string t = + if !elide then elided_message else Stdlib.Printexc.raw_backtrace_to_string t +;; + +let to_string_list t = String.split_lines (to_string t) +let sexp_of_t t = Sexp.List (List.map (to_string_list t) ~f:(fun x -> Sexp.Atom x)) + +module Exn = struct + let set_recording = Stdlib.Printexc.record_backtrace + let am_recording = Stdlib.Printexc.backtrace_status + let most_recent () = Stdlib.Printexc.get_raw_backtrace () + + let most_recent_for_exn exn = + if Exn.is_phys_equal_most_recent exn then Some (most_recent ()) else None + ;; + + (* We turn on backtraces by default if OCAMLRUNPARAM doesn't explicitly mention them. *) + let maybe_set_recording () = + let ocamlrunparam_mentions_backtraces = + match Sys.getenv "OCAMLRUNPARAM" with + | None -> false + | Some x -> List.exists (String.split x ~on:',') ~f:(String.is_prefix ~prefix:"b") + in + if not ocamlrunparam_mentions_backtraces then set_recording true + ;; + + (* the caller set something, they are responsible *) + + let with_recording b ~f = + let saved = am_recording () in + set_recording b; + Exn.protect ~f ~finally:(fun () -> set_recording saved) + ;; +end + +let initialize_module () = Exn.maybe_set_recording () diff --git a/unikernel/duniverse/base/src/backtrace.mli b/unikernel/duniverse/base/src/backtrace.mli new file mode 100644 index 00000000..d63681c5 --- /dev/null +++ b/unikernel/duniverse/base/src/backtrace.mli @@ -0,0 +1,105 @@ +(** Module for managing stack backtraces. + + The [Backtrace] module deals with two different kinds of backtraces: + + + Snapshots of the stack obtained on demand ([Backtrace.get]) + + The stack frames unwound when an exception is raised ([Backtrace.Exn]) +*) + +open! Import + +(** A [Backtrace.t] is a snapshot of the stack obtained by calling [Backtrace.get]. It is + represented as a string with newlines separating the frames. [sexp_of_t] splits the + string at newlines and removes some of the cruft, leaving a human-friendly list of + frames, but [to_string] does not. *) +type t = Stdlib.Printexc.raw_backtrace [@@deriving_inline sexp_of] + +val sexp_of_t : t -> Sexplib0.Sexp.t + +[@@@end] + +val get : ?at_most_num_frames:int -> unit -> t +val to_string : t -> string +val to_string_list : t -> string list + +(** The value of [elide] controls the behavior of backtrace serialization functions such + as {!to_string}, {!to_string_list}, and {!sexp_of_t}. When set to [false], these + functions behave as expected, returning a faithful representation of their argument. + When set to [true], these functions will ignore their argument and return a message + indicating that behavior. + + The default value is [false]. *) +val elide : bool ref + +(** [Backtrace.Exn] has functions for controlling and printing the backtrace of the most + recently raised exception. + + When an exception is raised, the runtime "unwinds" the stack, i.e., removes stack + frames, until it reaches a frame with an exception handler. It then matches the + exception against the patterns in the handler. If the exception matches, then the + program continues. If not, then the runtime continues unwinding the stack to the next + handler. + + If [am_recording () = true], then while the runtime is unwinding the stack, it keeps + track of the part of the stack that is unwound. This is available as a backtrace via + [most_recent ()]. Calling [most_recent] if [am_recording () = false] will yield the + empty backtrace. + + With [am_recording () = true], OCaml keeps only a backtrace for the most recently + raised exception. When one raises an exception, OCaml checks if it is physically equal + to the most recently raised exception. If it is, then OCaml appends the string + representation of the stack unwound by the current raise to the stored backtrace. If + the exception being raised is not physically equally to the most recently raised + exception, then OCaml starts recording a new backtrace. Thus one must call + [most_recent] before a subsequent [raise] of a (physically) distinct exception, or the + backtrace is lost. + + The initial value of [am_recording ()] is determined by the environment variable + OCAMLRUNPARAM. If OCAMLRUNPARAM is set and contains a "b" parameter, then + [am_recording ()] is set according to OCAMLRUNPARAM: true if "b" or "b=1" appears; + false if "b=0" appears. If OCAMLRUNPARAM is not set (as is always the case when + running in a web browser) or does not contain a "b" parameter, then [am_recording ()] + is initially true. + + This is the same functionality as provided by the OCaml stdlib [Printexc] functions + [backtrace_status], [record_backtraces], [get_backtrace]. *) +module Exn : sig + val am_recording : unit -> bool + val set_recording : bool -> unit + val with_recording : bool -> f:(unit -> 'a) -> 'a + + (** [most_recent ()] returns a backtrace containing the stack that was unwound by the + most recently raised exception. + + Normally this includes just the function calls that lead from the exception handler + being set up to the exception being raised. However, due to inlining, the stack + frame that has the exception handler may correspond to a chain of multiple function + calls. All of those function calls are then reported in this backtrace, even though + they are not themselves on the path from the exception handler to the "raise". *) + val most_recent : unit -> t + + (** [most_recent_for_exn exn] returns a backtrace containing the stack that was unwound + when raising [exn] if [exn] is the most recently raised exception. Otherwise it + returns [None]. + + Note that this may return a misleading backtrace instead of [None] if + different raise events happen to raise physically equal exceptions. + Consider the example below. Here if [e = Not_found] and [g] usees + [Not_found] internally then the backtrace will correspond to the + internal backtrace in [g] instead of the one used in [f], which is + not desirable. + + {[ + try f () with + | e -> + g (); + let bt = Backtrace.Exn.most_recent_for_exn e in + ... + ]} + *) + val most_recent_for_exn : Exn.t -> t option +end + +(** User code never calls this. It is called only in [base.ml], as a top-level side + effect, to initialize [am_recording ()] as specified above. *) +val initialize_module : unit -> unit diff --git a/unikernel/duniverse/base/src/base.ml b/unikernel/duniverse/base/src/base.ml new file mode 100644 index 00000000..bdc22337 --- /dev/null +++ b/unikernel/duniverse/base/src/base.ml @@ -0,0 +1,712 @@ +(** This module is the toplevel of the Base library; it's what you get when you write + [open Base]. + + The goal of Base is both to be a more complete standard library, with richer APIs, + and to be more consistent in its design. For instance, in the standard library + some things have modules and others don't; in Base, everything is a module. + + Base extends some modules and data structures from the standard library, like [Array], + [Buffer], [Bytes], [Char], [Hashtbl], [Int32], [Int64], [Lazy], [List], [Map], + [Nativeint], [Printf], [Random], [Set], [String], [Sys], and [Uchar]. One key + difference is that Base doesn't use exceptions as much as the standard library and + instead makes heavy use of the [Result] type, as in: + + {[ type ('a,'b) result = Ok of 'a | Error of 'b ]} + + Base also adds entirely new modules, most notably: + + - [Comparable], [Comparator], and [Comparisons] in lieu of polymorphic compare. + - [Container], which provides a consistent interface across container-like data + structures (arrays, lists, strings). + - [Result], [Error], and [Or_error], supporting the or-error pattern. +*) + +(*_ We hide this from the web docs because the line wrapping is bad, making it + pretty much inscrutable. *) +(**/**) + +(* The intent is to shadow all of INRIA's standard library. Modules below would cause + compilation errors without being removed from [Shadow_stdlib] before inclusion. *) + +include ( + Shadow_stdlib : + module type of struct + include Shadow_stdlib + end + (* Modules defined in Base *) + with module Array := Shadow_stdlib.Array + with module Atomic := Shadow_stdlib.Atomic + with module Bool := Shadow_stdlib.Bool + with module Buffer := Shadow_stdlib.Buffer + with module Bytes := Shadow_stdlib.Bytes + with module Char := Shadow_stdlib.Char + with module Condition := Shadow_stdlib.Condition + with module Either := Shadow_stdlib.Either + with module Float := Shadow_stdlib.Float + with module Hashtbl := Shadow_stdlib.Hashtbl + with module In_channel := Shadow_stdlib.In_channel + with module Int := Shadow_stdlib.Int + with module Int32 := Shadow_stdlib.Int32 + with module Int64 := Shadow_stdlib.Int64 + with module Lazy := Shadow_stdlib.Lazy + with module List := Shadow_stdlib.List + with module Map := Shadow_stdlib.Map + with module Nativeint := Shadow_stdlib.Nativeint + with module Option := Shadow_stdlib.Option + with module Out_channel := Shadow_stdlib.Out_channel + with module Printf := Shadow_stdlib.Printf + with module Queue := Shadow_stdlib.Queue + with module Random := Shadow_stdlib.Random + with module Result := Shadow_stdlib.Result + with module Set := Shadow_stdlib.Set + with module Semaphore := Shadow_stdlib.Semaphore + with module Stack := Shadow_stdlib.Stack + with module String := Shadow_stdlib.String + with module Sys := Shadow_stdlib.Sys + with module Uchar := Shadow_stdlib.Uchar + with module Unit := Shadow_stdlib.Unit + (* OCaml 5-related modules we don't want to start shadowing yet. *) + with module Domain := Shadow_stdlib.Domain + with module Type := Shadow_stdlib.Type + (* Support for generated lexers *) + with module Lexing := Shadow_stdlib.Lexing + with type ('a, 'b, 'c) format := ('a, 'b, 'c) format + with type ('a, 'b, 'c, 'd) format4 := ('a, 'b, 'c, 'd) format4 + with type ('a, 'b, 'c, 'd, 'e, 'f) format6 := ('a, 'b, 'c, 'd, 'e, 'f) format6 + with type 'a ref := 'a ref) +[@ocaml.warning "-3"] + +(**/**) + +open! Import +module Applicative = Applicative +module Array = Array +module Avltree = Avltree +module Backtrace = Backtrace +module Binary_search = Binary_search +module Binary_searchable = Binary_searchable +module Blit = Blit +module Bool = Bool +module Buffer = Buffer +module Bytes = Bytes +module Char = Char +module Comparable = Comparable +module Comparator = Comparator +module Comparisons = Comparisons +module Container = Container +module Either = Either +module Equal = Equal +module Error = Error +module Exn = Exn +module Field = Field +module Float = Float +module Floatable = Floatable +module Fn = Fn +module Formatter = Formatter +module Hash = Hash +module Hash_set = Hash_set +module Hashable = Hashable +module Hasher = Hasher +module Hashtbl = Hashtbl +module Identifiable = Identifiable +module Indexed_container = Indexed_container +module Info = Info +module Int = Int +module Int32 = Int32 +module Int63 = Int63 +module Int64 = Int64 +module Intable = Intable +module Int_math = Int_math +module Invariant = Invariant +module Dictionary_immutable = Dictionary_immutable +module Dictionary_mutable = Dictionary_mutable +module Lazy = Lazy +module List = List +module Map = Map +module Maybe_bound = Maybe_bound +module Monad = Monad +module Nativeint = Nativeint +module Nothing = Nothing +module Option = Option +module Option_array = Option_array +module Or_error = Or_error +module Ordered_collection_common = Ordered_collection_common +module Ordering = Ordering +module Poly = Poly +module Pretty_printer = Pretty_printer +module Printf = Printf +module Linked_queue = Linked_queue +module Queue = Queue +module Random = Random +module Ref = Ref +module Result = Result +module Sequence = Sequence +module Set = Set +module Sexpable = Sexpable +module Sign = Sign +module Sign_or_nan = Sign_or_nan +module Source_code_position = Source_code_position +module Stack = Stack +module Staged = Staged +module String = String +module Stringable = Stringable +module Sys = Sys +module T = T +module Type_equal = Type_equal +module Uniform_array = Uniform_array +module Unit = Unit +module Uchar = Uchar +module Variant = Variant +module With_return = With_return +module Word_size = Word_size + +(* Avoid a level of indirection for uses of the signatures defined in [T]. *) +include T + +(* This is a hack so that odoc creates better documentation. *) +module Sexp = struct + include Sexp_with_comparable (** @inline *) +end + +(* [Int_string_conversions] is separated from [Int_conversions] for dependency reasons, + but this separation is not important for clients. *) +module Int_conversions = struct + include Int_conversions + include Int_string_conversions +end + +(**/**) + +module Exported_for_specific_uses = struct + module Fieldslib = Fieldslib + module Globalize = Globalize + module Obj_local = Obj_local + module Ppx_compare_lib = Ppx_compare_lib + module Ppx_enumerate_lib = Ppx_enumerate_lib + module Ppx_hash_lib = Ppx_hash_lib + module Variantslib = Variantslib + + let am_testing = am_testing +end + +(**/**) + +module Export = struct + (* [deriving hash] is missing for [array] and [ref] since these types are mutable. *) + type 'a array = 'a Array.t + [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + + let compare_array__local : 'a. ('a -> 'a -> int) -> 'a array -> 'a array -> int = + Array.compare__local + ;; + + let compare_array : 'a. ('a -> 'a -> int) -> 'a array -> 'a array -> int = Array.compare + + let equal_array__local : 'a. ('a -> 'a -> bool) -> 'a array -> 'a array -> bool = + Array.equal__local + ;; + + let equal_array : 'a. ('a -> 'a -> bool) -> 'a array -> 'a array -> bool = Array.equal + + let globalize_array : 'a. ('a -> 'a) -> 'a array -> 'a array = + fun (type a__017_) : ((a__017_ -> a__017_) -> a__017_ array -> a__017_ array) -> + Array.globalize + ;; + + let array_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a array = + Array.t_of_sexp + ;; + + let sexp_of_array : 'a. ('a -> Sexplib0.Sexp.t) -> 'a array -> Sexplib0.Sexp.t = + Array.sexp_of_t + ;; + + let array_sexp_grammar : + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a array Sexplib0.Sexp_grammar.t + = + fun _'a_sexp_grammar -> Array.t_sexp_grammar _'a_sexp_grammar + ;; + + [@@@end] + + type bool = Bool.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_bool__local = (Bool.compare__local : bool -> bool -> int) + let compare_bool = (fun a b -> compare_bool__local a b : bool -> bool -> int) + let equal_bool__local = (Bool.equal__local : bool -> bool -> bool) + let equal_bool = (fun a b -> equal_bool__local a b : bool -> bool -> bool) + let (globalize_bool : bool -> bool) = (Bool.globalize : bool -> bool) + + let (hash_fold_bool : + Ppx_hash_lib.Std.Hash.state -> bool -> Ppx_hash_lib.Std.Hash.state) + = + Bool.hash_fold_t + + and (hash_bool : bool -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Bool.hash in + fun x -> func x + ;; + + let bool_of_sexp = (Bool.t_of_sexp : Sexplib0.Sexp.t -> bool) + let sexp_of_bool = (Bool.sexp_of_t : bool -> Sexplib0.Sexp.t) + let (bool_sexp_grammar : bool Sexplib0.Sexp_grammar.t) = Bool.t_sexp_grammar + + [@@@end] + + type char = Char.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_char__local = (Char.compare__local : char -> char -> int) + let compare_char = (fun a b -> compare_char__local a b : char -> char -> int) + let equal_char__local = (Char.equal__local : char -> char -> bool) + let equal_char = (fun a b -> equal_char__local a b : char -> char -> bool) + let (globalize_char : char -> char) = (Char.globalize : char -> char) + + let (hash_fold_char : + Ppx_hash_lib.Std.Hash.state -> char -> Ppx_hash_lib.Std.Hash.state) + = + Char.hash_fold_t + + and (hash_char : char -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Char.hash in + fun x -> func x + ;; + + let char_of_sexp = (Char.t_of_sexp : Sexplib0.Sexp.t -> char) + let sexp_of_char = (Char.sexp_of_t : char -> Sexplib0.Sexp.t) + let (char_sexp_grammar : char Sexplib0.Sexp_grammar.t) = Char.t_sexp_grammar + + [@@@end] + + type exn = Exn.t [@@deriving_inline sexp_of] + + let sexp_of_exn = (Exn.sexp_of_t : exn -> Sexplib0.Sexp.t) + + [@@@end] + + type float = Float.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_float__local = (Float.compare__local : float -> float -> int) + let compare_float = (fun a b -> compare_float__local a b : float -> float -> int) + let equal_float__local = (Float.equal__local : float -> float -> bool) + let equal_float = (fun a b -> equal_float__local a b : float -> float -> bool) + let (globalize_float : float -> float) = (Float.globalize : float -> float) + + let (hash_fold_float : + Ppx_hash_lib.Std.Hash.state -> float -> Ppx_hash_lib.Std.Hash.state) + = + Float.hash_fold_t + + and (hash_float : float -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Float.hash in + fun x -> func x + ;; + + let float_of_sexp = (Float.t_of_sexp : Sexplib0.Sexp.t -> float) + let sexp_of_float = (Float.sexp_of_t : float -> Sexplib0.Sexp.t) + let (float_sexp_grammar : float Sexplib0.Sexp_grammar.t) = Float.t_sexp_grammar + + [@@@end] + + type int = Int.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_int__local = (Int.compare__local : int -> int -> int) + let compare_int = (fun a b -> compare_int__local a b : int -> int -> int) + let equal_int__local = (Int.equal__local : int -> int -> bool) + let equal_int = (fun a b -> equal_int__local a b : int -> int -> bool) + let (globalize_int : int -> int) = (Int.globalize : int -> int) + + let (hash_fold_int : Ppx_hash_lib.Std.Hash.state -> int -> Ppx_hash_lib.Std.Hash.state) = + Int.hash_fold_t + + and (hash_int : int -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Int.hash in + fun x -> func x + ;; + + let int_of_sexp = (Int.t_of_sexp : Sexplib0.Sexp.t -> int) + let sexp_of_int = (Int.sexp_of_t : int -> Sexplib0.Sexp.t) + let (int_sexp_grammar : int Sexplib0.Sexp_grammar.t) = Int.t_sexp_grammar + + [@@@end] + + type int32 = Int32.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_int32__local = (Int32.compare__local : int32 -> int32 -> int) + let compare_int32 = (fun a b -> compare_int32__local a b : int32 -> int32 -> int) + let equal_int32__local = (Int32.equal__local : int32 -> int32 -> bool) + let equal_int32 = (fun a b -> equal_int32__local a b : int32 -> int32 -> bool) + let (globalize_int32 : int32 -> int32) = (Int32.globalize : int32 -> int32) + + let (hash_fold_int32 : + Ppx_hash_lib.Std.Hash.state -> int32 -> Ppx_hash_lib.Std.Hash.state) + = + Int32.hash_fold_t + + and (hash_int32 : int32 -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Int32.hash in + fun x -> func x + ;; + + let int32_of_sexp = (Int32.t_of_sexp : Sexplib0.Sexp.t -> int32) + let sexp_of_int32 = (Int32.sexp_of_t : int32 -> Sexplib0.Sexp.t) + let (int32_sexp_grammar : int32 Sexplib0.Sexp_grammar.t) = Int32.t_sexp_grammar + + [@@@end] + + type int64 = Int64.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_int64__local = (Int64.compare__local : int64 -> int64 -> int) + let compare_int64 = (fun a b -> compare_int64__local a b : int64 -> int64 -> int) + let equal_int64__local = (Int64.equal__local : int64 -> int64 -> bool) + let equal_int64 = (fun a b -> equal_int64__local a b : int64 -> int64 -> bool) + let (globalize_int64 : int64 -> int64) = (Int64.globalize : int64 -> int64) + + let (hash_fold_int64 : + Ppx_hash_lib.Std.Hash.state -> int64 -> Ppx_hash_lib.Std.Hash.state) + = + Int64.hash_fold_t + + and (hash_int64 : int64 -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Int64.hash in + fun x -> func x + ;; + + let int64_of_sexp = (Int64.t_of_sexp : Sexplib0.Sexp.t -> int64) + let sexp_of_int64 = (Int64.sexp_of_t : int64 -> Sexplib0.Sexp.t) + let (int64_sexp_grammar : int64 Sexplib0.Sexp_grammar.t) = Int64.t_sexp_grammar + + [@@@end] + + type 'a list = 'a List.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_list__local : 'a. ('a -> 'a -> int) -> 'a list -> 'a list -> int = + List.compare__local + ;; + + let compare_list : 'a. ('a -> 'a -> int) -> 'a list -> 'a list -> int = List.compare + + let equal_list__local : 'a. ('a -> 'a -> bool) -> 'a list -> 'a list -> bool = + List.equal__local + ;; + + let equal_list : 'a. ('a -> 'a -> bool) -> 'a list -> 'a list -> bool = List.equal + + let globalize_list : 'a. ('a -> 'a) -> 'a list -> 'a list = + fun (type a__078_) : ((a__078_ -> a__078_) -> a__078_ list -> a__078_ list) -> + List.globalize + ;; + + let hash_fold_list : + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a list + -> Ppx_hash_lib.Std.Hash.state + = + List.hash_fold_t + ;; + + let list_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a list = + List.t_of_sexp + ;; + + let sexp_of_list : 'a. ('a -> Sexplib0.Sexp.t) -> 'a list -> Sexplib0.Sexp.t = + List.sexp_of_t + ;; + + let list_sexp_grammar : + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a list Sexplib0.Sexp_grammar.t + = + fun _'a_sexp_grammar -> List.t_sexp_grammar _'a_sexp_grammar + ;; + + [@@@end] + + type nativeint = Nativeint.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_nativeint__local = + (Nativeint.compare__local : nativeint -> nativeint -> int) + ;; + + let compare_nativeint = + (fun a b -> compare_nativeint__local a b : nativeint -> nativeint -> int) + ;; + + let equal_nativeint__local = (Nativeint.equal__local : nativeint -> nativeint -> bool) + + let equal_nativeint = + (fun a b -> equal_nativeint__local a b : nativeint -> nativeint -> bool) + ;; + + let (globalize_nativeint : nativeint -> nativeint) = + (Nativeint.globalize : nativeint -> nativeint) + ;; + + let (hash_fold_nativeint : + Ppx_hash_lib.Std.Hash.state -> nativeint -> Ppx_hash_lib.Std.Hash.state) + = + Nativeint.hash_fold_t + + and (hash_nativeint : nativeint -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Nativeint.hash in + fun x -> func x + ;; + + let nativeint_of_sexp = (Nativeint.t_of_sexp : Sexplib0.Sexp.t -> nativeint) + let sexp_of_nativeint = (Nativeint.sexp_of_t : nativeint -> Sexplib0.Sexp.t) + + let (nativeint_sexp_grammar : nativeint Sexplib0.Sexp_grammar.t) = + Nativeint.t_sexp_grammar + ;; + + [@@@end] + + type 'a option = 'a Option.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_option__local : 'a. ('a -> 'a -> int) -> 'a option -> 'a option -> int = + Option.compare__local + ;; + + let compare_option : 'a. ('a -> 'a -> int) -> 'a option -> 'a option -> int = + Option.compare + ;; + + let equal_option__local : 'a. ('a -> 'a -> bool) -> 'a option -> 'a option -> bool = + Option.equal__local + ;; + + let equal_option : 'a. ('a -> 'a -> bool) -> 'a option -> 'a option -> bool = + Option.equal + ;; + + let globalize_option : 'a. ('a -> 'a) -> 'a option -> 'a option = + fun (type a__109_) : ((a__109_ -> a__109_) -> a__109_ option -> a__109_ option) -> + Option.globalize + ;; + + let hash_fold_option : + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a option + -> Ppx_hash_lib.Std.Hash.state + = + Option.hash_fold_t + ;; + + let option_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a option = + Option.t_of_sexp + ;; + + let sexp_of_option : 'a. ('a -> Sexplib0.Sexp.t) -> 'a option -> Sexplib0.Sexp.t = + Option.sexp_of_t + ;; + + let option_sexp_grammar : + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a option Sexplib0.Sexp_grammar.t + = + fun _'a_sexp_grammar -> Option.t_sexp_grammar _'a_sexp_grammar + ;; + + [@@@end] + + type 'a ref = 'a Ref.t + [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + + let compare_ref__local : 'a. ('a -> 'a -> int) -> 'a ref -> 'a ref -> int = + Ref.compare__local + ;; + + let compare_ref : 'a. ('a -> 'a -> int) -> 'a ref -> 'a ref -> int = Ref.compare + + let equal_ref__local : 'a. ('a -> 'a -> bool) -> 'a ref -> 'a ref -> bool = + Ref.equal__local + ;; + + let equal_ref : 'a. ('a -> 'a -> bool) -> 'a ref -> 'a ref -> bool = Ref.equal + + let globalize_ref : 'a. ('a -> 'a) -> 'a ref -> 'a ref = + fun (type a__134_) : ((a__134_ -> a__134_) -> a__134_ ref -> a__134_ ref) -> + Ref.globalize + ;; + + let ref_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a ref = + Ref.t_of_sexp + ;; + + let sexp_of_ref : 'a. ('a -> Sexplib0.Sexp.t) -> 'a ref -> Sexplib0.Sexp.t = + Ref.sexp_of_t + ;; + + let ref_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a ref Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> Ref.t_sexp_grammar _'a_sexp_grammar + ;; + + [@@@end] + + type string = String.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_string__local = (String.compare__local : string -> string -> int) + let compare_string = (fun a b -> compare_string__local a b : string -> string -> int) + let equal_string__local = (String.equal__local : string -> string -> bool) + let equal_string = (fun a b -> equal_string__local a b : string -> string -> bool) + let (globalize_string : string -> string) = (String.globalize : string -> string) + + let (hash_fold_string : + Ppx_hash_lib.Std.Hash.state -> string -> Ppx_hash_lib.Std.Hash.state) + = + String.hash_fold_t + + and (hash_string : string -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = String.hash in + fun x -> func x + ;; + + let string_of_sexp = (String.t_of_sexp : Sexplib0.Sexp.t -> string) + let sexp_of_string = (String.sexp_of_t : string -> Sexplib0.Sexp.t) + let (string_sexp_grammar : string Sexplib0.Sexp_grammar.t) = String.t_sexp_grammar + + [@@@end] + + type bytes = Bytes.t + [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + + let compare_bytes__local = (Bytes.compare__local : bytes -> bytes -> int) + let compare_bytes = (fun a b -> compare_bytes__local a b : bytes -> bytes -> int) + let equal_bytes__local = (Bytes.equal__local : bytes -> bytes -> bool) + let equal_bytes = (fun a b -> equal_bytes__local a b : bytes -> bytes -> bool) + let (globalize_bytes : bytes -> bytes) = (Bytes.globalize : bytes -> bytes) + let bytes_of_sexp = (Bytes.t_of_sexp : Sexplib0.Sexp.t -> bytes) + let sexp_of_bytes = (Bytes.sexp_of_t : bytes -> Sexplib0.Sexp.t) + let (bytes_sexp_grammar : bytes Sexplib0.Sexp_grammar.t) = Bytes.t_sexp_grammar + + [@@@end] + + type unit = Unit.t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + let compare_unit__local = (Unit.compare__local : unit -> unit -> int) + let compare_unit = (fun a b -> compare_unit__local a b : unit -> unit -> int) + let equal_unit__local = (Unit.equal__local : unit -> unit -> bool) + let equal_unit = (fun a b -> equal_unit__local a b : unit -> unit -> bool) + let (globalize_unit : unit -> unit) = (Unit.globalize : unit -> unit) + + let (hash_fold_unit : + Ppx_hash_lib.Std.Hash.state -> unit -> Ppx_hash_lib.Std.Hash.state) + = + Unit.hash_fold_t + + and (hash_unit : unit -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = Unit.hash in + fun x -> func x + ;; + + let unit_of_sexp = (Unit.t_of_sexp : Sexplib0.Sexp.t -> unit) + let sexp_of_unit = (Unit.sexp_of_t : unit -> Sexplib0.Sexp.t) + let (unit_sexp_grammar : unit Sexplib0.Sexp_grammar.t) = Unit.t_sexp_grammar + + [@@@end] + + (** Format stuff *) + + type nonrec ('a, 'b, 'c) format = ('a, 'b, 'c) format + type nonrec ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'd) format4 + type nonrec ('a, 'b, 'c, 'd, 'e, 'f) format6 = ('a, 'b, 'c, 'd, 'e, 'f) format6 + + (** List operators *) + + include List.Infix + + (** Int operators and comparisons *) + + include Int.O + include Int_replace_polymorphic_compare + + (** Float operators *) + + include Float.O_dot + + (* This is declared as an external to be optimized away in more contexts. *) + + (** Reverse application operator. [x |> g |> f] is equivalent to [f (g (x))]. *) + external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply" + + (** Application operator. [g @@ f @@ x] is equivalent to [g (f (x))]. *) + external ( @@ ) : (('a -> 'b)[@local_opt]) -> 'a -> 'b = "%apply" + + (** Boolean operations *) + + (* These need to be declared as an external to get the lazy behavior *) + external ( && ) : (bool[@local_opt]) -> (bool[@local_opt]) -> bool = "%sequand" + external ( || ) : (bool[@local_opt]) -> (bool[@local_opt]) -> bool = "%sequor" + external not : (bool[@local_opt]) -> bool = "%boolnot" + + (* This must be declared as an external for the warnings to work properly. *) + external ignore : (_[@local_opt]) -> unit = "%ignore" + + (** Common string operations *) + let ( ^ ) = String.( ^ ) + + (** Reference operations *) + + (* Declared as an externals so that the compiler skips the caml_modify when possible and + to keep reference unboxing working *) + external ( ! ) : ('a ref[@local_opt]) -> 'a = "%field0" + external ref : 'a -> ('a ref[@local_opt]) = "%makemutable" + external ( := ) : ('a ref[@local_opt]) -> 'a -> unit = "%setfield0" + + (** Pair operations *) + + let fst = fst + let snd = snd + + (** Exceptions stuff *) + + (* Declared as an external so that the compiler may rewrite '%raise' as '%reraise'. *) + external raise : exn -> _ = "%raise" + + let failwith = failwith + let invalid_arg = invalid_arg + let raise_s = Error.raise_s + + (** Misc *) + + external phys_equal : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%eq" + external force : ('a Lazy.t[@local_opt]) -> 'a = "%lazy_force" +end + +include Export + +include Container_intf.Export (** @inline *) + +exception Not_found_s = Not_found_s + +(* We perform these side effects here because we want them to run for any code that uses + [Base]. If this were in another module in [Base] that was not used in some program, + then the side effects might not be run in that program. This will run as long as the + program refers to at least one value directly in [Base]; referring to values in + [Base.Bool], for example, is not sufficient. *) +let () = Backtrace.initialize_module () + +module Caml = struct end [@@deprecated "[since 2023-01] use Stdlib instead of Caml"] diff --git a/unikernel/duniverse/base/src/binary_search.ml b/unikernel/duniverse/base/src/binary_search.ml new file mode 100644 index 00000000..02a2406c --- /dev/null +++ b/unikernel/duniverse/base/src/binary_search.ml @@ -0,0 +1,123 @@ +open! Import +open Int_replace_polymorphic_compare + +(* These functions implement a search for the first (resp. last) element + satisfying a predicate, assuming that the predicate is increasing on + the container, meaning that, if the container is [u1...un], there exists a + k such that p(u1)=....=p(uk) = false and p(uk+1)=....=p(un)= true. + If this k = 1 (resp n), find_last_not_satisfying (resp find_first_satisfying) + will return None. *) + +let rec linear_search_first_satisfying t ~get ~lo ~hi ~pred = + if lo > hi + then None + else if pred (get t lo) + then Some lo + else linear_search_first_satisfying t ~get ~lo:(lo + 1) ~hi ~pred +;; + +(* Takes a container [t], a predicate [pred] and two indices [lo < hi], such that + [pred] is increasing on [t] between [lo] and [hi]. + + return a range (lo, hi) where: + - lo and hi are close enough together for a linear search + - If [pred] is not constantly [false] on [t] between [lo] and [hi], the first element + on which [pred] is [true] is between [lo] and [hi]. *) +(* Invariant: the first element satisfying [pred], if it exists is between [lo] and [hi] *) +let rec find_range_near_first_satisfying t ~get ~lo ~hi ~pred = + (* Warning: this function will not terminate if the constant (currently 8) is + set <= 1 *) + if hi - lo <= 8 + then lo, hi + else ( + let mid = lo + ((hi - lo) / 2) in + if pred (get t mid) + (* INVARIANT check: it means the first satisfying element is between [lo] and [mid] *) + then + find_range_near_first_satisfying t ~get ~lo ~hi:mid ~pred + (* INVARIANT check: it means the first satisfying element, if it exists, + is between [mid+1] and [hi] *) + else find_range_near_first_satisfying t ~get ~lo:(mid + 1) ~hi ~pred) +;; + +let find_first_satisfying ?pos ?len t ~get ~length ~pred = + let pos, len = + Ordered_collection_common.get_pos_len_exn () ?pos ?len ~total_length:(length t) + in + let lo = pos in + let hi = pos + len - 1 in + let lo, hi = find_range_near_first_satisfying t ~get ~lo ~hi ~pred in + linear_search_first_satisfying t ~get ~lo ~hi ~pred +;; + +(* Takes an array with shape [true,...true,false,...false] (i.e., the _reverse_ of what + is described above) and returns the index of the last true or None if there are no + true*) +let find_last_satisfying ?pos ?len t ~pred ~get ~length = + let pos, len = + Ordered_collection_common.get_pos_len_exn () ?pos ?len ~total_length:(length t) + in + if len = 0 + then None + else ( + (* The last satisfying is the one just before the first not satisfying *) + match + find_first_satisfying ~pos ~len t ~get ~length ~pred:(fun x -> not (pred x)) + with + | None -> Some (pos + len - 1) + (* This means that all elements satisfy pred. + There is at least an element as (len > 0) *) + | Some i when i = pos -> None (* no element satisfies pred *) + | Some i -> Some (i - 1)) +;; + +let binary_search + ?pos + ?len + t + ~(length : _ -> _) + ~(get : _ -> _ -> _) + ~(compare : _ -> _ -> _) + how + v + = + match how with + | `Last_strictly_less_than -> + find_last_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v < 0) [@nontail + ] + | `Last_less_than_or_equal_to -> + find_last_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v <= 0) [@nontail + ] + | `First_equal_to -> + (match + find_first_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v >= 0) + with + | Some x when compare (get t x) v = 0 -> Some x + | None | Some _ -> None) + | `Last_equal_to -> + (match + find_last_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v <= 0) + with + | Some x when compare (get t x) v = 0 -> Some x + | None | Some _ -> None) + | `First_greater_than_or_equal_to -> + find_first_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v >= 0) [@nontail + ] + | `First_strictly_greater_than -> + find_first_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v > 0) [@nontail + ] +;; + +let binary_search_segmented ?pos ?len t ~length ~get ~segment_of how = + let is_left x = + match segment_of x with + | `Left -> true + | `Right -> false + in + let is_right x = not (is_left x) in + match how with + | `Last_on_left -> + find_last_satisfying ?pos ?len t ~length ~get ~pred:is_left [@nontail] + | `First_on_right -> + find_first_satisfying ?pos ?len t ~length ~get ~pred:is_right [@nontail] +;; diff --git a/unikernel/duniverse/base/src/binary_search.mli b/unikernel/duniverse/base/src/binary_search.mli new file mode 100644 index 00000000..1a299c8f --- /dev/null +++ b/unikernel/duniverse/base/src/binary_search.mli @@ -0,0 +1,86 @@ +(** Functions for performing binary searches over ordered sequences given + [length] and [get] functions. + + These functions can be specialized and added to a data structure using the functors + supplied in {{!Base.Binary_searchable}[Binary_searchable]} and described in + {{!Base.Binary_searchable_intf}[Binary_searchable_intf]}. + + {2:examples Examples} + + Below we assume that the functions [get], [length] and [compare] are in scope: + + {[ + (* Find the index of an element [e] in [t] *) + binary_search t ~get ~length ~compare `First_equal_to e; + + (* Find the index where an element [e] should be inserted *) + binary_search t ~get ~length ~compare `First_greater_than_or_equal_to e; + + (* Find the index in [t] where all elements to the left are less than [e] *) + binary_search_segmented t ~get ~length ~segment_of:(fun e' -> + if compare e' e <= 0 then `Left else `Right) `First_on_right + ]} *) + +open! Import + +(** [binary_search ?pos ?len t ~length ~get ~compare which elt] takes [t] that is sorted + in increasing order according to [compare], where [compare] and [elt] divide [t] into + three (possibly empty) segments: + + {v + | < elt | = elt | > elt | + v} + + [binary_search] returns the index in [t] of an element on the boundary of segments + as specified by [which]. See the diagram below next to the [which] variants. + + By default, [binary_search] searches the entire [t]. One can supply [?pos] or + [?len] to search a slice of [t]. + + [binary_search] does not check that [compare] orders [t], and behavior is + unspecified if [compare] doesn't order [t]. Behavior is also unspecified if + [compare] mutates [t]. *) +val binary_search + : ?pos:int + -> ?len:int + -> 't + -> length:('t -> int) + -> get:('t -> int -> 'elt) + -> compare:('elt -> 'key -> int) + -> [ `Last_strictly_less_than (** {v | < elt X | v} *) + | `Last_less_than_or_equal_to (** {v | <= elt X | v} *) + | `Last_equal_to (** {v | = elt X | v} *) + | `First_equal_to (** {v | X = elt | v} *) + | `First_greater_than_or_equal_to (** {v | X >= elt | v} *) + | `First_strictly_greater_than (** {v | X > elt | v} *) + ] + -> 'key + -> int option + +(** [binary_search_segmented ?pos ?len t ~length ~get ~segment_of which] takes a + [segment_of] function that divides [t] into two (possibly empty) segments: + + {v + | segment_of elt = `Left | segment_of elt = `Right | + v} + + [binary_search_segmented] returns the index of the element on the boundary of the + segments as specified by [which]: [`Last_on_left] yields the index of the last + element of the left segment, while [`First_on_right] yields the index of the first + element of the right segment. It returns [None] if the segment is empty. + + By default, [binary_search] searches the entire [t]. One can supply [?pos] or + [?len] to search a slice of [t]. + + [binary_search_segmented] does not check that [segment_of] segments [t] as in the + diagram, and behavior is unspecified if [segment_of] doesn't segment [t]. Behavior + is also unspecified if [segment_of] mutates [t]. *) +val binary_search_segmented + : ?pos:int + -> ?len:int + -> 't + -> length:('t -> int) + -> get:('t -> int -> 'elt) + -> segment_of:('elt -> [ `Left | `Right ]) + -> [ `Last_on_left | `First_on_right ] + -> int option diff --git a/unikernel/duniverse/base/src/binary_searchable.ml b/unikernel/duniverse/base/src/binary_searchable.ml new file mode 100644 index 00000000..539dfb96 --- /dev/null +++ b/unikernel/duniverse/base/src/binary_searchable.ml @@ -0,0 +1,38 @@ +open! Import +include Binary_searchable_intf + +module type Arg = sig + type 'a elt + type 'a t + + val get : 'a t -> int -> 'a elt + val length : _ t -> int +end + +module Make_gen (T : Arg) = struct + let get = T.get + let length = T.length + + let binary_search ?pos ?len t ~compare how v = + Binary_search.binary_search ?pos ?len t ~get ~length ~compare how v + ;; + + let binary_search_segmented ?pos ?len t ~segment_of how = + Binary_search.binary_search_segmented ?pos ?len t ~get ~length ~segment_of how + ;; +end + +module Make (T : Indexable) = Make_gen (struct + include T + + type 'a elt = T.elt + type 'a t = T.t +end) + +module Make1 (T : Indexable1) = Make_gen (struct + type 'a elt = 'a + type 'a t = 'a T.t + + let get = T.get + let length = T.length +end) diff --git a/unikernel/duniverse/base/src/binary_searchable.mli b/unikernel/duniverse/base/src/binary_searchable.mli new file mode 100644 index 00000000..85837ea7 --- /dev/null +++ b/unikernel/duniverse/base/src/binary_searchable.mli @@ -0,0 +1 @@ +include Binary_searchable_intf.Binary_searchable (** @inline *) diff --git a/unikernel/duniverse/base/src/binary_searchable_intf.ml b/unikernel/duniverse/base/src/binary_searchable_intf.ml new file mode 100644 index 00000000..581ef18c --- /dev/null +++ b/unikernel/duniverse/base/src/binary_searchable_intf.ml @@ -0,0 +1,110 @@ +(** Module types for a [binary_search] function for a sequence, and functors for building + [binary_search] functions. *) + +open! Import + +(** An [Indexable] type is a finite sequence of elements indexed by consecutive integers + [0] ... [length t - 1]. [get] and [length] must be O(1) for the resulting + [binary_search] to be lg(n). *) +module type Indexable = sig + type elt + type t + + val get : t -> int -> elt + val length : t -> int +end + +module type Indexable1 = sig + type 'a t + + val get : 'a t -> int -> 'a + val length : _ t -> int +end + +module Which_target_by_key = struct + type t = + [ `Last_strictly_less_than (** {v | < elt X | v} *) + | `Last_less_than_or_equal_to (** {v | <= elt X | v} *) + | `Last_equal_to (** {v | = elt X | v} *) + | `First_equal_to (** {v | X = elt | v} *) + | `First_greater_than_or_equal_to (** {v | X >= elt | v} *) + | `First_strictly_greater_than (** {v | X > elt | v} *) + ] + [@@deriving_inline enumerate] + + let all = + ([ `Last_strictly_less_than + ; `Last_less_than_or_equal_to + ; `Last_equal_to + ; `First_equal_to + ; `First_greater_than_or_equal_to + ; `First_strictly_greater_than + ] + : t list) + ;; + + [@@@end] +end + +module Which_target_by_segment = struct + type t = + [ `Last_on_left + | `First_on_right + ] + [@@deriving_inline enumerate] + + let all = ([ `Last_on_left; `First_on_right ] : t list) + + [@@@end] +end + +type ('t, 'elt, 'key) binary_search = + ?pos:int + -> ?len:int + -> 't + -> compare:('elt -> 'key -> int) + -> Which_target_by_key.t + -> 'key + -> int option + +type ('t, 'elt) binary_search_segmented = + ?pos:int + -> ?len:int + -> 't + -> segment_of:('elt -> [ `Left | `Right ]) + -> Which_target_by_segment.t + -> int option + +module type S = sig + type elt + type t + + (** See [Binary_search.binary_search] in binary_search.ml *) + val binary_search : (t, elt, 'key) binary_search + + (** See [Binary_search.binary_search_segmented] in binary_search.ml *) + val binary_search_segmented : (t, elt) binary_search_segmented +end + +module type S1 = sig + type 'a t + + val binary_search : ('a t, 'a, 'key) binary_search + val binary_search_segmented : ('a t, 'a) binary_search_segmented +end + +module type Binary_searchable = sig + module type S = S + module type S1 = S1 + module type Indexable = Indexable + module type Indexable1 = Indexable1 + + module Which_target_by_key = Which_target_by_key + module Which_target_by_segment = Which_target_by_segment + + type nonrec ('t, 'elt, 'key) binary_search = ('t, 'elt, 'key) binary_search + type nonrec ('t, 'elt) binary_search_segmented = ('t, 'elt) binary_search_segmented + + module Make (T : Indexable) : S with type t := T.t with type elt := T.elt + module Make1 (T : Indexable1) : S1 with type 'a t := 'a T.t +end diff --git a/unikernel/duniverse/base/src/blit.ml b/unikernel/duniverse/base/src/blit.ml new file mode 100644 index 00000000..78d00379 --- /dev/null +++ b/unikernel/duniverse/base/src/blit.ml @@ -0,0 +1,133 @@ +open! Import +include Blit_intf + +module type Sequence_gen = sig + type 'a t + + val length : _ t -> int +end + +module Make_gen + (Src : Sequence_gen) (Dst : sig + include Sequence_gen + + val create_like : len:int -> 'a Src.t -> 'a t + val unsafe_blit : ('a Src.t, 'a t) blit + end) = +struct + let unsafe_blit = Dst.unsafe_blit + + let blit ~src ~src_pos ~dst ~dst_pos ~len = + Ordered_collection_common.check_pos_len_exn + ~pos:src_pos + ~len + ~total_length:(Src.length src); + Ordered_collection_common.check_pos_len_exn + ~pos:dst_pos + ~len + ~total_length:(Dst.length dst); + if len > 0 then unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len + ;; + + let blito + ~src + ?(src_pos = 0) + ?(src_len = Src.length src - src_pos) + ~dst + ?(dst_pos = 0) + () + = + blit ~src ~src_pos ~len:src_len ~dst ~dst_pos + ;; + + (* [sub] and [subo] ensure that every position of the created sequence is populated by + an element of the source array. Thus every element of [dst] below is well + defined. *) + let sub src ~pos ~len = + Ordered_collection_common.check_pos_len_exn ~pos ~len ~total_length:(Src.length src); + let dst = Dst.create_like ~len src in + if len > 0 then unsafe_blit ~src ~src_pos:pos ~dst ~dst_pos:0 ~len; + dst + ;; + + let subo ?(pos = 0) ?len src = + sub + src + ~pos + ~len: + (match len with + | Some i -> i + | None -> Src.length src - pos) + ;; +end + +module Make1 (Sequence : sig + include Sequence_gen + + val create_like : len:int -> 'a t -> 'a t + val unsafe_blit : ('a t, 'a t) blit +end) = + Make_gen (Sequence) (Sequence) + +module Make1_generic (Sequence : Sequence1) = Make_gen (Sequence) (Sequence) + +module Make (Sequence : sig + include Sequence + + val create : len:int -> t + val unsafe_blit : (t, t) blit +end) = +struct + module Sequence = struct + type 'a t = Sequence.t + + open Sequence + + let create_like ~len _ = create ~len + let length = length + let unsafe_blit = unsafe_blit + end + + include Make_gen (Sequence) (Sequence) +end + +module Make_distinct + (Src : Sequence) (Dst : sig + include Sequence + + val create : len:int -> t + val unsafe_blit : (Src.t, t) blit + end) = + Make_gen + (struct + type 'a t = Src.t + + open Src + + let length = length + end) + (struct + type 'a t = Dst.t + + open Dst + + let length = length + let create_like ~len _ = create ~len + let unsafe_blit = unsafe_blit + end) + +module Make_to_string (T : sig + type t +end) +(To_bytes : S_distinct with type src := T.t with type dst := bytes) = +struct + open To_bytes + + let sub src ~pos ~len = + Bytes0.unsafe_to_string ~no_mutation_while_string_reachable:(sub src ~pos ~len) + ;; + + let subo ?pos ?len src = + Bytes0.unsafe_to_string ~no_mutation_while_string_reachable:(subo ?pos ?len src) + ;; +end diff --git a/unikernel/duniverse/base/src/blit.mli b/unikernel/duniverse/base/src/blit.mli new file mode 100644 index 00000000..ea4c29cc --- /dev/null +++ b/unikernel/duniverse/base/src/blit.mli @@ -0,0 +1 @@ +include Blit_intf.Blit (** @inline *) diff --git a/unikernel/duniverse/base/src/blit_intf.ml b/unikernel/duniverse/base/src/blit_intf.ml new file mode 100644 index 00000000..05690699 --- /dev/null +++ b/unikernel/duniverse/base/src/blit_intf.ml @@ -0,0 +1,173 @@ +(** Standard type for [blit] functions, and reusable code for validating [blit] + arguments. *) + +open! Import + +(** If [blit : (src, dst) blit], then [blit ~src ~src_pos ~len ~dst ~dst_pos] blits [len] + values from [src] starting at position [src_pos] to [dst] at position [dst_pos]. + Furthermore, [blit] raises if [src_pos], [len], and [dst_pos] don't specify valid + slices of [src] and [dst]. *) +type ('src, 'dst) blit = + src:'src -> src_pos:int -> dst:'dst -> dst_pos:int -> len:int -> unit + +(** [blito] is like [blit], except that the [src_pos], [src_len], and [dst_pos] are + optional (hence the "o" in "blito"). Also, we use [src_len] rather than [len] as a + reminder that if [src_len] isn't supplied, then the default is to take the slice + running from [src_pos] to the end of [src]. *) +type ('src, 'dst) blito = + src:'src + -> ?src_pos:int (** default is [0] *) + -> ?src_len:int (** default is [length src - src_pos] *) + -> dst:'dst + -> ?dst_pos:int (** default is [0] *) + -> unit + -> unit + +(** If [sub : (src, dst) sub], then [sub ~src ~pos ~len] returns a sequence of type [dst] + containing [len] characters of [src] starting at [pos]. + + [subo] is like [sub], except [pos] and [len] are optional. *) +type ('src, 'dst) sub = 'src -> pos:int -> len:int -> 'dst + +type ('src, 'dst) subo = + ?pos:int (** default is [0] *) + -> ?len:int (** default is [length src - pos] *) + -> 'src + -> 'dst + +(*_ These are not implemented less-general-in-terms-of-more-general because odoc produces + unreadable documentation in that case, with or without [inline] on [include]. *) + +module type S = sig + type t + + val blit : (t, t) blit + val blito : (t, t) blito + val unsafe_blit : (t, t) blit + val sub : (t, t) sub + val subo : (t, t) subo +end + +module type S1 = sig + type 'a t + + val blit : ('a t, 'a t) blit + val blito : ('a t, 'a t) blito + val unsafe_blit : ('a t, 'a t) blit + val sub : ('a t, 'a t) sub + val subo : ('a t, 'a t) subo +end + +module type S_distinct = sig + type src + type dst + + val blit : (src, dst) blit + val blito : (src, dst) blito + val unsafe_blit : (src, dst) blit + val sub : (src, dst) sub + val subo : (src, dst) subo +end + +module type S1_distinct = sig + type 'a src + type 'a dst + + val blit : (_ src, _ dst) blit + val blito : (_ src, _ dst) blito + val unsafe_blit : (_ src, _ dst) blit + val sub : (_ src, _ dst) sub + val subo : (_ src, _ dst) subo +end + +module type S_to_string = sig + type t + + val sub : (t, string) sub + val subo : (t, string) subo +end + +(** Users of modules matching the blit signatures [S], [S1], and [S1_distinct] only need + to understand the code above. The code below is only for those that need to implement + modules that match those signatures. *) + +module type Sequence = sig + type t + + val length : t -> int +end + +type 'a poly = 'a + +module type Sequence1 = sig + type 'a t + + (** [Make1*] guarantees to only call [create_like ~len t] with [len > 0] if [length t > + 0]. *) + val create_like : len:int -> 'a t -> 'a t + + val length : _ t -> int + val unsafe_blit : ('a t, 'a t) blit +end + +module type Blit = sig + type nonrec ('src, 'dst) blit = ('src, 'dst) blit + type nonrec ('src, 'dst) blito = ('src, 'dst) blito + type nonrec ('src, 'dst) sub = ('src, 'dst) sub + type nonrec ('src, 'dst) subo = ('src, 'dst) subo + + module type S = S + module type S1 = S1 + module type S_distinct = S_distinct + module type S1_distinct = S1_distinct + module type S_to_string = S_to_string + module type Sequence = Sequence + module type Sequence1 = Sequence1 + + (** There are various [Make*] functors that turn an [unsafe_blit] function into a [blit] + function. The functors differ in whether the sequence type is monomorphic or + polymorphic, and whether the src and dst types are distinct or are the same. + + The blit functions make sure the slices are valid and then call [unsafe_blit]. They + guarantee at a call [unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len] that: + + {[ + len > 0 + && src_pos >= 0 + && src_pos + len <= get_src_len src + && dst_pos >= 0 + && dst_pos + len <= get_dst_len dst + ]} + + The [Make*] functors also automatically create unit tests. *) + + (** [Make] is for blitting between two values of the same monomorphic type. *) + module Make (Sequence : sig + include Sequence + + val create : len:int -> t + val unsafe_blit : (t, t) blit + end) : S with type t := Sequence.t + + (** [Make_distinct] is for blitting between values of distinct monomorphic types. *) + module Make_distinct + (Src : Sequence) (Dst : sig + include Sequence + + val create : len:int -> t + val unsafe_blit : (Src.t, t) blit + end) : S_distinct with type src := Src.t with type dst := Dst.t + + module Make_to_string (T : sig + type t + end) + (To_bytes : S_distinct with type src := T.t with type dst := bytes) : + S_to_string with type t := T.t + + (** [Make1] is for blitting between two values of the same polymorphic type. *) + module Make1 (Sequence : Sequence1) : S1 with type 'a t := 'a Sequence.t + + (** [Make1_generic] is for blitting between two values of the same container type that's + not fully polymorphic (in the sense of Container.Generic). *) + module Make1_generic (Sequence : Sequence1) : S1 with type 'a t := 'a Sequence.t +end diff --git a/unikernel/duniverse/base/src/bool.ml b/unikernel/duniverse/base/src/bool.ml new file mode 100644 index 00000000..91393bfa --- /dev/null +++ b/unikernel/duniverse/base/src/bool.ml @@ -0,0 +1,92 @@ +open! Import +include Bool0 + +let invalid_argf = Printf.invalid_argf + +module T = struct + type t = bool + [@@deriving_inline compare, enumerate, globalize, hash, sexp, sexp_grammar] + + let compare = (compare_bool : t -> t -> int) + let all = ([ false; true ] : t list) + let (globalize : t -> t) = (globalize_bool : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_bool + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_bool in + fun x -> func x + ;; + + let t_of_sexp = (bool_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_bool : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = bool_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + + let of_string = function + | "true" -> true + | "false" -> false + | s -> invalid_argf "Bool.of_string: expected true or false but got %s" s () + ;; + + let to_string = Stdlib.string_of_bool +end + +include T +include Comparator.Make (T) + +include Pretty_printer.Register (struct + type nonrec t = t + + let to_string = to_string + let module_name = "Base.Bool" +end) + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! Bool_replace_polymorphic_compare + +let invariant (_ : t) = () +let between t ~low ~high = low <= t && t <= high +let clamp_unchecked t ~min ~max = if t < min then min else if t <= max then t else max + +let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max +;; + +let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) +;; + +let to_int x = bool_to_int x + +module Non_short_circuiting = struct + (* We don't expose this, since we don't want to break the invariant mentioned below of + (to_int true = 1) and (to_int false = 0). *) + let unsafe_of_int (x : int) : bool = Stdlib.Obj.magic x + let ( || ) a b = unsafe_of_int (to_int a lor to_int b) + let ( && ) a b = unsafe_of_int (to_int a land to_int b) +end + +(* We do this as a direct assert on the theory that it's a cheap thing to test and a + really core invariant that we never expect to break, and we should be happy for a + program to fail immediately if this is violated. *) +let () = assert (Poly.( = ) (to_int true) 1 && Poly.( = ) (to_int false) 0) + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Bool_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/bool.mli b/unikernel/duniverse/base/src/bool.mli new file mode 100644 index 00000000..43ed752e --- /dev/null +++ b/unikernel/duniverse/base/src/bool.mli @@ -0,0 +1,45 @@ +(** Boolean type extended to be enumerable, hashable, sexpable, comparable, and + stringable. *) + +open! Import + +type t = bool [@@deriving_inline enumerate, globalize, sexp, sexp_grammar] + +include Ppx_enumerate_lib.Enumerable.S with type t := t + +val globalize : t -> t + +include Sexplib0.Sexpable.S with type t := t + +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Identifiable.S with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t +include Invariant.S with type t := t + +(** + - [to_int true = 1] + - [to_int false = 0] *) +val to_int : t -> int + +external select + : bool + -> ('a[@local_opt]) + -> ('a[@local_opt]) + -> ('a[@local_opt]) + = "caml_csel_value" + [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] + +module Non_short_circuiting : sig + (** Non-short circuiting and branch-free boolean operators. + + The default versions of these infix operators are short circuiting, which + requires branching instructions to implement. The operators below are + instead branch-free, and therefore not short-circuiting. *) + + val ( && ) : t -> t -> t + val ( || ) : t -> t -> t +end diff --git a/unikernel/duniverse/base/src/bool0.ml b/unikernel/duniverse/base/src/bool0.ml new file mode 100644 index 00000000..0994b685 --- /dev/null +++ b/unikernel/duniverse/base/src/bool0.ml @@ -0,0 +1,7 @@ +external select + : bool + -> ('a[@local_opt]) + -> ('a[@local_opt]) + -> ('a[@local_opt]) + = "caml_csel_value" + [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] diff --git a/unikernel/duniverse/base/src/bool0.mli b/unikernel/duniverse/base/src/bool0.mli new file mode 100644 index 00000000..0994b685 --- /dev/null +++ b/unikernel/duniverse/base/src/bool0.mli @@ -0,0 +1,7 @@ +external select + : bool + -> ('a[@local_opt]) + -> ('a[@local_opt]) + -> ('a[@local_opt]) + = "caml_csel_value" + [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] diff --git a/unikernel/duniverse/base/src/buffer.ml b/unikernel/duniverse/base/src/buffer.ml new file mode 100644 index 00000000..12a85b4f --- /dev/null +++ b/unikernel/duniverse/base/src/buffer.ml @@ -0,0 +1,36 @@ +open! Import +include Buffer_intf +include Stdlib.Buffer + +let contents_bytes = to_bytes +let add_substring t s ~pos ~len = add_substring t s pos len +let add_subbytes t s ~pos ~len = add_subbytes t s pos len +let sexp_of_t t = sexp_of_string (contents t) +let caml_buffer_length = (Stdlib.Obj.magic (Stdlib.Buffer.length : t -> int) : t -> int) + +let caml_buffer_blit = + (Stdlib.Obj.magic + (Stdlib.Buffer.blit : Stdlib.Buffer.t -> int -> Bytes.t -> int -> int -> unit) + : Stdlib.Buffer.t -> int -> Bytes.t -> int -> int -> unit) +;; + +module To_bytes = + Blit.Make_distinct + (struct + type nonrec t = t + + let length = caml_buffer_length + end) + (struct + type t = Bytes.t + + let create ~len = Bytes.create len + let length = Bytes.length + + let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len = + caml_buffer_blit src src_pos dst dst_pos len + ;; + end) + +include To_bytes +module To_string = Blit.Make_to_string (Stdlib.Buffer) (To_bytes) diff --git a/unikernel/duniverse/base/src/buffer.mli b/unikernel/duniverse/base/src/buffer.mli new file mode 100644 index 00000000..a5212a30 --- /dev/null +++ b/unikernel/duniverse/base/src/buffer.mli @@ -0,0 +1,8 @@ +(** Extensible character buffers. + + This module implements character buffers that automatically expand as necessary. It + provides cumulative concatenation of strings in quasi-linear time (instead of + quadratic time when strings are concatenated pairwise). +*) + +include Buffer_intf.Buffer (** @inline *) diff --git a/unikernel/duniverse/base/src/buffer_intf.ml b/unikernel/duniverse/base/src/buffer_intf.ml new file mode 100644 index 00000000..2818cdc4 --- /dev/null +++ b/unikernel/duniverse/base/src/buffer_intf.ml @@ -0,0 +1,82 @@ +open! Import + +module type S = sig + (** The abstract type of buffers. *) + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + (** [create n] returns a fresh buffer, initially empty. The [n] parameter is the + initial size of the internal storage medium that holds the buffer contents. That + storage is automatically reallocated when more than [n] characters are stored in the + buffer, but shrinks back to [n] characters when [reset] is called. + + For best performance, [n] should be of the same order of magnitude as the number of + characters that are expected to be stored in the buffer (for instance, 80 for a + buffer that holds one output line). Nothing bad will happen if the buffer grows + beyond that limit, however. In doubt, take [n = 16] for instance. *) + val create : int -> t + + (** Return a copy of the current contents of the buffer. The buffer itself is + unchanged. *) + val contents : t -> string + + val contents_bytes : t -> bytes + + (** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] characters from the current + contents of the buffer [src], starting at offset [src_pos] to bytes [dst], starting + at character [dst_pos]. + + Raises [Invalid_argument] if [src_pos] and [len] do not designate a valid substring + of [src], or if [dst_pos] and [len] do not designate a valid substring of [dst]. *) + + include Blit.S_distinct with type src := t with type dst := bytes + module To_string : Blit.S_to_string with type t := t + + (** Gets the (zero-based) n-th character of the buffer. Raises [Invalid_argument] if + index out of bounds. *) + val nth : t -> int -> char + + (** Returns the number of characters currently contained in the buffer. *) + val length : t -> int + + (** Empties the buffer. *) + val clear : t -> unit + + (** Empties the buffer and deallocates the internal storage holding the buffer contents, + replacing it with the initial internal storage of length [n] that was allocated by + [create n]. For long-lived buffers that may have grown a lot, [reset] allows faster + reclamation of the space used by the buffer. *) + val reset : t -> unit + + (** [add_char b c] appends the character [c] at the end of the buffer [b]. *) + val add_char : t -> char -> unit + + (** [add_string b s] appends the string [s] at the end of the buffer [b]. *) + val add_string : t -> string -> unit + + (** [add_substring b s pos len] takes [len] characters from offset [pos] in string [s] + and appends them at the end of the buffer [b]. *) + val add_substring : t -> string -> pos:int -> len:int -> unit + + (** [add_bytes b s] appends the bytes [s] at the end of the buffer [b]. *) + val add_bytes : t -> bytes -> unit + + (** [add_subbytes b s pos len] takes [len] characters from offset [pos] in bytes [s] + and appends them at the end of the buffer [b]. *) + val add_subbytes : t -> bytes -> pos:int -> len:int -> unit + + (** [add_buffer b1 b2] appends the current contents of buffer [b2] at the end of buffer + [b1]. [b2] is not modified. *) + val add_buffer : t -> t -> unit +end + +module type Buffer = sig + module type S = S + + (** Buffers using strings as underlying storage medium: *) + + include S with type t = Stdlib.Buffer.t (** @open *) +end diff --git a/unikernel/duniverse/base/src/bytes.ml b/unikernel/duniverse/base/src/bytes.ml new file mode 100644 index 00000000..0c2e534f --- /dev/null +++ b/unikernel/duniverse/base/src/bytes.ml @@ -0,0 +1,180 @@ +open! Import +module Array = Array0 +include Bytes_intf + +let stage = Staged.stage + +module T = struct + type t = bytes [@@deriving_inline globalize, sexp, sexp_grammar] + + let (globalize : t -> t) = (globalize_bytes : t -> t) + let t_of_sexp = (bytes_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_bytes : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = bytes_sexp_grammar + + [@@@end] + + include Bytes0 + + let module_name = "Base.Bytes" + let pp fmt t = Stdlib.Format.fprintf fmt "%S" (to_string t) +end + +include T + +module To_bytes = Blit.Make (struct + include T + + let create ~len = create len +end) + +include To_bytes +include Comparator.Make (T) +include Pretty_printer.Register_pp (T) + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! Bytes_replace_polymorphic_compare +module To_string = Blit.Make_to_string (T) (To_bytes) + +module From_string = + Blit.Make_distinct + (struct + type t = string + + let length = String.length + end) + (struct + type nonrec t = t + + let create ~len = create len + let length = length + let unsafe_blit = unsafe_blit_string + end) + +let invariant (_ : t) = () + +let init n ~f = + if Int_replace_polymorphic_compare.( < ) n 0 + then Printf.invalid_argf "Bytes.init %d" n (); + let t = create n in + for i = 0 to n - 1 do + unsafe_set t i (f i) + done; + t +;; + +let of_char_list l = + let t = create (List.length l) in + List.iteri l ~f:(fun i c -> set t i c); + t +;; + +let to_list t = + let rec loop t i acc = + if Int_replace_polymorphic_compare.( < ) i 0 + then acc + else loop t (i - 1) (unsafe_get t i :: acc) + in + loop t (length t - 1) [] +;; + +let to_array t = Array.init (length t) ~f:(fun i -> unsafe_get t i) +let map t ~f = map t ~f +let mapi t ~f = mapi t ~f + +let fold = + let rec loop t ~f ~len ~pos acc = + if Int_replace_polymorphic_compare.equal pos len + then acc + else loop t ~f ~len ~pos:(pos + 1) (f acc (unsafe_get t pos)) + in + fun t ~init ~f -> loop t ~f ~len:(length t) ~pos:0 init +;; + +let foldi = + let rec loop t ~f ~len ~pos acc = + if Int_replace_polymorphic_compare.equal pos len + then acc + else loop t ~f ~len ~pos:(pos + 1) (f pos acc (unsafe_get t pos)) + in + fun t ~init ~f -> loop t ~f ~len:(length t) ~pos:0 init +;; + +let tr ~target ~replacement s = + for i = 0 to length s - 1 do + if Char.equal (unsafe_get s i) target then unsafe_set s i replacement + done +;; + +let tr_multi ~target ~replacement = + if Int_replace_polymorphic_compare.( = ) (String.length target) 0 + then stage ignore + else if Int_replace_polymorphic_compare.( = ) (String.length replacement) 0 + then invalid_arg "tr_multi: replacement is the empty string" + else ( + match Bytes_tr.tr_create_map ~target ~replacement with + | None -> stage ignore + | Some tr_map -> + stage (fun s -> + for i = 0 to length s - 1 do + unsafe_set s i (String.unsafe_get tr_map (Char.to_int (unsafe_get s i))) + done)) +;; + +let between t ~low ~high = low <= t && t <= high +let clamp_unchecked t ~min ~max = if t < min then min else if t <= max then t else max + +let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max +;; + +let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) +;; + +let contains ?pos ?len t char = + let pos, len = + Ordered_collection_common.get_pos_len_exn () ?pos ?len ~total_length:(length t) + in + let last = pos + len in + let rec loop i = + Int_replace_polymorphic_compare.( < ) i last + && (Char.equal (get t i) char || loop (i + 1)) + in + loop pos +;; + +module Utf8 = struct + let set = set_uchar_utf_8 +end + +module Utf16le = struct + let set = set_uchar_utf_16le +end + +module Utf16be = struct + let set = set_uchar_utf_16be +end + +module Utf32le = struct + let set = set_uchar_utf_32le +end + +module Utf32be = struct + let set = set_uchar_utf_32be +end + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Bytes_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/bytes.mli b/unikernel/duniverse/base/src/bytes.mli new file mode 100644 index 00000000..0833e87d --- /dev/null +++ b/unikernel/duniverse/base/src/bytes.mli @@ -0,0 +1 @@ +include Bytes_intf.Bytes (** @inline *) diff --git a/unikernel/duniverse/base/src/bytes0.ml b/unikernel/duniverse/base/src/bytes0.ml new file mode 100644 index 00000000..093512f3 --- /dev/null +++ b/unikernel/duniverse/base/src/bytes0.ml @@ -0,0 +1,175 @@ +(* [Bytes0] defines string functions that are primitives or can be simply + defined in terms of [Stdlib.Bytes]. [Bytes0] is intended to completely express + the part of [Stdlib.Bytes] that [Base] uses -- no other file in Base other + than bytes0.ml should use [Stdlib.Bytes]. [Bytes0] has few dependencies, and + so is available early in Base's build order. + + All Base files that need to use strings and come before [Base.Bytes] in + build order should do: + + {[ + module Bytes = Bytes0 + ]} + + Defining [module Bytes = Bytes0] is also necessary because it prevents + ocamldep from mistakenly causing a file to depend on [Base.Bytes]. *) + +open! Import0 +module Uchar = Uchar0 +module Sys = Sys0 + +module Primitives = struct + external get : (bytes[@local_opt]) -> (int[@local_opt]) -> char = "%bytes_safe_get" + external length : (bytes[@local_opt]) -> int = "%bytes_length" + + external unsafe_get + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> char + = "%bytes_unsafe_get" + + external set + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> (char[@local_opt]) + -> unit + = "%bytes_safe_set" + + external unsafe_set + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> (char[@local_opt]) + -> unit + = "%bytes_unsafe_set" + + (* [unsafe_blit_string] is not exported in the [stdlib] so we export it here *) + external unsafe_blit_string + : src:(string[@local_opt]) + -> src_pos:int + -> dst:(bytes[@local_opt]) + -> dst_pos:int + -> len:int + -> unit + = "caml_blit_string" + [@@noalloc] + + external unsafe_get_int64 + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> int64 + = "%caml_bytes_get64u" + + external unsafe_set_int64 + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> (int64[@local_opt]) + -> unit + = "%caml_bytes_set64u" + + external unsafe_get_int32 + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> int32 + = "%caml_bytes_get32u" + + external unsafe_set_int32 + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> (int32[@local_opt]) + -> unit + = "%caml_bytes_set32u" + + external unsafe_get_int16 + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> int + = "%caml_bytes_get16u" + + external unsafe_set_int16 + : (bytes[@local_opt]) + -> (int[@local_opt]) + -> (int[@local_opt]) + -> unit + = "%caml_bytes_set16u" +end + +include Primitives + +let max_length = Sys.max_string_length +let blit = Stdlib.Bytes.blit +let blit_string = Stdlib.Bytes.blit_string +let compare = Stdlib.Bytes.compare +let copy = Stdlib.Bytes.copy +let create = Stdlib.Bytes.create +let set_uchar_utf_8 = Stdlib.Bytes.set_utf_8_uchar +let set_uchar_utf_16le = Stdlib.Bytes.set_utf_16le_uchar +let set_uchar_utf_16be = Stdlib.Bytes.set_utf_16be_uchar + +let set_utf_32_uchar ~set_int32 bytes idx uchar = + Uchar.to_int uchar + |> Int_conversions.int_to_int32_trunc (* should never have anything to truncate *) + |> set_int32 bytes idx; + 4 +;; + +let set_uchar_utf_32le = set_utf_32_uchar ~set_int32:Stdlib.Bytes.set_int32_le +let set_uchar_utf_32be = set_utf_32_uchar ~set_int32:Stdlib.Bytes.set_int32_be + +external unsafe_create_local : int -> bytes = "Base_unsafe_create_local_bytes" + +let create_local len = + if len > Sys0.max_string_length then invalid_arg "Bytes.create_local"; + unsafe_create_local len +;; + +let fill = Stdlib.Bytes.fill +let make = Stdlib.Bytes.make + +let map t ~(f : _ -> _) = + let l = length t in + if l = 0 + then t + else ( + let r = create l in + for i = 0 to l - 1 do + unsafe_set r i (f (unsafe_get t i)) + done; + r) +;; + +let mapi t ~(f : _ -> _ -> _) = + let l = length t in + if l = 0 + then t + else ( + let r = create l in + for i = 0 to l - 1 do + unsafe_set r i (f i (unsafe_get t i)) + done; + r) +;; + +let sub = Stdlib.Bytes.sub + +external unsafe_blit + : src:(bytes[@local_opt]) + -> src_pos:int + -> dst:(bytes[@local_opt]) + -> dst_pos:int + -> len:int + -> unit + = "caml_blit_bytes" + [@@noalloc] + +let to_string = Stdlib.Bytes.to_string +let of_string = Stdlib.Bytes.of_string + +external unsafe_to_string + : no_mutation_while_string_reachable:(bytes[@local_opt]) + -> (string[@local_opt]) + = "%bytes_to_string" + +external unsafe_of_string_promise_no_mutation + : (string[@local_opt]) + -> (bytes[@local_opt]) + = "%bytes_of_string" diff --git a/unikernel/duniverse/base/src/bytes_intf.ml b/unikernel/duniverse/base/src/bytes_intf.ml new file mode 100644 index 00000000..2d19700b --- /dev/null +++ b/unikernel/duniverse/base/src/bytes_intf.ml @@ -0,0 +1,308 @@ +open! Import + +(** Interface for Unicode encodings, such as UTF-8. *) +module type Utf = sig + type t := bytes + + (** Writes a Unicode character to a given position using this encoding. *) + val set : t -> int -> Uchar0.t -> int +end + +module type Bytes = sig + (** OCaml's byte sequence type, semantically similar to a [char array], but + taking less space in memory. + + A byte sequence is a mutable data structure that contains a fixed-length + sequence of bytes (of type [char]). Each byte can be indexed in constant + time for reading or writing. *) + + open! Import + + type t = bytes [@@deriving_inline globalize, sexp, sexp_grammar] + + val globalize : t -> t + + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + (** {1 Common Interfaces} *) + + include Blit.S with type t := t + include Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + include Stringable.S with type t := t + + (** Note that [pp] allocates in order to preserve the state of the byte + sequence it was initially called with. *) + include Pretty_printer.S with type t := t + + include Invariant.S with type t := t + + module To_string : sig + val sub : (t, string) Blit.sub + val subo : (t, string) Blit.subo + end + + module From_string : Blit.S_distinct with type src := string and type dst := t + + (** [create len] returns a newly-allocated and uninitialized byte sequence of + length [len]. No guarantees are made about the contents of the return + value. *) + val create : int -> t + + (** [create_local] is like [create], but returns a stack-allocated [Bytes.t]. *) + val create_local : int -> t + + (** [make len c] returns a newly-allocated byte sequence of length [len] filled + with the byte [c]. *) + val make : int -> char -> t + + (** [map f t] applies function [f] to every byte, in order, and builds the byte + sequence with the results returned by [f]. *) + val map : t -> f:(char -> char) -> t + + (** Like [map], but passes each character's index to [f] along with the char. *) + val mapi : t -> f:(int -> char -> char) -> t + + (** [copy t] returns a newly-allocated byte sequence that contains the same + bytes as [t]. *) + val copy : t -> t + + (** [init len ~f] returns a newly-allocated byte sequence of length [len] with + index [i] in the sequence being initialized with the result of [f i]. *) + val init : int -> f:(int -> char) -> t + + (** [of_char_list l] returns a newly-allocated byte sequence where each byte in + the sequence corresponds to the byte in [l] at the same index. *) + val of_char_list : char list -> t + + (** [length t] returns the number of bytes in [t]. *) + external length : (t[@local_opt]) -> int = "%bytes_length" + + (** [get t i] returns the [i]th byte of [t]. *) + val get : t -> int -> char + + external unsafe_get : (t[@local_opt]) -> (int[@local_opt]) -> char = "%bytes_unsafe_get" + + (** [set t i c] sets the [i]th byte of [t] to [c]. *) + external set + : (t[@local_opt]) + -> (int[@local_opt]) + -> (char[@local_opt]) + -> unit + = "%bytes_safe_set" + + external unsafe_set + : (t[@local_opt]) + -> (int[@local_opt]) + -> (char[@local_opt]) + -> unit + = "%bytes_unsafe_set" + + external unsafe_get_int64 + : (t[@local_opt]) + -> (int[@local_opt]) + -> int64 + = "%caml_bytes_get64u" + + external unsafe_set_int64 + : (t[@local_opt]) + -> (int[@local_opt]) + -> (int64[@local_opt]) + -> unit + = "%caml_bytes_set64u" + + external unsafe_get_int32 + : (t[@local_opt]) + -> (int[@local_opt]) + -> int32 + = "%caml_bytes_get32u" + + external unsafe_set_int32 + : (t[@local_opt]) + -> (int[@local_opt]) + -> (int32[@local_opt]) + -> unit + = "%caml_bytes_set32u" + + external unsafe_get_int16 + : (t[@local_opt]) + -> (int[@local_opt]) + -> int + = "%caml_bytes_get16u" + + external unsafe_set_int16 + : (t[@local_opt]) + -> (int[@local_opt]) + -> (int[@local_opt]) + -> unit + = "%caml_bytes_set16u" + + (** [fill t ~pos ~len c] modifies [t] in place, replacing all the bytes from + [pos] to [pos + len] with [c]. *) + val fill : t -> pos:int -> len:int -> char -> unit + + (** [tr ~target ~replacement t] modifies [t] in place, replacing every instance + of [target] in [s] with [replacement]. *) + val tr : target:char -> replacement:char -> t -> unit + + (** [tr_multi ~target ~replacement] returns an in-place function that replaces + every instance of a character in [target] with the corresponding character + in [replacement]. + + If [replacement] is shorter than [target], it is lengthened by repeating + its last character. Empty [replacement] is illegal unless [target] also is. + + If [target] contains multiple copies of the same character, the last + corresponding [replacement] character is used. Note that character ranges + are {b not} supported, so [~target:"a-z"] means the literal characters ['a'], + ['-'], and ['z']. *) + val tr_multi : target:string -> replacement:string -> (t -> unit) Staged.t + + (** [to_list t] returns the bytes in [t] as a list of chars. *) + val to_list : t -> char list + + (** [to_array t] returns the bytes in [t] as an array of chars. *) + val to_array : t -> char array + + (** [fold a ~f ~init:b] is [f a1 (f a2 (...))] *) + val fold : t -> init:'acc -> f:('acc -> char -> 'acc) -> 'acc + + (** [foldi] works similarly to [fold], but also passes the index of each character to + [f]. *) + val foldi : t -> init:'acc -> f:(int -> 'acc -> char -> 'acc) -> 'acc + + (** [contains ?pos ?len t c] returns [true] iff [c] appears in [t] between [pos] + and [pos + len]. *) + val contains : ?pos:int -> ?len:int -> t -> char -> bool + + (** Maximum length of a byte sequence, which is architecture-dependent. Attempting to + create a [Bytes] larger than this will raise an exception. *) + val max_length : int + + (** {2:unsafe Unsafe conversions (for advanced users)} + + This section describes unsafe, low-level conversion functions between + [bytes] and [string]. They might not copy the internal data; used + improperly, they can break the immutability invariant on strings provided + by the [-safe-string] option. They are available for expert library + authors, but for most purposes you should use the always-correct + {!Bytes.to_string} and {!Bytes.of_string} instead. + *) + + (** Unsafely convert a byte sequence into a string. + + To reason about the use of [unsafe_to_string], it is convenient to + consider an "ownership" discipline. A piece of code that + manipulates some data "owns" it; there are several disjoint ownership + modes, including: + {ul + {- Unique ownership: the data may be accessed and mutated} + {- Shared ownership: the data has several owners, that may only + access it, not mutate it.}} + Unique ownership is linear: passing the data to another piece of + code means giving up ownership (we cannot access the + data again). A unique owner may decide to make the data shared + (giving up mutation rights on it), but shared data may not become + uniquely-owned again. + [unsafe_to_string s] can only be used when the caller owns the byte + sequence [s] -- either uniquely or as shared immutable data. The + caller gives up ownership of [s], and gains (the same mode of) ownership + of the returned string. + There are two valid use-cases that respect this ownership + discipline: + {ol + {- The first is creating a string by initializing and mutating a byte + sequence that is never changed after initialization is performed. + {[ + let string_init len f : string = + let s = Bytes.create len in + for i = 0 to len - 1 do Bytes.set s i (f i) done; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:s + ]} + This function is safe because the byte sequence [s] will never be + accessed or mutated after [unsafe_to_string] is called. The + [string_init] code gives up ownership of [s], and returns the + ownership of the resulting string to its caller. + + Note that it would be unsafe if [s] was passed as an additional + parameter to the function [f] as it could escape this way and be + mutated in the future -- [string_init] would give up ownership of + [s] to pass it to [f], and could not call [unsafe_to_string] + safely. + + We have provided the {!String.init}, {!String.map} and + {!String.mapi} functions to cover most cases of building + new strings. You should prefer those over [to_string] or + [unsafe_to_string] whenever applicable.} + {- The second is temporarily giving ownership of a byte sequence to + a function that expects a uniquely owned string and returns ownership + back, so that we can mutate the sequence again after the call ended. + {[ + let bytes_length (s : bytes) = + String.length + (Bytes.unsafe_to_string ~no_mutation_while_string_reachable:s) + ]} + In this use-case, we do not promise that [s] will never be mutated + after the call to [bytes_length s]. The {!String.length} function + temporarily borrows unique ownership of the byte sequence + (and sees it as a [string]), but returns this ownership back to + the caller, which may assume that [s] is still a valid byte + sequence after the call. Note that this is only correct because we + know that {!String.length} does not capture its argument -- it could + escape by a side-channel such as a memoization combinator. + The caller may not mutate [s] while the string is borrowed (it has + temporarily given up ownership). This affects concurrent programs, + but also higher-order functions: if {!String.length} returned + a closure to be called later, [s] should not be mutated until this + closure is fully applied and returns ownership.}} + *) + external unsafe_to_string + : no_mutation_while_string_reachable:(t[@local_opt]) + -> (string[@local_opt]) + = "%bytes_to_string" + + (** Unsafely convert a shared string to a byte sequence that should + not be mutated. + + The same ownership discipline that makes [unsafe_to_string] + correct applies to [unsafe_of_string_promise_no_mutation], + however unique ownership of string values is extremely difficult + to reason about correctly in practice. As such, one should always + assume strings are shared, never uniquely owned (For example, + string literals are implicitly shared by the compiler, so you + never uniquely own them) + + The only case we have reasonable confidence is safe is if the + produced [bytes] is shared -- used as an immutable byte + sequence. This is possibly useful for incremental migration of + low-level programs that manipulate immutable sequences of bytes + (for example {!Marshal.from_bytes}) and previously used the + [string] type for this purpose. + *) + external unsafe_of_string_promise_no_mutation + : (string[@local_opt]) + -> (t[@local_opt]) + = "%bytes_of_string" + + (** UTF-8 encoding. See [Utf] interface. *) + module Utf8 : Utf + + (** UTF-16 little-endian encoding. See [Utf] interface. *) + module Utf16le : Utf + + (** UTF-16 big-endian encoding. See [Utf] interface. *) + module Utf16be : Utf + + (** UTF-32 little-endian encoding. See [Utf] interface. *) + module Utf32le : Utf + + (** UTF-32 big-endian encoding. See [Utf] interface. *) + module Utf32be : Utf + + module type Utf = Utf +end diff --git a/unikernel/duniverse/base/src/bytes_stubs.c b/unikernel/duniverse/base/src/bytes_stubs.c new file mode 100644 index 00000000..f1a7b574 --- /dev/null +++ b/unikernel/duniverse/base/src/bytes_stubs.c @@ -0,0 +1,9 @@ +#include + +/* This is the same as caml_create_local_bytes, except that we skip the + bounds-check and instead do it on the ocaml side, so that we can mark the C + call noalloc. */ +CAMLprim value Base_unsafe_create_local_bytes(value len) { + mlsize_t size = Long_val(len); + return caml_alloc_string(size); +} diff --git a/unikernel/duniverse/base/src/bytes_tr.ml b/unikernel/duniverse/base/src/bytes_tr.ml new file mode 100644 index 00000000..6c3a3108 --- /dev/null +++ b/unikernel/duniverse/base/src/bytes_tr.ml @@ -0,0 +1,41 @@ +open! Import0.Int_replace_polymorphic_compare +module Bytes = Bytes0 +module String = String0 + +(* Construct a byte string of length 256, mapping every input character code to + its corresponding output character. + + Benchmarks indicate that this is faster than the lambda (including cost of + this function), even if target/replacement are just 2 characters each. + + Return None if the translation map is equivalent to just the identity. *) +let tr_create_map ~target ~replacement = + let tr_map = Bytes.create 256 in + for i = 0 to 255 do + Bytes.unsafe_set tr_map i (Char.of_int_exn i) + done; + for i = 0 to min (String.length target) (String.length replacement) - 1 do + let index = Char.to_int (String.unsafe_get target i) in + Bytes.unsafe_set tr_map index (String.unsafe_get replacement i) + done; + let last_replacement = String.unsafe_get replacement (String.length replacement - 1) in + for + i = min (String.length target) (String.length replacement) to String.length target - 1 + do + let index = Char.to_int (String.unsafe_get target i) in + Bytes.unsafe_set tr_map index last_replacement + done; + let rec have_any_different tr_map i = + if i = 256 + then false + else if Char.( <> ) (Bytes0.unsafe_get tr_map i) (Char.of_int_exn i) + then true + else have_any_different tr_map (i + 1) + in + (* quick check on the first target character which will 99% be true *) + let first_target = target.[0] in + if Char.( <> ) (Bytes0.unsafe_get tr_map (Char.to_int first_target)) first_target + || have_any_different tr_map 0 + then Some (Bytes0.unsafe_to_string ~no_mutation_while_string_reachable:tr_map) + else None +;; diff --git a/unikernel/duniverse/base/src/char.ml b/unikernel/duniverse/base/src/char.ml new file mode 100644 index 00000000..9bb893f4 --- /dev/null +++ b/unikernel/duniverse/base/src/char.ml @@ -0,0 +1,163 @@ +open! Import +module Array = Array0 +module String = String0 +include Char0 + +module T = struct + type t = char [@@deriving_inline compare, hash, globalize, sexp, sexp_grammar] + + let compare = (compare_char : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_char + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_char in + fun x -> func x + ;; + + let (globalize : t -> t) = (globalize_char : t -> t) + let t_of_sexp = (char_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_char : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = char_sexp_grammar + + [@@@end] + + let to_string t = String.make 1 t + + let of_string s = + match String.length s with + | 1 -> s.[0] + | _ -> failwithf "Char.of_string: %S" s () + ;; +end + +include T + +include Identifiable.Make (struct + include T + + let module_name = "Base.Char" +end) + +let pp fmt c = Stdlib.Format.fprintf fmt "%C" c + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! Char_replace_polymorphic_compare + +let invariant (_ : t) = () +let all = Array.init 256 ~f:unsafe_of_int |> Array.to_list + +let is_lowercase = function + | 'a' .. 'z' -> true + | _ -> false +;; + +let is_uppercase = function + | 'A' .. 'Z' -> true + | _ -> false +;; + +let is_print = function + | ' ' .. '~' -> true + | _ -> false +;; + +let is_whitespace = function + | '\t' | '\n' | '\011' (* vertical tab *) | '\012' (* form feed *) | '\r' | ' ' -> true + | _ -> false +;; + +let is_digit = function + | '0' .. '9' -> true + | _ -> false +;; + +let is_alpha = function + | 'a' .. 'z' | 'A' .. 'Z' -> true + | _ -> false +;; + +(* Writing these out, instead of calling [is_alpha] and [is_digit], reduces + runtime by approx. 30% *) +let is_alphanum = function + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> true + | _ -> false +;; + +let get_digit_unsafe t = to_int t - to_int '0' + +let get_digit_exn t = + if is_digit t + then get_digit_unsafe t + else failwithf "Char.get_digit_exn %C: not a digit" t () +;; + +let get_digit t = if is_digit t then Some (get_digit_unsafe t) else None + +let is_hex_digit = function + | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true + | _ -> false +;; + +let is_hex_digit_lower = function + | '0' .. '9' | 'a' .. 'f' -> true + | _ -> false +;; + +let is_hex_digit_upper = function + | '0' .. '9' | 'A' .. 'F' -> true + | _ -> false +;; + +let get_hex_digit_exn = function + | '0' .. '9' as t -> to_int t - to_int '0' + | 'a' .. 'f' as t -> to_int t - to_int 'a' + 10 + | 'A' .. 'F' as t -> to_int t - to_int 'A' + 10 + | t -> + Error.raise_s + (Sexp.message + "Char.get_hex_digit_exn: not a hexadecimal digit" + [ "char", sexp_of_t t ]) +;; + +let get_hex_digit t = if is_hex_digit t then Some (get_hex_digit_exn t) else None + +module O = struct + let ( >= ) = ( >= ) + let ( <= ) = ( <= ) + let ( = ) = ( = ) + let ( > ) = ( > ) + let ( < ) = ( < ) + let ( <> ) = ( <> ) +end + +module Caseless = struct + module T = struct + type t = char [@@deriving_inline sexp, sexp_grammar] + + let t_of_sexp = (char_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_char : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = char_sexp_grammar + + [@@@end] + + let compare c1 c2 = compare (lowercase c1) (lowercase c2) + let compare__local c1 c2 = compare c1 c2 + let hash_fold_t state t = hash_fold_char state (lowercase t) + let hash t = Hash.run hash_fold_t t + end + + include T + include Comparable.Make (T) + + let equal__local t1 t2 = equal_int (compare__local t1 t2) 0 +end + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Char_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/char.mli b/unikernel/duniverse/base/src/char.mli new file mode 100644 index 00000000..044afab0 --- /dev/null +++ b/unikernel/duniverse/base/src/char.mli @@ -0,0 +1,107 @@ +(** A type for 8-bit characters. *) + +open! Import + +(** An alias for the type of characters. *) +type t = char [@@deriving_inline enumerate, globalize, sexp, sexp_grammar] + +include Ppx_enumerate_lib.Enumerable.S with type t := t + +val globalize : t -> t + +include Sexplib0.Sexpable.S with type t := t + +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Identifiable.S with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t +include Invariant.S with type t := t +module O : Comparisons.Infix with type t := t + +(** Returns the ASCII code of the argument. *) +val to_int : t -> int + +(** Returns the character with the given ASCII code or [None] is the argument is outside + the range 0 to 255. *) +val of_int : int -> t option + +(** Returns the character with the given ASCII code. Raises [Failure] if the argument is + outside the range 0 to 255. *) +val of_int_exn : int -> t + +val unsafe_of_int : int -> t + +(** Returns a string representing the given character, with special characters escaped + following the lexical conventions of OCaml. *) +val escaped : t -> string + +(** Converts the given character to its equivalent lowercase character. *) +val lowercase : t -> t + +(** Converts the given character to its equivalent uppercase character. *) +val uppercase : t -> t + +(** '0' - '9' *) +val is_digit : t -> bool + +(** 'a' - 'z' *) +val is_lowercase : t -> bool + +(** 'A' - 'Z' *) +val is_uppercase : t -> bool + +(** 'a' - 'z' or 'A' - 'Z' *) +val is_alpha : t -> bool + +(** 'a' - 'z' or 'A' - 'Z' or '0' - '9' *) +val is_alphanum : t -> bool + +(** ' ' - '~' *) +val is_print : t -> bool + +(** ' ' or '\t' or '\r' or '\n' *) +val is_whitespace : t -> bool + +(** Returns [Some i] if [is_digit c] and [None] otherwise. *) +val get_digit : t -> int option + +(** Returns [i] if [is_digit c] and raises [Failure] otherwise. *) +val get_digit_exn : t -> int + +(** '0' - '9' or 'a' - 'f' or 'A' - 'F' *) +val is_hex_digit : t -> bool + +(** '0' - '9' or 'a' - 'f' *) +val is_hex_digit_lower : t -> bool + +(** '0' - '9' or 'A' - 'F' *) +val is_hex_digit_upper : t -> bool + +(** Returns [Some i] where [0 <= i && i < 16] if [is_hex_digit c] and [None] otherwise. *) +val get_hex_digit : t -> int option + +(** Same as [get_hex_digit] but raises instead of returning None. *) +val get_hex_digit_exn : t -> int + +val min_value : t +val max_value : t + +(** [Caseless] compares and hashes characters ignoring case, so that for example + [Caseless.equal 'A' 'a'] and [Caseless.('a' < 'B')] are [true]. *) +module Caseless : sig + type nonrec t = t [@@deriving_inline hash, sexp, sexp_grammar] + + include Ppx_hash_lib.Hashable.S with type t := t + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Comparable.S with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t +end diff --git a/unikernel/duniverse/base/src/char0.ml b/unikernel/duniverse/base/src/char0.ml new file mode 100644 index 00000000..36bca106 --- /dev/null +++ b/unikernel/duniverse/base/src/char0.ml @@ -0,0 +1,32 @@ +(* [Char0] defines char functions that are primitives or can be simply defined in terms of + [Stdlib.Char]. [Char0] is intended to completely express the part of [Stdlib.Char] that + [Base] uses -- no other file in Base other than char0.ml should use [Stdlib.Char]. + [Char0] has few dependencies, and so is available early in Base's build order. All + Base files that need to use chars and come before [Base.Char] in build order should do + [module Char = Char0]. Defining [module Char = Char0] is also necessary because it + prevents ocamldep from mistakenly causing a file to depend on [Base.Char]. *) + +open! Import0 + +let failwithf = Printf.failwithf +let escaped = Stdlib.Char.escaped +let lowercase = Stdlib.Char.lowercase_ascii +let to_int = Stdlib.Char.code +let unsafe_of_int = Stdlib.Char.unsafe_chr +let uppercase = Stdlib.Char.uppercase_ascii + +(* We use our own range test when converting integers to chars rather than + calling [Stdlib.Char.chr] because it's simple and it saves us a function call + and the try-with (exceptions cost, especially in the world with backtraces). *) +let int_is_ok i = 0 <= i && i <= 255 +let min_value = unsafe_of_int 0 +let max_value = unsafe_of_int 255 +let of_int i = if int_is_ok i then Some (unsafe_of_int i) else None + +let of_int_exn i = + if int_is_ok i + then unsafe_of_int i + else failwithf "Char.of_int_exn got integer out of range: %d" i () +;; + +let equal (t1 : char) t2 = Poly.equal t1 t2 diff --git a/unikernel/duniverse/base/src/comparable.ml b/unikernel/duniverse/base/src/comparable.ml new file mode 100644 index 00000000..e55dca76 --- /dev/null +++ b/unikernel/duniverse/base/src/comparable.ml @@ -0,0 +1,205 @@ +open! Import +include Comparable_intf + +module With_zero (T : sig + type t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S with type t := t + + [@@@end] + + val zero : t +end) = +struct + open T + + let is_positive t = compare t zero > 0 + let is_non_negative t = compare t zero >= 0 + let is_negative t = compare t zero < 0 + let is_non_positive t = compare t zero <= 0 + let sign t = Sign0.of_int (compare t zero) +end + +module Poly (T : sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end) = +struct + module Replace_polymorphic_compare = struct + type t = T.t [@@deriving_inline sexp_of] + + let sexp_of_t = (T.sexp_of_t : t -> Sexplib0.Sexp.t) + + [@@@end] + + include Poly + end + + include Poly + + let between t ~low ~high = low <= t && t <= high + let clamp_unchecked t ~min ~max = if t < min then min else if t <= max then t else max + + let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max + ;; + + let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) + ;; + + module C = struct + include T + include Comparator.Make (Replace_polymorphic_compare) + end + + include C +end + +let gt cmp a b = cmp a b > 0 +let lt cmp a b = cmp a b < 0 +let geq cmp a b = cmp a b >= 0 +let leq cmp a b = cmp a b <= 0 +let equal cmp a b = cmp a b = 0 +let not_equal cmp a b = cmp a b <> 0 +let min cmp t t' = if leq cmp t t' then t else t' +let max cmp t t' = if geq cmp t t' then t else t' + +module Infix (T : sig + type t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S with type t := t + + [@@@end] +end) : Infix with type t := T.t = struct + let ( > ) a b = gt T.compare a b + let ( < ) a b = lt T.compare a b + let ( >= ) a b = geq T.compare a b + let ( <= ) a b = leq T.compare a b + let ( = ) a b = equal T.compare a b + let ( <> ) a b = not_equal T.compare a b +end +[@@inline always] + +module Comparisons (T : sig + type t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S with type t := t + + [@@@end] +end) : Comparisons with type t := T.t = struct + include Infix (T) + + let compare = T.compare + let equal = ( = ) + let min t t' = min compare t t' + let max t t' = max compare t t' +end +[@@inline always] + +module Make_using_comparator (T : sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + include Comparator.S with type t := t +end) : S with type t := T.t and type comparator_witness = T.comparator_witness = struct + module T = struct + include T + + let compare = comparator.compare + end + + include T + module Replace_polymorphic_compare = Comparisons (T) + include Replace_polymorphic_compare + + let ascending = compare + let descending t t' = compare t' t + let between t ~low ~high = low <= t && t <= high + let clamp_unchecked t ~min ~max = if t < min then min else if t <= max then t else max + + let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max + ;; + + let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) + ;; +end + +module Make (T : sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end) = +Make_using_comparator [@inlined hint] (struct + include T + include Comparator.Make (T) +end) + +module Inherit (C : sig + type t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S with type t := t + + [@@@end] +end) (T : sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + val component : t -> C.t +end) = +Make (struct + type t = T.t [@@deriving_inline sexp_of] + + let sexp_of_t = (T.sexp_of_t : t -> Sexplib0.Sexp.t) + + [@@@end] + + let compare t t' = C.compare (T.component t) (T.component t') +end) + +(* compare [x] and [y] lexicographically using functions in the list [cmps] *) +let lexicographic cmps x y = + let rec loop = function + | cmp :: cmps -> + let res = cmp x y in + if res = 0 then loop cmps else res + | [] -> 0 + in + loop cmps +;; + +let lift cmp ~f x y = cmp (f x) (f y) +let reverse cmp x y = cmp y x + +type 'a reversed = 'a + +let compare_reversed cmp x y = cmp y x diff --git a/unikernel/duniverse/base/src/comparable.mli b/unikernel/duniverse/base/src/comparable.mli new file mode 100644 index 00000000..da677d94 --- /dev/null +++ b/unikernel/duniverse/base/src/comparable.mli @@ -0,0 +1 @@ +include Comparable_intf.Comparable (** @inline *) diff --git a/unikernel/duniverse/base/src/comparable_intf.ml b/unikernel/duniverse/base/src/comparable_intf.ml new file mode 100644 index 00000000..30bd0b00 --- /dev/null +++ b/unikernel/duniverse/base/src/comparable_intf.ml @@ -0,0 +1,229 @@ +open! Import + +module type Infix = Comparisons.Infix +module type Comparisons = Comparisons.S + +module Sign = Sign0 (** @canonical Base.Sign *) + +module type With_compare = sig + (** Various combinators for [compare] and [equal] functions. *) + + (** [lexicographic cmps x y] compares [x] and [y] lexicographically using functions in the + list [cmps]. *) + val lexicographic : ('a -> 'a -> int) list -> 'a -> 'a -> int + + (** [lift cmp ~f x y] compares [x] and [y] by comparing [f x] and [f y] via [cmp]. *) + val lift : ('a -> 'a -> 'result) -> f:('b -> 'a) -> 'b -> 'b -> 'result + + (** [reverse cmp x y = cmp y x] + + Reverses the direction of asymmetric relations by swapping their arguments. Useful, + e.g., for relations implementing "is a subset of" or "is a descendant of". + + Where reversed relations are already provided, use them directly. For example, + [Comparable.S] provides [ascending] and [descending], which are more readable as a + pair than [compare] and [reverse compare]. Similarly, [<=] is more idiomatic than + [reverse (>=)]. *) + val reverse : ('a -> 'a -> 'result) -> 'a -> 'a -> 'result + + (** {!reversed} is the identity type but its associated compare function is the same as + the {!reverse} function above. It allows you to get reversed comparisons with + [ppx_compare], writing, for example, [[%compare: string Comparable.reversed]] to + have strings ordered in the reverse order. *) + type 'a reversed = 'a + + val compare_reversed : ('a -> 'a -> int) -> 'a reversed -> 'a reversed -> int + + (** The functions below are analogues of the type-specific functions exported by the + [Comparable.S] interface. *) + + val equal : ('a -> 'a -> int) -> 'a -> 'a -> bool + val max : ('a -> 'a -> int) -> 'a -> 'a -> 'a + val min : ('a -> 'a -> int) -> 'a -> 'a -> 'a +end + +module type With_zero = sig + type t + + val is_positive : t -> bool + val is_non_negative : t -> bool + val is_negative : t -> bool + val is_non_positive : t -> bool + + (** Returns [Neg], [Zero], or [Pos] in a way consistent with the above functions. *) + val sign : t -> Sign.t +end + +module type S = sig + include Comparisons + + (** [ascending] is identical to [compare]. [descending x y = ascending y x]. These are + intended to be mnemonic when used like [List.sort ~compare:ascending] and [List.sort + ~cmp:descending], since they cause the list to be sorted in ascending or descending + order, respectively. *) + val ascending : t -> t -> int + + val descending : t -> t -> int + + (** [between t ~low ~high] means [low <= t <= high] *) + val between : t -> low:t -> high:t -> bool + + (** [clamp_exn t ~min ~max] returns [t'], the closest value to [t] such that + [between t' ~low:min ~high:max] is true. + + Raises if [not (min <= max)]. *) + val clamp_exn : t -> min:t -> max:t -> t + + val clamp : t -> min:t -> max:t -> t Or_error.t + + include Comparator.S with type t := t +end + +(** Usage example: + + {[ + module Foo : sig + type t = ... + include Comparable.S with type t := t + end + ]} + + Then use [Comparable.Make] in the struct (see comparable.mli for an example). *) + +module type Comparable = sig + (** Defines functors for making modules comparable. *) + + (** Usage example: + + {[ + module Foo = struct + module T = struct + type t = ... [@@deriving compare, sexp] + end + include T + include Comparable.Make (T) + end + ]} + + Then include [Comparable.S] in the signature + + {[ + module Foo : sig + type t = ... + include Comparable.S with type t := t + end + ]} + + To add an [Infix] submodule: + + {[ + module C = Comparable.Make (T) + include C + module Infix = (C : Comparable.Infix with type t := t) + ]} + + A common pattern is to define a module [O] with a restricted signature. It aims to be + (locally) opened to bring useful operators into scope without shadowing unexpected + variable names. E.g., in the [Date] module: + + {[ + module O = struct + include (C : Comparable.Infix with type t := t) + let to_string t = .. + end + ]} + + Opening [Date] would shadow [now], but opening [Date.O] doesn't: + + {[ + let now = .. in + let someday = .. in + Date.O.(now > someday) + ]} *) + + module type Infix = Infix + module type S = S + module type Comparisons = Comparisons + module type With_compare = With_compare + module type With_zero = With_zero + + include With_compare + + (** Derive [Infix] or [Comparisons] functions from just [[@@deriving compare]], + without need for the [sexp_of_t] required by [Make*] (see below). *) + + module Infix (T : sig + type t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S with type t := t + + [@@@end] + end) : Infix with type t := T.t + + module Comparisons (T : sig + type t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S with type t := t + + [@@@end] + end) : Comparisons with type t := T.t + + (** Inherit comparability from a component. *) + module Inherit (C : sig + type t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S with type t := t + + [@@@end] + end) (T : sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + val component : t -> C.t + end) : S with type t := T.t + + module Make (T : sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + end) : S with type t := T.t + + module Make_using_comparator (T : sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + include Comparator.S with type t := t + end) : S with type t := T.t with type comparator_witness := T.comparator_witness + + module Poly (T : sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + end) : S with type t := T.t + + module With_zero (T : sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + val zero : t + end) : sig + include With_zero with type t := T.t + end +end diff --git a/unikernel/duniverse/base/src/comparator.ml b/unikernel/duniverse/base/src/comparator.ml new file mode 100644 index 00000000..30209876 --- /dev/null +++ b/unikernel/duniverse/base/src/comparator.ml @@ -0,0 +1,214 @@ +open! Import + +type ('a, 'witness) t = + { compare : 'a -> 'a -> int + ; sexp_of_t : 'a -> Sexp.t + } + +type ('a, 'b) comparator = ('a, 'b) t + +module type S = sig + type t + type comparator_witness + + val comparator : (t, comparator_witness) comparator +end + +module type S1 = sig + type 'a t + type comparator_witness + + val comparator : ('a t, comparator_witness) comparator +end + +module type S_fc = sig + type comparable_t + + include S with type t := comparable_t +end + +module Module = struct + type ('a, 'b) t = (module S with type t = 'a and type comparator_witness = 'b) +end + +let of_module (type a b) ((module M) : (a, b) Module.t) = M.comparator + +let to_module (type a b) t : (a, b) Module.t = + (module struct + type t = a + type comparator_witness = b + + let comparator = t + end) +;; + +let make (type t) ~compare ~sexp_of_t = + (module struct + type comparable_t = t + type comparator_witness + + let comparator = { compare; sexp_of_t } + end : S_fc + with type comparable_t = t) +;; + +module S_to_S1 (S : S) = struct + type 'a t = S.t + type comparator_witness = S.comparator_witness + + open S + + let comparator = comparator +end + +module Make (M : sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end) = +struct + include M + + type comparator_witness + + let comparator = M.{ compare; sexp_of_t } +end + +module Make1 (M : sig + type 'a t + + val compare : 'a t -> 'a t -> int + val sexp_of_t : 'a t -> Sexp.t +end) = +struct + type comparator_witness + + let comparator = M.{ compare; sexp_of_t } +end + +module Poly = struct + type 'a t = 'a + + include Make1 (struct + type 'a t = 'a + + let compare = Poly.compare + let sexp_of_t _ = Sexp.Atom "_" + end) +end + +module type Derived = sig + type 'a t + type !'cmp comparator_witness + + val comparator : ('a, 'cmp) comparator -> ('a t, 'cmp comparator_witness) comparator +end + +module Derived (M : sig + type 'a t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + + [@@@end] +end) = +struct + type !'cmp comparator_witness + + let comparator a = + { compare = M.compare a.compare; sexp_of_t = M.sexp_of_t a.sexp_of_t } + ;; +end + +module type Derived2 = sig + type ('a, 'b) t + type (!'cmp_a, !'cmp_b) comparator_witness + + val comparator + : ('a, 'cmp_a) comparator + -> ('b, 'cmp_b) comparator + -> (('a, 'b) t, ('cmp_a, 'cmp_b) comparator_witness) comparator +end + +module Derived2 (M : sig + type ('a, 'b) t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t + + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t + + [@@@end] +end) = +struct + type (!'cmp_a, !'cmp_b) comparator_witness + + let comparator a b = + { compare = M.compare a.compare b.compare + ; sexp_of_t = M.sexp_of_t a.sexp_of_t b.sexp_of_t + } + ;; +end + +module type Derived_phantom = sig + type ('a, 'b) t + type 'cmp comparator_witness + + val comparator + : ('a, 'cmp) comparator + -> (('a, _) t, 'cmp comparator_witness) comparator +end + +module Derived_phantom (M : sig + type ('a, 'b) t + + val compare : ('a -> 'a -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + val sexp_of_t : ('a -> Sexp.t) -> ('a, _) t -> Sexp.t +end) = +struct + type 'cmp_a comparator_witness + + let comparator a = + { compare = M.compare a.compare; sexp_of_t = M.sexp_of_t a.sexp_of_t } + ;; +end + +module type Derived2_phantom = sig + type ('a, 'b, 'c) t + type (!'cmp_a, !'cmp_b) comparator_witness + + val comparator + : ('a, 'cmp_a) comparator + -> ('b, 'cmp_b) comparator + -> (('a, 'b, _) t, ('cmp_a, 'cmp_b) comparator_witness) comparator +end + +module Derived2_phantom (M : sig + type ('a, 'b, 'c) t + + val compare + : ('a -> 'a -> int) + -> ('b -> 'b -> int) + -> ('a, 'b, 'c) t + -> ('a, 'b, 'c) t + -> int + + val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b, _) t -> Sexp.t +end) = +struct + type (!'cmp_a, !'cmp_b) comparator_witness + + let comparator a b = + { compare = M.compare a.compare b.compare + ; sexp_of_t = M.sexp_of_t a.sexp_of_t b.sexp_of_t + } + ;; +end diff --git a/unikernel/duniverse/base/src/comparator.mli b/unikernel/duniverse/base/src/comparator.mli new file mode 100644 index 00000000..a3fa35e7 --- /dev/null +++ b/unikernel/duniverse/base/src/comparator.mli @@ -0,0 +1,170 @@ +(** Comparison and serialization for a type, using a witness type to distinguish between + comparison functions with different behavior. *) + +open! Import + +(** [('a, 'witness) t] contains a comparison function for values of type ['a]. Two values + of type [t] with the same ['witness] are guaranteed to have the same comparison + function. *) +type ('a, 'witness) t = private + { compare : 'a -> 'a -> int + ; sexp_of_t : 'a -> Sexp.t + } + +type ('a, 'b) comparator = ('a, 'b) t + +module type S = sig + type t + type comparator_witness + + val comparator : (t, comparator_witness) comparator +end + +module type S1 = sig + type 'a t + type comparator_witness + + val comparator : ('a t, comparator_witness) comparator +end + +module type S_fc = sig + type comparable_t + + include S with type t := comparable_t +end + +(** [make] creates a comparator witness for the given comparison. It is intended as a + lightweight alternative to the functors below, to be used like so: + + {[ + include (val Comparator.make ~compare ~sexp_of_t) + ]} +*) +val make + : compare:('a -> 'a -> int) + -> sexp_of_t:('a -> Sexp.t) + -> (module S_fc with type comparable_t = 'a) + +module Poly : S1 with type 'a t = 'a + +module Module : sig + (** First-class module providing a comparator and witness type. *) + type ('a, 'b) t = (module S with type t = 'a and type comparator_witness = 'b) +end + +val of_module : ('a, 'b) Module.t -> ('a, 'b) t +val to_module : ('a, 'b) t -> ('a, 'b) Module.t + +module S_to_S1 (S : S) : + S1 with type 'a t = S.t with type comparator_witness = S.comparator_witness + +(** [Make] creates a [comparator] value and its phantom [comparator_witness] type for a + nullary type. *) +module Make (M : sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end) : S with type t := M.t + +(** [Make1] creates a [comparator] value and its phantom [comparator_witness] type for a + unary type. It takes a [compare] and [sexp_of_t] that have + non-standard types because the [Comparator.t] type doesn't allow passing in + additional values for the type argument. *) +module Make1 (M : sig + type 'a t + + val compare : 'a t -> 'a t -> int + val sexp_of_t : _ t -> Sexp.t +end) : S1 with type 'a t := 'a M.t + +module type Derived = sig + type 'a t + type !'cmp comparator_witness + + val comparator : ('a, 'cmp) comparator -> ('a t, 'cmp comparator_witness) comparator +end + +(** [Derived] creates a [comparator] function that constructs a comparator for the type + ['a t] given a comparator for the type ['a]. *) +module Derived (M : sig + type 'a t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + + [@@@end] +end) : Derived with type 'a t := 'a M.t + +module type Derived2 = sig + type ('a, 'b) t + type (!'cmp_a, !'cmp_b) comparator_witness + + val comparator + : ('a, 'cmp_a) comparator + -> ('b, 'cmp_b) comparator + -> (('a, 'b) t, ('cmp_a, 'cmp_b) comparator_witness) comparator +end + +(** [Derived2] creates a [comparator] function that constructs a comparator for the type + [('a, 'b) t] given comparators for the type ['a] and ['b]. *) +module Derived2 (M : sig + type ('a, 'b) t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t + + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t + + [@@@end] +end) : Derived2 with type ('a, 'b) t := ('a, 'b) M.t + +module type Derived_phantom = sig + type ('a, 'b) t + type 'cmp comparator_witness + + val comparator + : ('a, 'cmp) comparator + -> (('a, _) t, 'cmp comparator_witness) comparator +end + +(** [Derived_phantom] creates a [comparator] function that constructs a comparator for the + type [('a, 'b) t] given a comparator for the type ['a]. *) +module Derived_phantom (M : sig + type ('a, 'b) t + + val compare : ('a -> 'a -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + val sexp_of_t : ('a -> Sexp.t) -> ('a, _) t -> Sexp.t +end) : Derived_phantom with type ('a, 'b) t := ('a, 'b) M.t + +module type Derived2_phantom = sig + type ('a, 'b, 'c) t + type (!'cmp_a, !'cmp_b) comparator_witness + + val comparator + : ('a, 'cmp_a) comparator + -> ('b, 'cmp_b) comparator + -> (('a, 'b, _) t, ('cmp_a, 'cmp_b) comparator_witness) comparator +end + +(** [Derived2_phantom] creates a [comparator] function that constructs a comparator for the + type [('a, 'b, 'c) t] given a comparator for the types ['a] and ['b]. *) +module Derived2_phantom (M : sig + type ('a, 'b, 'c) t + + val compare + : ('a -> 'a -> int) + -> ('b -> 'b -> int) + -> ('a, 'b, 'c) t + -> ('a, 'b, 'c) t + -> int + + val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b, _) t -> Sexp.t +end) : Derived2_phantom with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t diff --git a/unikernel/duniverse/base/src/comparisons.ml b/unikernel/duniverse/base/src/comparisons.ml new file mode 100644 index 00000000..8339f968 --- /dev/null +++ b/unikernel/duniverse/base/src/comparisons.ml @@ -0,0 +1,45 @@ +(** Interfaces for infix comparison operators and comparison functions. *) + +open! Import + +(** [Infix] lists the typical infix comparison operators. These functions are provided by + [.O] modules, i.e., modules that expose monomorphic infix comparisons over some + [.t]. *) +module type Infix = sig + type t + + val ( >= ) : t -> t -> bool + val ( <= ) : t -> t -> bool + val ( = ) : t -> t -> bool + val ( > ) : t -> t -> bool + val ( < ) : t -> t -> bool + val ( <> ) : t -> t -> bool +end + +module type S = sig + include Infix + + val equal : t -> t -> bool + + (** [compare t1 t2] returns 0 if [t1] is equal to [t2], a negative integer if [t1] is + less than [t2], and a positive integer if [t1] is greater than [t2]. *) + val compare : t -> t -> int + + val min : t -> t -> t + val max : t -> t -> t +end + +module type S_with_local_opt = sig + type t + + external ( < ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%lessthan" + external ( <= ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%lessequal" + external ( <> ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%notequal" + external ( = ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%equal" + external ( > ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%greaterthan" + external ( >= ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%greaterequal" + external equal : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%equal" + external compare : (t[@local_opt]) -> (t[@local_opt]) -> int = "%compare" + val min : t -> t -> t + val max : t -> t -> t +end diff --git a/unikernel/duniverse/base/src/container.ml b/unikernel/duniverse/base/src/container.ml new file mode 100644 index 00000000..e9686881 --- /dev/null +++ b/unikernel/duniverse/base/src/container.ml @@ -0,0 +1,230 @@ +open! Import +module Array = Array0 +module Either = Either0 +module List = List0 +include Container_intf + +let with_return = With_return.with_return + +type ('t, 'a, 'accum) fold = 't -> init:'accum -> f:('accum -> 'a -> 'accum) -> 'accum +type ('t, 'a) iter = 't -> f:('a -> unit) -> unit +type 't length = 't -> int + +let iter ~(fold : (_, _, _) fold) t ~f = fold t ~init:() ~f:(fun () a -> f a) [@nontail] +let count ~fold t ~f = fold t ~init:0 ~f:(fun n a -> if f a then n + 1 else n) [@nontail] + +let sum (type a) ~fold (module M : Summable with type t = a) t ~f = + fold t ~init:M.zero ~f:(fun n a -> M.( + ) n (f a)) [@nontail] +;; + +let fold_result ~fold ~init ~f t = + with_return (fun { return } -> + Result.Ok + (fold t ~init ~f:(fun acc item -> + match f acc item with + | Result.Ok x -> x + | Error _ as e -> return e))) [@nontail] +;; + +let fold_until ~fold ~init ~f ~finish t = + with_return (fun { return } -> + finish + (fold t ~init ~f:(fun acc item -> + match f acc item with + | Continue_or_stop.Continue x -> x + | Stop x -> return x))) [@nontail] +;; + +let min_elt ~fold t ~compare = + fold t ~init:None ~f:(fun acc elt -> + match acc with + | None -> Some elt + | Some min -> if compare min elt > 0 then Some elt else acc) [@nontail] +;; + +let max_elt ~fold t ~compare = + fold t ~init:None ~f:(fun acc elt -> + match acc with + | None -> Some elt + | Some max -> if compare max elt < 0 then Some elt else acc) [@nontail] +;; + +let length ~fold c = fold c ~init:0 ~f:(fun acc _ -> acc + 1) + +let is_empty ~iter c = + with_return (fun r -> + iter c ~f:(fun _ -> r.return false); + true) +;; + +let mem ~iter c x ~equal = + with_return (fun r -> + iter c ~f:(fun y -> if equal x y then r.return true); + false) [@nontail] +;; + +let exists ~iter c ~f = + with_return (fun r -> + iter c ~f:(fun x -> if f x then r.return true); + false) [@nontail] +;; + +let for_all ~iter c ~f = + with_return (fun r -> + iter c ~f:(fun x -> if not (f x) then r.return false); + true) [@nontail] +;; + +let find_map ~iter t ~f = + with_return (fun r -> + iter t ~f:(fun x -> + match f x with + | None -> () + | Some _ as res -> r.return res); + None) [@nontail] +;; + +let find ~iter c ~f = + with_return (fun r -> + iter c ~f:(fun x -> if f x then r.return (Some x)); + None) [@nontail] +;; + +let to_list ~fold c = List.rev (fold c ~init:[] ~f:(fun acc x -> x :: acc)) + +let to_array ~length ~iter c = + let array = ref [||] in + let i = ref 0 in + iter c ~f:(fun x -> + if !i = 0 then array := Array.create ~len:(length c) x; + !array.(!i) <- x; + incr i); + !array +;; + +module Make_gen (T : Make_gen_arg) : + Generic + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt = struct + let fold = T.fold + + let iter = + match T.iter with + | `Custom iter -> iter + | `Define_using_fold -> fun t ~f -> iter ~fold t ~f + ;; + + let length = + match T.length with + | `Custom length -> length + | `Define_using_fold -> fun t -> length ~fold t + ;; + + let is_empty t = is_empty ~iter t + let mem t x ~equal = mem ~iter t x ~equal + let sum m t = sum ~fold m t + let count t ~f = count ~fold t ~f + let exists t ~f = exists ~iter t ~f + let for_all t ~f = for_all ~iter t ~f + let find_map t ~f = find_map ~iter t ~f + let find t ~f = find ~iter t ~f + let to_list t = to_list ~fold t + let to_array t = to_array ~length ~iter t + let min_elt t ~compare = min_elt ~fold t ~compare + let max_elt t ~compare = max_elt ~fold t ~compare + let fold_result t ~init ~f = fold_result t ~fold ~init ~f + let fold_until t ~init ~f ~finish = fold_until t ~fold ~init ~f ~finish +end + +module Make (T : Make_arg) = struct + include Make_gen (struct + include T + + type ('a, _, _) t = 'a T.t + type 'a elt = 'a + end) +end + +module Make0 (T : Make0_arg) = struct + include Make_gen (struct + include T + + type ('a, _, _) t = T.t + type 'a elt = T.Elt.t + end) + + let mem t x = mem t x ~equal:T.Elt.equal +end + +module Make_gen_with_creators (T : Make_gen_with_creators_arg) : + Generic_with_creators + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom1, 'phantom2) concat := ('a, 'phantom1, 'phantom2) T.concat = +struct + include Make_gen (T) + + let of_list = T.of_list + let of_array = T.of_array + let concat = T.concat + let concat_of_array = T.concat_of_array + let append a b = concat (concat_of_array [| a; b |]) + let concat_map t ~f = concat (concat_of_array (Array.map (to_array t) ~f)) + + let filter_map t ~f = + concat_map t ~f:(fun x -> + match f x with + | None -> of_array [||] + | Some y -> of_array [| y |]) [@nontail] + ;; + + let map t ~f = filter_map t ~f:(fun x -> Some (f x)) [@nontail] + let filter t ~f = filter_map t ~f:(fun x -> if f x then Some x else None) [@nontail] + + let partition_map t ~f = + let array = Array.map (to_array t) ~f in + let xs = + Array.fold_right array ~init:[] ~f:(fun either acc -> + match (either : _ Either.t) with + | First x -> x :: acc + | Second _ -> acc) + in + let ys = + Array.fold_right array ~init:[] ~f:(fun either acc -> + match (either : _ Either.t) with + | First _ -> acc + | Second x -> x :: acc) + in + of_list xs, of_list ys + ;; + + let partition_tf t ~f = + partition_map t ~f:(fun x -> if f x then First x else Second x) [@nontail] + ;; +end + +module Make_with_creators (T : Make_with_creators_arg) = struct + include Make_gen_with_creators (struct + include T + + type ('a, _, _) t = 'a T.t + type 'a elt = 'a + type ('a, _, _) concat = 'a T.t + + let concat_of_array = of_array + end) +end + +module Make0_with_creators (T : Make0_with_creators_arg) = struct + include Make_gen_with_creators (struct + include T + + type ('a, _, _) t = T.t + type 'a elt = T.Elt.t + type ('a, _, _) concat = 'a list + + let concat_of_array = Array.to_list + end) + + let mem t x = mem t x ~equal:T.Elt.equal +end diff --git a/unikernel/duniverse/base/src/container.mli b/unikernel/duniverse/base/src/container.mli new file mode 100644 index 00000000..37313b1c --- /dev/null +++ b/unikernel/duniverse/base/src/container.mli @@ -0,0 +1 @@ +include Container_intf.Container (** @inline *) diff --git a/unikernel/duniverse/base/src/container_intf.ml b/unikernel/duniverse/base/src/container_intf.ml new file mode 100644 index 00000000..e9ff98aa --- /dev/null +++ b/unikernel/duniverse/base/src/container_intf.ml @@ -0,0 +1,775 @@ +(** Provides generic signatures for container data structures. + + These signatures include functions ([iter], [fold], [exists], [for_all], ...) that + you would expect to find in any container. Used by including [Container.S0] or + [Container.S1] in the signature for every container-like data structure ([Array], + [List], [String], ...) to ensure a consistent interface. *) + +open! Import + +module Export = struct + (** [Continue_or_stop.t] is used by the [f] argument to [fold_until] in order to + indicate whether folding should continue, or stop early. + + @canonical Base.Container.Continue_or_stop + *) + module Continue_or_stop = struct + type ('a, 'b) t = + | Continue of 'a + | Stop of 'b + end +end + +include Export + +(** @canonical Base.Container.Summable *) +module type Summable = sig + type t + + (** The result of summing no values. *) + val zero : t + + (** An operation that combines two [t]'s and handles [zero + x] by just returning [x], + as well as in the symmetric case. *) + val ( + ) : t -> t -> t +end + +(** Signature for monomorphic container - a container for a specific element type, e.g., + string, which is a container of characters ([type elt = char]) and never of anything + else. *) +module type S0 = sig + type t + type elt + + (** Checks whether the provided element is there, using equality on [elt]s. *) + val mem : t -> elt -> bool + + val length : t -> int + val is_empty : t -> bool + + (** [iter] must allow exceptions raised in [f] to escape, terminating the iteration + cleanly. The same holds for all functions below taking an [f]. *) + val iter : t -> f:(elt -> unit) -> unit + + (** [fold t ~init ~f] returns [f (... f (f (f init e1) e2) e3 ...) en], where [e1..en] + are the elements of [t]. *) + val fold : t -> init:'acc -> f:('acc -> elt -> 'acc) -> 'acc + + (** [fold_result t ~init ~f] is a short-circuiting version of [fold] that runs in the + [Result] monad. If [f] returns an [Error _], that value is returned without any + additional invocations of [f]. *) + val fold_result + : t + -> init:'acc + -> f:('acc -> elt -> ('acc, 'e) Result.t) + -> ('acc, 'e) Result.t + + (** [fold_until t ~init ~f ~finish] is a short-circuiting version of [fold]. If [f] + returns [Stop _] the computation ceases and results in that value. If [f] returns + [Continue _], the fold will proceed. If [f] never returns [Stop _], the final result + is computed by [finish]. + + Example: + + {[ + type maybe_negative = + | Found_negative of int + | All_nonnegative of { sum : int } + + (** [first_neg_or_sum list] returns the first negative number in [list], if any, + otherwise returns the sum of the list. *) + let first_neg_or_sum = + List.fold_until ~init:0 + ~f:(fun sum x -> + if x < 0 + then Stop (Found_negative x) + else Continue (sum + x)) + ~finish:(fun sum -> All_nonnegative { sum }) + ;; + + let x = first_neg_or_sum [1; 2; 3; 4; 5] + val x : maybe_negative = All_nonnegative {sum = 15} + + let y = first_neg_or_sum [1; 2; -3; 4; 5] + val y : maybe_negative = Found_negative -3 + ]} *) + val fold_until + : t + -> init:'acc + -> f:('acc -> elt -> ('acc, 'final) Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + (** Returns [true] if and only if there exists an element for which the provided + function evaluates to [true]. This is a short-circuiting operation. *) + val exists : t -> f:(elt -> bool) -> bool + + (** Returns [true] if and only if the provided function evaluates to [true] for all + elements. This is a short-circuiting operation. *) + val for_all : t -> f:(elt -> bool) -> bool + + (** Returns the number of elements for which the provided function evaluates to true. *) + val count : t -> f:(elt -> bool) -> int + + (** Returns the sum of [f i] for all [i] in the container. *) + val sum : (module Summable with type t = 'sum) -> t -> f:(elt -> 'sum) -> 'sum + + (** Returns as an [option] the first element for which [f] evaluates to true. *) + val find : t -> f:(elt -> bool) -> elt option + + (** Returns the first evaluation of [f] that returns [Some], and returns [None] if there + is no such element. *) + val find_map : t -> f:(elt -> 'a option) -> 'a option + + val to_list : t -> elt list + val to_array : t -> elt array + + (** Returns a min (resp. max) element from the collection using the provided [compare] + function. In case of a tie, the first element encountered while traversing the + collection is returned. The implementation uses [fold] so it has the same + complexity as [fold]. Returns [None] iff the collection is empty. *) + val min_elt : t -> compare:(elt -> elt -> int) -> elt option + + val max_elt : t -> compare:(elt -> elt -> int) -> elt option +end + +module type S0_phantom = sig + type elt + type 'a t + + (** Checks whether the provided element is there, using equality on [elt]s. *) + val mem : _ t -> elt -> bool + + val length : _ t -> int + val is_empty : _ t -> bool + val iter : _ t -> f:(elt -> unit) -> unit + + (** [fold t ~init ~f] returns [f (... f (f (f init e1) e2) e3 ...) en], where [e1..en] + are the elements of [t]. *) + val fold : _ t -> init:'acc -> f:('acc -> elt -> 'acc) -> 'acc + + (** [fold_result t ~init ~f] is a short-circuiting version of [fold] that runs in the + [Result] monad. If [f] returns an [Error _], that value is returned without any + additional invocations of [f]. *) + val fold_result + : _ t + -> init:'acc + -> f:('acc -> elt -> ('acc, 'e) Result.t) + -> ('acc, 'e) Result.t + + (** [fold_until t ~init ~f ~finish] is a short-circuiting version of [fold]. If [f] + returns [Stop _] the computation ceases and results in that value. If [f] returns + [Continue _], the fold will proceed. If [f] never returns [Stop _], the final result + is computed by [finish]. + + Example: + + {[ + type maybe_negative = + | Found_negative of int + | All_nonnegative of { sum : int } + + (** [first_neg_or_sum list] returns the first negative number in [list], if any, + otherwise returns the sum of the list. *) + let first_neg_or_sum = + List.fold_until ~init:0 + ~f:(fun sum x -> + if x < 0 + then Stop (Found_negative x) + else Continue (sum + x)) + ~finish:(fun sum -> All_nonnegative { sum }) + ;; + + let x = first_neg_or_sum [1; 2; 3; 4; 5] + val x : maybe_negative = All_nonnegative {sum = 15} + + let y = first_neg_or_sum [1; 2; -3; 4; 5] + val y : maybe_negative = Found_negative -3 + ]} *) + val fold_until + : _ t + -> init:'acc + -> f:('acc -> elt -> ('acc, 'final) Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + (** Returns [true] if and only if there exists an element for which the provided + function evaluates to [true]. This is a short-circuiting operation. *) + val exists : _ t -> f:(elt -> bool) -> bool + + (** Returns [true] if and only if the provided function evaluates to [true] for all + elements. This is a short-circuiting operation. *) + val for_all : _ t -> f:(elt -> bool) -> bool + + (** Returns the number of elements for which the provided function evaluates to true. *) + val count : _ t -> f:(elt -> bool) -> int + + (** Returns the sum of [f i] for all [i] in the container. The order in which the + elements will be summed is unspecified. *) + val sum : (module Summable with type t = 'sum) -> _ t -> f:(elt -> 'sum) -> 'sum + + (** Returns as an [option] the first element for which [f] evaluates to true. *) + val find : _ t -> f:(elt -> bool) -> elt option + + (** Returns the first evaluation of [f] that returns [Some], and returns [None] if there + is no such element. *) + val find_map : _ t -> f:(elt -> 'a option) -> 'a option + + val to_list : _ t -> elt list + val to_array : _ t -> elt array + + (** Returns a min (resp max) element from the collection using the provided [compare] + function, or [None] if the collection is empty. In case of a tie, the first element + encountered while traversing the collection is returned. *) + val min_elt : _ t -> compare:(elt -> elt -> int) -> elt option + + val max_elt : _ t -> compare:(elt -> elt -> int) -> elt option +end + +(** Signature for polymorphic container, e.g., ['a list] or ['a array]. *) +module type S1 = sig + type 'a t + + (** Checks whether the provided element is there, using [equal]. *) + val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool + + val length : 'a t -> int + val is_empty : 'a t -> bool + val iter : 'a t -> f:('a -> unit) -> unit + + (** [fold t ~init ~f] returns [f (... f (f (f init e1) e2) e3 ...) en], where [e1..en] + are the elements of [t] *) + val fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc + + (** [fold_result t ~init ~f] is a short-circuiting version of [fold] that runs in the + [Result] monad. If [f] returns an [Error _], that value is returned without any + additional invocations of [f]. *) + val fold_result + : 'a t + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'e) Result.t) + -> ('acc, 'e) Result.t + + (** [fold_until t ~init ~f ~finish] is a short-circuiting version of [fold]. If [f] + returns [Stop _] the computation ceases and results in that value. If [f] returns + [Continue _], the fold will proceed. If [f] never returns [Stop _], the final result + is computed by [finish]. + + Example: + + {[ + type maybe_negative = + | Found_negative of int + | All_nonnegative of { sum : int } + + (** [first_neg_or_sum list] returns the first negative number in [list], if any, + otherwise returns the sum of the list. *) + let first_neg_or_sum = + List.fold_until ~init:0 + ~f:(fun sum x -> + if x < 0 + then Stop (Found_negative x) + else Continue (sum + x)) + ~finish:(fun sum -> All_nonnegative { sum }) + ;; + + let x = first_neg_or_sum [1; 2; 3; 4; 5] + val x : maybe_negative = All_nonnegative {sum = 15} + + let y = first_neg_or_sum [1; 2; -3; 4; 5] + val y : maybe_negative = Found_negative -3 + ]} *) + val fold_until + : 'a t + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'final) Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + (** Returns [true] if and only if there exists an element for which the provided + function evaluates to [true]. This is a short-circuiting operation. *) + val exists : 'a t -> f:('a -> bool) -> bool + + (** Returns [true] if and only if the provided function evaluates to [true] for all + elements. This is a short-circuiting operation. *) + val for_all : 'a t -> f:('a -> bool) -> bool + + (** Returns the number of elements for which the provided function evaluates to true. *) + val count : 'a t -> f:('a -> bool) -> int + + (** Returns the sum of [f i] for all [i] in the container. *) + + val sum : (module Summable with type t = 'sum) -> 'a t -> f:('a -> 'sum) -> 'sum + + (** Returns as an [option] the first element for which [f] evaluates to true. *) + val find : 'a t -> f:('a -> bool) -> 'a option + + (** Returns the first evaluation of [f] that returns [Some], and returns [None] if there + is no such element. *) + val find_map : 'a t -> f:('a -> 'b option) -> 'b option + + val to_list : 'a t -> 'a list + val to_array : 'a t -> 'a array + + (** Returns a minimum (resp maximum) element from the collection using the provided + [compare] function, or [None] if the collection is empty. In case of a tie, the first + element encountered while traversing the collection is returned. The implementation + uses [fold] so it has the same complexity as [fold]. *) + val min_elt : 'a t -> compare:('a -> 'a -> int) -> 'a option + + val max_elt : 'a t -> compare:('a -> 'a -> int) -> 'a option +end + +module type S1_phantom = sig + type ('a, 'phantom) t + + (** Checks whether the provided element is there, using [equal]. *) + val mem : ('a, _) t -> 'a -> equal:('a -> 'a -> bool) -> bool + + val length : (_, _) t -> int + val is_empty : (_, _) t -> bool + val iter : ('a, _) t -> f:('a -> unit) -> unit + + (** [fold t ~init ~f] returns [f (... f (f (f init e1) e2) e3 ...) en], where [e1..en] + are the elements of [t]. *) + val fold : ('a, _) t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc + + (** [fold_result t ~init ~f] is a short-circuiting version of [fold] that runs in the + [Result] monad. If [f] returns an [Error _], that value is returned without any + additional invocations of [f]. *) + val fold_result + : ('a, _) t + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'e) Result.t) + -> ('acc, 'e) Result.t + + (** [fold_until t ~init ~f ~finish] is a short-circuiting version of [fold]. If [f] + returns [Stop _] the computation ceases and results in that value. If [f] returns + [Continue _], the fold will proceed. If [f] never returns [Stop _], the final result + is computed by [finish]. + + Example: + + {[ + type maybe_negative = + | Found_negative of int + | All_nonnegative of { sum : int } + + (** [first_neg_or_sum list] returns the first negative number in [list], if any, + otherwise returns the sum of the list. *) + let first_neg_or_sum = + List.fold_until ~init:0 + ~f:(fun sum x -> + if x < 0 + then Stop (Found_negative x) + else Continue (sum + x)) + ~finish:(fun sum -> All_nonnegative { sum }) + ;; + + let x = first_neg_or_sum [1; 2; 3; 4; 5] + val x : maybe_negative = All_nonnegative {sum = 15} + + let y = first_neg_or_sum [1; 2; -3; 4; 5] + val y : maybe_negative = Found_negative -3 + ]} *) + val fold_until + : ('a, _) t + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'final) Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + (** Returns [true] if and only if there exists an element for which the provided + function evaluates to [true]. This is a short-circuiting operation. *) + val exists : ('a, _) t -> f:('a -> bool) -> bool + + (** Returns [true] if and only if the provided function evaluates to [true] for all + elements. This is a short-circuiting operation. *) + val for_all : ('a, _) t -> f:('a -> bool) -> bool + + (** Returns the number of elements for which the provided function evaluates to true. *) + val count : ('a, _) t -> f:('a -> bool) -> int + + (** Returns the sum of [f i] for all [i] in the container. *) + val sum : (module Summable with type t = 'sum) -> ('a, _) t -> f:('a -> 'sum) -> 'sum + + (** Returns as an [option] the first element for which [f] evaluates to true. *) + val find : ('a, _) t -> f:('a -> bool) -> 'a option + + (** Returns the first evaluation of [f] that returns [Some], and returns [None] if there + is no such element. *) + val find_map : ('a, _) t -> f:('a -> 'b option) -> 'b option + + val to_list : ('a, _) t -> 'a list + val to_array : ('a, _) t -> 'a array + + (** Returns a min (resp max) element from the collection using the provided [compare] + function. In case of a tie, the first element encountered while traversing the + collection is returned. The implementation uses [fold] so it has the same complexity + as [fold]. Returns [None] iff the collection is empty. *) + val min_elt : ('a, _) t -> compare:('a -> 'a -> int) -> 'a option + + val max_elt : ('a, _) t -> compare:('a -> 'a -> int) -> 'a option +end + +module type Generic = sig + type ('a, 'phantom1, 'phantom2) t + type 'a elt + + val length : (_, _, _) t -> int + val is_empty : (_, _, _) t -> bool + val mem : ('a, _, _) t -> 'a elt -> equal:('a elt -> 'a elt -> bool) -> bool + val iter : ('a, _, _) t -> f:('a elt -> unit) -> unit + val fold : ('a, _, _) t -> init:'acc -> f:('acc -> 'a elt -> 'acc) -> 'acc + + val fold_result + : ('a, _, _) t + -> init:'acc + -> f:('acc -> 'a elt -> ('acc, 'e) Result.t) + -> ('acc, 'e) Result.t + + val fold_until + : ('a, _, _) t + -> init:'acc + -> f:('acc -> 'a elt -> ('acc, 'final) Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + val exists : ('a, _, _) t -> f:('a elt -> bool) -> bool + val for_all : ('a, _, _) t -> f:('a elt -> bool) -> bool + val count : ('a, _, _) t -> f:('a elt -> bool) -> int + + val sum + : (module Summable with type t = 'sum) + -> ('a, _, _) t + -> f:('a elt -> 'sum) + -> 'sum + + val find : ('a, _, _) t -> f:('a elt -> bool) -> 'a elt option + val find_map : ('a, _, _) t -> f:('a elt -> 'b option) -> 'b option + val to_list : ('a, _, _) t -> 'a elt list + val to_array : ('a, _, _) t -> 'a elt array + val min_elt : ('a, _, _) t -> compare:('a elt -> 'a elt -> int) -> 'a elt option + val max_elt : ('a, _, _) t -> compare:('a elt -> 'a elt -> int) -> 'a elt option +end + +module type S0_with_creators = sig + include S0 + + val of_list : elt list -> t + val of_array : elt array -> t + + (** E.g., [append (of_list [a; b]) (of_list [c; d; e])] is [of_list [a; b; c; d; e]] *) + val append : t -> t -> t + + (** Concatenates a nested container. The elements of the inner containers are + concatenated together in order to give the result. *) + val concat : t list -> t + + (** [map f (of_list [a1; ...; an])] applies [f] to [a1], [a2], ..., [an], in order, and + builds a result equivalent to [of_list [f a1; ...; f an]]. *) + val map : t -> f:(elt -> elt) -> t + + (** [filter t ~f] returns all the elements of [t] that satisfy the predicate [f]. *) + val filter : t -> f:(elt -> bool) -> t + + (** [filter_map t ~f] applies [f] to every [x] in [t]. The result contains every [y] for + which [f x] returns [Some y]. *) + val filter_map : t -> f:(elt -> elt option) -> t + + (** [concat_map t ~f] is equivalent to [concat (map t ~f)]. *) + val concat_map : t -> f:(elt -> t) -> t + + (** [partition_tf t ~f] returns a pair [t1, t2], where [t1] is all elements of [t] that + satisfy [f], and [t2] is all elements of [t] that do not satisfy [f]. The "tf" + suffix is mnemonic to remind readers that the result is (trues, falses). *) + val partition_tf : t -> f:(elt -> bool) -> t * t + + (** [partition_map t ~f] partitions [t] according to [f]. *) + val partition_map : t -> f:(elt -> (elt, elt) Either0.t) -> t * t +end + +module type S1_with_creators = sig + include S1 + + val of_list : 'a list -> 'a t + val of_array : 'a array -> 'a t + + (** E.g., [append (of_list [1; 2]) (of_list [3; 4; 5])] is [of_list [1; 2; 3; 4; 5]] *) + val append : 'a t -> 'a t -> 'a t + + (** Concatenates a nested container. The elements of the inner containers are + concatenated together in order to give the result. *) + val concat : 'a t t -> 'a t + + (** [map f (of_list [a1; ...; an])] applies [f] to [a1], [a2], ..., [an], in order, and + builds a result equivalent to [of_list [f a1; ...; f an]]. *) + val map : 'a t -> f:('a -> 'b) -> 'b t + + (** [filter t ~f] returns all the elements of [t] that satisfy the predicate [f]. *) + val filter : 'a t -> f:('a -> bool) -> 'a t + + (** [filter_map t ~f] applies [f] to every [x] in [t]. The result contains every [y] for + which [f x] returns [Some y]. *) + val filter_map : 'a t -> f:('a -> 'b option) -> 'b t + + (** [concat_map t ~f] is equivalent to [concat (map t ~f)]. *) + val concat_map : 'a t -> f:('a -> 'b t) -> 'b t + + (** [partition_tf t ~f] returns a pair [t1, t2], where [t1] is all elements of [t] that + satisfy [f], and [t2] is all elements of [t] that do not satisfy [f]. The "tf" + suffix is mnemonic to remind readers that the result is (trues, falses). *) + val partition_tf : 'a t -> f:('a -> bool) -> 'a t * 'a t + + (** [partition_map t ~f] partitions [t] according to [f]. *) + val partition_map : 'a t -> f:('a -> ('b, 'c) Either0.t) -> 'b t * 'c t +end + +module type Generic_with_creators = sig + type (_, _, _) concat + + include Generic + + val of_list : 'a elt list -> ('a, _, _) t + val of_array : 'a elt array -> ('a, _, _) t + val append : ('a, 'p1, 'p2) t -> ('a, 'p1, 'p2) t -> ('a, 'p1, 'p2) t + val concat : (('a, 'p1, 'p2) t, 'p1, 'p2) concat -> ('a, 'p1, 'p2) t + val map : ('a, 'p1, 'p2) t -> f:('a elt -> 'b elt) -> ('b, 'p1, 'p2) t + val filter : ('a, 'p1, 'p2) t -> f:('a elt -> bool) -> ('a, 'p1, 'p2) t + val filter_map : ('a, 'p1, 'p2) t -> f:('a elt -> 'b elt option) -> ('b, 'p1, 'p2) t + val concat_map : ('a, 'p1, 'p2) t -> f:('a elt -> ('b, 'p1, 'p2) t) -> ('b, 'p1, 'p2) t + + val partition_tf + : ('a, 'p1, 'p2) t + -> f:('a elt -> bool) + -> ('a, 'p1, 'p2) t * ('a, 'p1, 'p2) t + + val partition_map + : ('a, 'p1, 'p2) t + -> f:('a elt -> ('b elt, 'c elt) Either0.t) + -> ('b, 'p1, 'p2) t * ('c, 'p1, 'p2) t +end + +module type Make_gen_arg = sig + type ('a, 'phantom1, 'phantom2) t + type 'a elt + + val fold + : ('a, 'phantom1, 'phantom2) t + -> init:'acc + -> f:('acc -> 'a elt -> 'acc) + -> 'acc + + (** The [iter] argument to [Container.Make] specifies how to implement the + container's [iter] function. [`Define_using_fold] means to define [iter] + via: + + {[ + iter t ~f = Container.iter ~fold t ~f + ]} + + [`Custom] overrides the default implementation, presumably with something more + efficient. Several other functions returned by [Container.Make] are defined in + terms of [iter], so passing in a more efficient [iter] will improve their efficiency + as well. *) + val iter + : [ `Define_using_fold + | `Custom of ('a, 'phantom1, 'phantom2) t -> f:('a elt -> unit) -> unit + ] + + (** The [length] argument to [Container.Make] specifies how to implement the + container's [length] function. [`Define_using_fold] means to define + [length] via: + + {[ + length t ~f = Container.length ~fold t ~f + ]} + + [`Custom] overrides the default implementation, presumably with something more + efficient. Several other functions returned by [Container.Make] are defined in + terms of [length], so passing in a more efficient [length] will improve their + efficiency as well. *) + val length : [ `Define_using_fold | `Custom of ('a, 'phantom1, 'phantom2) t -> int ] +end + +module type Make_arg = sig + type 'a t + + include Make_gen_arg with type ('a, _, _) t := 'a t and type 'a elt := 'a +end + +module type Make0_arg = sig + module Elt : sig + type t + + val equal : t -> t -> bool + end + + type t + + include Make_gen_arg with type ('a, _, _) t := t and type 'a elt := Elt.t +end + +module type Make_common_with_creators_arg = sig + include Make_gen_arg + + type (_, _, _) concat + + val of_list : 'a elt list -> ('a, _, _) t + val of_array : 'a elt array -> ('a, _, _) t + val concat : (('a, _, _) t, _, _) concat -> ('a, _, _) t +end + +module type Make_gen_with_creators_arg = sig + include Make_common_with_creators_arg + + val concat_of_array : 'a array -> ('a, _, _) concat +end + +module type Make_with_creators_arg = sig + type 'a t + + include + Make_common_with_creators_arg + with type ('a, _, _) t := 'a t + and type 'a elt := 'a + and type ('a, _, _) concat := 'a t +end + +module type Make0_with_creators_arg = sig + module Elt : sig + type t + + val equal : t -> t -> bool + end + + type t + + include + Make_common_with_creators_arg + with type ('a, _, _) t := t + and type 'a elt := Elt.t + and type ('a, _, _) concat := 'a list +end + +module type Derived = sig + (** Generic definitions of container operations in terms of [fold]. + + E.g.: [iter ~fold t ~f = fold t ~init:() ~f:(fun () a -> f a)]. *) + + type ('t, 'a, 'acc) fold = 't -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc + type ('t, 'a) iter = 't -> f:('a -> unit) -> unit + type 't length = 't -> int + + val iter : fold:('t, 'a, unit) fold -> ('t, 'a) iter + val count : fold:('t, 'a, int) fold -> 't -> f:('a -> bool) -> int + + val min_elt + : fold:('t, 'a, 'a option) fold + -> 't + -> compare:('a -> 'a -> int) + -> 'a option + + val max_elt + : fold:('t, 'a, 'a option) fold + -> 't + -> compare:('a -> 'a -> int) + -> 'a option + + val length : fold:('t, _, int) fold -> 't -> int + val to_list : fold:('t, 'a, 'a list) fold -> 't -> 'a list + + val sum + : fold:('t, 'a, 'sum) fold + -> (module Summable with type t = 'sum) + -> 't + -> f:('a -> 'sum) + -> 'sum + + val fold_result + : fold:('t, 'a, 'acc) fold + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'e) Result.t) + -> 't + -> ('acc, 'e) Result.t + + val fold_until + : fold:('t, 'a, 'acc) fold + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'final) Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 't + -> 'final + + (** Generic definitions of container operations in terms of [iter] and [length]. *) + + val is_empty : iter:('t, 'a) iter -> 't -> bool + val mem : iter:('t, 'a) iter -> 't -> 'a -> equal:('a -> 'a -> bool) -> bool + val exists : iter:('t, 'a) iter -> 't -> f:('a -> bool) -> bool + val for_all : iter:('t, 'a) iter -> 't -> f:('a -> bool) -> bool + val find : iter:('t, 'a) iter -> 't -> f:('a -> bool) -> 'a option + val find_map : iter:('t, 'a) iter -> 't -> f:('a -> 'b option) -> 'b option + val to_array : length:'t length -> iter:('t, 'a) iter -> 't -> 'a array +end + +module type Container = sig + include module type of struct + include Export + end + + module type S0 = S0 + module type S0_phantom = S0_phantom + module type S0_with_creators = S0_with_creators + module type S1 = S1 + module type S1_phantom = S1_phantom + module type S1_with_creators = S1_with_creators + module type Derived = Derived + module type Generic = Generic + module type Generic_with_creators = Generic_with_creators + module type Summable = Summable + + include Derived + + (** The idiom for using [Container.Make] is to bind the resulting module and to + explicitly import each of the functions that one wants: + + {[ + module C = Container.Make (struct ... end) + let count = C.count + let exists = C.exists + let find = C.find + (* ... *) + ]} + + This is preferable to: + + {[ + include Container.Make (struct ... end) + ]} + + because the [include] makes it too easy to shadow specialized implementations of + container functions ([length] being a common one). + + [Container.Make0] is like [Container.Make], but for monomorphic containers like + [string]. *) + module Make (T : Make_arg) : S1 with type 'a t := 'a T.t + + module Make0 (T : Make0_arg) : S0 with type t := T.t and type elt := T.Elt.t + + module Make_gen (T : Make_gen_arg) : + Generic + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt + + module Make_with_creators (T : Make_with_creators_arg) : + S1_with_creators with type 'a t := 'a T.t + + module Make0_with_creators (T : Make0_with_creators_arg) : + S0_with_creators with type t := T.t and type elt := T.Elt.t + + module Make_gen_with_creators (T : Make_gen_with_creators_arg) : + Generic_with_creators + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom1, 'phantom2) concat := ('a, 'phantom1, 'phantom2) T.concat +end diff --git a/unikernel/duniverse/base/src/dictionary_immutable.ml b/unikernel/duniverse/base/src/dictionary_immutable.ml new file mode 100644 index 00000000..69214019 --- /dev/null +++ b/unikernel/duniverse/base/src/dictionary_immutable.ml @@ -0,0 +1 @@ +include Dictionary_immutable_intf.Definitions diff --git a/unikernel/duniverse/base/src/dictionary_immutable.mli b/unikernel/duniverse/base/src/dictionary_immutable.mli new file mode 100644 index 00000000..f60c9180 --- /dev/null +++ b/unikernel/duniverse/base/src/dictionary_immutable.mli @@ -0,0 +1 @@ +include Dictionary_immutable_intf.Dictionary_immutable (** @inline *) diff --git a/unikernel/duniverse/base/src/dictionary_immutable_intf.ml b/unikernel/duniverse/base/src/dictionary_immutable_intf.ml new file mode 100644 index 00000000..755f94a7 --- /dev/null +++ b/unikernel/duniverse/base/src/dictionary_immutable_intf.ml @@ -0,0 +1,711 @@ +(** Interfaces for immutable dictionary types, such as [Map.t]. + + We define separate interfaces for [Accessors] and [Creators], along with [S] combining + both. These interfaces are written once in their most general form, which involves + extra type definitions and type parameters that most instances do not need. + + We then provide instantiations of these interfaces with 1, 2, and 3 type parameters + for [t]. These cover more common usage patterns for the interfaces. *) + +open! Import + +(** These definitions are re-exported by [Dictionary_immutable]. *) +module Definitions = struct + module type Accessors = sig + (** The type of keys. This will be ['key] for polymorphic dictionaries, or some fixed + type for dictionaries with monomorphic keys. *) + type 'key key + + (** Dictionaries. Their keys have type ['key key]. Each key's associated value has + type ['data]. The dictionary may be distinguished by a ['phantom] type. *) + type ('key, 'data, 'phantom) t + + (** The type of accessor functions ['fn] that operate on [('key, 'data, 'phantom) t]. + May take extra arguments before ['fn], such as a comparison function. *) + type ('fn, 'key, 'data, 'phantom) accessor + + (** Whether the dictionary is empty. *) + val is_empty : (_, _, _) t -> bool + + (** How many key/value pairs the dictionary contains. *) + val length : (_, _, _) t -> int + + (** All key/value pairs. *) + val to_alist : ('key, 'data, _) t -> ('key key * 'data) list + + (** All keys in the dictionary, in the same order as [to_alist]. *) + val keys : ('key, _, _) t -> 'key key list + + (** All values in the dictionary, in the same order as [to_alist]. *) + val data : (_, 'data, _) t -> 'data list + + (** Like [to_alist]. Produces a sequence. *) + val to_sequence : ('key, 'data, 'phantom) t -> ('key key * 'data) Sequence.t + + (** Whether [key] has a value. *) + val mem : (('key, _, 'phantom) t -> 'key key -> bool, 'key, 'data, 'phantom) accessor + + (** Produces the current value, or absence thereof, for a given key. *) + val find + : ( ('key, 'data, 'phantom) t -> 'key key -> 'data option + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [find]. Raises if there is no value for the given key. *) + val find_exn + : (('key, 'data, 'phantom) t -> 'key key -> 'data, 'key, 'data, 'phantom) accessor + + (** Adds a key/value pair for a key the dictionary does not contain, or reports a + duplicate. *) + val add + : ( ('key, 'data, 'phantom) t + -> key:'key key + -> data:'data + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate ] + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [add]. Raises on duplicates. *) + val add_exn + : ( ('key, 'data, 'phantom) t + -> key:'key key + -> data:'data + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds or replaces a key/value pair in the dictionary. *) + val set + : ( ('key, 'data, 'phantom) t + -> key:'key key + -> data:'data + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Removes any value for the given key. *) + val remove + : ( ('key, 'data, 'phantom) t -> 'key key -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds, replaces, or removes the value for a given key, depending on its current + value or lack thereof. *) + val change + : ( ('key, 'data, 'phantom) t + -> 'key key + -> f:('data option -> 'data option) + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds or replaces the value for a given key, depending on its current value or + lack thereof. *) + val update + : ( ('key, 'data, 'phantom) t + -> 'key key + -> f:('data option -> 'data) + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds [data] to the existing key/value pair for [key]. Interprets a missing key as + having an empty list. *) + val add_multi + : ( ('key, 'data list, 'phantom) t + -> key:'key key + -> data:'data + -> ('key, 'data list, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Removes one element from the existing key/value pair for [key]. Removes the key + entirely if the new list is empty. *) + val remove_multi + : ( ('key, 'data list, 'phantom) t -> 'key key -> ('key, 'data list, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Produces the list associated with the corresponding key. Interprets a missing + key as having an empty list. *) + val find_multi + : ( ('key, 'data list, 'phantom) t -> 'key key -> 'data list + , 'key + , 'data + , 'phantom ) + accessor + + (** Combines every value in the dictionary. *) + val fold + : ('key, 'data, _) t + -> init:'acc + -> f:(key:'key key -> data:'data -> 'acc -> 'acc) + -> 'acc + + (** Like [fold]. May stop before completing the iteration. *) + val fold_until + : ('key, 'data, _) t + -> init:'acc + -> f: + (key:'key key + -> data:'data + -> 'acc + -> ('acc, 'final) Container.Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + (** Whether every value satisfies [f]. *) + val for_all : ('key, 'data, _) t -> f:('data -> bool) -> bool + + (** Like [for_all]. The predicate may also depend on the associated key. *) + val for_alli : ('key, 'data, _) t -> f:(key:'key key -> data:'data -> bool) -> bool + + (** Whether at least one value satisfies [f]. *) + val exists : ('key, 'data, _) t -> f:('data -> bool) -> bool + + (** Like [exists]. The predicate may also depend on the associated key. *) + val existsi : ('key, 'data, _) t -> f:(key:'key key -> data:'data -> bool) -> bool + + (** How many values satisfy [f]. *) + val count : ('key, 'data, _) t -> f:('data -> bool) -> int + + (** Like [count]. The predicate may also depend on the associated key. *) + val counti : ('key, 'data, _) t -> f:(key:'key key -> data:'data -> bool) -> int + + (** Sum up [f data] for all data in the dictionary. *) + val sum + : (module Container.Summable with type t = 'a) + -> ('key, 'data, _) t + -> f:('data -> 'a) + -> 'a + + (** Like [sum]. The function may also depend on the associated key. *) + val sumi + : (module Container.Summable with type t = 'a) + -> ('key, 'data, _) t + -> f:(key:'key -> data:'data -> 'a) + -> 'a + + (** Produces the key/value pair with the smallest key if non-empty. *) + val min_elt : ('key, 'data, _) t -> ('key key * 'data) option + + (** Like [min_elt]. Raises if empty. *) + val min_elt_exn : ('key, 'data, _) t -> 'key key * 'data + + (** Produces the key/value pair with the largest key if non-empty. *) + val max_elt : ('key, 'data, _) t -> ('key key * 'data) option + + (** Like [max_elt]. Raises if empty. *) + val max_elt_exn : ('key, 'data, _) t -> 'key key * 'data + + (** Calls [f] for every key. *) + val iter_keys : ('key, _, _) t -> f:('key key -> unit) -> unit + + (** Calls [f] for every value. *) + val iter : (_, 'data, _) t -> f:('data -> unit) -> unit + + (** Calls [f] for every key/value pair. *) + val iteri : ('key, 'data, _) t -> f:(key:'key key -> data:'data -> unit) -> unit + + (** Transforms every value. *) + val map + : ('key, 'data1, 'phantom) t + -> f:('data1 -> 'data2) + -> ('key, 'data2, 'phantom) t + + (** Like [map]. The transformation may also depend on the associated key. *) + val mapi + : ('key, 'data1, 'phantom) t + -> f:(key:'key key -> data:'data1 -> 'data2) + -> ('key, 'data2, 'phantom) t + + (** Produces only those key/value pairs whose key satisfies [f]. *) + val filter_keys + : ('key, 'data, 'phantom) t + -> f:('key key -> bool) + -> ('key, 'data, 'phantom) t + + (** Produces only those key/value pairs whose value satisfies [f]. *) + val filter + : ('key, 'data, 'phantom) t + -> f:('data -> bool) + -> ('key, 'data, 'phantom) t + + (** Produces only those key/value pairs which satisfy [f]. *) + val filteri + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> ('key, 'data, 'phantom) t + + (** Produces key/value pairs for which [f] produces [Some]. *) + val filter_map + : ('key, 'data1, 'phantom) t + -> f:('data1 -> 'data2 option) + -> ('key, 'data2, 'phantom) t + + (** Like [filter_map]. The new value may also depend on the associated key. *) + val filter_mapi + : ('key, 'data1, 'phantom) t + -> f:(key:'key key -> data:'data1 -> 'data2 option) + -> ('key, 'data2, 'phantom) t + + (** Splits one dictionary into two. The first contains key/value pairs for which the + value satisfies [f]. The second contains the remainder. *) + val partition_tf + : ('key, 'data, 'phantom) t + -> f:('data -> bool) + -> ('key, 'data, 'phantom) t * ('key, 'data, 'phantom) t + + (** Like [partition_tf]. The predicate may also depend on the associated key. *) + val partitioni_tf + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> ('key, 'data, 'phantom) t * ('key, 'data, 'phantom) t + + (** Splits one dictionary into two, corresponding respectively to [First _] and + [Second _] results from [f]. *) + val partition_map + : ('key, 'data1, 'phantom) t + -> f:('data1 -> ('data2, 'data3) Either.t) + -> ('key, 'data2, 'phantom) t * ('key, 'data3, 'phantom) t + + (** Like [partition_map]. The split may also depend on the associated key. *) + val partition_mapi + : ('key, 'data1, 'phantom) t + -> f:(key:'key key -> data:'data1 -> ('data2, 'data3) Either.t) + -> ('key, 'data2, 'phantom) t * ('key, 'data3, 'phantom) t + + (** Produces an error combining all error messages from key/value pairs, or a + dictionary of all [Ok] values if none are [Error]. *) + val combine_errors + : ( ('key, 'data Or_error.t, 'phantom) t -> ('key, 'data, 'phantom) t Or_error.t + , 'key + , 'data + , 'phantom ) + accessor + + (** Splits the [fst] and [snd] components of values associated with keys into separate + dictionaries. *) + val unzip + : ('key, 'data1 * 'data2, 'phantom) t + -> ('key, 'data1, 'phantom) t * ('key, 'data2, 'phantom) t + + (** Merges two dictionaries by fully traversing both. Not suitable for efficiently + merging lists of dictionaries. See [merge_disjoint_exn] and [merge_skewed] + instead. *) + val merge + : ( ('key, 'data1, 'phantom) t + -> ('key, 'data2, 'phantom) t + -> f: + (key:'key key + -> [ `Left of 'data1 | `Right of 'data2 | `Both of 'data1 * 'data2 ] + -> 'data3 option) + -> ('key, 'data3, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Merges two dictionaries with the same type of data and disjoint sets of keys. + Raises if any keys overlap. *) + val merge_disjoint_exn + : ( ('key, 'data, 'phantom) t + -> ('key, 'data, 'phantom) t + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Merges two dictionaries by traversing only the smaller of the two. Adds key/value + pairs missing from the larger dictionary, and [combine]s duplicate values. *) + val merge_skewed + : ( ('key, 'data, 'phantom) t + -> ('key, 'data, 'phantom) t + -> combine:(key:'key key -> 'data -> 'data -> 'data) + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + accessor + + (** Computes a sequence of differences between two dictionaries. *) + val symmetric_diff + : ( ('key, 'data, 'phantom) t + -> ('key, 'data, 'phantom) t + -> data_equal:('data -> 'data -> bool) + -> ('key key * [ `Left of 'data | `Right of 'data | `Unequal of 'data * 'data ]) + Sequence.t + , 'key + , 'data + , 'phantom ) + accessor + + (** Folds over the result of [symmetric_diff]. May be more performant. *) + val fold_symmetric_diff + : ( ('key, 'data, 'phantom) t + -> ('key, 'data, 'phantom) t + -> data_equal:('data -> 'data -> bool) + -> init:'acc + -> f: + ('acc + -> 'key key + * [ `Left of 'data | `Right of 'data | `Unequal of 'data * 'data ] + -> 'acc) + -> 'acc + , 'key + , 'data + , 'phantom ) + accessor + end + + module type Accessors1 = sig + type key + type 'data t + + (** @inline *) + include + Accessors + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn + end + + module type Accessors2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) accessor + + (** @inline *) + include + Accessors + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + end + + module type Accessors3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + + (** @inline *) + include + Accessors + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + end + + module type Creators = sig + (** The type of keys. This will be ['key] for polymorphic dictionaries, or some fixed + type for dictionaries with monomorphic keys. *) + type 'key key + + (** Dictionaries. Their keys have type ['key key]. Each key's associated value has + type ['data]. The dictionary may be distinguished by a ['phantom] type. *) + type ('key, 'data, 'phantom) t + + (** The type of creator functions ['fn] that operate on [('key, 'data, 'phantom) t]. + May take extra arguments before ['fn], such as a comparison function. *) + type ('fn, 'key, 'data, 'phantom) creator + + (** The empty dictionary. *) + val empty : (('key, 'data, 'phantom) t, 'key, 'data, 'phantom) creator + + (** Dictionary with a single key/value pair. *) + val singleton + : ('key key -> 'data -> ('key, 'data, 'phantom) t, 'key, 'data, 'phantom) creator + + (** Dictionary containing the given key/value pairs. Fails if there are duplicate + keys. *) + val of_alist + : ( ('key key * 'data) list + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_key of 'key key ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. Returns a [Result.t]. *) + val of_alist_or_error + : ( ('key key * 'data) list -> ('key, 'data, 'phantom) t Or_error.t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. Raises on duplicates. *) + val of_alist_exn + : ( ('key key * 'data) list -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Produces a dictionary mapping each key to a list of associated values. *) + val of_alist_multi + : ( ('key key * 'data) list -> ('key, 'data list, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Produces a dictionary using each key/value pair. Combines all values for a given + key with [init] using [f]. *) + val of_alist_fold + : ( ('key key * 'data) list + -> init:'acc + -> f:('acc -> 'data -> 'acc) + -> ('key, 'acc, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Produces a dictionary using each key/value pair. Combines multiple values for a + given key using [f]. *) + val of_alist_reduce + : ( ('key key * 'data) list + -> f:('data -> 'data -> 'data) + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. Consumes a sequence. *) + val of_sequence + : ( ('key key * 'data) Sequence.t + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_key of 'key key ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_or_error]. Consumes a sequence. *) + val of_sequence_or_error + : ( ('key key * 'data) Sequence.t -> ('key, 'data, 'phantom) t Or_error.t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_exn]. Consumes a sequence. *) + val of_sequence_exn + : ( ('key key * 'data) Sequence.t -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_multi]. Consumes a sequence. *) + val of_sequence_multi + : ( ('key key * 'data) Sequence.t -> ('key, 'data list, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_fold]. Consumes a sequence. *) + val of_sequence_fold + : ( ('key key * 'data) Sequence.t + -> init:'c + -> f:('c -> 'data -> 'c) + -> ('key, 'c, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_reduce]. Consumes a sequence. *) + val of_sequence_reduce + : ( ('key key * 'data) Sequence.t + -> f:('data -> 'data -> 'data) + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. Consume values for which keys can be computed. *) + val of_list_with_key + : ( 'data list + -> get_key:('data -> 'key key) + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_key of 'key key ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_or_error]. Consume values for which keys can be computed. *) + val of_list_with_key_or_error + : ( 'data list -> get_key:('data -> 'key key) -> ('key, 'data, 'phantom) t Or_error.t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_exn]. Consume values for which keys can be computed. *) + val of_list_with_key_exn + : ( 'data list -> get_key:('data -> 'key key) -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_multi]. Consume values for which keys can be computed. *) + val of_list_with_key_multi + : ( 'data list -> get_key:('data -> 'key key) -> ('key, 'data list, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Produces a dictionary of all key/value pairs that [iteri] passes to [~f]. Fails if + a duplicate key is found. *) + val of_iteri + : ( iteri:(f:(key:'key key -> data:'data -> unit) -> unit) + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_key of 'key key ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_iteri]. Raises on duplicate key. *) + val of_iteri_exn + : ( iteri:(f:(key:'key key -> data:'data -> unit) -> unit) + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + end + + module type Creators1 = sig + type key + type 'data t + + (** @inline *) + include + Creators + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) creator := 'fn + end + + module type Creators2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) creator + + (** @inline *) + include + Creators + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + end + + module type Creators3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) creator + + (** @inline *) + include + Creators + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end + + module type S = sig + type 'key key + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + type ('fn, 'key, 'data, 'phantom) creator + + (** @inline *) + include + Accessors + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + + (** @inline *) + include + Creators + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end + + module type S1 = sig + type key + type 'data t + + (** @inline *) + include + S + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn + and type ('fn, _, _, _) creator := 'fn + end + + module type S2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) accessor + type ('fn, 'key, 'data) creator + + (** @inline *) + include + S + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + end + + module type S3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + type ('fn, 'key, 'data, 'phantom) creator + + (** @inline *) + include + S + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end +end + +module type Dictionary_immutable = sig + (** @inline *) + include module type of struct + include Definitions (** @inline *) + end +end diff --git a/unikernel/duniverse/base/src/dictionary_mutable.ml b/unikernel/duniverse/base/src/dictionary_mutable.ml new file mode 100644 index 00000000..9f67e683 --- /dev/null +++ b/unikernel/duniverse/base/src/dictionary_mutable.ml @@ -0,0 +1 @@ +include Dictionary_mutable_intf.Definitions diff --git a/unikernel/duniverse/base/src/dictionary_mutable.mli b/unikernel/duniverse/base/src/dictionary_mutable.mli new file mode 100644 index 00000000..de752597 --- /dev/null +++ b/unikernel/duniverse/base/src/dictionary_mutable.mli @@ -0,0 +1 @@ +include Dictionary_mutable_intf.Dictionary_mutable diff --git a/unikernel/duniverse/base/src/dictionary_mutable_intf.ml b/unikernel/duniverse/base/src/dictionary_mutable_intf.ml new file mode 100644 index 00000000..f37eb283 --- /dev/null +++ b/unikernel/duniverse/base/src/dictionary_mutable_intf.ml @@ -0,0 +1,666 @@ +(** Interfaces for mutable dictionary types, such as [Hashtbl.t]. + + We define separate interfaces for [Accessors] and [Creators], along with [S] combining + both. These interfaces are written once in their most general form, which involves + extra type definitions and type parameters that most instances do not need. + + We then provide instantiations of these interfaces with 1, 2, and 3 type parameters + for [t]. These cover more common usage patterns for the interfaces. *) + +open! Import + +(** These definitions are re-exported by [Dictionary_mutable]. *) +module Definitions = struct + (** @canonical Base.Dictionary_mutable.Merge_into_action *) + module Merge_into_action = struct + type 'data t = + | Remove + | Set_to of 'data + end + + module type Accessors = sig + (** The type of keys. This will be ['key] for polymorphic dictionaries, or some fixed + type for dictionaries with monomorphic keys. *) + type 'key key + + (** Dictionaries. Their keys have type ['key key]. Each key's associated value has + type ['data]. The dictionary may be distinguished by a ['phantom] type. *) + type ('key, 'data, 'phantom) t + + (** The type of accessor functions ['fn] that operate on [('key, 'data, 'phantom) t]. + May take extra arguments before ['fn], such as a comparison function. *) + type ('fn, 'key, 'data, 'phantom) accessor + + (** Whether the dictionary is empty. *) + val is_empty : (_, _, 'phantom) t -> bool + + (** How many key/value pairs the dictionary contains. *) + val length : (_, _, 'phantom) t -> int + + (** All key/value pairs. *) + val to_alist : ('key, 'data, 'phantom) t -> ('key key * 'data) list + + (** All keys in the dictionary, in the same order as [to_alist]. *) + val keys : ('key, _, 'phantom) t -> 'key key list + + (** All values in the dictionary, in the same order as [to_alist]. *) + val data : (_, 'data, 'phantom) t -> 'data list + + (** Removes all key/value pairs from the dictionary. *) + val clear : (_, _, 'phantom) t -> unit + + (** A new dictionary containing the same key/value pairs. *) + val copy : ('key, 'data, 'phantom) t -> ('key, 'data, 'phantom) t + + (** Whether [key] has a value. *) + val mem + : (('key, 'data, 'phantom) t -> 'key key -> bool, 'key, 'data, 'phantom) accessor + + (** Produces the current value, or absence thereof, for a given key. *) + val find + : ( ('key, 'data, 'phantom) t -> 'key key -> 'data option + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [find]. Raises if there is no value for the given key. *) + val find_exn + : (('key, 'data, 'phantom) t -> 'key key -> 'data, 'key, 'data, 'phantom) accessor + + (** Like [find]. Adds the value [default ()] if none exists, then returns it. *) + val find_or_add + : ( ('key, 'data, 'phantom) t -> 'key key -> default:(unit -> 'data) -> 'data + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [find]. Adds [default key] if no value exists. *) + val findi_or_add + : ( ('key, 'data, 'phantom) t -> 'key key -> default:('key key -> 'data) -> 'data + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [find]. Calls [if_found data] if a value exists, or [if_not_found key] + otherwise. Avoids allocation [Some]. *) + val find_and_call + : ( ('key, 'data, 'phantom) t + -> 'key key + -> if_found:('data -> 'c) + -> if_not_found:('key key -> 'c) + -> 'c + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [findi]. Calls [if_found ~key ~data] if a value exists. *) + val findi_and_call + : ( ('key, 'data, 'phantom) t + -> 'key key + -> if_found:(key:'key key -> data:'data -> 'c) + -> if_not_found:('key key -> 'c) + -> 'c + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [find]. Removes the value for [key], if any, from the dictionary before + returning it. *) + val find_and_remove + : ( ('key, 'data, 'phantom) t -> 'key key -> 'data option + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds a key/value pair for a key the dictionary does not contain, or reports a + duplicate. *) + val add + : ( ('key, 'data, 'phantom) t -> key:'key key -> data:'data -> [ `Ok | `Duplicate ] + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [add]. Raises on duplicates. *) + val add_exn + : ( ('key, 'data, 'phantom) t -> key:'key key -> data:'data -> unit + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds or replaces a key/value pair in the dictionary. *) + val set + : ( ('key, 'data, 'phantom) t -> key:'key key -> data:'data -> unit + , 'key + , 'data + , 'phantom ) + accessor + + (** Removes any value for the given key. *) + val remove + : (('key, 'data, 'phantom) t -> 'key key -> unit, 'key, 'data, 'phantom) accessor + + (** Adds, replaces, or removes the value for a given key, depending on its current + value or lack thereof. *) + val change + : ( ('key, 'data, 'phantom) t -> 'key key -> f:('data option -> 'data option) -> unit + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds or replaces the value for a given key, depending on its current value or + lack thereof. *) + val update + : ( ('key, 'data, 'phantom) t -> 'key key -> f:('data option -> 'data) -> unit + , 'key + , 'data + , 'phantom ) + accessor + + (** Like [update]. Returns the new value. *) + val update_and_return + : ('key, 'data, 'phantom) t + -> 'key key + -> f:('data option -> 'data) + -> 'data + + (** Adds [by] to the value for [key], default 0 if [key] is absent. May remove [key] + if the result is [0], depending on [remove_if_zero]. *) + val incr + : ( ?by:int (** default: 1 *) + -> ?remove_if_zero:bool (** default: false *) + -> ('key, int, 'phantom) t + -> 'key key + -> unit + , 'key + , 'data + , 'phantom ) + accessor + + (** Subtracts [by] from the value for [key], default 0 if [key] is absent. May remove + [key] if the result is [0], depending on [remove_if_zero]. *) + val decr + : ( ?by:int (** default: 1 *) + -> ?remove_if_zero:bool (** default: false *) + -> ('key, int, 'phantom) t + -> 'key key + -> unit + , 'key + , 'data + , 'phantom ) + accessor + + (** Adds [data] to the existing key/value pair for [key]. Interprets a missing key as + having an empty list. *) + val add_multi + : ( ('key, 'data list, 'phantom) t -> key:'key key -> data:'data -> unit + , 'key + , 'data + , 'phantom ) + accessor + + (** Removes one element from the existing key/value pair for [key]. Removes the key + entirely if the new list is empty. *) + val remove_multi + : (('key, _ list, 'phantom) t -> 'key key -> unit, 'key, 'data, 'phantom) accessor + + (** Produces the list associated with the corresponding key. Interprets a missing + key as having an empty list. *) + val find_multi + : ( ('key, 'data list, 'phantom) t -> 'key key -> 'data list + , 'key + , 'data + , 'phantom ) + accessor + + (** Combines every value in the dictionary. *) + val fold + : ('key, 'data, 'phantom) t + -> init:'acc + -> f:(key:'key key -> data:'data -> 'acc -> 'acc) + -> 'acc + + (** Whether every value satisfies [f]. *) + val for_all : (_, 'data, 'phantom) t -> f:('data -> bool) -> bool + + (** Like [for_all]. The predicate may also depend on the associated key. *) + val for_alli + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> bool + + (** Whether at least one value satisfies [f]. *) + val exists : (_, 'data, 'phantom) t -> f:('data -> bool) -> bool + + (** Like [exists]. The predicate may also depend on the associated key. *) + val existsi + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> bool + + (** How many values satisfy [f]. *) + val count : (_, 'data, 'phantom) t -> f:('data -> bool) -> int + + (** Like [count]. The predicate may also depend on the associated key. *) + val counti + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> int + + (** Arbitrary, deterministic key/value pair if non-empty. *) + val choose : ('key, 'data, 'phantom) t -> ('key key * 'data) option + + (** Like [choose]. Raises if empty. *) + val choose_exn : ('key, 'data, 'phantom) t -> 'key key * 'data + + (** Arbitrary, pseudo-random key/value pair if non-empty. *) + val choose_randomly + : ?random_state:Random.State.t + -> ('key, 'data, 'phantom) t + -> ('key key * 'data) option + + (** Like [choose_randomly]. Raises if empty. *) + val choose_randomly_exn + : ?random_state:Random.State.t + -> ('key, 'data, 'phantom) t + -> 'key key * 'data + + (** Calls [f] for every key. *) + val iter_keys : ('key, _, 'phantom) t -> f:('key key -> unit) -> unit + + (** Calls [f] for every value. *) + val iter : (_, 'data, 'phantom) t -> f:('data -> unit) -> unit + + (** Calls [f] for every key/value pair. *) + val iteri + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> unit) + -> unit + + (** Transforms every value. *) + val map : ('key, 'data, 'phantom) t -> f:('data -> 'c) -> ('key, 'c, 'phantom) t + + (** Like [map]. The transformation may also depend on the associated key. *) + val mapi + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> 'c) + -> ('key, 'c, 'phantom) t + + (** Like [map]. Modifies the input. *) + val map_inplace : (_, 'data, 'phantom) t -> f:('data -> 'data) -> unit + + (** Like [mapi]. Modifies the input. *) + val mapi_inplace + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> 'data) + -> unit + + (** Produces only those key/value pairs whose key satisfies [f]. *) + val filter_keys + : ('key, 'data, 'phantom) t + -> f:('key key -> bool) + -> ('key, 'data, 'phantom) t + + (** Produces only those key/value pairs whose value satisfies [f]. *) + val filter + : ('key, 'data, 'phantom) t + -> f:('data -> bool) + -> ('key, 'data, 'phantom) t + + (** Produces only those key/value pairs which satisfy [f]. *) + val filteri + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> ('key, 'data, 'phantom) t + + (** Like [filter_keys]. Modifies the input. *) + val filter_keys_inplace : ('key, _, 'phantom) t -> f:('key key -> bool) -> unit + + (** Like [filter]. Modifies the input. *) + val filter_inplace : (_, 'data, 'phantom) t -> f:('data -> bool) -> unit + + (** Like [filteri]. Modifies the input. *) + val filteri_inplace + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> unit + + (** Produces key/value pairs for which [f] produces [Some]. *) + val filter_map + : ('key, 'data, 'phantom) t + -> f:('data -> 'c option) + -> ('key, 'c, 'phantom) t + + (** Like [filter_map]. The new value may also depend on the associated key. *) + val filter_mapi + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> 'c option) + -> ('key, 'c, 'phantom) t + + (** Like [filter_map]. Modifies the input. *) + val filter_map_inplace : (_, 'data, 'phantom) t -> f:('data -> 'data option) -> unit + + (** Like [filter_mapi]. Modifies the input. *) + val filter_mapi_inplace + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> 'data option) + -> unit + + (** Splits one dictionary into two. The first contains key/value pairs for which the + value satisfies [f]. The second contains the remainder. *) + val partition_tf + : ('key, 'data, 'phantom) t + -> f:('data -> bool) + -> ('key, 'data, 'phantom) t * ('key, 'data, 'phantom) t + + (** Like [partition_tf]. The predicate may also depend on the associated key. *) + val partitioni_tf + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> bool) + -> ('key, 'data, 'phantom) t * ('key, 'data, 'phantom) t + + (** Splits one dictionary into two, corresponding respectively to [First _] and + [Second _] results from [f]. *) + val partition_map + : ('key, 'data, 'phantom) t + -> f:('data -> ('c, 'd) Either.t) + -> ('key, 'c, 'phantom) t * ('key, 'd, 'phantom) t + + (** Like [partition_map]. The split may also depend on the associated key. *) + val partition_mapi + : ('key, 'data, 'phantom) t + -> f:(key:'key key -> data:'data -> ('c, 'd) Either.t) + -> ('key, 'c, 'phantom) t * ('key, 'd, 'phantom) t + + (** Merges two dictionaries by fully traversing both. Not suitable for efficiently + merging lists of dictionaries. See [merge_into] instead. *) + val merge + : ( ('key, 'data1, 'phantom) t + -> ('key, 'data2, 'phantom) t + -> f: + (key:'key key + -> [ `Left of 'data1 | `Right of 'data2 | `Both of 'data1 * 'data2 ] + -> 'data3 option) + -> ('key, 'data3, 'phantom) t + , 'key + , 'data3 + , 'phantom ) + accessor + + (** Merges two dictionaries by traversing [src] and adding to [dst]. Computes the + effect on [dst] of each key/value pair in [src] using [f]. *) + val merge_into + : ( src:('key, 'data1, 'phantom) t + -> dst:('key, 'data2, 'phantom) t + -> f:(key:'key key -> 'data1 -> 'data2 option -> 'data2 Merge_into_action.t) + -> unit + , 'key + , 'data + , 'phantom ) + accessor + end + + module type Accessors1 = sig + type key + type 'data t + + include + Accessors + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn + end + + module type Accessors2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) accessor + + include + Accessors + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + end + + module type Accessors3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + + include + Accessors + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + end + + module type Creators = sig + (** The type of keys. This will be ['key] for polymorphic dictionaries, or some fixed + type for dictionaries with monomorphic keys. *) + type 'key key + + (** Dictionaries. Their keys have type ['key key]. Each key's associated value has + type ['data]. The dictionary may be distinguished by a ['phantom] type. *) + type ('key, 'data, 'phantom) t + + (** The type of creator functions ['fn] that operate on [('key, 'data, 'phantom) t]. + May take extra arguments before ['fn], such as a comparison function. *) + type ('fn, 'key, 'data, 'phantom) creator + + (** Creates a new empty dictionary. *) + val create : (unit -> ('key, 'data, 'phantom) t, 'key, 'data, 'phantom) creator + + (** Dictionary containing the given key/value pairs. Fails if there are duplicate + keys. *) + val of_alist + : ( ('key key * 'data) list + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_key of 'key key ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. On failure, provides all duplicate keys instead of a single + representative. *) + val of_alist_report_all_dups + : ( ('key key * 'data) list + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_keys of 'key key list ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. Returns a [Result.t]. *) + val of_alist_or_error + : ( ('key key * 'data) list -> ('key, 'data, 'phantom) t Or_error.t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. Raises on duplicates. *) + val of_alist_exn + : ( ('key key * 'data) list -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Produces a dictionary mapping each key to a list of associated values. *) + val of_alist_multi + : ( ('key key * 'data) list -> ('key, 'data list, 'phantom) t + , 'key + , 'data list + , 'phantom ) + creator + + (** Like [of_alist]. Consume a list of elements for which key/value pairs can be + computed. *) + val create_mapped + : ( get_key:('a -> 'key key) + -> get_data:('a -> 'data) + -> 'a list + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_keys of 'key key list ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist]. Consume values for which keys can be computed. *) + val create_with_key + : ( get_key:('data -> 'key key) + -> 'data list + -> [ `Ok of ('key, 'data, 'phantom) t | `Duplicate_keys of 'key key list ] + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_or_error]. Consume values for which keys can be computed. *) + val create_with_key_or_error + : ( get_key:('data -> 'key key) -> 'data list -> ('key, 'data, 'phantom) t Or_error.t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [of_alist_exn]. Consume values for which keys can be computed. *) + val create_with_key_exn + : ( get_key:('data -> 'key key) -> 'data list -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + + (** Like [create_mapped]. Multiple values for a key are [combine]d rather than + producing an error. *) + val group + : ( get_key:('a -> 'key key) + -> get_data:('a -> 'data) + -> combine:('data -> 'data -> 'data) + -> 'a list + -> ('key, 'data, 'phantom) t + , 'key + , 'data + , 'phantom ) + creator + end + + module type Creators1 = sig + type key + type 'data t + + (** @inline *) + include + Creators + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) creator := 'fn + end + + module type Creators2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) creator + + (** @inline *) + include + Creators + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + end + + module type Creators3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) creator + + (** @inline *) + include + Creators + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end + + module type S = sig + type 'key key + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + type ('fn, 'key, 'data, 'phantom) creator + + (** @inline *) + include + Accessors + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + + (** @inline *) + include + Creators + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end + + module type S1 = sig + type key + type 'data t + + (** @inline *) + include + S + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn + and type ('fn, _, _, _) creator := 'fn + end + + module type S2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) accessor + type ('fn, 'key, 'data) creator + + (** @inline *) + include + S + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + end + + module type S3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + type ('fn, 'key, 'data, 'phantom) creator + + (** @inline *) + include + S + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end +end + +module type Dictionary_mutable = sig + (** @inline *) + include module type of struct + include Definitions (** @inline *) + end +end diff --git a/unikernel/duniverse/base/src/discover/discover.ml b/unikernel/duniverse/base/src/discover/discover.ml new file mode 100644 index 00000000..b1c189d2 --- /dev/null +++ b/unikernel/duniverse/base/src/discover/discover.ml @@ -0,0 +1,24 @@ +open Configurator.V1 + +let program = + {| +int main(int argc, char ** argv) +{ + return __builtin_popcount(argc); +} +|} +;; + +let () = + let output = ref "" in + main + ~name:"discover" + ~args:[ "-o", Set_string output, "FILENAME output file" ] + (fun c -> + let has_popcnt = + match ocaml_config_var_exn c "system" with + | "macosx" -> false + | _ -> c_test c ~c_flags:[ "-mpopcnt" ] program + in + Flags.write_sexp !output (if has_popcnt then [ "-mpopcnt" ] else [])) +;; diff --git a/unikernel/duniverse/base/src/discover/discover.mli b/unikernel/duniverse/base/src/discover/discover.mli new file mode 100644 index 00000000..e790aeb7 --- /dev/null +++ b/unikernel/duniverse/base/src/discover/discover.mli @@ -0,0 +1 @@ +(* empty *) diff --git a/unikernel/duniverse/base/src/discover/dune b/unikernel/duniverse/base/src/discover/dune new file mode 100644 index 00000000..9f30348e --- /dev/null +++ b/unikernel/duniverse/base/src/discover/dune @@ -0,0 +1,5 @@ +(executables + (modes byte exe) + (names discover) + (libraries dune-configurator) + (preprocess no_preprocessing)) diff --git a/unikernel/duniverse/base/src/dune b/unikernel/duniverse/base/src/dune new file mode 100644 index 00000000..489530d7 --- /dev/null +++ b/unikernel/duniverse/base/src/dune @@ -0,0 +1,51 @@ +(rule + (targets random_repr.ml) + (deps + (:first_dep select-random-repr/select.ml)) + (action + (run %{ocaml} %{first_dep} -ocaml-version %{ocaml_version} -o %{targets}))) + +(rule + (targets pow_overflow_bounds.ml) + (deps + (:first_dep ../generate/generate_pow_overflow_bounds.exe)) + (action + (run %{first_dep} -atomic -o %{targets})) + (mode fallback)) + +(library + (foreign_stubs + (language c) + (names bytes_stubs exn_stubs int_math_stubs hash_stubs obj_stubs am_testing) + (flags + :standard + -D_LARGEFILE64_SOURCE + (:include mpopcnt.sexp))) + (name base) + (public_name base) + (ocamlopt_flags + :standard + (:include ocamlopt-flags)) + (libraries base_internalhash_types sexplib0 shadow_stdlib + ocaml_intrinsics_kernel) + (preprocess no_preprocessing) + (lint + (pps ppx_base ppx_base_lint -check-doc-comments -type-conv-keep-w32=both + -apply=js_style,base_lint,type_conv,cold)) + (js_of_ocaml + (javascript_files runtime.js))) + +(rule + (targets mpopcnt.sexp) + (action + (run ./discover/discover.exe -o %{targets}))) + +(ocamllex hex_lexer) + +(documentation) + +(rule + (targets ocamlopt-flags) + (deps) + (action + (bash "echo '()' > ocamlopt-flags"))) diff --git a/unikernel/duniverse/base/src/either.ml b/unikernel/duniverse/base/src/either.ml new file mode 100644 index 00000000..dc959784 --- /dev/null +++ b/unikernel/duniverse/base/src/either.ml @@ -0,0 +1,223 @@ +open! Import +include Either_intf +module List = List0 +include Either0 + +let swap = function + | First x -> Second x + | Second x -> First x +;; + +let is_first = function + | First _ -> true + | Second _ -> false +;; + +let is_second = function + | First _ -> false + | Second _ -> true +;; + +let value (First x | Second x) = x + +let value_map t ~first ~second = + match t with + | First x -> first x + | Second x -> second x +;; + +let iter = value_map + +let map t ~first ~second = + match t with + | First x -> First (first x) + | Second x -> Second (second x) +;; + +let first x = First x +let second x = Second x + +let equal eq1 eq2 t1 t2 = + match t1, t2 with + | First x, First y -> eq1 x y + | Second x, Second y -> eq2 x y + | First _, Second _ | Second _, First _ -> false +;; + +let local_equal eq1 eq2 t1 t2 = + match t1, t2 with + | First x, First y -> eq1 x y + | Second x, Second y -> eq2 x y + | First _, Second _ | Second _, First _ -> false +;; + +let invariant f s = function + | First x -> f x + | Second y -> s y +;; + +module Focus = struct + type ('a, 'b) t = + | Focus of { value : 'a } + | Other of { value : 'b } +end + +module Make_focused (M : sig + type (+'a, +'b) t + + val return : 'a -> ('a, _) t + val other : 'b -> (_, 'b) t + val focus : ('a, 'b) t -> ('a, 'b) Focus.t + + val combine + : ('a, 'd) t + -> ('b, 'd) t + -> f:('a -> 'b -> 'c) + -> other:('d -> 'd -> 'd) + -> ('c, 'd) t + + val bind : ('a, 'b) t -> f:('a -> ('c, 'b) t) -> ('c, 'b) t +end) = +struct + include M + open With_return + + let map t ~f = + let res = bind t ~f:(fun x -> return (f x)) in + res + ;; + + include Monad.Make2_local (struct + type nonrec ('a, 'b) t = ('a, 'b) t + + let return = return + let bind = bind + let map = `Custom map + end) + + module App = Applicative.Make2_using_map2_local (struct + type nonrec ('a, 'b) t = ('a, 'b) t + + let return = return + let map = `Custom map + + let map2 : ('a, 'x) t -> ('b, 'x) t -> f:('a -> 'b -> 'c) -> ('c, 'x) t = + fun t1 t2 ~f -> + bind t1 ~f:(fun x -> bind t2 ~f:(fun y -> return (f x y)) [@nontail]) [@nontail] + ;; + end) + + include App + + let combine_all = + let rec other_loop f acc = function + | [] -> other acc + | t :: ts -> + (match focus t with + | Focus _ -> other_loop f acc ts + | Other o -> other_loop f (f acc o.value) ts) + in + let rec return_loop f acc = function + | [] -> return (List.rev acc) + | t :: ts -> + (match focus t with + | Focus x -> return_loop f (x.value :: acc) ts + | Other o -> other_loop f o.value ts) + in + fun ts ~f -> return_loop f [] ts + ;; + + let combine_all_unit = + let rec other_loop f acc = function + | [] -> other acc + | t :: ts -> + (match focus t with + | Focus _ -> other_loop f acc ts + | Other o -> other_loop f (f acc o.value) ts) + in + let rec return_loop f = function + | [] -> return () + | t :: ts -> + (match focus t with + | Focus { value = () } -> return_loop f ts + | Other { value = o } -> other_loop f o ts) + in + fun ts ~f -> return_loop f ts + ;; + + let to_option t = + match focus t with + | Focus x -> Some x.value + | Other _ -> None + ;; + + let value t ~default = + match focus t with + | Focus x -> x.value + | Other _ -> default + ;; + + let with_return f = + with_return (fun ret -> other (f (With_return.prepend ret ~f:return))) [@nontail] + ;; +end + +module First = Make_focused (struct + type nonrec ('a, 'b) t = ('a, 'b) t + + let return = first + let other = second + + let focus t : _ Focus.t = + match t with + | First x -> Focus { value = x } + | Second y -> Other { value = y } + ;; + + let combine t1 t2 ~f ~other = + match t1, t2 with + | First x, First y -> First (f x y) + | Second x, Second y -> Second (other x y) + | Second x, _ | _, Second x -> Second x + ;; + + let bind t ~f = + match t with + | First x -> f x + (* Reuse the value in order to avoid allocation. *) + | Second _ as y -> y + ;; +end) + +module Second = Make_focused (struct + type nonrec ('a, 'b) t = ('b, 'a) t + + let return = second + let other = first + + let focus t : _ Focus.t = + match t with + | Second x -> Focus { value = x } + | First y -> Other { value = y } + ;; + + let combine t1 t2 ~f ~other = + match t1, t2 with + | Second x, Second y -> Second (f x y) + | First x, First y -> First (other x y) + | First x, _ | _, First x -> First x + ;; + + let bind t ~f = + match t with + | Second x -> f x + (* Reuse the value in order to avoid allocation, like [First.bind] above. *) + | First _ as y -> y + ;; +end) + +module Export = struct + type ('f, 's) _either = ('f, 's) t = + | First of 'f + | Second of 's +end diff --git a/unikernel/duniverse/base/src/either.mli b/unikernel/duniverse/base/src/either.mli new file mode 100644 index 00000000..e3587aab --- /dev/null +++ b/unikernel/duniverse/base/src/either.mli @@ -0,0 +1 @@ +include Either_intf.Either (** @inline *) diff --git a/unikernel/duniverse/base/src/either0.ml b/unikernel/duniverse/base/src/either0.ml new file mode 100644 index 00000000..3efd97b9 --- /dev/null +++ b/unikernel/duniverse/base/src/either0.ml @@ -0,0 +1,142 @@ +open! Import + +type ('f, 's) t = + | First of 'f + | Second of 's +[@@deriving_inline compare ~localize, hash, sexp, sexp_grammar] + +let compare__local : + 'f 's. ('f -> 'f -> int) -> ('s -> 's -> int) -> ('f, 's) t -> ('f, 's) t -> int + = + fun _cmp__f _cmp__s a__007_ b__008_ -> + if Stdlib.( == ) a__007_ b__008_ + then 0 + else ( + match a__007_, b__008_ with + | First _a__009_, First _b__010_ -> _cmp__f _a__009_ _b__010_ + | First _, _ -> -1 + | _, First _ -> 1 + | Second _a__011_, Second _b__012_ -> _cmp__s _a__011_ _b__012_) +;; + +let compare : + 'f 's. ('f -> 'f -> int) -> ('s -> 's -> int) -> ('f, 's) t -> ('f, 's) t -> int + = + fun _cmp__f _cmp__s a__001_ b__002_ -> + if Stdlib.( == ) a__001_ b__002_ + then 0 + else ( + match a__001_, b__002_ with + | First _a__003_, First _b__004_ -> _cmp__f _a__003_ _b__004_ + | First _, _ -> -1 + | _, First _ -> 1 + | Second _a__005_, Second _b__006_ -> _cmp__s _a__005_ _b__006_) +;; + +let hash_fold_t + : type f s. + (Ppx_hash_lib.Std.Hash.state -> f -> Ppx_hash_lib.Std.Hash.state) + -> (Ppx_hash_lib.Std.Hash.state -> s -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> (f, s) t + -> Ppx_hash_lib.Std.Hash.state + = + fun _hash_fold_f _hash_fold_s hsv arg -> + match arg with + | First _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 0 in + let hsv = hsv in + _hash_fold_f hsv _a0 + | Second _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 1 in + let hsv = hsv in + _hash_fold_s hsv _a0 +;; + +let t_of_sexp : + 'f 's. + (Sexplib0.Sexp.t -> 'f) -> (Sexplib0.Sexp.t -> 's) -> Sexplib0.Sexp.t -> ('f, 's) t + = + fun (type f__029_ s__030_) + : ((Sexplib0.Sexp.t -> f__029_) -> (Sexplib0.Sexp.t -> s__030_) -> Sexplib0.Sexp.t + -> (f__029_, s__030_) t) -> + let error_source__017_ = "either0.ml.t" in + fun _of_f__013_ _of_s__014_ -> function + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("first" | "First") as _tag__020_) :: sexp_args__021_) as + _sexp__019_ -> + (match sexp_args__021_ with + | arg0__022_ :: [] -> + let res0__023_ = _of_f__013_ arg0__022_ in + First res0__023_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__017_ + _tag__020_ + _sexp__019_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("second" | "Second") as _tag__025_) :: sexp_args__026_) as + _sexp__024_ -> + (match sexp_args__026_ with + | arg0__027_ :: [] -> + let res0__028_ = _of_s__014_ arg0__027_ in + Second res0__028_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__017_ + _tag__025_ + _sexp__024_) + | Sexplib0.Sexp.Atom ("first" | "First") as sexp__018_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__017_ sexp__018_ + | Sexplib0.Sexp.Atom ("second" | "Second") as sexp__018_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__017_ sexp__018_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__016_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__017_ sexp__016_ + | Sexplib0.Sexp.List [] as sexp__016_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__017_ sexp__016_ + | sexp__016_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__017_ sexp__016_ +;; + +let sexp_of_t : + 'f 's. + ('f -> Sexplib0.Sexp.t) -> ('s -> Sexplib0.Sexp.t) -> ('f, 's) t -> Sexplib0.Sexp.t + = + fun (type f__037_ s__038_) + : ((f__037_ -> Sexplib0.Sexp.t) -> (s__038_ -> Sexplib0.Sexp.t) + -> (f__037_, s__038_) t -> Sexplib0.Sexp.t) -> + fun _of_f__031_ _of_s__032_ -> function + | First arg0__033_ -> + let res0__034_ = _of_f__031_ arg0__033_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "First"; res0__034_ ] + | Second arg0__035_ -> + let res0__036_ = _of_s__032_ arg0__035_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Second"; res0__036_ ] +;; + +let t_sexp_grammar : + 'f 's. + 'f Sexplib0.Sexp_grammar.t + -> 's Sexplib0.Sexp_grammar.t + -> ('f, 's) t Sexplib0.Sexp_grammar.t + = + fun _'f_sexp_grammar _'s_sexp_grammar -> + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag + { name = "First" + ; clause_kind = + List_clause { args = Cons (_'f_sexp_grammar.untyped, Empty) } + } + ; No_tag + { name = "Second" + ; clause_kind = + List_clause { args = Cons (_'s_sexp_grammar.untyped, Empty) } + } + ] + } + } +;; + +[@@@end] diff --git a/unikernel/duniverse/base/src/either_intf.ml b/unikernel/duniverse/base/src/either_intf.ml new file mode 100644 index 00000000..7d2daf13 --- /dev/null +++ b/unikernel/duniverse/base/src/either_intf.ml @@ -0,0 +1,87 @@ +(** A type that represents values with two possibilities. + + [Either] can be seen as a generic sum type, the dual of [Tuple]. [First] is neither + more important nor less important than [Second]. + + Many functions in [Either] focus on just one constructor. The [Focused] signature + abstracts over which constructor is the focus. To use these functions, use the + [First] or [Second] modules in [S]. *) + +open! Import + +module type Focused = sig + type (+'focus, +'other) t + + include Monad.S2_local with type ('a, 'b) t := ('a, 'b) t + include Applicative.S2_local with type ('a, 'b) t := ('a, 'b) t + + val value : ('a, _) t -> default:'a -> 'a + val to_option : ('a, _) t -> 'a option + val with_return : ('a With_return.return -> 'b) -> ('a, 'b) t + + val combine + : ('a, 'd) t + -> ('b, 'd) t + -> f:('a -> 'b -> 'c) + -> other:('d -> 'd -> 'd) + -> ('c, 'd) t + + val combine_all : ('a, 'b) t list -> f:('b -> 'b -> 'b) -> ('a list, 'b) t + val combine_all_unit : (unit, 'b) t list -> f:('b -> 'b -> 'b) -> (unit, 'b) t +end + +module type Either = sig + type ('f, 's) t = ('f, 's) Either0.t = + | First of 'f + | Second of 's + [@@deriving_inline compare ~localize, hash, sexp, sexp_grammar] + + include Ppx_compare_lib.Comparable.S2 with type ('f, 's) t := ('f, 's) t + include Ppx_compare_lib.Comparable.S_local2 with type ('f, 's) t := ('f, 's) t + include Ppx_hash_lib.Hashable.S2 with type ('f, 's) t := ('f, 's) t + include Sexplib0.Sexpable.S2 with type ('f, 's) t := ('f, 's) t + + val t_sexp_grammar + : 'f Sexplib0.Sexp_grammar.t + -> 's Sexplib0.Sexp_grammar.t + -> ('f, 's) t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Invariant.S2 with type ('a, 'b) t := ('a, 'b) t + + val swap : ('f, 's) t -> ('s, 'f) t + val value : ('a, 'a) t -> 'a + val iter : ('a, 'b) t -> first:('a -> unit) -> second:('b -> unit) -> unit + val value_map : ('a, 'b) t -> first:('a -> 'c) -> second:('b -> 'c) -> 'c + val map : ('a, 'b) t -> first:('a -> 'c) -> second:('b -> 'd) -> ('c, 'd) t + val equal : ('f -> 'f -> bool) -> ('s -> 's -> bool) -> ('f, 's) t -> ('f, 's) t -> bool + + val local_equal + : ('f -> 'f -> bool) + -> ('s -> 's -> bool) + -> ('f, 's) t + -> ('f, 's) t + -> bool + + module type Focused = Focused + + module First : Focused with type ('a, 'b) t = ('a, 'b) t + module Second : Focused with type ('a, 'b) t = ('b, 'a) t + + val is_first : (_, _) t -> bool + val is_second : (_, _) t -> bool + + (** [first] and [second] are [First.return] and [Second.return]. *) + val first : 'f -> ('f, _) t + + val second : 's -> (_, 's) t + + (**/**) + + module Export : sig + type ('f, 's) _either = ('f, 's) t = + | First of 'f + | Second of 's + end +end diff --git a/unikernel/duniverse/base/src/equal.ml b/unikernel/duniverse/base/src/equal.ml new file mode 100644 index 00000000..d6443d37 --- /dev/null +++ b/unikernel/duniverse/base/src/equal.ml @@ -0,0 +1,44 @@ +(** This module defines signatures that are to be included in other signatures to ensure a + consistent interface to [equal] functions. There is a signature ([S], [S1], [S2], + [S3]) for each arity of type. Usage looks like: + + {[ + type t + include Equal.S with type t := t + ]} + + or + + {[ + type 'a t + include Equal.S1 with type 'a t := 'a t + ]} *) + +open! Import + +type 'a t = 'a -> 'a -> bool +type 'a equal = 'a t + +module type S = sig + type t + + val equal : t equal +end + +module type S1 = sig + type 'a t + + val equal : 'a equal -> 'a t equal +end + +module type S2 = sig + type ('a, 'b) t + + val equal : 'a equal -> 'b equal -> ('a, 'b) t equal +end + +module type S3 = sig + type ('a, 'b, 'c) t + + val equal : 'a equal -> 'b equal -> 'c equal -> ('a, 'b, 'c) t equal +end diff --git a/unikernel/duniverse/base/src/error.ml b/unikernel/duniverse/base/src/error.ml new file mode 100644 index 00000000..e82588ea --- /dev/null +++ b/unikernel/duniverse/base/src/error.ml @@ -0,0 +1,19 @@ +(* This module is trying to minimize dependencies on modules in Core, so as to allow + [Error] and [Or_error] to be used in various places. Please avoid adding new + dependencies. *) + +open! Import +include Info + +let t_sexp_grammar : t Sexplib0.Sexp_grammar.t = { untyped = Any "Error.t" } +let[@cold] raise t = raise (to_exn t) +let[@cold] raise_s sexp = raise (create_s sexp) +let to_info t = t +let of_info t = t + +include Pretty_printer.Register_pp (struct + type nonrec t = t + + let module_name = "Base.Error" + let pp = pp +end) diff --git a/unikernel/duniverse/base/src/error.mli b/unikernel/duniverse/base/src/error.mli new file mode 100644 index 00000000..ba2bca1e --- /dev/null +++ b/unikernel/duniverse/base/src/error.mli @@ -0,0 +1,14 @@ +(** A lazy string, implemented with [Info], but intended specifically for error + messages. *) + +open! Import + +include Info_intf.S with type t = private Info.t (** @open *) + +(** Note that the exception raised by this function maintains a reference to the [t] + passed in. *) +val raise : t -> _ + +val raise_s : Sexp.t -> _ +val to_info : t -> Info.t +val of_info : Info.t -> t diff --git a/unikernel/duniverse/base/src/exn.ml b/unikernel/duniverse/base/src/exn.ml new file mode 100644 index 00000000..794a9bcd --- /dev/null +++ b/unikernel/duniverse/base/src/exn.ml @@ -0,0 +1,172 @@ +open! Import + +type t = exn [@@deriving_inline sexp_of] + +let sexp_of_t = (sexp_of_exn : t -> Sexplib0.Sexp.t) + +[@@@end] + +let exit = Stdlib.exit + +exception Finally of t * t [@@deriving_inline sexp] + +let () = + Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Finally] (function + | Finally (arg0__001_, arg1__002_) -> + let res0__003_ = sexp_of_t arg0__001_ + and res1__004_ = sexp_of_t arg1__002_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "exn.ml.Finally"; res0__003_; res1__004_ ] + | _ -> assert false) +;; + +[@@@end] + +exception Reraised of string * t [@@deriving_inline sexp] + +let () = + Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Reraised] (function + | Reraised (arg0__005_, arg1__006_) -> + let res0__007_ = sexp_of_string arg0__005_ + and res1__008_ = sexp_of_t arg1__006_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "exn.ml.Reraised"; res0__007_; res1__008_ ] + | _ -> assert false) +;; + +[@@@end] + +exception Sexp of Sexp.t + +(* We install a custom exn-converter rather than use: + + {[ + exception Sexp of Sexp.t [@@deriving_inline sexp] + (* ... *) + [@@@end] + ]} + + to eliminate the extra wrapping of [(Sexp ...)]. *) +let () = + Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Sexp] (function + | Sexp t -> t + | _ -> + (* Reaching this branch indicates a bug in sexplib. *) + assert false) +;; + +let create_s sexp = Sexp sexp + +let raise_with_original_backtrace t backtrace = + Stdlib.Printexc.raise_with_backtrace t backtrace +;; + +external is_phys_equal_most_recent : t -> bool = "Base_caml_exn_is_most_recent_exn" + +let reraise exn str = + let exn' = Reraised (str, exn) in + if is_phys_equal_most_recent exn + then ( + let bt = Stdlib.Printexc.get_raw_backtrace () in + raise_with_original_backtrace exn' bt) + else raise exn' +;; + +let reraisef exc format = Printf.ksprintf (fun str () -> reraise exc str) format +let to_string exc = Sexp.to_string_hum ~indent:2 (sexp_of_exn exc) +let to_string_mach exc = Sexp.to_string_mach (sexp_of_exn exc) +let sexp_of_t = sexp_of_exn + +let protectx ~f x ~(finally : _ -> unit) = + match f x with + | res -> + finally x; + res + | exception exn -> + let bt = Stdlib.Printexc.get_raw_backtrace () in + (match finally x with + | () -> raise_with_original_backtrace exn bt + | exception final_exn -> + (* Unfortunately, the backtrace of the [final_exn] is discarded here. *) + raise_with_original_backtrace (Finally (exn, final_exn)) bt) +;; + +let protect ~f ~finally = protectx ~f () ~finally + +let does_raise (type a) (f : unit -> a) = + try + ignore (f () : a); + false + with + | _ -> true +;; + +include Pretty_printer.Register_pp (struct + type t = exn + + let pp ppf t = + match sexp_of_exn_opt t with + | Some sexp -> Sexp.pp_hum ppf sexp + | None -> Stdlib.Format.pp_print_string ppf (Stdlib.Printexc.to_string t) + ;; + + let module_name = "Base.Exn" +end) + +let print_with_backtrace exc raw_backtrace = + Stdlib.Format.eprintf "@[<2>Uncaught exception:@\n@\n@[%a@]@]@\n@." pp exc; + if Stdlib.Printexc.backtrace_status () + then Stdlib.Printexc.print_raw_backtrace Stdlib.stderr raw_backtrace; + Stdlib.flush Stdlib.stderr +;; + +let set_uncaught_exception_handler () = + Stdlib.Printexc.set_uncaught_exception_handler print_with_backtrace +;; + +let handle_uncaught_aux ~do_at_exit ~exit f = + try f () with + | exc -> + let raw_backtrace = Stdlib.Printexc.get_raw_backtrace () in + (* One reason to run [do_at_exit] handlers before printing out the error message is + that it helps curses applications bring the terminal in a good state, otherwise the + error message might get corrupted. Also, the OCaml top-level uncaught exception + handler does the same. *) + if do_at_exit + then ( + try Stdlib.do_at_exit () with + | _ -> ()); + (try print_with_backtrace exc raw_backtrace with + | _ -> + (try + Stdlib.Printf.eprintf "Exn.handle_uncaught could not print; exiting anyway\n%!" + with + | _ -> ())); + exit 1 +;; + +let handle_uncaught_and_exit f = handle_uncaught_aux f ~exit ~do_at_exit:true + +let handle_uncaught ~exit:must_exit f = + handle_uncaught_aux f ~exit:(if must_exit then exit else ignore) ~do_at_exit:must_exit +;; + +let reraise_uncaught str func = + try func () with + | exn -> + let bt = Stdlib.Printexc.get_raw_backtrace () in + raise_with_original_backtrace (Reraised (str, exn)) bt +;; + +external clear_backtrace : unit -> unit = "Base_clear_caml_backtrace_pos" [@@noalloc] + +let raise_without_backtrace e = + (* We clear the backtrace to reduce confusion, so that people don't think whatever + is stored corresponds to this raise. *) + clear_backtrace (); + Stdlib.raise_notrace e +;; + +let initialize_module () = set_uncaught_exception_handler () + +module Private = struct + let clear_backtrace = clear_backtrace +end diff --git a/unikernel/duniverse/base/src/exn.mli b/unikernel/duniverse/base/src/exn.mli new file mode 100644 index 00000000..ef4d087f --- /dev/null +++ b/unikernel/duniverse/base/src/exn.mli @@ -0,0 +1,113 @@ +(** Exceptions. + + [sexp_of_t] uses a global table of sexp converters. To register a converter for a new + exception, add [[@@deriving sexp]] to its definition. If no suitable converter is + found, the standard converter in [Printexc] will be used to generate an atomic + S-expression. *) + +open! Import + +type t = exn [@@deriving_inline sexp_of] + +val sexp_of_t : t -> Sexplib0.Sexp.t + +[@@@end] + +include Pretty_printer.S with type t := t + +(** Raised when finalization after an exception failed, too. + The first exception argument is the one raised by the initial + function, the second exception the one raised by the finalizer. *) +exception Finally of t * t + +exception Reraised of string * t + +(** [create_s sexp] returns an exception [t] such that [phys_equal (sexp_of_t t) sexp]. + This is useful when one wants to create an exception that serves as a message and the + particular exn constructor doesn't matter. *) +val create_s : Sexp.t -> t + +(** Same as [raise], except that the backtrace is not recorded. *) +val raise_without_backtrace : t -> _ + +(** [raise_with_original_backtrace t bt] raises the exception [exn], recording [bt] + as the backtrace it was originally raised at. This is useful to re-raise + exceptions annotated with extra information. *) +val raise_with_original_backtrace : t -> Stdlib.Printexc.raw_backtrace -> _ + +val reraise : t -> string -> _ + +(** Types with [format4] are hard to read, so here's an example. + + {[ + let foobar str = + try + ... + with exn -> + Exn.reraisef exn "Foobar is buggy on: %s" str () + ]} *) +val reraisef : t -> ('a, unit, string, unit -> _) format4 -> 'a + +(** Human-readable, multi-line. *) +val to_string : t -> string + +(** Machine format, single-line. *) +val to_string_mach : t -> string + +(** Executes [f] and afterwards executes [finally], whether [f] throws an exception or + not. *) +val protectx : f:('a -> 'b) -> 'a -> finally:('a -> unit) -> 'b + +val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a + +(** [handle_uncaught ~exit f] catches an exception escaping [f] and prints an error + message to stderr. Exits with return code 1 if [exit] is [true], and returns unit + otherwise. + + Note that since OCaml 4.02.0, you don't need to use this at the entry point of your + program, as the OCaml runtime will do better than this function. *) +val handle_uncaught : exit:bool -> (unit -> unit) -> unit + +(** [handle_uncaught_and_exit f] returns [f ()], unless that raises, in which case it + prints the exception and exits nonzero. *) +val handle_uncaught_and_exit : (unit -> 'a) -> 'a + +(** Traces exceptions passing through. Useful because in practice, backtraces still don't + seem to work. + + Example: + {[ + let rogue_function () = if Random.bool () then failwith "foo" else 3 + let traced_function () = Exn.reraise_uncaught "rogue_function" rogue_function + traced_function ();; + ]} + {v : Program died with Reraised("rogue_function", Failure "foo") v} *) +val reraise_uncaught : string -> (unit -> 'a) -> 'a + +(** [does_raise f] returns [true] iff [f ()] raises, which is often useful in unit + tests. *) +val does_raise : (unit -> _) -> bool + +(** Returns [true] if this exception is physically equal to the most recently raised one. + If so, then [Backtrace.Exn.most_recent ()] is a backtrace corresponding to this + exception. + + Note that, confusingly, exceptions can be physically equal even if the caller was not + involved in handling of the last-raised exception. See the documentation of + [Backtrace.Exn.most_recent_for_exn] for further discussion. +*) +val is_phys_equal_most_recent : t -> bool + +(** User code never calls this. It is called in [base.ml] as a top-level side + effect to change the display of exceptions and install an uncaught-exception + printer. *) +val initialize_module : unit -> unit + +(**/**) + +(*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) +module Private : sig + val clear_backtrace : unit -> unit +end diff --git a/unikernel/duniverse/base/src/exn_stubs.c b/unikernel/duniverse/base/src/exn_stubs.c new file mode 100644 index 00000000..114a8cca --- /dev/null +++ b/unikernel/duniverse/base/src/exn_stubs.c @@ -0,0 +1,18 @@ +#define CAML_INTERNALS +#ifndef CAML_NAME_SPACE +#define CAML_NAME_SPACE +#endif +/* If CAML_NAME_SPACE is not defined, then legacy names like + [backtrace_last_exn] are in scope, which can lead to confusing errors. + It's cleaner to disable those names. */ +#include +#include + +CAMLprim value Base_clear_caml_backtrace_pos() { + caml_backtrace_pos = 0; + return Val_unit; +} + +CAMLprim value Base_caml_exn_is_most_recent_exn(value exn) { + return Val_bool(caml_backtrace_last_exn == exn); +} diff --git a/unikernel/duniverse/base/src/field.ml b/unikernel/duniverse/base/src/field.ml new file mode 100644 index 00000000..cc46dc83 --- /dev/null +++ b/unikernel/duniverse/base/src/field.ml @@ -0,0 +1,69 @@ +(* The type [t] should be abstract to make the fset and set functions unavailable + for private types at the level of types (and not by putting None in the field). + Unfortunately, making the type abstract means that when creating fields (through + a [create] function) value restriction kicks in. This is worked around by instead + not making the type abstract, but forcing anyone breaking the abstraction to use + the [For_generated_code] module, making it obvious to any reader that something ugly + is going on. + t_with_perm (and derivatives) is the type that users really use. It is a constructor + because: + 1. it makes type errors more readable (less aliasing) + 2. the typer in ocaml 4.01 allows this: + + {[ + module A = struct + type t = {a : int} + end + type t = A.t + let f (x : t) = x.a + ]} + + (although with Warning 40: a is used out of scope) + which means that if [t_with_perm] was really an alias on [For_generated_code.t], + people could say [t.setter] and break the abstraction with no indication that + something ugly is going on in the source code. + The warning is (I think) for people who want to make their code compatible with + previous versions of ocaml, so we may very well turn it off. + + The type t_with_perm could also have been a [unit -> For_generated_code.t] to work + around value restriction and then [For_generated_code.t] would have been a proper + abstract type, but it looks like it could impact performance (for example, a fold on a + record type with 40 fields would actually allocate the 40 [For_generated_code.t]'s at + every single fold.) *) + +module For_generated_code = struct + type ('perm, 'record, 'field) t = + { force_variance : 'perm -> unit + ; (* force [t] to be contravariant in ['perm], because phantom type variables on + concrete types don't work that well otherwise (using :> can remove them easily) *) + name : string + ; setter : ('record -> 'field -> unit) option + ; getter : 'record -> 'field + ; fset : 'record -> 'field -> 'record + } + + let opaque_identity = Sys0.opaque_identity +end + +type ('perm, 'record, 'field) t_with_perm = + | Field of ('perm, 'record, 'field) For_generated_code.t +[@@unboxed] + +type ('record, 'field) t = ([ `Read | `Set_and_create ], 'record, 'field) t_with_perm +type ('record, 'field) readonly_t = ([ `Read ], 'record, 'field) t_with_perm + +let name (Field field) = field.name +let get (Field field) r = field.getter r +let fset (Field field) r v = field.fset r v +let setter (Field field) = field.setter + +type ('perm, 'record, 'result) user = + { f : 'field. ('perm, 'record, 'field) t_with_perm -> 'result } + +let map (Field field) r ~f = field.fset r (f (field.getter r)) + +let updater (Field field) = + match field.setter with + | None -> None + | Some setter -> Some (fun r ~f -> setter r (f (field.getter r))) +;; diff --git a/unikernel/duniverse/base/src/field.mli b/unikernel/duniverse/base/src/field.mli new file mode 100644 index 00000000..e79a9bc1 --- /dev/null +++ b/unikernel/duniverse/base/src/field.mli @@ -0,0 +1,45 @@ +(** OCaml record field. *) + +(**/**) + +module For_generated_code : sig + (*_ don't use this by hand, it is only meant for ppx_fields_conv *) + + type ('perm, 'record, 'field) t = + { force_variance : 'perm -> unit + ; name : string + ; setter : ('record -> 'field -> unit) option + ; getter : 'record -> 'field + ; fset : 'record -> 'field -> 'record + } + + val opaque_identity : 'a -> 'a +end + +(**/**) + +(** ['record] is the type of the record. ['field] is the type of the + values stored in the record field with name [name]. ['perm] is a way + of restricting the operations that can be used. *) +type ('perm, 'record, 'field) t_with_perm = + | Field of ('perm, 'record, 'field) For_generated_code.t +[@@unboxed] + +(** A record field with no restrictions. *) +type ('record, 'field) t = ([ `Read | `Set_and_create ], 'record, 'field) t_with_perm + +(** A record that can only be read, because it belongs to a private type. *) +type ('record, 'field) readonly_t = ([ `Read ], 'record, 'field) t_with_perm + +val name : (_, _, _) t_with_perm -> string +val get : (_, 'r, 'a) t_with_perm -> 'r -> 'a +val fset : ([> `Set_and_create ], 'r, 'a) t_with_perm -> 'r -> 'a -> 'r +val setter : ([> `Set_and_create ], 'r, 'a) t_with_perm -> ('r -> 'a -> unit) option +val map : ([> `Set_and_create ], 'r, 'a) t_with_perm -> 'r -> f:('a -> 'a) -> 'r + +val updater + : ([> `Set_and_create ], 'r, 'a) t_with_perm + -> ('r -> f:('a -> 'a) -> unit) option + +type ('perm, 'record, 'result) user = + { f : 'field. ('perm, 'record, 'field) t_with_perm -> 'result } diff --git a/unikernel/duniverse/base/src/fieldslib.ml b/unikernel/duniverse/base/src/fieldslib.ml new file mode 100644 index 00000000..dd41b034 --- /dev/null +++ b/unikernel/duniverse/base/src/fieldslib.ml @@ -0,0 +1,3 @@ +(** This module is for use by ppx_fields_conv, and is thus not in the interface of + Base. *) +module Field = Field diff --git a/unikernel/duniverse/base/src/float.ml b/unikernel/duniverse/base/src/float.ml new file mode 100644 index 00000000..7462a12a --- /dev/null +++ b/unikernel/duniverse/base/src/float.ml @@ -0,0 +1,1067 @@ +open! Import +open! Printf +module Bytes = Bytes0 +include Float0 + +let raise_s = Error.raise_s + +module T = struct + type t = float [@@deriving_inline hash, globalize, sexp, sexp_grammar] + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_float + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_float in + fun x -> func x + ;; + + let (globalize : t -> t) = (globalize_float : t -> t) + let t_of_sexp = (float_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_float : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = float_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + let compare = Float_replace_polymorphic_compare.compare +end + +include T +include Comparator.Make (T) + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open Float_replace_polymorphic_compare + +let invariant (_ : t) = () +let to_float x = x +let of_float x = x + +let of_string s = + try float_of_string s with + | _ -> invalid_argf "Float.of_string %s" s () +;; + +let of_string_opt = float_of_string_opt + +external format_float : string -> float -> string = "caml_format_float" + +(* Stolen from [pervasives.ml]. Adds a "." at the end if needed. It is in + [pervasives.mli], but it also says not to use it directly, so we copy and paste the + code. It makes the assumption on the string passed in argument that it was returned by + [format_float]. *) +let valid_float_lexem s = + let l = String.length s in + let rec loop i = + if Int_replace_polymorphic_compare.( >= ) i l + then s ^ "." + else ( + match s.[i] with + | '0' .. '9' | '-' -> loop (i + 1) + | _ -> s) + in + loop 0 +;; + +(* Let [y] be a power of 2. Then the next representable float is: + [z = y * (1 + 2 ** -52)] + and the previous one is + [x = y * (1 - 2 ** -53)] + + In general, every two adjacent floats are within a factor of between [1 + 2**-53] + and [1 + 2**-52] from each other, that is within [1 + 1.1e-16] and [1 + 2.3e-16]. + + So if the decimal representation of a float starts with "1", then its adjacent floats + will usually differ from it by 1, and sometimes by 2, at the 17th significant digit + (counting from 1). + + On the other hand, if the decimal representation starts with "9", then the adjacent + floats will be off by no more than 23 at the 16th and 17th significant digits. + + E.g.: + + {v + # sprintf "%.17g" (1024. *. (1. -. 2.** (-53.)));; + 11111111 + 1234 5678901234567 + - : string = "1023.9999999999999" + v} + Printing a couple of extra digits reveals that the difference indeed is roughly 11 at + digits 17th and 18th (that is, 13th and 14th after "."): + + {v + # sprintf "%.19g" (1024. *. (1. -. 2.** (-53.)));; + 1111111111 + 1234 567890123456789 + - : string = "1023.999999999999886" + v} + + The ulp (the difference between adjacent floats) is twice as big on the other side of + 1024.: + + {v + # sprintf "%.19g" (1024. *. (1. +. 2.** (-52.)));; + 1111111111 + 1234 567890123456789 + - : string = "1024.000000000000227" + v} + + Now take a power of 2 which starts with 99: + + {v + # 2.**93. ;; + 1111111111 + 1 23456789012345678 + - : float = 9.9035203142830422e+27 + + # 2.**93. *. (1. +. 2.** (-52.));; + - : float = 9.9035203142830444e+27 + + # 2.**93. *. (1. -. 2.** (-53.));; + - : float = 9.9035203142830411e+27 + v} + + The difference between 2**93 and its two neighbors is slightly more than, respectively, + 1 and 2 at significant digit 16. + + Those examples show that: + - 17 significant digits is always sufficient to represent a float without ambiguity + - 15th significant digit can always be represented accurately + - converting a decimal number with 16 significant digits to its nearest float and back + can change the last decimal digit by no more than 1 + + To make sure that floats obtained by conversion from decimal fractions (e.g. "3.14") + are printed without trailing non-zero digits, one should choose the first among the + '%.15g', '%.16g', and '%.17g' representations which does round-trip: + + {v + # sprintf "%.15g" 3.14;; + - : string = "3.14" (* pick this one *) + # sprintf "%.16g" 3.14;; + - : string = "3.14" + # sprintf "%.17g" 3.14;; + - : string = "3.1400000000000001" (* do not pick this one *) + + # sprintf "%.15g" 8.000000000000002;; + - : string = "8" (* do not pick this one--does not round-trip *) + # sprintf "%.16g" 8.000000000000002;; + - : string = "8.000000000000002" (* prefer this one *) + # sprintf "%.17g" 8.000000000000002;; + - : string = "8.0000000000000018" (* this one has one digit of junk at the end *) + v} + + Skipping the '%.16g' in the above procedure saves us some time, but it means that, as + seen in the second example above, occasionally numbers with exactly 16 significant + digits will have an error introduced at the 17th digit. That is probably OK for + typical use, because a number with 16 significant digits is "ugly" already. Adding one + more doesn't make it much worse for a human reader. + + On the other hand, we cannot skip '%.15g' and only look at '%.16g' and '%.17g', since + the inaccuracy at the 16th digit might introduce the noise we want to avoid: + + {v + # sprintf "%.15g" 9.992;; + - : string = "9.992" (* pick this one *) + # sprintf "%.16g" 9.992;; + - : string = "9.992000000000001" (* do not pick this one--junk at the end *) + # sprintf "%.17g" 9.992;; + - : string = "9.9920000000000009" + v} +*) +let to_string x = + valid_float_lexem + (let y = format_float "%.15g" x in + if float_of_string y = x then y else format_float "%.17g" x) +;; + +let max_value = infinity +let min_value = neg_infinity +let min_positive_subnormal_value = 2. ** -1074. +let min_positive_normal_value = 2. ** -1022. +let zero = 0. +let one = 1. +let minus_one = -1. +let pi = 0x3.243F6A8885A308D313198A2E037073 +let sqrt_pi = 0x1.C5BF891B4EF6AA79C3B0520D5DB938 +let sqrt_2pi = 0x2.81B263FEC4E0B2CAF9483F5CE459DC +let euler = 0x0.93C467E37DB0C7A4D1BE3F810152CB +let of_int = Int.to_float +let to_int = Int.of_float +let of_int63 i = Int63.to_float i +let of_int64 i = Stdlib.Int64.to_float i +let to_int64 = Stdlib.Int64.of_float +let iround_lbound = lower_bound_for_int Int.num_bits +let iround_ubound = upper_bound_for_int Int.num_bits + +(* The performance of the "exn" rounding functions is important, so they are written + out separately, and tuned individually. (We could have the option versions call + the "exn" versions, but that imposes arguably gratuitous overhead---especially + in the case where the capture of backtraces is enabled upon "with"---and that seems + not worth it when compared to the relatively small amount of code duplication.) *) + +(* Error reporting below is very carefully arranged so that, e.g., [iround_nearest_exn] + itself can be inlined into callers such that they don't need to allocate a box for the + [float] argument. This is done with a box [box] function carefully chosen to allow the + compiler to create a separate box for the float only in error cases. See, e.g., + [../../zero/test/price_test.ml] for a mechanical test of this property when building + with [X_LIBRARY_INLINING=true]. *) + +let iround_up t = + if t > 0.0 + then ( + let t' = ceil t in + if t' <= iround_ubound then Some (Int.of_float_unchecked t') else None) + else if t >= iround_lbound + then Some (Int.of_float_unchecked t) + else None +;; + +let[@ocaml.inline always] iround_up_exn t = + if t > 0.0 + then ( + let t' = ceil t in + if t' <= iround_ubound + then Int.of_float_unchecked t' + else invalid_argf "Float.iround_up_exn: argument (%f) is too large" (box t) ()) + else if t >= iround_lbound + then Int.of_float_unchecked t + else invalid_argf "Float.iround_up_exn: argument (%f) is too small or NaN" (box t) () +;; + +let iround_down t = + if t >= 0.0 + then if t <= iround_ubound then Some (Int.of_float_unchecked t) else None + else ( + let t' = floor t in + if t' >= iround_lbound then Some (Int.of_float_unchecked t') else None) +;; + +let[@ocaml.inline always] iround_down_exn t = + if t >= 0.0 + then + if t <= iround_ubound + then Int.of_float_unchecked t + else invalid_argf "Float.iround_down_exn: argument (%f) is too large" (box t) () + else ( + let t' = floor t in + if t' >= iround_lbound + then Int.of_float_unchecked t' + else + invalid_argf "Float.iround_down_exn: argument (%f) is too small or NaN" (box t) ()) +;; + +let iround_towards_zero t = + if t >= iround_lbound && t <= iround_ubound + then Some (Int.of_float_unchecked t) + else None +;; + +let[@ocaml.inline always] iround_towards_zero_exn t = + if t >= iround_lbound && t <= iround_ubound + then Int.of_float_unchecked t + else + invalid_argf + "Float.iround_towards_zero_exn: argument (%f) is out of range or NaN" + (box t) + () +;; + +(* Outside of the range (round_nearest_lb..round_nearest_ub), all representable doubles + are integers in the mathematical sense, and [round_nearest] should be identity. + + However, for odd numbers with the absolute value between 2**52 and 2**53, the formula + [round_nearest x = floor (x + 0.5)] does not hold: + + {v + # let naive_round_nearest x = floor (x +. 0.5);; + # let x = 2. ** 52. +. 1.;; + val x : float = 4503599627370497. + # naive_round_nearest x;; + - : float = 4503599627370498. + v} +*) + +let round_nearest_lb = -.(2. ** 52.) +let round_nearest_ub = 2. ** 52. + +(* For [x = one_ulp `Down 0.5], the formula [floor (x +. 0.5)] for rounding to nearest + does not work, because the exact result is halfway between [one_ulp `Down 1.] and [1.], + and it gets rounded up to [1.] due to the round-ties-to-even rule. *) +let one_ulp_less_than_half = one_ulp `Down 0.5 + +let[@ocaml.inline always] add_half_for_round_nearest t = + t + +. + if t = one_ulp_less_than_half + then one_ulp_less_than_half (* since t < 0.5, make sure the result is < 1.0 *) + else 0.5 +;; + +let iround_nearest_32 t = + if t >= 0. + then ( + let t' = add_half_for_round_nearest t in + if t' <= iround_ubound then Some (Int.of_float_unchecked t') else None) + else ( + let t' = floor (t +. 0.5) in + if t' >= iround_lbound then Some (Int.of_float_unchecked t') else None) +;; + +let iround_nearest_64 t = + if t >= 0. + then + if t < round_nearest_ub + then Some (Int.of_float_unchecked (add_half_for_round_nearest t)) + else if t <= iround_ubound + then Some (Int.of_float_unchecked t) + else None + else if t > round_nearest_lb + then Some (Int.of_float_unchecked (floor (t +. 0.5))) + else if t >= iround_lbound + then Some (Int.of_float_unchecked t) + else None +;; + +let iround_nearest = + match Word_size.word_size with + | W64 -> iround_nearest_64 + | W32 -> iround_nearest_32 +;; + +let iround_nearest_exn_32 t = + if t >= 0. + then ( + let t' = add_half_for_round_nearest t in + if t' <= iround_ubound + then Int.of_float_unchecked t' + else invalid_argf "Float.iround_nearest_exn: argument (%f) is too large" (box t) ()) + else ( + let t' = floor (t +. 0.5) in + if t' >= iround_lbound + then Int.of_float_unchecked t' + else invalid_argf "Float.iround_nearest_exn: argument (%f) is too small" (box t) ()) +;; + +let[@ocaml.inline always] iround_nearest_exn_64 t = + if t >= 0. + then + if t < round_nearest_ub + then Int.of_float_unchecked (add_half_for_round_nearest t) + else if t <= iround_ubound + then Int.of_float_unchecked t + else invalid_argf "Float.iround_nearest_exn: argument (%f) is too large" (box t) () + else if t > round_nearest_lb + then Int.of_float_unchecked (floor (t +. 0.5)) + else if t >= iround_lbound + then Int.of_float_unchecked t + else + invalid_argf "Float.iround_nearest_exn: argument (%f) is too small or NaN" (box t) () +;; + +let iround_nearest_exn = + match Word_size.word_size with + | W64 -> iround_nearest_exn_64 + | W32 -> iround_nearest_exn_32 +;; + +(* The following [iround_exn] and [iround] functions are slower than the ones above. + Their equivalence to those functions is tested in the unit tests below. *) + +let[@inline] iround_exn ?(dir = `Nearest) t = + match dir with + | `Zero -> iround_towards_zero_exn t + | `Nearest -> iround_nearest_exn t + | `Up -> iround_up_exn t + | `Down -> iround_down_exn t +;; + +let iround ?(dir = `Nearest) t = + try Some (iround_exn ~dir t) with + | _ -> None +;; + +let is_inf t = 1. /. t = 0. +let is_finite t = t -. t = 0. + +let min_inan (x : t) y = + if is_nan y then x else if is_nan x then y else if x < y then x else y +;; + +let max_inan (x : t) y = + if is_nan y then x else if is_nan x then y else if x > y then x else y +;; + +let add = ( +. ) +let sub = ( -. ) +let neg = ( ~-. ) +let abs = abs_float +let scale = ( *. ) +let square x = x *. x + +module Parts : sig + type t + + val fractional : t -> float + val integral : t -> float + val modf : float -> t +end = struct + type t = float * float + + let fractional t = fst t + let integral t = snd t + let modf = modf +end + +let modf = Parts.modf +let round_down = floor +let round_up = ceil +let round_towards_zero t = if t >= 0. then round_down t else round_up t + +(* see the comment above [round_nearest_lb] and [round_nearest_ub] for an explanation *) +let[@ocaml.inline] round_nearest_inline t = + if t > round_nearest_lb && t < round_nearest_ub + then floor (add_half_for_round_nearest t) + else t +. 0. +;; + +let round_nearest t = (round_nearest_inline [@ocaml.inlined always]) t + +let round_nearest_half_to_even t = + if t <= round_nearest_lb || t >= round_nearest_ub + then t +. 0. + else ( + let floor = floor t in + (* [ceil_or_succ = if t is an integer then t +. 1. else ceil t]. Faster than [ceil]. *) + let ceil_or_succ = floor +. 1. in + let diff_floor = t -. floor in + let diff_ceil = ceil_or_succ -. t in + if diff_floor < diff_ceil + then floor + else if diff_floor > diff_ceil + then ceil_or_succ + else if (* exact tie, pick the even *) + mod_float floor 2. = 0. + then floor + else ceil_or_succ) +;; + +let int63_round_lbound = lower_bound_for_int Int63.num_bits +let int63_round_ubound = upper_bound_for_int Int63.num_bits + +let int63_round_up_exn t = + if t > 0.0 + then ( + let t' = ceil t in + if t' <= int63_round_ubound + then Int63.of_float_unchecked t' + else + invalid_argf + "Float.int63_round_up_exn: argument (%f) is too large" + (Float0.box t) + ()) + else if t >= int63_round_lbound + then Int63.of_float_unchecked t + else + invalid_argf + "Float.int63_round_up_exn: argument (%f) is too small or NaN" + (Float0.box t) + () +;; + +let int63_round_down_exn t = + if t >= 0.0 + then + if t <= int63_round_ubound + then Int63.of_float_unchecked t + else + invalid_argf + "Float.int63_round_down_exn: argument (%f) is too large" + (Float0.box t) + () + else ( + let t' = floor t in + if t' >= int63_round_lbound + then Int63.of_float_unchecked t' + else + invalid_argf + "Float.int63_round_down_exn: argument (%f) is too small or NaN" + (Float0.box t) + ()) +;; + +let int63_round_nearest_portable_alloc_exn t0 = + let t = (round_nearest_inline [@ocaml.inlined always]) t0 in + if t > 0. + then + if t <= int63_round_ubound + then Int63.of_float_unchecked t + else + invalid_argf + "Float.int63_round_nearest_portable_alloc_exn: argument (%f) is too large" + (box t0) + () + else if t >= int63_round_lbound + then Int63.of_float_unchecked t + else + invalid_argf + "Float.int63_round_nearest_portable_alloc_exn: argument (%f) is too small or NaN" + (box t0) + () +;; + +let[@inline] int63_round_nearest_arch64_noalloc_exn f = + Int63.of_int (iround_nearest_exn f) +;; + +let int63_round_nearest_exn = + match Word_size.word_size with + | W64 -> int63_round_nearest_arch64_noalloc_exn + | W32 -> int63_round_nearest_portable_alloc_exn +;; + +let round ?(dir = `Nearest) t = + match dir with + | `Nearest -> round_nearest t + | `Down -> round_down t + | `Up -> round_up t + | `Zero -> round_towards_zero t +;; + +module Class = struct + type t = + | Infinite + | Nan + | Normal + | Subnormal + | Zero + [@@deriving_inline compare ~localize, enumerate, sexp, sexp_grammar] + + let compare__local = (Stdlib.compare : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + let all = ([ Infinite; Nan; Normal; Subnormal; Zero ] : t list) + + let t_of_sexp = + (let error_source__007_ = "float.ml.Class.t" in + function + | Sexplib0.Sexp.Atom ("infinite" | "Infinite") -> Infinite + | Sexplib0.Sexp.Atom ("nan" | "Nan") -> Nan + | Sexplib0.Sexp.Atom ("normal" | "Normal") -> Normal + | Sexplib0.Sexp.Atom ("subnormal" | "Subnormal") -> Subnormal + | Sexplib0.Sexp.Atom ("zero" | "Zero") -> Zero + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("infinite" | "Infinite") :: _) as + sexp__008_ -> Sexplib0.Sexp_conv_error.stag_no_args error_source__007_ sexp__008_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("nan" | "Nan") :: _) as sexp__008_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__007_ sexp__008_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("normal" | "Normal") :: _) as sexp__008_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__007_ sexp__008_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("subnormal" | "Subnormal") :: _) as + sexp__008_ -> Sexplib0.Sexp_conv_error.stag_no_args error_source__007_ sexp__008_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("zero" | "Zero") :: _) as sexp__008_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__007_ sexp__008_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__006_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__007_ sexp__006_ + | Sexplib0.Sexp.List [] as sexp__006_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__007_ sexp__006_ + | sexp__006_ -> + Sexplib0.Sexp_conv_error.unexpected_stag error_source__007_ sexp__006_ + : Sexplib0.Sexp.t -> t) + ;; + + let sexp_of_t = + (function + | Infinite -> Sexplib0.Sexp.Atom "Infinite" + | Nan -> Sexplib0.Sexp.Atom "Nan" + | Normal -> Sexplib0.Sexp.Atom "Normal" + | Subnormal -> Sexplib0.Sexp.Atom "Subnormal" + | Zero -> Sexplib0.Sexp.Atom "Zero" + : t -> Sexplib0.Sexp.t) + ;; + + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag { name = "Infinite"; clause_kind = Atom_clause } + ; No_tag { name = "Nan"; clause_kind = Atom_clause } + ; No_tag { name = "Normal"; clause_kind = Atom_clause } + ; No_tag { name = "Subnormal"; clause_kind = Atom_clause } + ; No_tag { name = "Zero"; clause_kind = Atom_clause } + ] + } + } + ;; + + [@@@end] + + let to_string t = string_of_sexp (sexp_of_t t) + let of_string s = t_of_sexp (sexp_of_string s) +end + +let classify t = + let module C = Class in + match classify_float t with + | FP_normal -> C.Normal + | FP_subnormal -> C.Subnormal + | FP_zero -> C.Zero + | FP_infinite -> C.Infinite + | FP_nan -> C.Nan +;; + +let insert_underscores ?(delimiter = '_') ?(strip_zero = false) string = + match String.lsplit2 string ~on:'.' with + | None -> Int_string_conversions.insert_delimiter string ~delimiter + | Some (left, right) -> + let left = Int_string_conversions.insert_delimiter left ~delimiter in + let right = + if strip_zero then String.rstrip right ~drop:(fun c -> Char.( = ) c '0') else right + in + (match right with + | "" -> left + | _ -> left ^ "." ^ right) +;; + +let to_string_hum ?delimiter ?(decimals = 3) ?strip_zero ?(explicit_plus = false) f = + if Int_replace_polymorphic_compare.( < ) decimals 0 + then invalid_argf "to_string_hum: invalid argument ~decimals=%d" decimals (); + match classify f with + | Class.Infinite -> if f > 0. then "inf" else "-inf" + | Class.Nan -> "nan" + | Class.Normal | Class.Subnormal | Class.Zero -> + let s = + if explicit_plus then sprintf "%+.*f" decimals f else sprintf "%.*f" decimals f + in + insert_underscores s ?delimiter ?strip_zero +;; + +let sexp_of_t t = + let sexp = sexp_of_t t in + match !Sexp.of_float_style with + | `No_underscores -> sexp + | `Underscores -> + (match sexp with + | List _ -> + raise_s + (Sexp.message + "[sexp_of_float] produced strange sexp" + [ "sexp", Sexp.sexp_of_t sexp ]) + | Atom string -> + if String.contains string 'E' then sexp else Atom (insert_underscores string)) +;; + +let to_padded_compact_string_custom t ?(prefix = "") ~kilo ~mega ~giga ~tera ?peta () = + (* Round a ratio toward the nearest integer, resolving ties toward the nearest even + number. For sane inputs (in particular, when [denominator] is an integer and + [abs numerator < 2e52]) this should be accurate. Otherwise, the result might be a + little bit off, but we don't really use that case. *) + let iround_ratio_exn ~numerator ~denominator = + let k = floor (numerator /. denominator) in + (* if [abs k < 2e53], then both [k] and [k +. 1.] are accurately represented, and in + particular [k +. 1. > k]. If [denominator] is also an integer, and + [abs (denominator *. (k +. 1)) < 2e53] (and in some other cases, too), then [lower] + and [higher] are actually both accurate. Since (roughly) + [numerator = denominator *. k] then for [abs numerator < 2e52] we should be + fine. *) + let lower = denominator *. k in + let higher = denominator *. (k +. 1.) in + (* Subtracting numbers within a factor of two from each other is accurate. + So either the two subtractions below are accurate, or k = 0, or k = -1. + In case of a tie, round to even. *) + let diff_right = higher -. numerator in + let diff_left = numerator -. lower in + let k = iround_nearest_exn k in + if diff_right < diff_left + then k + 1 + else if diff_right > diff_left + then k + else if (* a tie *) + Int_replace_polymorphic_compare.( = ) (k mod 2) 0 + then k + else k + 1 + in + match classify t with + | Class.Infinite -> if t < 0.0 then "-inf " else "inf " + | Class.Nan -> "nan " + | Class.Subnormal | Class.Normal | Class.Zero -> + let go t = + let conv_one t = + assert (0. <= t && t < 999.95); + let x = prefix ^ format_float "%.1f" t in + (* Fix the ".0" suffix *) + if String.is_suffix x ~suffix:".0" + then ( + let x = Bytes.of_string x in + let n = Bytes.length x in + Bytes.set x (n - 1) ' '; + Bytes.set x (n - 2) ' '; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:x) + else x + in + let conv mag t denominator = + assert ( + (denominator = 100. && t >= 999.95) + || (denominator >= 100_000. && t >= round_nearest (denominator *. 9.999_5))); + assert (t < round_nearest (denominator *. 9_999.5)); + let i, d = + let k = iround_ratio_exn ~numerator:t ~denominator in + (* [mod] is okay here because we know i >= 0. *) + k / 10, k mod 10 + in + let open Int_replace_polymorphic_compare in + assert (0 <= i && i < 1000); + assert (0 <= d && d < 10); + if d = 0 + then sprintf "%s%d%s " prefix i mag + else sprintf "%s%d%s%d" prefix i mag d + in + (* While the standard metric prefixes (e.g. capital "M" rather than "m", [1]) are + nominally more correct, this hinders readability in our case. E.g., 10G6 and + 1066 look too similar. That's an extreme example, but in general k,m,g,t,p + probably stand out better than K,M,G,T,P when interspersed with digits. + + [1] http://en.wikipedia.org/wiki/Metric_prefix *) + (* The trick here is that: + - the first boundary (999.95) as a float is slightly over-represented (so it is + better approximated as "1k" than as "999.9"), + - the other boundaries are accurately represented, because they are integers. + That's why the strict equalities below do exactly what we want. *) + if t < 999.95E0 + then conv_one t + else if t < 999.95E3 + then conv kilo t 100. + else if t < 999.95E6 + then conv mega t 100_000. + else if t < 999.95E9 + then conv giga t 100_000_000. + else if t < 999.95E12 + then conv tera t 100_000_000_000. + else ( + match peta with + | None -> sprintf "%s%.1e" prefix t + | Some peta -> + if t < 999.95E15 + then conv peta t 100_000_000_000_000. + else sprintf "%s%.1e" prefix t) + in + if t >= 0. then go t else "-" ^ go ~-.t +;; + +let to_padded_compact_string t = + to_padded_compact_string_custom t ~kilo:"k" ~mega:"m" ~giga:"g" ~tera:"t" ~peta:"p" () +;; + +(* Performance note: Initializing the accumulator to 1 results in one extra + multiply; e.g., to compute x ** 4, we in principle only need 2 multiplies, + but this function will have 3 multiplies. However, attempts to avoid this + (like decrementing n and initializing accum to be x, or handling small + exponents as a special case) have not yielded anything that is a net + improvement. +*) +let int_pow x n = + let open Int_replace_polymorphic_compare in + if n = 0 + then 1. + else ( + (* Using [x +. (-0.)] on the following line convinces the compiler to avoid a certain + boxing (that would result in allocation in each iteration). Soon, the compiler + shouldn't need this "hint" to avoid the boxing. The reason we add -0 rather than 0 + is that [x +. (-0.)] is apparently always the same as [x], whereas [x +. 0.] is + not, in that it sends [-0.] to [0.]. This makes a difference because we want + [int_pow (-0.) (-1)] to return neg_infinity just like [-0. ** -1.] would. *) + let x = ref (x +. -0.) in + let n = ref n in + let accum = ref 1. in + if !n < 0 + then ( + (* x ** n = (1/x) ** -n *) + x := 1. /. !x; + n := ~- (!n); + if !n < 0 + then ( + (* n must have been min_int, so it is now so big that it has wrapped around. + We decrement it so that it looks positive again, but accordingly have + to put an extra factor of x in the accumulator. + *) + accum := !x; + decr n)); + (* Letting [a] denote (the original value of) [x ** n], we maintain + the invariant that [(x ** n) *. accum = a]. *) + while !n > 1 do + if !n land 1 <> 0 then accum := !x *. !accum; + x := !x *. !x; + n := !n lsr 1 + done; + (* n is necessarily 1 at this point, so there is one additional + multiplication by x. *) + !x *. !accum) +;; + +let round_gen x ~how = + if x = 0. + then 0. + else if not (is_finite x) + then x + else ( + (* Significant digits and decimal digits. *) + let sd, dd = + match how with + | `significant_digits sd -> + let dd = sd - to_int (round_up (log10 (abs x))) in + sd, dd + | `decimal_digits dd -> + let sd = dd + to_int (round_up (log10 (abs x))) in + sd, dd + in + let open Int_replace_polymorphic_compare in + if sd < 0 + then 0. + else if sd >= 17 + then x + else ( + (* Choose the order that is exactly representable as a float. Small positive + integers are, but their inverses in most cases are not. *) + let abs_dd = Int.abs dd in + if abs_dd > 22 || sd >= 16 + (* 10**22 is exactly representable as a float, but 10**23 is not, so use the slow + path. Similarly, if we need 16 significant digits in the result, then the integer + [round_nearest (x order)] might not be exactly representable as a float, since + for some ranges we only have 15 digits of precision guaranteed. + + That said, we are still rounding twice here: + + 1) first time when rounding [x *. order] or [x /. order] to the nearest float + (just the normal way floating-point multiplication or division works), + + 2) second time when applying [round_nearest_half_to_even] to the result of the + above operation + + So for arguments within an ulp from a tie we might still produce an off-by-one + result. *) + then of_string (sprintf "%.*g" sd x) + else ( + let order = int_pow 10. abs_dd in + if dd >= 0 + then round_nearest_half_to_even (x *. order) /. order + else round_nearest_half_to_even (x /. order) *. order))) +;; + +let round_significant x ~significant_digits = + if Int_replace_polymorphic_compare.( <= ) significant_digits 0 + then + invalid_argf + "Float.round_significant: invalid argument significant_digits:%d" + significant_digits + () + else round_gen x ~how:(`significant_digits significant_digits) +;; + +let round_decimal x ~decimal_digits = round_gen x ~how:(`decimal_digits decimal_digits) +let between t ~low ~high = low <= t && t <= high + +let clamp_exn t ~min ~max = + (* Also fails if [min] or [max] is nan *) + assert (min <= max); + (* clamp_unchecked is in float0.ml *) + clamp_unchecked + ~to_clamp_maybe_nan:t + ~min_which_is_not_nan:min + ~max_which_is_not_nan:max +;; + +let clamp t ~min ~max = + (* Also fails if [min] or [max] is nan *) + if min <= max + then + Ok + (clamp_unchecked + ~to_clamp_maybe_nan:t + ~min_which_is_not_nan:min + ~max_which_is_not_nan:max) + else + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) +;; + +let ( + ) = ( +. ) +let ( - ) = ( -. ) +let ( * ) = ( *. ) +let ( ** ) = ( ** ) +let ( / ) = ( /. ) +let ( % ) = ( %. ) +let ( ~- ) = ( ~-. ) + +let[@inline] sign_exn t : Sign.t = + if t > 0. + then Pos + else if t < 0. + then Neg + else if t = 0. + then Zero + else Error.raise_s (Sexp.message "Float.sign_exn of NAN" [ "", sexp_of_t t ]) +;; + +let sign_or_nan t : Sign_or_nan.t = + if t > 0. then Pos else if t < 0. then Neg else if t = 0. then Zero else Nan +;; + +let ieee_negative t = + let bits = Stdlib.Int64.bits_of_float t in + Poly.(bits < Stdlib.Int64.zero) +;; + +let exponent_bits = 11 +let mantissa_bits = 52 +let exponent_mask64 = Int64.(shift_left one exponent_bits - one) +let exponent_mask = Int64.to_int_exn exponent_mask64 +let mantissa_mask = Int63.(shift_left one mantissa_bits - one) +let mantissa_mask64 = Int63.to_int64 mantissa_mask + +let ieee_exponent t = + let bits = Stdlib.Int64.bits_of_float t in + Int64.(bit_and (shift_right_logical bits mantissa_bits) exponent_mask64) + |> Stdlib.Int64.to_int +;; + +let ieee_mantissa t = + let bits = Stdlib.Int64.bits_of_float t in + (* This is safe because mantissa_mask64 < Int63.max_value *) + (Int63.of_int64_trunc [@inlined]) Stdlib.Int64.(logand bits mantissa_mask64) +;; + +let create_ieee_exn ~negative ~exponent ~mantissa = + if Int.(bit_and exponent exponent_mask <> exponent) + then failwithf "exponent %d out of range [0, %d]" exponent exponent_mask () + else if Int63.(bit_and mantissa mantissa_mask <> mantissa) + then + failwithf + "mantissa %s out of range [0, %s]" + (Int63.to_string mantissa) + (Int63.to_string mantissa_mask) + () + else ( + let sign_bits = if negative then Stdlib.Int64.min_int else Stdlib.Int64.zero in + let expt_bits = + Stdlib.Int64.shift_left (Stdlib.Int64.of_int exponent) mantissa_bits + in + let mant_bits = Int63.to_int64 mantissa in + let bits = Stdlib.Int64.(logor sign_bits (logor expt_bits mant_bits)) in + Stdlib.Int64.float_of_bits bits) +;; + +let create_ieee ~negative ~exponent ~mantissa = + Or_error.try_with (fun () -> create_ieee_exn ~negative ~exponent ~mantissa) +;; + +module Terse = struct + type nonrec t = t + + let t_of_sexp = t_of_sexp + let to_string x = Printf.sprintf "%.8G" x + let sexp_of_t x = Sexp.Atom (to_string x) + let of_string x = of_string x + let t_sexp_grammar = t_sexp_grammar +end + +include Comparable.With_zero (struct + include T + + let zero = zero +end) + +(* These are partly here as a performance hack to avoid some boxing we're getting with + the versions we get from [With_zero]. They also make [Float.is_negative nan] and + [Float.is_non_positive nan] return [false]; the versions we get from [With_zero] return + [true]. *) +let is_positive t = t > 0. +let is_non_negative t = t >= 0. +let is_negative t = t < 0. +let is_non_positive t = t <= 0. + +include Pretty_printer.Register (struct + include T + + let module_name = "Base.Float" + let to_string = to_string +end) + +module O = struct + let ( + ) = ( + ) + let ( - ) = ( - ) + let ( * ) = ( * ) + let ( / ) = ( / ) + let ( % ) = ( % ) + let ( ~- ) = ( ~- ) + let ( ** ) = ( ** ) + + include (Float_replace_polymorphic_compare : Comparisons.Infix with type t := t) + + let abs = abs + let neg = neg + let zero = zero + let of_int = of_int + let of_float x = x +end + +module O_dot = struct + let ( *. ) = ( * ) + let ( +. ) = ( + ) + let ( -. ) = ( - ) + let ( /. ) = ( / ) + let ( %. ) = ( % ) + let ( ~-. ) = ( ~- ) + let ( **. ) = ( ** ) +end + +module Private = struct + let box = box + let clamp_unchecked = clamp_unchecked + let lower_bound_for_int = lower_bound_for_int + let upper_bound_for_int = upper_bound_for_int + let specialized_hash = hash_float + let one_ulp_less_than_half = one_ulp_less_than_half + let int63_round_nearest_portable_alloc_exn = int63_round_nearest_portable_alloc_exn + let int63_round_nearest_arch64_noalloc_exn = int63_round_nearest_arch64_noalloc_exn + let iround_nearest_exn_64 = iround_nearest_exn_64 +end + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Float_replace_polymorphic_compare + +(* These functions specifically replace defaults in replace_polymorphic_compare. + + The desired behavior here is to propagate a nan if either argument is nan. Because the + first comparison will always return false if either argument is nan, it suffices to + check if x is nan. Then, when x is nan or both x and y are nan, we return x = nan; and + when y is nan but not x, we return y = nan. + + There are various ways to implement these functions. The benchmark below shows a few + different versions. This benchmark was run over an array of random floats (none of + which are nan). + + ┌────────────────────────────────────────────────┬──────────┐ + │ Name │ Time/Run │ + ├────────────────────────────────────────────────┼──────────┤ + │ if is_nan x then x else if x < y then x else y │ 2.42us │ + │ if is_nan x || x < y then x else y │ 2.02us │ + │ if x < y || is_nan x then x else y │ 1.88us │ + └────────────────────────────────────────────────┴──────────┘ + + The benchmark below was run when x > y is always true (again, no nan values). + + ┌────────────────────────────────────────────────┬──────────┐ + │ Name │ Time/Run │ + ├────────────────────────────────────────────────┼──────────┤ + │ if is_nan x then x else if x < y then x else y │ 2.83us │ + │ if is_nan x || x < y then x else y │ 1.97us │ + │ if x < y || is_nan x then x else y │ 1.56us │ + └────────────────────────────────────────────────┴──────────┘ +*) +let min (x : t) y = if x < y || is_nan x then x else y +let max (x : t) y = if x > y || is_nan x then x else y diff --git a/unikernel/duniverse/base/src/float.mli b/unikernel/duniverse/base/src/float.mli new file mode 100644 index 00000000..6d0fdf92 --- /dev/null +++ b/unikernel/duniverse/base/src/float.mli @@ -0,0 +1,679 @@ +(** Floating-point representation and utilities. + + If using 32-bit OCaml, you cannot quite assume operations act as you'd expect for IEEE + 64-bit floats. E.g., one can have [let x = ~-. (2. ** 62.) in x = x -. 1.] evaluate + to [false] while [let x = ~-. (2. ** 62.) in let y = x -. 1 in x = y] evaluates to + [true]. This is related to 80-bit registers being used for calculations; you can + force representation as a 64-bit value by let-binding. *) + +open! Import + +type t = float [@@deriving_inline globalize, sexp_grammar] + +val globalize : t -> t +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Floatable.S with type t := t + +(** [max] and [min] will return nan if either argument is nan. + + The [validate_*] functions always fail if class is [Nan] or [Infinite]. *) + +include Identifiable.S with type t := t + +val of_string_opt : string -> t option + +include Comparable.With_zero with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t +include Invariant.S with type t := t +include Comparisons.S_with_local_opt with type t := t + +val nan : t +val infinity : t +val neg_infinity : t + +(** Equal to [infinity]. *) +val max_value : t + +(** Equal to [neg_infinity]. *) +val min_value : t + +val zero : t +val one : t +val minus_one : t + +(** The constant pi. *) +val pi : t + +(** The constant sqrt(pi). *) +val sqrt_pi : t + +(** The constant sqrt(2 * pi). *) +val sqrt_2pi : t + +(** Euler-Mascheroni constant (γ). *) +val euler : t + +(** The difference between 1.0 and the smallest exactly representable floating-point + number greater than 1.0. That is: + + [epsilon_float = (one_ulp `Up 1.0) -. 1.0] + + This gives the relative accuracy of type [t], in the sense that for numbers on the + order of [x], the roundoff error is on the order of [x *. float_epsilon]. + + See also: {{:http://en.wikipedia.org/wiki/Machine_epsilon} Machine epsilon}. +*) +val epsilon_float : t + +val max_finite_value : t + +(** + - [min_positive_subnormal_value = 2 ** -1074] + - [min_positive_normal_value = 2 ** -1022] *) + +val min_positive_subnormal_value : t +val min_positive_normal_value : t + +(** An order-preserving bijection between all floats except for nans, and all int64s with + absolute value smaller than or equal to [2**63 - 2**52]. Note both 0. and -0. map to + 0L. *) +val to_int64_preserve_order : t -> int64 option + +val to_int64_preserve_order_exn : t -> int64 + +(** Returns [nan] if the absolute value of the argument is too large. *) +val of_int64_preserve_order : int64 -> t + +(** The next or previous representable float. ULP stands for "unit of least precision", + and is the spacing between floating point numbers. Both [one_ulp `Up infinity] and + [one_ulp `Down neg_infinity] return a nan. *) +val one_ulp : [ `Up | `Down ] -> t -> t + +(** Note that this doesn't round trip in either direction. For example, [Float.to_int + (Float.of_int max_int) <> max_int]. *) +val of_int : int -> t + +val to_int : t -> int +val of_int63 : Int63.t -> t +val of_int64 : int64 -> t +val to_int64 : t -> int64 + +(** [round] rounds a float to an integer float. [iround{,_exn}] rounds a float to an + int. Both round according to a direction [dir], with default [dir] being [`Nearest]. + + {v + | `Down | rounds toward Float.neg_infinity | + | `Up | rounds toward Float.infinity | + | `Nearest | rounds to the nearest int ("round half-integers up") | + | `Zero | rounds toward zero | + v} + + [iround_exn] raises when trying to handle nan or trying to handle a float outside the + range \[float min_int, float max_int). + + + Here are some examples for [round] for each direction: + + {v + | `Down | [-2.,-1.) to -2. | [-1.,0.) to -1. | [0.,1.) to 0., [1.,2.) to 1. | + | `Up | (-2.,-1.] to -1. | (-1.,0.] to -0. | (0.,1.] to 1., (1.,2.] to 2. | + | `Zero | (-2.,-1.] to -1. | (-1.,1.) to 0. | [1.,2.) to 1. | + | `Nearest | [-1.5,-0.5) to -1. | [-0.5,0.5) to 0. | [0.5,1.5) to 1. | + v} + + For convenience, versions of these functions with the [dir] argument hard-coded are + provided. If you are writing performance-critical code you should use the + versions with the hard-coded arguments (e.g. [iround_down_exn]). The [_exn] ones + are the fastest. + + The following properties hold: + + - [of_int (iround_*_exn i) = i] for any float [i] that is an integer with + [min_int <= i <= max_int]. + + - [round_* i = i] for any float [i] that is an integer. + + - [iround_*_exn (of_int i) = i] for any int [i] with [-2**52 <= i <= 2**52]. *) +val round : ?dir:[ `Zero | `Nearest | `Up | `Down ] -> t -> t + +val iround : ?dir:[ `Zero | `Nearest | `Up | `Down ] -> t -> int option +val iround_exn : ?dir:[ `Zero | `Nearest | `Up | `Down ] -> t -> int +val round_towards_zero : t -> t +val round_down : t -> t +val round_up : t -> t + +(** Rounds half integers up. *) +val round_nearest : t -> t + +(** Rounds half integers to the even integer. *) +val round_nearest_half_to_even : t -> t + +val iround_towards_zero : t -> int option +val iround_down : t -> int option +val iround_up : t -> int option +val iround_nearest : t -> int option +val iround_towards_zero_exn : t -> int +val iround_down_exn : t -> int +val iround_up_exn : t -> int +val iround_nearest_exn : t -> int +val int63_round_down_exn : t -> Int63.t +val int63_round_up_exn : t -> Int63.t +val int63_round_nearest_exn : t -> Int63.t + +(** If [f < iround_lbound || f > iround_ubound], then [iround*] functions will refuse to + round [f], returning [None] or raising as appropriate. *) +val iround_lbound : t + +val iround_ubound : t +val int63_round_lbound : t +val int63_round_ubound : t + +(** [round_significant x ~significant_digits:n] rounds to the nearest number with [n] + significant digits. More precisely: it returns the representable float closest to [x + rounded to n significant digits]. It is meant to be equivalent to [sprintf "%.*g" n x + |> Float.of_string] but faster (10x-15x). Exact ties are resolved as round-to-even. + + However, it might in rare cases break the contract above. + + + It might in some cases appear as if it violates the round-to-even rule: + + {[ + let x = 4.36083208835;; + let z = 4.3608320883;; + assert (z = fast_approx_round_significant x ~sf:11) + ]} + + But in this case so does sprintf, since [x] as a float is slightly + under-represented: + + {[ + sprintf "%.11g" x = "4.3608320883";; + sprintf "%.30g" x = "4.36083208834999958014577714493" + ]} + + More importantly, [round_significant] might sometimes give a different + result than [sprintf ... |> Float.of_string] because it round-trips through an + integer. For example, the decimal fraction 0.009375 is slightly under-represented as + a float: + + {[ sprintf "%.17g" 0.009375 = "0.0093749999999999997" ]} + + But: + + {[ 0.009375 *. 1e5 = 937.5 ]} + + Therefore: + + {[ round_significant 0.009375 ~significant_digits:3 = 0.00938 ]} + + whereas: + + {[ sprintf "%.3g" 0.009375 = "0.00937" ]} + + + In general we believe (and have tested on numerous examples) that the following + holds for all x: + + {[ + let s = sprintf "%.*g" significant_digits x |> Float.of_string in + s = round_significant ~significant_digits x + || s = round_significant ~significant_digits (one_ulp `Up x) + || s = round_significant ~significant_digits (one_ulp `Down x) + ]} + + Also, for float representations of decimal fractions (like 0.009375), + [round_significant] is more likely to give the "desired" result than [sprintf ... |> + of_string] (that is, the result of rounding the decimal fraction, rather than its + float representation). But it's not guaranteed either--see the [4.36083208835] + example above. + +*) +val round_significant : float -> significant_digits:int -> float + +(** [round_decimal x ~decimal_digits:n] rounds [x] to the nearest [10**(-n)]. For positive + [n] it is meant to be equivalent to [sprintf "%.*f" n x |> Float.of_string], but + faster. + + All the considerations mentioned in [round_significant] apply (both functions use the + same code path). +*) +val round_decimal : float -> decimal_digits:int -> float + +val is_nan : t -> bool + +(** A float is infinite when it is either [infinity] or [neg_infinity]. *) +val is_inf : t -> bool + +(** A float is finite when neither [is_nan] nor [is_inf] is true. *) +val is_finite : t -> bool + +(** [is_integer x] is [true] if and only if [x] is an integer. *) +val is_integer : t -> bool + +(** [min_inan] and [max_inan] return, respectively, the min and max of the two given + values, except when one of the values is a [nan], in which case the other is + returned. (Returns [nan] if both arguments are [nan].) *) + +val min_inan : t -> t -> t +val max_inan : t -> t -> t +val ( + ) : t -> t -> t +val ( - ) : t -> t -> t +val ( / ) : t -> t -> t + +(** In analogy to Int.( % ), ( % ): + - always produces non-negative (or NaN) result + - raises when given a negative modulus. + + Like the other infix operators, NaNs in mean NaNs out. + + Other cases: (a % Infinity) = a when 0 <= a < Infinity, (a % Infinity) = Infinity when + -Infinity < a < 0, (+/- Infinity % a) = NaN, (a % 0) = NaN. *) +val ( % ) : t -> t -> t + +val ( * ) : t -> t -> t +val ( ** ) : t -> t -> t +val ( ~- ) : t -> t + +(** Returns the fractional part and the whole (i.e., integer) part. For example, [modf + (-3.14)] returns [{ fractional = -0.14; integral = -3.; }]! *) +module Parts : sig + type outer + type t + + val fractional : t -> outer + val integral : t -> outer +end +with type outer := t + +val modf : t -> Parts.t + +(** [mod_float x y] returns a result with the same sign as [x]. It returns [nan] if [y] + is [0]. It is basically + + {[ let mod_float x y = x -. float(truncate(x/.y)) *. y]} + + not + + {[ let mod_float x y = x -. floor(x/.y) *. y ]} + + and therefore resembles [mod] on integers more than [%]. *) +val mod_float : t -> t -> t + +(** {6 Ordinary functions for arithmetic operations} + + These are for modules that inherit from [t], since the infix operators are more + convenient. *) +val add : t -> t -> t + +val sub : t -> t -> t +val neg : t -> t +val scale : t -> t -> t +val abs : t -> t + +(** A sub-module designed to be opened to make working with floats more convenient. *) +module O : sig + val ( + ) : t -> t -> t + val ( - ) : t -> t -> t + val ( * ) : t -> t -> t + val ( / ) : t -> t -> t + val ( % ) : t -> t -> t + val ( ** ) : t -> t -> t + val ( ~- ) : t -> t + + include Comparisons.Infix with type t := t + + val abs : t -> t + val neg : t -> t + val zero : t + val of_int : int -> t + val of_float : float -> t +end + +(** Similar to [O], except that operators are suffixed with a dot, allowing one to have + both int and float operators in scope simultaneously. *) +module O_dot : sig + val ( +. ) : t -> t -> t + val ( -. ) : t -> t -> t + val ( *. ) : t -> t -> t + val ( /. ) : t -> t -> t + val ( %. ) : t -> t -> t + val ( **. ) : t -> t -> t + val ( ~-. ) : t -> t +end + +(** [to_string x] builds a string [s] representing the float [x] that guarantees the round + trip, that is such that [Float.equal x (Float.of_string s)]. + + It usually yields as few significant digits as possible. That is, it won't print + [3.14] as [3.1400000000000001243]. The only exception is that occasionally it will + output 17 significant digits when the number can be represented with just 16 (but not + 15 or less) of them. *) +val to_string : t -> string + +(** Pretty print float, for example [to_string_hum ~decimals:3 1234.1999 = "1_234.200"] + [to_string_hum ~decimals:3 ~strip_zero:true 1234.1999 = "1_234.2" ]. No delimiters + are inserted to the right of the decimal. *) +val to_string_hum + : ?delimiter:char (** defaults to ['_'] *) + -> ?decimals:int (** defaults to [3] *) + -> ?strip_zero:bool (** defaults to [false] *) + -> ?explicit_plus:bool + (** Forces a + in front of non-negative values. Defaults + to [false] *) + -> t + -> string + +(** Produce a lossy compact string representation of the float. The float is scaled by + an appropriate power of 1000 and rendered with one digit after the decimal point, + except that the decimal point is written as '.', 'k', 'm', 'g', 't', or 'p' to + indicate the scale factor. (However, if the digit after the "decimal" point is 0, + it is suppressed.) + + The smallest scale factor that allows the number to be rendered with at most 3 digits + to the left of the decimal is used. If the number is too large for this format (i.e., + the absolute value is at least 999.95e15), scientific notation is used instead. E.g.: + + - [to_padded_compact_string (-0.01) = "-0 "] + - [to_padded_compact_string 1.89 = "1.9"] + - [to_padded_compact_string 999_949.99 = "999k9"] + - [to_padded_compact_string 999_950. = "1m "] + + In the case where the digit after the "decimal", or the "decimal" itself is omitted, + the numbers are padded on the right with spaces to ensure the last two columns of the + string always correspond to the decimal and the digit afterward (except in the case of + scientific notation, where the exponent is the right-most element in the string and + could take up to four characters). + + - [to_padded_compact_string 1. = "1 "] + - [to_padded_compact_string 1.e6 = "1m "] + - [to_padded_compact_string 1.e16 = "1.e+16"] + - [to_padded_compact_string max_finite_value = "1.8e+308"] + + Numbers in the range -.05 < x < .05 are rendered as "0 " or "-0 ". + + Other cases: + + - [to_padded_compact_string nan = "nan "] + - [to_padded_compact_string infinity = "inf "] + - [to_padded_compact_string neg_infinity = "-inf "] + + Exact ties are resolved to even in the decimal: + + - [to_padded_compact_string 3.25 = "3.2"] + - [to_padded_compact_string 3.75 = "3.8"] + - [to_padded_compact_string 33_250. = "33k2"] + - [to_padded_compact_string 33_350. = "33k4"] + + [to_padded_compact_string] is defined in terms of [to_padded_compact_string_custom] + below as + {[ + let to_padded_compact_string t = + to_padded_compact_string_custom t ?prefix:None + ~kilo:"k" ~mega:"m" ~giga:"g" ~tera:"t" ~peta:"p" + () + ]} +*) +val to_padded_compact_string : t -> string + +(** Similar to [to_padded_compact_string] but allows the user to provide different + abbreviations. This can be useful to display currency values, e.g. $1mm3, where + prefix="$", mega="mm". +*) +val to_padded_compact_string_custom + : t + -> ?prefix:string + -> kilo:string + -> mega:string + -> giga:string + -> tera:string + -> ?peta:string + -> unit + -> string + +(** [int_pow x n] computes [x ** float n] via repeated squaring. It is generally much + faster than [**]. + + Note that [int_pow x 0] always returns [1.], even if [x = nan]. This + coincides with [x ** 0.] and is intentional. + + For [n >= 0] the result is identical to an n-fold product of [x] with itself under + [*.], with a certain placement of parentheses. For [n < 0] the result is identical + to [int_pow (1. /. x) (-n)]. + + The error will be on the order of [|n|] ulps, essentially the same as if you + perturbed [x] by up to a ulp and then exponentiated exactly. + + Benchmarks show a factor of 5-10 speedup (relative to [**]) for exponents up to about + 1000 (approximately 10ns vs. 70ns). For larger exponents the advantage is smaller but + persists into the trillions. For a recent or more detailed comparison, run the + benchmarks. + + Depending on context, calling this function might or might not allocate 2 minor words. + Even if called in a way that causes allocation, it still appears to be faster than + [**]. *) +val int_pow : t -> int -> t + +(** [square x] returns [x *. x]. *) +val square : t -> t + +(** [ldexp x n] returns [x *. 2 ** n] *) +val ldexp : t -> int -> t + +(** [frexp f] returns the pair of the significant and the exponent of [f]. When [f] is + zero, the significant [x] and the exponent [n] of [f] are equal to zero. When [f] is + non-zero, they are defined by [f = x *. 2 ** n] and [0.5 <= x < 1.0]. *) +val frexp : t -> t * int + +(** Base 10 logarithm. *) +external log10 : t -> t = "caml_log10_float" "log10" + [@@unboxed] [@@noalloc] + +(** Base 2 logarithm. *) +external log2 : t -> t = "caml_log2_float" "caml_log2" + [@@unboxed] [@@noalloc] + +(** [expm1 x] computes [exp x -. 1.0], giving numerically-accurate results even if [x] is + close to [0.0]. *) +external expm1 : t -> t = "caml_expm1_float" "caml_expm1" + [@@unboxed] [@@noalloc] + +(** [log1p x] computes [log(1.0 +. x)] (natural logarithm), giving numerically-accurate + results even if [x] is close to [0.0]. *) +external log1p : t -> t = "caml_log1p_float" "caml_log1p" + [@@unboxed] [@@noalloc] + +(** [copysign x y] returns a float whose absolute value is that of [x] and whose sign is + that of [y]. If [x] is [nan], returns [nan]. If [y] is [nan], returns either [x] or + [-. x], but it is not specified which. *) +external copysign : t -> t -> t = "caml_copysign_float" "caml_copysign" + [@@unboxed] [@@noalloc] + +(** Cosine. Argument is in radians. *) +external cos : t -> t = "caml_cos_float" "cos" + [@@unboxed] [@@noalloc] + +(** Sine. Argument is in radians. *) +external sin : t -> t = "caml_sin_float" "sin" + [@@unboxed] [@@noalloc] + +(** Tangent. Argument is in radians. *) +external tan : t -> t = "caml_tan_float" "tan" + [@@unboxed] [@@noalloc] + +(** Arc cosine. The argument must fall within the range [[-1.0, 1.0]]. Result is in + radians and is between [0.0] and [pi]. *) +external acos : t -> t = "caml_acos_float" "acos" + [@@unboxed] [@@noalloc] + +(** Arc sine. The argument must fall within the range [[-1.0, 1.0]]. Result is in + radians and is between [-pi/2] and [pi/2]. *) +external asin : t -> t = "caml_asin_float" "asin" + [@@unboxed] [@@noalloc] + +(** Arc tangent. Result is in radians and is between [-pi/2] and [pi/2]. *) +external atan : t -> t = "caml_atan_float" "atan" + [@@unboxed] [@@noalloc] + +(** [atan2 y x] returns the arc tangent of [y /. x]. The signs of [x] and [y] are used to + determine the quadrant of the result. Result is in radians and is between [-pi] and + [pi]. *) +external atan2 : t -> t -> t = "caml_atan2_float" "atan2" + [@@unboxed] [@@noalloc] + +(** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length of the hypotenuse of + a right-angled triangle with sides of length [x] and [y], or, equivalently, the + distance of the point [(x,y)] to origin. *) +external hypot : t -> t -> t = "caml_hypot_float" "caml_hypot" + [@@unboxed] [@@noalloc] + +(** Hyperbolic cosine. Argument is in radians. *) +external cosh : t -> t = "caml_cosh_float" "cosh" + [@@unboxed] [@@noalloc] + +(** Hyperbolic sine. Argument is in radians. *) +external sinh : t -> t = "caml_sinh_float" "sinh" + [@@unboxed] [@@noalloc] + +(** Hyperbolic tangent. Argument is in radians. *) +external tanh : t -> t = "caml_tanh_float" "tanh" + [@@unboxed] [@@noalloc] + +(** Hyperbolic arc cosine. The argument must fall within the range + [[1.0, inf]]. + Result is in radians and is between [0.0] and [inf]. +*) +external acosh : float -> float = "caml_acosh_float" "caml_acosh" + [@@unboxed] [@@noalloc] + +(** Hyperbolic arc sine. The argument and result range over the entire + real line. + Result is in radians. +*) +external asinh : float -> float = "caml_asinh_float" "caml_asinh" + [@@unboxed] [@@noalloc] + +(** Hyperbolic arc tangent. The argument must fall within the range + [[-1.0, 1.0]]. + Result is in radians and ranges over the entire real line. +*) +external atanh : float -> float = "caml_atanh_float" "caml_atanh" + [@@unboxed] [@@noalloc] + +(** Square root. *) +external sqrt : t -> t = "caml_sqrt_float" "sqrt" + [@@unboxed] [@@noalloc] + +(** Exponential. *) +external exp : t -> t = "caml_exp_float" "exp" [@@unboxed] [@@noalloc] + +(** Natural logarithm. *) +external log : t -> t = "caml_log_float" "log" + [@@unboxed] [@@noalloc] + +(** Excluding nan the floating-point "number line" looks like: + {v + t Class.t example + ^ neg_infinity Infinite neg_infinity + | neg normals Normal -3.14 + | neg subnormals Subnormal -.2. ** -1023. + | (-/+) zero Zero 0. + | pos subnormals Subnormal 2. ** -1023. + | pos normals Normal 3.14 + v infinity Infinite infinity + v} *) +module Class : sig + type t = + | Infinite + | Nan + | Normal + | Subnormal + | Zero + [@@deriving_inline compare ~localize, enumerate, sexp, sexp_grammar] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_enumerate_lib.Enumerable.S with type t := t + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Stringable.S with type t := t +end + +val classify : t -> Class.t + +(*_ Caution: If we remove this sig item, [sign] will still be present from + [Comparable.With_zero]. *) + +val sign : t -> Sign.t + [@@deprecated "[since 2016-01] Replace [sign] with [robust_sign] or [sign_exn]"] + +(** The sign of a float. Both [-0.] and [0.] map to [Zero]. Raises on nan. All other + values map to [Neg] or [Pos]. *) +val sign_exn : t -> Sign.t + +(** The sign of a float, with support for NaN. Both [-0.] and [0.] map to [Zero]. All NaN + values map to [Nan]. All other values map to [Neg] or [Pos]. *) +val sign_or_nan : t -> Sign_or_nan.t + +(** These functions construct and destruct 64-bit floating point numbers based on their + IEEE representation with a sign bit, an 11-bit non-negative (biased) exponent, and a + 52-bit non-negative mantissa (or significand). See + {{:http://en.wikipedia.org/wiki/Double-precision_floating-point_format} Wikipedia} for + details of the encoding. + + In particular, if 1 <= exponent <= 2046, then: + + {[ + create_ieee_exn ~negative:false ~exponent ~mantissa + = 2 ** (exponent - 1023) * (1 + (2 ** -52) * mantissa) + ]} *) +val create_ieee : negative:bool -> exponent:int -> mantissa:Int63.t -> t Or_error.t + +val create_ieee_exn : negative:bool -> exponent:int -> mantissa:Int63.t -> t +val ieee_negative : t -> bool +val ieee_exponent : t -> int +val ieee_mantissa : t -> Int63.t + +(** S-expressions contain at most 8 significant digits. *) +module Terse : sig + type nonrec t = t [@@deriving_inline sexp, sexp_grammar] + + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Stringable.S with type t := t +end + +(**/**) + +(*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) +module Private : sig + val box : t -> t + + val clamp_unchecked + : to_clamp_maybe_nan:t + -> min_which_is_not_nan:t + -> max_which_is_not_nan:t + -> t + + val lower_bound_for_int : int -> t + val upper_bound_for_int : int -> t + val specialized_hash : t -> int + val one_ulp_less_than_half : t + val int63_round_nearest_portable_alloc_exn : t -> Int63.t + val int63_round_nearest_arch64_noalloc_exn : t -> Int63.t + val iround_nearest_exn_64 : t -> int +end diff --git a/unikernel/duniverse/base/src/float0.ml b/unikernel/duniverse/base/src/float0.ml new file mode 100644 index 00000000..9ccd8666 --- /dev/null +++ b/unikernel/duniverse/base/src/float0.ml @@ -0,0 +1,232 @@ +open! Import + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! Float_replace_polymorphic_compare + +let ceil = Stdlib.ceil +let floor = Stdlib.floor +let mod_float = Stdlib.mod_float +let modf = Stdlib.modf +let float_of_string = Stdlib.float_of_string +let float_of_string_opt = Stdlib.float_of_string_opt +let nan = Stdlib.nan +let infinity = Stdlib.infinity +let neg_infinity = Stdlib.neg_infinity +let max_finite_value = Stdlib.max_float +let epsilon_float = Stdlib.epsilon_float +let classify_float = Stdlib.classify_float +let abs_float = Stdlib.abs_float +let is_integer = Stdlib.Float.is_integer +let ( ** ) = Stdlib.( ** ) + +let ( %. ) a b = + (* Raise in case of a negative modulus, as does Int.( % ). *) + if b < 0. + then Printf.invalid_argf "%f %% %f in float0.ml: modulus should be positive" a b (); + let m = Stdlib.mod_float a b in + (* Produce a non-negative result in analogy with Int.( % ). *) + if m < 0. then m +. b else m +;; + +(* The bits of INRIA's [Stdlib] that we just want to expose in [Float]. Most are + already deprecated in [Stdlib], and eventually all of them should be. *) +include ( + struct + include Stdlib + include Stdlib.Float + end : + sig + external frexp : float -> float * int = "caml_frexp_float" + + external ldexp + : (float[@unboxed]) + -> (int[@untagged]) + -> (float[@unboxed]) + = "caml_ldexp_float" "caml_ldexp_float_unboxed" + [@@noalloc] + + external log10 : float -> float = "caml_log10_float" "log10" [@@unboxed] [@@noalloc] + + external log2 : float -> float = "caml_log2_float" "caml_log2" + [@@unboxed] [@@noalloc] + + external expm1 : float -> float = "caml_expm1_float" "caml_expm1" + [@@unboxed] [@@noalloc] + + external log1p : float -> float = "caml_log1p_float" "caml_log1p" + [@@unboxed] [@@noalloc] + + external copysign : float -> float -> float = "caml_copysign_float" "caml_copysign" + [@@unboxed] [@@noalloc] + + external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc] + external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc] + external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc] + external acos : float -> float = "caml_acos_float" "acos" [@@unboxed] [@@noalloc] + external asin : float -> float = "caml_asin_float" "asin" [@@unboxed] [@@noalloc] + external atan : float -> float = "caml_atan_float" "atan" [@@unboxed] [@@noalloc] + + external acosh : float -> float = "caml_acosh_float" "caml_acosh" + [@@unboxed] [@@noalloc] + + external asinh : float -> float = "caml_asinh_float" "caml_asinh" + [@@unboxed] [@@noalloc] + + external atanh : float -> float = "caml_atanh_float" "caml_atanh" + [@@unboxed] [@@noalloc] + + external atan2 : float -> float -> float = "caml_atan2_float" "atan2" + [@@unboxed] [@@noalloc] + + external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot" + [@@unboxed] [@@noalloc] + + external cosh : float -> float = "caml_cosh_float" "cosh" [@@unboxed] [@@noalloc] + external sinh : float -> float = "caml_sinh_float" "sinh" [@@unboxed] [@@noalloc] + external tanh : float -> float = "caml_tanh_float" "tanh" [@@unboxed] [@@noalloc] + external sqrt : float -> float = "caml_sqrt_float" "sqrt" [@@unboxed] [@@noalloc] + external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc] + external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc] + end) + +(* We need this indirection because these are exposed as "val" instead of "external" *) +let frexp = frexp +let ldexp = ldexp +let is_nan x = (x : float) <> x + +(* An order-preserving bijection between all floats except for NaNs, and 99.95% of + int64s. + + Note we don't distinguish 0. and -0. as separate values here, they both map to 0L, which + maps back to 0. + + This should work both on little-endian and high-endian CPUs. Wikipedia says: "on + modern standard computers (i.e., implementing IEEE 754), one may in practice safely + assume that the endianness is the same for floating point numbers as for integers" + (http://en.wikipedia.org/wiki/Endianness#Floating-point_and_endianness). +*) +let to_int64_preserve_order t = + if is_nan t + then None + else if t = 0. + then (* also includes -0. *) + Some 0L + else if t > 0. + then Some (Stdlib.Int64.bits_of_float t) + else Some (Stdlib.Int64.neg (Stdlib.Int64.bits_of_float (-.t))) +;; + +let to_int64_preserve_order_exn x = Option.value_exn (to_int64_preserve_order x) + +let of_int64_preserve_order x = + if Int64_replace_polymorphic_compare.( >= ) x 0L + then Stdlib.Int64.float_of_bits x + else ~-.(Stdlib.Int64.float_of_bits (Stdlib.Int64.neg x)) +;; + +let one_ulp dir t = + match to_int64_preserve_order t with + | None -> Stdlib.nan + | Some x -> + of_int64_preserve_order + (Stdlib.Int64.add + x + (match dir with + | `Up -> 1L + | `Down -> -1L)) +;; + +(* [upper_bound_for_int] and [lower_bound_for_int] are for calculating the max/min float + that fits in a given-size integer when rounded towards 0 (using [int_of_float]). + + max_int/min_int depend on [num_bits], e.g. +/- 2^30, +/- 2^62 if 31-bit, 63-bit + (respectively) while float is IEEE standard for double (52 significant bits). + + In all cases, we want to guarantee that + [lower_bound_for_int <= x <= upper_bound_for_int] + iff [int_of_float x] fits in an int with [num_bits] bits. + + [2 ** (num_bits - 1)] is the first float greater that max_int, we use the preceding + float as upper bound. + + [- (2 ** (num_bits - 1))] is equal to min_int. + For lower bound we look for the smallest float [f] satisfying [f > min_int - 1] so that + [f] rounds toward zero to [min_int] + + So in particular we will have: + [lower_bound_for_int x <= - (2 ** (1-x))] + [upper_bound_for_int x < 2 ** (1-x) ] +*) +let upper_bound_for_int num_bits = + let exp = Stdlib.float_of_int (num_bits - 1) in + one_ulp `Down (2. ** exp) +;; + +let is_x_minus_one_exact x = + (* [x = x -. 1.] does not work with x87 floating point arithmetic backend (which is used + on 32-bit ocaml) because of 80-bit register precision of intermediate computations. + + An alternative way of computing this: [x -. one_ulp `Down x <= 1.] is also prone to + the same precision issues: you need to make sure [x] is 64-bit. + *) + let open Int64_replace_polymorphic_compare in + not (Stdlib.Int64.bits_of_float x = Stdlib.Int64.bits_of_float (x -. 1.)) +;; + +let lower_bound_for_int num_bits = + let exp = Stdlib.float_of_int (num_bits - 1) in + let min_int_as_float = ~-.(2. ** exp) in + let open Int_replace_polymorphic_compare in + if num_bits - 1 < 53 (* 53 = #bits in the float's mantissa with sign included *) + then ( + (* The smallest float that rounds towards zero to [min_int] is + [min_int - 1 + epsilon] *) + assert (is_x_minus_one_exact min_int_as_float); + one_ulp `Up (min_int_as_float -. 1.)) + else ( + (* [min_int_as_float] is already the smallest float [f] satisfying [f > min_int - 1]. *) + assert (not (is_x_minus_one_exact min_int_as_float)); + min_int_as_float) +;; + +(* X86 docs say: + + If only one value is a NaN (SNaN or QNaN) for this instruction, the second source + operand, either a NaN or a valid floating-point value + is written to the result. + + So we have to be VERY careful how we use these! + + These intrinsics were copied from [Ocaml_intrinsics] to avoid build deps we don't want +*) +module Intrinsics_with_weird_nan_behavior = struct + let[@inline always] min a b = Ocaml_intrinsics_kernel.Float.min a b + let[@inline always] max a b = Ocaml_intrinsics_kernel.Float.max a b +end + +let clamp_unchecked + ~(to_clamp_maybe_nan : float) + ~min_which_is_not_nan + ~max_which_is_not_nan + = + (* We want to propagate nans; as per the x86 docs, this means we have to use them as the + _second_ argument. *) + let t_maybe_nan = + Intrinsics_with_weird_nan_behavior.max min_which_is_not_nan to_clamp_maybe_nan + in + Intrinsics_with_weird_nan_behavior.min max_which_is_not_nan t_maybe_nan +;; + +let box = + (* Prevent potential constant folding of [+. 0.] in the near ocamlopt future. *) + let x = Sys0.opaque_identity 0. in + fun f -> f +. x +;; + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Float_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/floatable.ml b/unikernel/duniverse/base/src/floatable.ml new file mode 100644 index 00000000..92b42471 --- /dev/null +++ b/unikernel/duniverse/base/src/floatable.ml @@ -0,0 +1,10 @@ +(** Module type with float conversion functions. *) + +open! Import + +module type S = sig + type t + + val of_float : float -> t + val to_float : t -> float +end diff --git a/unikernel/duniverse/base/src/fn.ml b/unikernel/duniverse/base/src/fn.ml new file mode 100644 index 00000000..d0c9ef3b --- /dev/null +++ b/unikernel/duniverse/base/src/fn.ml @@ -0,0 +1,27 @@ +open! Import + +let const c _ = c + +external ignore : (_[@local_opt]) -> unit = "%ignore" + +(* this has the same behavior as [Stdlib.ignore] *) + +let non f x = not (f x) + +let forever f = + let rec forever () = + f (); + forever () + in + try forever () with + | e -> e +;; + +external id : ('a[@local_opt]) -> ('a[@local_opt]) = "%identity" +external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply" + +(* The typical use case for these functions is to pass in functional arguments and get + functions as a result. *) +let compose f g x = f (g x) +let flip f x y = f y x +let rec apply_n_times ~n f x = if n <= 0 then x else apply_n_times ~n:(n - 1) f (f x) diff --git a/unikernel/duniverse/base/src/fn.mli b/unikernel/duniverse/base/src/fn.mli new file mode 100644 index 00000000..2468495f --- /dev/null +++ b/unikernel/duniverse/base/src/fn.mli @@ -0,0 +1,36 @@ +(** Various combinators for functions. *) + +open! Import + +(** A "pipe" operator. [x |> f] is equivalent to [f x]. + + See {{:https://github.com/janestreet/ppx_pipebang} ppx_pipebang} for + further details. *) +external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply" + +(** Produces a function that just returns its first argument. *) +val const : 'a -> _ -> 'a + +(** Ignores its argument and returns [()]. *) +external ignore : (_[@local_opt]) -> unit = "%ignore" + +(** Negates a boolean function. *) +val non : ('a -> bool) -> 'a -> bool + +(** [forever f] runs [f ()] until it throws an exception and returns the + exception. This function is useful for read_line loops, etc. *) +val forever : (unit -> unit) -> exn + +(** [apply_n_times ~n f x] is the [n]-fold application of [f] to [x]. *) +val apply_n_times : n:int -> ('a -> 'a) -> 'a -> 'a + +(** The identity function. + + See also: {!Sys.opaque_identity}. *) +external id : ('a[@local_opt]) -> ('a[@local_opt]) = "%identity" + +(** [compose f g x] is [f (g x)]. *) +val compose : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c + +(** Reverses the order of arguments for a binary function. *) +val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c diff --git a/unikernel/duniverse/base/src/formatter.ml b/unikernel/duniverse/base/src/formatter.ml new file mode 100644 index 00000000..fb16f5f1 --- /dev/null +++ b/unikernel/duniverse/base/src/formatter.ml @@ -0,0 +1 @@ +type t = Stdlib.Format.formatter diff --git a/unikernel/duniverse/base/src/formatter.mli b/unikernel/duniverse/base/src/formatter.mli new file mode 100644 index 00000000..13beaeb7 --- /dev/null +++ b/unikernel/duniverse/base/src/formatter.mli @@ -0,0 +1,9 @@ +(** The [Format.formatter] type from OCaml's standard library, exported here + for convenience and compatibility with other libraries. + + The [Format] module itself is deprecated in Base. You may refer to it + explicitly through [Stdlib.Format], though you may wish to search for other + alternatives for constructing pretty-printers using the [Format.formatter] + type. *) + +type t = Stdlib.Format.formatter diff --git a/unikernel/duniverse/base/src/globalize.ml b/unikernel/duniverse/base/src/globalize.ml new file mode 100644 index 00000000..671d6daa --- /dev/null +++ b/unikernel/duniverse/base/src/globalize.ml @@ -0,0 +1,49 @@ +(* The [globalize_{bool,char,unit}] functions are written as matches plus the identity + function so that the type checker can give them the desired type, without having to do + anything special. However, [globalize_int] cannot be written this way, so we resort to + using an [external]. *) + +let globalize_bool = function + | (true | false) as b -> b +;; + +let globalize_char = function + | '\x00' .. '\xFF' as c -> c +;; + +external globalize_float : float -> float = "caml_obj_dup" +external globalize_int : int -> int = "%identity" +external globalize_int32 : int32 -> int32 = "caml_obj_dup" +external globalize_int64 : int64 -> int64 = "caml_obj_dup" +external globalize_nativeint : nativeint -> nativeint = "caml_obj_dup" +external globalize_bytes : bytes -> bytes = "caml_obj_dup" +external globalize_string : string -> string = "caml_obj_dup" + +let globalize_unit (() as u) = u + +external globalize_array' : 'a array -> 'a array = "caml_obj_dup" + +let globalize_array _ a = globalize_array' a + +let rec globalize_list f = function + | [] -> [] + | x :: xs -> f x :: globalize_list f xs +;; + +let globalize_option f = function + | None -> None + | Some x -> Some (f x) +;; + +let globalize_result globalize_a globalize_b t = + match t with + | Ok a -> Ok (globalize_a a) + | Error b -> Error (globalize_b b) +;; + +let globalize_ref' r = ref !r +let globalize_ref _ r = globalize_ref' r + +external globalize_lazy_t_mono : 'a lazy_t -> 'a lazy_t = "%identity" + +let globalize_lazy_t _ t = globalize_lazy_t_mono t diff --git a/unikernel/duniverse/base/src/globalize.mli b/unikernel/duniverse/base/src/globalize.mli new file mode 100644 index 00000000..d5266951 --- /dev/null +++ b/unikernel/duniverse/base/src/globalize.mli @@ -0,0 +1,33 @@ +(** + `globalize` functions for the builtin types. + + These functions are equivalent to the identity function, except that they copy their + input rather than return it. They only copy as much as is required to match that type: + `global_` and mutable subcomponents are not copied since those are already global. + Globalizing a type with mutable contents (e.g., ['a array] or ['a ref]) will therefore + create a non-shared copy; mutating the copy won't affect the original and vice versa. + + Further globalize functions can be generated with `ppx_globalize`. *) + +val globalize_bool : bool -> bool +val globalize_char : char -> char +val globalize_float : float -> float +val globalize_int : int -> int +val globalize_int32 : int32 -> int32 +val globalize_int64 : int64 -> int64 +val globalize_nativeint : nativeint -> nativeint +val globalize_bytes : bytes -> bytes +val globalize_string : string -> string +val globalize_unit : unit -> unit +val globalize_array : ('a -> 'b) -> 'a array -> 'a array +val globalize_lazy_t : ('a -> 'b) -> 'a lazy_t -> 'a lazy_t +val globalize_list : ('a -> 'b) -> 'a list -> 'b list +val globalize_option : ('a -> 'b) -> 'a option -> 'b option + +val globalize_result + : ('ok -> 'ok) + -> ('err -> 'err) + -> ('ok, 'err) result + -> ('ok, 'err) result + +val globalize_ref : ('a -> 'b) -> 'a ref -> 'a ref diff --git a/unikernel/duniverse/base/src/hash.ml b/unikernel/duniverse/base/src/hash.ml new file mode 100644 index 00000000..cb194fb8 --- /dev/null +++ b/unikernel/duniverse/base/src/hash.ml @@ -0,0 +1,235 @@ +(* + This is the interface to the runtime support for [ppx_hash]. + + The [ppx_hash] syntax extension supports: [@@deriving hash] and [%hash_fold: TYPE] and + [%hash: TYPE] + + For type [t] a function [hash_fold_t] of type [Hash.state -> t -> Hash.state] is + generated. + + The generated [hash_fold_] function is compositional, following the structure of the + type; allowing user overrides at every level. This is in contrast to ocaml's builtin + polymorphic hashing [Hashtbl.hash] which ignores user overrides. + + The generator also provides a direct hash-function [hash] (named [hash_] when != + "t") of type: [t -> Hash.hash_value]. + + The folding hash function can be accessed as [%hash_fold: TYPE] + The direct hash function can be accessed as [%hash: TYPE] +*) + +open! Import0 +module Array = Array0 +module Char = Char0 +module Int = Int0 +module List = List0 +include Hash_intf + +(** Builtin folding-style hash functions, abstracted over [Hash_intf.S] *) +module Folding (Hash : Hash_intf.S) : + Hash_intf.Builtin_intf + with type state = Hash.state + and type hash_value = Hash.hash_value = struct + type state = Hash.state + type hash_value = Hash.hash_value + type 'a folder = state -> 'a -> state + + let hash_fold_unit s () = s + let hash_fold_int = Hash.fold_int + let hash_fold_int64 = Hash.fold_int64 + let hash_fold_float = Hash.fold_float + let hash_fold_string = Hash.fold_string + let as_int f s x = hash_fold_int s (f x) + + (* This ignores the sign bit on 32-bit architectures, but it's unlikely to lead to + frequent collisions (min_value colliding with 0 is the most likely one). *) + let hash_fold_int32 = as_int Stdlib.Int32.to_int + let hash_fold_char = as_int Char.to_int + + let hash_fold_bool = + as_int (function + | true -> 1 + | false -> 0) + ;; + + let hash_fold_nativeint s x = hash_fold_int64 s (Stdlib.Int64.of_nativeint x) + + let hash_fold_option hash_fold_elem s = function + | None -> hash_fold_int s 0 + | Some x -> hash_fold_elem (hash_fold_int s 1) x + ;; + + let rec hash_fold_list_body hash_fold_elem s list = + match list with + | [] -> s + | x :: xs -> hash_fold_list_body hash_fold_elem (hash_fold_elem s x) xs + ;; + + let hash_fold_list hash_fold_elem s list = + (* The [length] of the list must be incorporated into the hash-state so values of + types such as [unit list] - ([], [()], [();()],..) are hashed differently. *) + (* The [length] must come before the elements to avoid a violation of the rule + enforced by Perfect_hash. *) + let s = hash_fold_int s (List.length list) in + let s = hash_fold_list_body hash_fold_elem s list in + s + ;; + + let hash_fold_lazy_t hash_fold_elem s x = hash_fold_elem s (Stdlib.Lazy.force x) + let hash_fold_ref_frozen hash_fold_elem s x = hash_fold_elem s !x + + let rec hash_fold_array_frozen_i hash_fold_elem s array i = + if i = Array.length array + then s + else ( + let e = Array.unsafe_get array i in + hash_fold_array_frozen_i hash_fold_elem (hash_fold_elem s e) array (i + 1)) + ;; + + let hash_fold_array_frozen hash_fold_elem s array = + hash_fold_array_frozen_i + (* [length] must be incorporated for arrays, as it is for lists. See comment above *) + hash_fold_elem + (hash_fold_int s (Array.length array)) + array + 0 + ;; + + (* the duplication here is because we think + ocaml can't eliminate indirect function calls otherwise. *) + let hash_nativeint x = + Hash.get_hash_value (hash_fold_nativeint (Hash.reset (Hash.alloc ())) x) + ;; + + let hash_int64 x = Hash.get_hash_value (hash_fold_int64 (Hash.reset (Hash.alloc ())) x) + let hash_int32 x = Hash.get_hash_value (hash_fold_int32 (Hash.reset (Hash.alloc ())) x) + let hash_char x = Hash.get_hash_value (hash_fold_char (Hash.reset (Hash.alloc ())) x) + let hash_int x = Hash.get_hash_value (hash_fold_int (Hash.reset (Hash.alloc ())) x) + let hash_bool x = Hash.get_hash_value (hash_fold_bool (Hash.reset (Hash.alloc ())) x) + + let hash_string x = + Hash.get_hash_value (hash_fold_string (Hash.reset (Hash.alloc ())) x) + ;; + + let hash_float x = Hash.get_hash_value (hash_fold_float (Hash.reset (Hash.alloc ())) x) + let hash_unit x = Hash.get_hash_value (hash_fold_unit (Hash.reset (Hash.alloc ())) x) +end + +module F (Hash : Hash_intf.S) : + Hash_intf.Full + with type hash_value = Hash.hash_value + and type state = Hash.state + and type seed = Hash.seed = struct + include Hash + + type 'a folder = state -> 'a -> state + + let create ?seed () = reset ?seed (alloc ()) + let of_fold hash_fold_t t = get_hash_value (hash_fold_t (create ()) t) + + module Builtin = Folding (Hash) + + let run ?seed folder x = + Hash.get_hash_value (folder (Hash.reset ?seed (Hash.alloc ())) x) + ;; +end + +module Internalhash : sig + include + Hash_intf.S + with type state = Base_internalhash_types.state + (* We give a concrete type for [state], albeit only partially exposed (see + Base_internalhash_types), so that it unifies with the same type in [Base_boot], + and to allow optimizations for the immediate type. *) + and type seed = Base_internalhash_types.seed + and type hash_value = Base_internalhash_types.hash_value + + external fold_int64 + : state + -> (int64[@unboxed]) + -> state + = "Base_internalhash_fold_int64" "Base_internalhash_fold_int64_unboxed" + [@@noalloc] + + external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc] + + external fold_float + : state + -> (float[@unboxed]) + -> state + = "Base_internalhash_fold_float" "Base_internalhash_fold_float_unboxed" + [@@noalloc] + + external fold_string : state -> string -> state = "Base_internalhash_fold_string" + [@@noalloc] + + external get_hash_value : state -> hash_value = "Base_internalhash_get_hash_value" + [@@noalloc] +end = struct + let description = "internalhash" + + include Base_internalhash_types + + let alloc () = create_seeded 0 + let reset ?(seed = 0) _t = create_seeded seed + + module For_tests = struct + let compare_state (a : state) (b : state) = compare (a :> int) (b :> int) + let state_to_string (state : state) = Int.to_string (state :> int) + end +end + +module T = struct + include Internalhash + + type 'a folder = state -> 'a -> state + + let create ?seed () = reset ?seed (alloc ()) + let run ?seed folder x = get_hash_value (folder (reset ?seed (alloc ())) x) + let of_fold hash_fold_t t = get_hash_value (hash_fold_t (create ()) t) + + module Builtin = struct + module Folding = Folding (Internalhash) + include Folding + + (* [Folding] provides some default implementations for the [hash_*] functions below, + but they are inefficient for some use-cases because of the use of the [hash_fold] + functions. At this point, the [hash_value] type has been fixed to [int], so this + module can provide specialized implementations. *) + + let hash_char = Char0.to_int + + (* This hash was chosen from here: https://gist.github.com/badboy/6267743 + + It attempts to fulfill the primary goals of a non-cryptographic hash function: + + - a bit change in the input should change ~1/2 of the output bits + - the output should be uniformly distributed across the output range + - inputs that are close to each other shouldn't lead to outputs that are close to + each other. + - all bits of the input are used in generating the output + + In our case we also want it to be fast, non-allocating, and inlinable. *) + let[@inline always] hash_int (t : int) = + let t = lnot t + (t lsl 21) in + let t = t lxor (t lsr 24) in + let t = t + (t lsl 3) + (t lsl 8) in + let t = t lxor (t lsr 14) in + let t = t + (t lsl 2) + (t lsl 4) in + let t = t lxor (t lsr 28) in + t + (t lsl 31) + ;; + + let hash_bool x = if x then 1 else 0 + + external hash_float + : (float[@unboxed]) + -> int + = "Base_hash_double" "Base_hash_double_unboxed" + [@@noalloc] + + let hash_unit () = 0 + end +end + +include T diff --git a/unikernel/duniverse/base/src/hash.mli b/unikernel/duniverse/base/src/hash.mli new file mode 100644 index 00000000..1b586b42 --- /dev/null +++ b/unikernel/duniverse/base/src/hash.mli @@ -0,0 +1 @@ +include Hash_intf.Hash (** @inline *) diff --git a/unikernel/duniverse/base/src/hash_intf.ml b/unikernel/duniverse/base/src/hash_intf.ml new file mode 100644 index 00000000..7717ee5c --- /dev/null +++ b/unikernel/duniverse/base/src/hash_intf.ml @@ -0,0 +1,195 @@ +(** [Hash_intf.S] is the interface which a hash function must support. + + The functions of [Hash_intf.S] are only allowed to be used in specific sequence: + + [alloc], [reset ?seed], [fold_..*], [get_hash_value], [reset ?seed], [fold_..*], + [get_hash_value], ... + + (The optional [seed]s passed to each reset may differ.) + + The chain of applications from [reset] to [get_hash_value] must be done in a + single-threaded manner (you can't use [fold_*] on a state that's been used + before). More precisely, [alloc ()] creates a new family of states. All functions that + take [t] and produce [t] return a new state from the same family. + + At any point in time, at most one state in the family is "valid". The other states are + "invalid". + + - The state returned by [alloc] is invalid. + - The state returned by [reset] is valid (all of the other states become invalid). + - The [fold_*] family of functions requires a valid state and produces a valid state + (thereby making the input state invalid). + - [get_hash_value] requires a valid state and makes it invalid. + + These requirements are currently formally encoded in the [Check_initialized_correctly] + module in bench/bench.ml. *) + +open! Import0 + +module type S = sig + (** Name of the hash-function, e.g., "internalhash", "siphash" *) + val description : string + + (** [state] is the internal hash-state used by the hash function. *) + type state + + (** [fold_ state v] incorporates a value [v] of type into the hash-state, + returning a modified hash-state. Implementations of the [fold_] functions may + mutate the [state] argument in place, and return a reference to it. Implementations + of the fold_ functions should not allocate. *) + val fold_int : state -> int -> state + + val fold_int64 : state -> int64 -> state + val fold_float : state -> float -> state + val fold_string : state -> string -> state + + (** [seed] is the type used to seed the initial hash-state. *) + type seed + + (** [alloc ()] returns a fresh uninitialized hash-state. May allocate. *) + val alloc : unit -> state + + (** [reset ?seed state] initializes/resets a hash-state with the given [seed], or else a + default-seed. Argument [state] may be mutated. Should not allocate. *) + val reset : ?seed:seed -> state -> state + + (** [hash_value] The type of hash values, returned by [get_hash_value]. *) + type hash_value + + (** [get_hash_value] extracts a hash-value from the hash-state. *) + val get_hash_value : state -> hash_value + + module For_tests : sig + val compare_state : state -> state -> int + val state_to_string : state -> string + end +end + +module type Builtin_hash_fold_intf = sig + type state + type 'a folder = state -> 'a -> state + + val hash_fold_nativeint : nativeint folder + val hash_fold_int64 : int64 folder + val hash_fold_int32 : int32 folder + val hash_fold_char : char folder + val hash_fold_int : int folder + val hash_fold_bool : bool folder + val hash_fold_string : string folder + val hash_fold_float : float folder + val hash_fold_unit : unit folder + val hash_fold_option : 'a folder -> 'a option folder + val hash_fold_list : 'a folder -> 'a list folder + val hash_fold_lazy_t : 'a folder -> 'a lazy_t folder + + (** Hash support for [array] and [ref] is provided, but is potentially DANGEROUS, since + it incorporates the current contents of the array/ref into the hash value. Because + of this we add a [_frozen] suffix to the function name. + + Hash support for [string] is also potentially DANGEROUS, but strings are mutated + less often, so we don't append [_frozen] to it. + + Also note that we don't support [bytes]. *) + val hash_fold_ref_frozen : 'a folder -> 'a ref folder + + val hash_fold_array_frozen : 'a folder -> 'a array folder +end + +module type Builtin_hash_intf = sig + type hash_value + + val hash_nativeint : nativeint -> hash_value + val hash_int64 : int64 -> hash_value + val hash_int32 : int32 -> hash_value + val hash_char : char -> hash_value + val hash_int : int -> hash_value + val hash_bool : bool -> hash_value + val hash_string : string -> hash_value + val hash_float : float -> hash_value + val hash_unit : unit -> hash_value +end + +module type Builtin_intf = sig + include Builtin_hash_fold_intf + include Builtin_hash_intf +end + +module type Full = sig + include S (** @inline *) + + type 'a folder = state -> 'a -> state + + (** [create ?seed ()] is a convenience. Equivalent to [reset ?seed (alloc ())]. *) + val create : ?seed:seed -> unit -> state + + (** [of_fold fold] constructs a standard hash function from an existing fold + function. *) + val of_fold : (state -> 'a -> state) -> 'a -> hash_value + + module Builtin : + Builtin_intf + with type state := state + and type 'a folder := 'a folder + and type hash_value := hash_value + + (** [run ?seed folder x] runs [folder] on [x] in a newly allocated hash-state, + initialized using optional [seed] or a default-seed. + + The following identity exists: [run [%hash_fold: T]] == [[%hash: T]] + + [run] can be used if we wish to run a hash-folder with a non-default seed. *) + val run : ?seed:seed -> 'a folder -> 'a -> hash_value +end + +module type Hash = sig + module type Full = Full + module type S = S + + module F (Hash : S) : + Full + with type hash_value = Hash.hash_value + and type state = Hash.state + and type seed = Hash.seed + + (** The code of [ppx_hash] is agnostic to the choice of hash algorithm that is + used. However, it is not currently possible to mix various choices of hash algorithms + in a given code base. + + We experimented with: + - (a) custom hash algorithms implemented in OCaml and + - (b) in C; + - (c) OCaml's internal hash function (which is a custom version of Murmur3, + implemented in C); + - (d) siphash, a modern hash function implemented in C. + + Our findings were as follows: + + - Implementing our own custom hash algorithms in OCaml and C yielded very little + performance improvement over the (c) proposal, without providing the benefit of being + a peer-reviewed, widely used hash function. + + - Siphash (a modern hash function with an internal state of 32 bytes) has a worse + performance profile than (a,b,c) above (hashing takes more time). Since its internal + state is bigger than an OCaml immediate value, one must either manage allocation of + such state explicitly, or paying the cost of allocation each time a hash is computed. + While being a supposedly good hash function (with good hash quality), this quality was + not translated in measurable improvements in our macro benchmarks. (Also, based on + the data available at the time of writing, it's unclear that other hash algorithms in + this class would be more than marginally faster.) + + - By contrast, using the internal combinators of OCaml hash function means that we do + not allocate (the internal state of this hash function is 32 bit) and have the same + quality and performance as Hashtbl.hash. + + Hence, we are here making the choice of using this Internalhash (that is, Murmur3, the + OCaml hash algorithm as of 4.03) as our hash algorithm. It means that the state of the + hash function does not need to be preallocated, and makes for simpler use in hash + tables and other structures. *) + + (** @open *) + include + Full + with type state = Base_internalhash_types.state + and type seed = Base_internalhash_types.seed + and type hash_value = Base_internalhash_types.hash_value +end diff --git a/unikernel/duniverse/base/src/hash_set.ml b/unikernel/duniverse/base/src/hash_set.ml new file mode 100644 index 00000000..4cf7d1d0 --- /dev/null +++ b/unikernel/duniverse/base/src/hash_set.ml @@ -0,0 +1,195 @@ +open! Import +include Hash_set_intf + +let hashable_s = Hashtbl.hashable_s +let hashable = Hashtbl.Private.hashable +let poly_hashable = Hashtbl.Poly.hashable +let with_return = With_return.with_return + +type 'a t = ('a, unit) Hashtbl.t +type 'a hash_set = 'a t +type 'a elt = 'a + +module Accessors = struct + let hashable = hashable + let clear = Hashtbl.clear + let length = Hashtbl.length + let mem = Hashtbl.mem + let is_empty t = Hashtbl.is_empty t + + let find_map t ~f = + with_return (fun r -> + Hashtbl.iter_keys t ~f:(fun elt -> + match f elt with + | None -> () + | Some _ as o -> r.return o); + None) [@nontail] + ;; + + let find t ~f = find_map t ~f:(fun a -> if f a then Some a else None) [@nontail] + let add t k = Hashtbl.set t ~key:k ~data:() + + let strict_add t k = + if mem t k + then Or_error.error_string "element already exists" + else ( + Hashtbl.set t ~key:k ~data:(); + Result.Ok ()) + ;; + + let strict_add_exn t k = Or_error.ok_exn (strict_add t k) + let remove = Hashtbl.remove + + let strict_remove t k = + if mem t k + then ( + remove t k; + Result.Ok ()) + else Or_error.error "element not in set" k (Hashtbl.sexp_of_key t) + ;; + + let strict_remove_exn t k = Or_error.ok_exn (strict_remove t k) + + let fold t ~init ~f = + Hashtbl.fold t ~init ~f:(fun ~key ~data:() acc -> f acc key) [@nontail] + ;; + + let iter t ~f = Hashtbl.iter_keys t ~f + let count t ~f = Container.count ~fold t ~f + let sum m t ~f = Container.sum ~fold m t ~f + let min_elt t ~compare = Container.min_elt ~fold t ~compare + let max_elt t ~compare = Container.max_elt ~fold t ~compare + let fold_result t ~init ~f = Container.fold_result ~fold ~init ~f t + let fold_until t ~init ~f ~finish = Container.fold_until ~fold ~init ~f t ~finish + let to_list = Hashtbl.keys + + let sexp_of_t sexp_of_e t = + sexp_of_list sexp_of_e (to_list t |> List.sort ~compare:(hashable t).compare) + ;; + + let to_array t = + let len = length t in + let index = ref (len - 1) in + fold t ~init:[||] ~f:(fun acc key -> + if Array.length acc = 0 + then Array.create ~len key + else ( + index := !index - 1; + acc.(!index) <- key; + acc)) + ;; + + let exists t ~f = Hashtbl.existsi t ~f:(fun ~key ~data:() -> f key) [@nontail] + let for_all t ~f = not (Hashtbl.existsi t ~f:(fun ~key ~data:() -> not (f key))) + let equal t1 t2 = Hashtbl.equal (fun () () -> true) t1 t2 + let copy t = Hashtbl.copy t + let filter t ~f = Hashtbl.filteri t ~f:(fun ~key ~data:() -> f key) [@nontail] + let union t1 t2 = Hashtbl.merge t1 t2 ~f:(fun ~key:_ _ -> Some ()) + let diff t1 t2 = filter t1 ~f:(fun key -> not (Hashtbl.mem t2 key)) + + let inter t1 t2 = + let smaller, larger = if length t1 > length t2 then t2, t1 else t1, t2 in + Hashtbl.filteri smaller ~f:(fun ~key ~data:() -> Hashtbl.mem larger key) + ;; + + let filter_inplace t ~f = + let to_remove = fold t ~init:[] ~f:(fun ac x -> if f x then ac else x :: ac) in + List.iter to_remove ~f:(fun x -> remove t x) + ;; + + let of_hashtbl_keys hashtbl = Hashtbl.map hashtbl ~f:ignore + let to_hashtbl t ~f = Hashtbl.mapi t ~f:(fun ~key ~data:() -> f key) [@nontail] +end + +include Accessors + +let create ?growth_allowed ?size m = Hashtbl.create ?growth_allowed ?size m + +let of_list ?growth_allowed ?size m l = + let size = + match size with + | Some x -> x + | None -> List.length l + in + let t = Hashtbl.create ?growth_allowed ~size m in + List.iter l ~f:(fun k -> add t k); + t +;; + +let t_of_sexp m e_of_sexp sexp = + match sexp with + | Sexp.Atom _ -> of_sexp_error "Hash_set.t_of_sexp requires a list" sexp + | Sexp.List list -> + let t = create m ~size:(List.length list) in + List.iter list ~f:(fun sexp -> + let e = e_of_sexp sexp in + match strict_add t e with + | Ok () -> () + | Error _ -> of_sexp_error "Hash_set.t_of_sexp got a duplicate element" sexp); + t +;; + +module Creators (Elt : sig + type 'a t + + val hashable : 'a t Hashable.t +end) : sig + val t_of_sexp : (Sexp.t -> 'a Elt.t) -> Sexp.t -> 'a Elt.t t + + include + Creators_generic + with type 'a t := 'a Elt.t t + with type 'a elt := 'a Elt.t + with type ('elt, 'z) create_options := + ('elt, 'z) create_options_without_first_class_module +end = struct + let create ?growth_allowed ?size () = + create ?growth_allowed ?size (Hashable.to_key Elt.hashable) + ;; + + let of_list ?growth_allowed ?size l = + of_list ?growth_allowed ?size (Hashable.to_key Elt.hashable) l + ;; + + let t_of_sexp e_of_sexp sexp = t_of_sexp (Hashable.to_key Elt.hashable) e_of_sexp sexp +end + +module Poly = struct + type 'a t = 'a hash_set + type 'a elt = 'a + + let hashable = poly_hashable + + include Creators (struct + type 'a t = 'a + + let hashable = hashable + end) + + include Accessors + + let sexp_of_t = sexp_of_t + let t_sexp_grammar grammar = Sexplib0.Sexp_grammar.coerce (List.t_sexp_grammar grammar) +end + +module M (Elt : T.T) = struct + type nonrec t = Elt.t t +end + +let sexp_of_m__t (type elt) (module Elt : Sexp_of_m with type t = elt) t = + sexp_of_t Elt.sexp_of_t t +;; + +let m__t_of_sexp (type elt) (module Elt : M_of_sexp with type t = elt) sexp = + t_of_sexp (module Elt) Elt.t_of_sexp sexp +;; + +let m__t_sexp_grammar (type elt) (module Elt : M_sexp_grammar with type t = elt) = + Sexplib0.Sexp_grammar.coerce (list_sexp_grammar Elt.t_sexp_grammar) +;; + +let equal_m__t (module _ : Equal_m) t1 t2 = equal t1 t2 + +module Private = struct + let hashable = Hashtbl.Private.hashable +end diff --git a/unikernel/duniverse/base/src/hash_set.mli b/unikernel/duniverse/base/src/hash_set.mli new file mode 100644 index 00000000..f69262f6 --- /dev/null +++ b/unikernel/duniverse/base/src/hash_set.mli @@ -0,0 +1 @@ +include Hash_set_intf.Hash_set (** @inline *) diff --git a/unikernel/duniverse/base/src/hash_set_intf.ml b/unikernel/duniverse/base/src/hash_set_intf.ml new file mode 100644 index 00000000..cb29cc0f --- /dev/null +++ b/unikernel/duniverse/base/src/hash_set_intf.ml @@ -0,0 +1,216 @@ +open! Import +module Key = Hashtbl_intf.Key + +module type Accessors = sig + type 'a t + + include Container.Generic with type ('a, _, _) t := 'a t + + (** override [Container.Generic.mem] *) + val mem : 'a t -> 'a -> bool + + (** preserves the equality function *) + val copy : 'a t -> 'a t + + val add : 'a t -> 'a -> unit + + (** [strict_add t x] returns [Ok ()] if the [x] was not in [t], or an [Error] if it + was. *) + val strict_add : 'a t -> 'a -> unit Or_error.t + + val strict_add_exn : 'a t -> 'a -> unit + val remove : 'a t -> 'a -> unit + + (** [strict_remove t x] returns [Ok ()] if the [x] was in [t], or an [Error] if it + was not. *) + val strict_remove : 'a t -> 'a -> unit Or_error.t + + val strict_remove_exn : 'a t -> 'a -> unit + val clear : 'a t -> unit + val equal : 'a t -> 'a t -> bool + val filter : 'a t -> f:('a -> bool) -> 'a t + val filter_inplace : 'a t -> f:('a -> bool) -> unit + + (** [inter t1 t2] computes the set intersection of [t1] and [t2]. Runs in O(min(length + t1, length t2)). Behavior is undefined if [t1] and [t2] don't have the same + equality function. *) + val inter : 'key t -> 'key t -> 'key t + + val union : 'a t -> 'a t -> 'a t + val diff : 'a t -> 'a t -> 'a t + val of_hashtbl_keys : ('a, _) Hashtbl.t -> 'a t + val to_hashtbl : 'key t -> f:('key -> 'data) -> ('key, 'data) Hashtbl.t +end + +type ('key, 'z) create_options = ('key, unit, 'z) Hashtbl_intf.create_options + +type ('key, 'z) create_options_without_first_class_module = + ('key, unit, 'z) Hashtbl_intf.create_options_without_first_class_module + +module type Creators = sig + type 'a t + + val create + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> 'a t + + val of_list + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> 'a list + -> 'a t +end + +module type Creators_generic = sig + type 'a t + type 'a elt + type ('a, 'z) create_options + + val create : ('a, unit -> 'a t) create_options + val of_list : ('a, 'a elt list -> 'a t) create_options +end + +module type Sexp_of_m = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end + +module type M_of_sexp = sig + type t [@@deriving_inline of_sexp] + + val t_of_sexp : Sexplib0.Sexp.t -> t + + [@@@end] + + include Hashtbl_intf.Key.S with type t := t +end + +module type M_sexp_grammar = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] +end + +module type Equal_m = sig end + +module type For_deriving = sig + type 'a t + + module type M_of_sexp = M_of_sexp + module type Sexp_of_m = Sexp_of_m + module type Equal_m = Equal_m + + (** [M] is meant to be used in combination with OCaml applicative functor types: + + {[ + type string_hash_set = Hash_set.M(String).t + ]} + + which stands for: + + {[ + type string_hash_set = String.t Hash_set.t + ]} + + The point is that [Hash_set.M(String).t] supports deriving, whereas the second + syntax doesn't (because [t_of_sexp] doesn't know what comparison/hash function to + use). *) + module M (Elt : T.T) : sig + type nonrec t = Elt.t t + end + + val sexp_of_m__t : (module Sexp_of_m with type t = 'elt) -> 'elt t -> Sexp.t + val m__t_of_sexp : (module M_of_sexp with type t = 'elt) -> Sexp.t -> 'elt t + + val m__t_sexp_grammar + : (module M_sexp_grammar with type t = 'elt) + -> 'elt t Sexplib0.Sexp_grammar.t + + val equal_m__t : (module Equal_m) -> 'elt t -> 'elt t -> bool +end + +module type Hash_set = sig + type !'a t [@@deriving_inline sexp_of] + + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + + [@@@end] + + (** We use [[@@deriving sexp_of]] but not [[@@deriving sexp]] because we want people to be + explicit about the hash and comparison functions used when creating hashtables. One + can use [Hash_set.Poly.t], which does have [[@@deriving sexp]], to use polymorphic + comparison and hashing. *) + + module Key = Key + + module type Creators = Creators + module type Creators_generic = Creators_generic + module type For_deriving = For_deriving + + type nonrec ('key, 'z) create_options = ('key, 'z) create_options + + include Creators with type 'a t := 'a t (** @open *) + + module type Accessors = Accessors + + include Accessors with type 'a t := 'a t with type 'a elt = 'a (** @open *) + + val hashable_s : 'key t -> 'key Key.t + + type nonrec ('key, 'z) create_options_without_first_class_module = + ('key, 'z) create_options_without_first_class_module + + (** A hash set that uses polymorphic comparison *) + module Poly : sig + type nonrec 'a t = 'a t [@@deriving_inline sexp, sexp_grammar] + + include Sexplib0.Sexpable.S1 with type 'a t := 'a t + + val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + + [@@@end] + + include + Creators_generic + with type 'a t := 'a t + with type 'a elt = 'a + with type ('key, 'z) create_options := + ('key, 'z) create_options_without_first_class_module + + include Accessors with type 'a t := 'a t with type 'a elt := 'a elt + end + + module Creators (Elt : sig + type 'a t + + val hashable : 'a t Hashable.t + end) : sig + val t_of_sexp : (Sexp.t -> 'a Elt.t) -> Sexp.t -> 'a Elt.t t + + include + Creators_generic + with type 'a t := 'a Elt.t t + with type 'a elt := 'a Elt.t + with type ('elt, 'z) create_options := + ('elt, 'z) create_options_without_first_class_module + end + + include For_deriving with type 'a t := 'a t + + (**/**) + + (*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) + module Private : sig + val hashable : 'a t -> 'a Hashable.t + end +end diff --git a/unikernel/duniverse/base/src/hash_stubs.c b/unikernel/duniverse/base/src/hash_stubs.c new file mode 100644 index 00000000..e8f8c294 --- /dev/null +++ b/unikernel/duniverse/base/src/hash_stubs.c @@ -0,0 +1,30 @@ +#include +#include +#include + +/* Final mix and return from the hash.c implementation from INRIA */ +#define FINAL_MIX_AND_RETURN(h) \ + h ^= h >> 16; \ + h *= 0x85ebca6b; \ + h ^= h >> 13; \ + h *= 0xc2b2ae35; \ + h ^= h >> 16; \ + return Val_int(h & 0x3FFFFFFFU); + +CAMLprim value Base_hash_string(value string) { + uint32_t h; + h = caml_hash_mix_string(0, string); + FINAL_MIX_AND_RETURN(h) +} + +CAMLprim value Base_hash_double(value d) { + uint32_t h; + h = caml_hash_mix_double(0, Double_val(d)); + FINAL_MIX_AND_RETURN(h); +} + +CAMLprim value Base_hash_double_unboxed(double d) { + uint32_t h; + h = caml_hash_mix_double(0, d); + FINAL_MIX_AND_RETURN(h); +} diff --git a/unikernel/duniverse/base/src/hashable.ml b/unikernel/duniverse/base/src/hashable.ml new file mode 100644 index 00000000..5a56c0d4 --- /dev/null +++ b/unikernel/duniverse/base/src/hashable.ml @@ -0,0 +1,2 @@ +open! Import +include Hashable_intf diff --git a/unikernel/duniverse/base/src/hashable.mli b/unikernel/duniverse/base/src/hashable.mli new file mode 100644 index 00000000..14a8a797 --- /dev/null +++ b/unikernel/duniverse/base/src/hashable.mli @@ -0,0 +1,6 @@ +open! Import + +module type Key = Hashable_intf.Key +module type Hashable = Hashable_intf.Hashable + +include Hashable (** @inline *) diff --git a/unikernel/duniverse/base/src/hashable_intf.ml b/unikernel/duniverse/base/src/hashable_intf.ml new file mode 100644 index 00000000..bdb43d2f --- /dev/null +++ b/unikernel/duniverse/base/src/hashable_intf.ml @@ -0,0 +1,85 @@ +open! Import + +(** @canonical Base.Hashable.Key *) +module type Key = sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + (** Values returned by [hash] must be non-negative. An exception will be raised in the + case that [hash] returns a negative value. *) + val hash : t -> int +end + +module Hashable = struct + type 'a t = + { hash : 'a -> int + ; compare : 'a -> 'a -> int + ; sexp_of_t : 'a -> Sexp.t + } + + (** This function is sound but not complete, meaning that if it returns [true] then it's + safe to use the two interchangeably. If it's [false], you have no guarantees. For + example: + + {[ + > utop + open Core;; + let equal (a : 'a Hashtbl_intf.Hashable.t) b = + phys_equal a b + || (phys_equal a.hash b.hash + && phys_equal a.compare b.compare + && phys_equal a.sexp_of_t b.sexp_of_t) + ;; + let a = Hashtbl_intf.Hashable.{ hash; compare; sexp_of_t = Int.sexp_of_t };; + let b = Hashtbl_intf.Hashable.{ hash; compare; sexp_of_t = Int.sexp_of_t };; + equal a b;; (* false?! *) + ]} + *) + let equal a b = + phys_equal a b + || (phys_equal a.hash b.hash + && phys_equal a.compare b.compare + && phys_equal a.sexp_of_t b.sexp_of_t) + ;; + + let hash_param = Stdlib.Hashtbl.hash_param + let hash = Stdlib.Hashtbl.hash + let poly = { hash; compare = Poly.compare; sexp_of_t = (fun _ -> Sexp.Atom "_") } + + let of_key (type a) (module Key : Key with type t = a) = + { hash = Key.hash; compare = Key.compare; sexp_of_t = Key.sexp_of_t } + ;; + + let to_key (type a) { hash; compare; sexp_of_t } = + (module struct + type t = a + + let hash = hash + let compare = compare + let sexp_of_t = sexp_of_t + end : Key + with type t = a) + ;; +end + +include Hashable + +module type Hashable = sig + type 'a t = 'a Hashable.t = + { hash : 'a -> int + ; compare : 'a -> 'a -> int + ; sexp_of_t : 'a -> Sexp.t + } + + val equal : 'a t -> 'a t -> bool + val poly : 'a t + val of_key : (module Key with type t = 'a) -> 'a t + val to_key : 'a t -> (module Key with type t = 'a) + val hash_param : int -> int -> 'a -> int + val hash : 'a -> int +end diff --git a/unikernel/duniverse/base/src/hasher.ml b/unikernel/duniverse/base/src/hasher.ml new file mode 100644 index 00000000..205450d5 --- /dev/null +++ b/unikernel/duniverse/base/src/hasher.ml @@ -0,0 +1,54 @@ +open! Import + +(** Signatures required of types which can be used in [[@@deriving hash]]. *) + +module type S = sig + (** The type that is hashed. *) + type t + + (** [hash_fold_t state x] mixes the content of [x] into the [state]. + + By default, all our [hash_fold_t] functions (derived or not) should satisfy the + following properties. + + 1. [hash_fold_t state x] should mix all the information present in [x] in the state. + That is, by default, [hash_fold_t] will traverse the full term [x] (this is a + significant change for Hashtbl.hash which by default stops traversing the term after + after considering a small number of "significant values"). [hash_fold_t] must not + discard the [state]. + + 2. [hash_fold_t] must be compatible with the associated [compare] function: that is, + for all [x] [y] and [s], [compare x y = 0] must imply [hash_fold_t s x = hash_fold_t + s y]. + + 3. To avoid avoid systematic collisions, [hash_fold_t] should expand to different + sequences of built-in mixing functions for different values of [x]. No such sequence + is allowed to be a prefix of another. + + A common mistake is to implement [hash_fold_t] of a collection by just folding all + the elements. This makes the folding sequence of [a] be a prefix of [a @ b], thereby + violating the requirement. This creates large families of collisions: all of the + following collections would hash the same: + + {v + [[]; [1;2;3]] + [[1]; [2;3]] + [[1; 2]; [3]] + [[1; 2; 3]; []] + [[1]; [2]; []; [3];] + ... + v} + + A good way to avoid this is to mix in the size of the collection to the beginning + ([fold ~init:(hash_fold_int state length) ~f:hash_fold_elem]). The default in our + libraries is to mix the length of the structure before folding. To prevent the + aforementioned collisions, one should respect this ordering. + *) + val hash_fold_t : Hash.state -> t -> Hash.state +end + +module type S1 = sig + type 'a t + + val hash_fold_t : (Hash.state -> 'a -> Hash.state) -> Hash.state -> 'a t -> Hash.state +end diff --git a/unikernel/duniverse/base/src/hashtbl.ml b/unikernel/duniverse/base/src/hashtbl.ml new file mode 100644 index 00000000..f493040d --- /dev/null +++ b/unikernel/duniverse/base/src/hashtbl.ml @@ -0,0 +1,973 @@ +open! Import +include Hashtbl_intf + +module type Key = Key.S + +let with_return = With_return.with_return +let hash_param = Hashable.hash_param +let hash = Hashable.hash +let raise_s = Error.raise_s + +type ('k, 'v) t = + { mutable table : ('k, 'v) Avltree.t array + ; mutable length : int + ; growth_allowed : bool + ; hashable : 'k Hashable.t + ; mutable mutation_allowed : bool (* Set during all iteration operations *) + } + +type 'a key = 'a + +let sexp_of_key t = t.hashable.Hashable.sexp_of_t +let compare_key t = t.hashable.Hashable.compare + +let ensure_mutation_allowed t = + if not t.mutation_allowed then failwith "Hashtbl: mutation not allowed during iteration" +;; + +let without_mutating t f = + if t.mutation_allowed + then ( + t.mutation_allowed <- false; + match f () with + | x -> + t.mutation_allowed <- true; + x + | exception exn -> + t.mutation_allowed <- true; + raise exn) + else f () +;; + +(** Internally use a maximum size that is a power of 2. Reverses the above to find the + floor power of 2 below the system max array length *) +let max_table_length = Int.floor_pow2 Array.max_length + +(* The default size is chosen to be 0 (as opposed to 128 as it was before) because: + - 128 can create substantial memory overhead (x10) when creating many tables, most + of which are not big (say, if you have a hashtbl of hashtbl). And memory overhead is + not that easy to profile. + - if a hashtbl is going to grow, it's not clear why 128 is markedly better than other + sizes (if you going to stick 1000 elements, you're going to grow the hashtable once + or twice anyway) + - in other languages (like rust, python, and apparently go), the default is also a + small size. *) +let create ?(growth_allowed = true) ?(size = 0) ~hashable () = + let size = Int.min (Int.max 1 size) max_table_length in + let size = Int.ceil_pow2 size in + { table = Array.create ~len:size Avltree.empty + ; length = 0 + ; growth_allowed + ; hashable + ; mutation_allowed = true + } +;; + +(** Supplemental hash. This may not be necessary, it is intended as a defense against poor + hash functions, for which the power of 2 sized table will be especially sensitive. + With some testing we may choose to add it, but this table is designed to be robust to + collisions, and in most of my testing this degrades performance. *) +let _supplemental_hash h = + let h = h lxor ((h lsr 20) lxor (h lsr 12)) in + h lxor (h lsr 7) lxor (h lsr 4) +;; + +let slot t key = + let hash = t.hashable.Hashable.hash key in + (* this is always non-negative because we do [land] with non-negative number *) + hash land (Array.length t.table - 1) +;; + +let add_worker t ~replace ~key ~data = + let i = slot t key in + let root = t.table.(i) in + let added = ref false in + let new_root = + (* The avl tree might replace the value [replace=true] or do nothing [replace=false] + to the entry, in that case the table did not get bigger, so we should not + increment length, we pass in the bool ref t.added so that it can tell us whether + it added or replaced. We do it this way to avoid extra allocation. Since the bool + is an immediate it does not go through the write barrier. *) + Avltree.add ~replace root ~compare:(compare_key t) ~added ~key ~data + in + if !added then t.length <- t.length + 1; + (* This little optimization saves a caml_modify when the tree + hasn't been rebalanced. *) + if not (phys_equal new_root root) then t.table.(i) <- new_root; + !added +;; + +let maybe_resize_table t = + let len = Array.length t.table in + let should_grow = t.length > len in + if should_grow && t.growth_allowed + then ( + let new_array_length = Int.min (len * 2) max_table_length in + if new_array_length > len + then ( + let new_table = Array.create ~len:new_array_length Avltree.empty in + let old_table = t.table in + t.table <- new_table; + t.length <- 0; + let f ~key ~data = ignore (add_worker ~replace:true t ~key ~data : bool) in + for i = 0 to Array.length old_table - 1 do + Avltree.iter old_table.(i) ~f + done)) +;; + +let capacity t = Array.length t.table + +let set t ~key ~data = + ensure_mutation_allowed t; + ignore (add_worker ~replace:true t ~key ~data : bool); + maybe_resize_table t +;; + +let add t ~key ~data = + ensure_mutation_allowed t; + let added = add_worker ~replace:false t ~key ~data in + if added + then ( + maybe_resize_table t; + `Ok) + else `Duplicate +;; + +let add_exn t ~key ~data = + match add t ~key ~data with + | `Ok -> () + | `Duplicate -> + let sexp_of_key = sexp_of_key t in + let error = Error.create "Hashtbl.add_exn got key already present" key sexp_of_key in + Error.raise error +;; + +let clear t = + ensure_mutation_allowed t; + for i = 0 to Array.length t.table - 1 do + t.table.(i) <- Avltree.empty + done; + t.length <- 0 +;; + +let find_and_call t key ~if_found ~if_not_found = + (* with a good hash function these first two cases will be the overwhelming majority, + and Avltree.find is recursive, so it can't be inlined, so doing this avoids a + function call in most cases. *) + match t.table.(slot t key) with + | Avltree.Empty -> if_not_found key + | Avltree.Leaf { key = k; value = v } -> + if compare_key t k key = 0 then if_found v else if_not_found key + | tree -> + Avltree.find_and_call tree ~compare:(compare_key t) key ~if_found ~if_not_found +;; + +let find_and_call1 t key ~a ~if_found ~if_not_found = + match t.table.(slot t key) with + | Avltree.Empty -> if_not_found key a + | Avltree.Leaf { key = k; value = v } -> + if compare_key t k key = 0 then if_found v a else if_not_found key a + | tree -> + Avltree.find_and_call1 tree ~compare:(compare_key t) key ~a ~if_found ~if_not_found +;; + +let find_and_call2 t key ~a ~b ~if_found ~if_not_found = + match t.table.(slot t key) with + | Avltree.Empty -> if_not_found key a b + | Avltree.Leaf { key = k; value = v } -> + if compare_key t k key = 0 then if_found v a b else if_not_found key a b + | tree -> + Avltree.find_and_call2 tree ~compare:(compare_key t) key ~a ~b ~if_found ~if_not_found +;; + +let findi_and_call t key ~if_found ~if_not_found = + (* with a good hash function these first two cases will be the overwhelming majority, + and Avltree.find is recursive, so it can't be inlined, so doing this avoids a + function call in most cases. *) + match t.table.(slot t key) with + | Avltree.Empty -> if_not_found key + | Avltree.Leaf { key = k; value = v } -> + if compare_key t k key = 0 then if_found ~key:k ~data:v else if_not_found key + | tree -> + Avltree.findi_and_call tree ~compare:(compare_key t) key ~if_found ~if_not_found +;; + +let findi_and_call1 t key ~a ~if_found ~if_not_found = + match t.table.(slot t key) with + | Avltree.Empty -> if_not_found key a + | Avltree.Leaf { key = k; value = v } -> + if compare_key t k key = 0 then if_found ~key:k ~data:v a else if_not_found key a + | tree -> + Avltree.findi_and_call1 tree ~compare:(compare_key t) key ~a ~if_found ~if_not_found +;; + +let findi_and_call2 t key ~a ~b ~if_found ~if_not_found = + match t.table.(slot t key) with + | Avltree.Empty -> if_not_found key a b + | Avltree.Leaf { key = k; value = v } -> + if compare_key t k key = 0 then if_found ~key:k ~data:v a b else if_not_found key a b + | tree -> + Avltree.findi_and_call2 + tree + ~compare:(compare_key t) + key + ~a + ~b + ~if_found + ~if_not_found +;; + +let find = + let if_found v = Some v in + let if_not_found _ = None in + fun t key -> find_and_call t key ~if_found ~if_not_found +;; + +let mem t key = + match t.table.(slot t key) with + | Avltree.Empty -> false + | Avltree.Leaf { key = k; value = _ } -> compare_key t k key = 0 + | tree -> Avltree.mem tree ~compare:(compare_key t) key +;; + +let remove t key = + ensure_mutation_allowed t; + let i = slot t key in + let root = t.table.(i) in + let removed = ref false in + let new_root = Avltree.remove root ~removed ~compare:(compare_key t) key in + if not (phys_equal root new_root) then t.table.(i) <- new_root; + if !removed then t.length <- t.length - 1 +;; + +let length t = t.length +let is_empty t = length t = 0 + +let fold t ~init ~f = + if length t = 0 + then init + else ( + let n = Array.length t.table in + let acc = ref init in + let m = t.mutation_allowed in + match + t.mutation_allowed <- false; + for i = 0 to n - 1 do + match Array.unsafe_get t.table i with + | Avltree.Empty -> () + | Avltree.Leaf { key; value = data } -> acc := f ~key ~data !acc + | bucket -> acc := Avltree.fold bucket ~init:!acc ~f + done + with + | () -> + t.mutation_allowed <- m; + !acc + | exception exn -> + t.mutation_allowed <- m; + raise exn) +;; + +let iteri t ~f = + if t.length = 0 + then () + else ( + let n = Array.length t.table in + let m = t.mutation_allowed in + match + t.mutation_allowed <- false; + for i = 0 to n - 1 do + match Array.unsafe_get t.table i with + | Avltree.Empty -> () + | Avltree.Leaf { key; value = data } -> f ~key ~data + | bucket -> Avltree.iter bucket ~f + done + with + | () -> t.mutation_allowed <- m + | exception exn -> + t.mutation_allowed <- m; + raise exn) +;; + +let iter t ~f = iteri t ~f:(fun ~key:_ ~data -> f data) [@nontail] +let iter_keys t ~f = iteri t ~f:(fun ~key ~data:_ -> f key) [@nontail] + +let rec choose_nonempty table i = + let avltree = Array.unsafe_get table i in + if Avltree.is_empty avltree + then choose_nonempty table ((i + 1) land (Array.length table - 1)) + else Avltree.choose_exn avltree +;; + +let choose_exn t = + if t.length = 0 then raise_s (Sexp.message "[Hashtbl.choose_exn] of empty hashtbl" []); + choose_nonempty t.table 0 +;; + +let choose t = if is_empty t then None else Some (choose_nonempty t.table 0) + +let choose_randomly_nonempty ~random_state t = + let start_idx = Random.State.int random_state (Array.length t.table) in + choose_nonempty t.table start_idx +;; + +let choose_randomly ?(random_state = Random.State.default) t = + if is_empty t then None else Some (choose_randomly_nonempty ~random_state t) +;; + +let choose_randomly_exn ?(random_state = Random.State.default) t = + if t.length = 0 + then raise_s (Sexp.message "[Hashtbl.choose_randomly_exn] of empty hashtbl" []); + choose_randomly_nonempty ~random_state t +;; + +let invariant invariant_key invariant_data t = + for i = 0 to Array.length t.table - 1 do + Avltree.invariant t.table.(i) ~compare:(compare_key t) + done; + let real_len = + fold t ~init:0 ~f:(fun ~key ~data i -> + invariant_key key; + invariant_data data; + i + 1) + in + assert (real_len = t.length) +;; + +let find_exn = + let if_found v _ = v in + let if_not_found k t = + raise + (Not_found_s (List [ Atom "Hashtbl.find_exn: not found"; t.hashable.sexp_of_t k ])) + in + let find_exn t key = find_and_call1 t key ~a:t ~if_found ~if_not_found in + (* named to preserve symbol in compiled binary *) + find_exn +;; + +let existsi t ~f = + with_return (fun r -> + iteri t ~f:(fun ~key ~data -> if f ~key ~data then r.return true); + false) [@nontail] +;; + +let exists t ~f = existsi t ~f:(fun ~key:_ ~data -> f data) [@nontail] +let for_alli t ~f = not (existsi t ~f:(fun ~key ~data -> not (f ~key ~data))) +let for_all t ~f = not (existsi t ~f:(fun ~key:_ ~data -> not (f data))) + +let counti t ~f = + fold t ~init:0 ~f:(fun ~key ~data acc -> if f ~key ~data then acc + 1 else acc) [@nontail + ] +;; + +let count t ~f = + fold t ~init:0 ~f:(fun ~key:_ ~data acc -> if f data then acc + 1 else acc) [@nontail] +;; + +let mapi t ~f = + let new_t = + create ~growth_allowed:t.growth_allowed ~hashable:t.hashable ~size:t.length () + in + iteri t ~f:(fun ~key ~data -> set new_t ~key ~data:(f ~key ~data)); + new_t +;; + +let map t ~f = mapi t ~f:(fun ~key:_ ~data -> f data) [@nontail] +let copy t = map t ~f:Fn.id + +let filter_mapi t ~f = + let new_t = + create ~growth_allowed:t.growth_allowed ~hashable:t.hashable ~size:t.length () + in + iteri t ~f:(fun ~key ~data -> + match f ~key ~data with + | Some new_data -> set new_t ~key ~data:new_data + | None -> ()); + new_t +;; + +let filter_map t ~f = filter_mapi t ~f:(fun ~key:_ ~data -> f data) [@nontail] + +let filteri t ~f = + filter_mapi t ~f:(fun ~key ~data -> if f ~key ~data then Some data else None) [@nontail] +;; + +let filter t ~f = filteri t ~f:(fun ~key:_ ~data -> f data) [@nontail] +let filter_keys t ~f = filteri t ~f:(fun ~key ~data:_ -> f key) [@nontail] + +let partition_mapi t ~f = + let t0 = + create ~growth_allowed:t.growth_allowed ~hashable:t.hashable ~size:t.length () + in + let t1 = + create ~growth_allowed:t.growth_allowed ~hashable:t.hashable ~size:t.length () + in + iteri t ~f:(fun ~key ~data -> + match (f ~key ~data : _ Either.t) with + | First new_data -> set t0 ~key ~data:new_data + | Second new_data -> set t1 ~key ~data:new_data); + t0, t1 +;; + +let partition_map t ~f = partition_mapi t ~f:(fun ~key:_ ~data -> f data) [@nontail] + +let partitioni_tf t ~f = + partition_mapi t ~f:(fun ~key ~data -> if f ~key ~data then First data else Second data) + [@nontail] +;; + +let partition_tf t ~f = partitioni_tf t ~f:(fun ~key:_ ~data -> f data) [@nontail] + +let find_or_add t id ~default = + find_and_call + t + id + ~if_found:(fun data -> data) + ~if_not_found:(fun key -> + let default = default () in + set t ~key ~data:default; + default) [@nontail] +;; + +let findi_or_add t id ~default = + find_and_call + t + id + ~if_found:(fun data -> data) + ~if_not_found:(fun key -> + let default = default key in + set t ~key ~data:default; + default) [@nontail] +;; + +(* Some hashtbl implementations may be able to perform this more efficiently than two + separate lookups *) +let find_and_remove t id = + let result = find t id in + if Option.is_some result then remove t id; + result +;; + +let change t id ~f = + match f (find t id) with + | None -> remove t id + | Some data -> set t ~key:id ~data +;; + +let update_and_return t id ~f = + let data = f (find t id) in + set t ~key:id ~data; + data +;; + +let update t id ~f = ignore (update_and_return t id ~f : _) + +let incr_by ~remove_if_zero t key by = + if remove_if_zero + then + change t key ~f:(fun opt -> + match by + Option.value opt ~default:0 with + | 0 -> None + | n -> Some n) + else + update t key ~f:(function + | None -> by + | Some i -> by + i) +;; + +let incr ?(by = 1) ?(remove_if_zero = false) t key = incr_by ~remove_if_zero t key by +let decr ?(by = 1) ?(remove_if_zero = false) t key = incr_by ~remove_if_zero t key (-by) + +let add_multi t ~key ~data = + update t key ~f:(function + | None -> [ data ] + | Some l -> data :: l) +;; + +let remove_multi t key = + match find t key with + | None -> () + | Some [] | Some [ _ ] -> remove t key + | Some (_ :: tl) -> set t ~key ~data:tl +;; + +let find_multi t key = + match find t key with + | None -> [] + | Some l -> l +;; + +let create_mapped ?growth_allowed ?size ~hashable ~get_key ~get_data rows = + let size = + match size with + | Some s -> s + | None -> List.length rows + in + let res = create ?growth_allowed ~hashable ~size () in + let dupes = ref [] in + List.iter rows ~f:(fun r -> + let key = get_key r in + let data = get_data r in + if mem res key then dupes := key :: !dupes else set res ~key ~data); + match !dupes with + | [] -> `Ok res + | keys -> `Duplicate_keys (List.dedup_and_sort ~compare:hashable.Hashable.compare keys) +;; + +let create_mapped_multi ?growth_allowed ?size ~hashable ~get_key ~get_data rows = + let size = + match size with + | Some s -> s + | None -> List.length rows + in + let res = create ?growth_allowed ~size ~hashable () in + List.iter rows ~f:(fun r -> + let key = get_key r in + let data = get_data r in + add_multi res ~key ~data); + res +;; + +let of_alist ?growth_allowed ?size ~hashable lst = + match create_mapped ?growth_allowed ?size ~hashable ~get_key:fst ~get_data:snd lst with + | `Ok t -> `Ok t + | `Duplicate_keys k -> `Duplicate_key (List.hd_exn k) +;; + +let of_alist_report_all_dups ?growth_allowed ?size ~hashable lst = + create_mapped ?growth_allowed ?size ~hashable ~get_key:fst ~get_data:snd lst +;; + +let of_alist_or_error ?growth_allowed ?size ~hashable lst = + match of_alist ?growth_allowed ?size ~hashable lst with + | `Ok v -> Result.Ok v + | `Duplicate_key key -> + let sexp_of_key = hashable.Hashable.sexp_of_t in + Or_error.error "Hashtbl.of_alist_exn: duplicate key" key sexp_of_key +;; + +let of_alist_exn ?growth_allowed ?size ~hashable lst = + match of_alist_or_error ?growth_allowed ?size ~hashable lst with + | Result.Ok v -> v + | Result.Error e -> Error.raise e +;; + +let of_alist_multi ?growth_allowed ?size ~hashable lst = + create_mapped_multi ?growth_allowed ?size ~hashable ~get_key:fst ~get_data:snd lst +;; + +let to_alist t = fold ~f:(fun ~key ~data list -> (key, data) :: list) ~init:[] t + +let sexp_of_t sexp_of_key sexp_of_data t = + t + |> to_alist + |> List.sort ~compare:(fun (k1, _) (k2, _) -> t.hashable.compare k1 k2) + |> sexp_of_list (sexp_of_pair sexp_of_key sexp_of_data) +;; + +let t_of_sexp ~hashable k_of_sexp d_of_sexp sexp = + let alist = list_of_sexp (pair_of_sexp k_of_sexp d_of_sexp) sexp in + match of_alist ~hashable alist ~size:(List.length alist) with + | `Ok v -> v + | `Duplicate_key k -> + (* find the sexp of a duplicate key, so the error is narrowed to a key and not + the whole map *) + let alist_sexps = list_of_sexp (pair_of_sexp Fn.id Fn.id) sexp in + let found_first_k = ref false in + List.iter2_exn alist alist_sexps ~f:(fun (k2, _) (k2_sexp, _) -> + if hashable.compare k k2 = 0 + then + if !found_first_k + then of_sexp_error "Hashtbl.t_of_sexp: duplicate key" k2_sexp + else found_first_k := true); + assert false +;; + +let t_sexp_grammar + (type k v) + (k_grammar : k Sexplib0.Sexp_grammar.t) + (v_grammar : v Sexplib0.Sexp_grammar.t) + : (k, v) t Sexplib0.Sexp_grammar.t + = + Sexplib0.Sexp_grammar.coerce (List.Assoc.t_sexp_grammar k_grammar v_grammar) +;; + +let keys t = fold t ~init:[] ~f:(fun ~key ~data:_ acc -> key :: acc) +let data t = fold ~f:(fun ~key:_ ~data list -> data :: list) ~init:[] t + +let add_to_groups groups ~get_key ~get_data ~combine ~rows = + List.iter rows ~f:(fun row -> + let key = get_key row in + let data = get_data row in + let data = + match find groups key with + | None -> data + | Some old -> combine old data + in + set groups ~key ~data) [@nontail] +;; + +let group ?growth_allowed ?size ~hashable ~get_key ~get_data ~combine rows = + let res = create ?growth_allowed ?size ~hashable () in + add_to_groups res ~get_key ~get_data ~combine ~rows; + res +;; + +let create_with_key ?growth_allowed ?size ~hashable ~get_key rows = + create_mapped ?growth_allowed ?size ~hashable ~get_key ~get_data:Fn.id rows +;; + +let create_with_key_or_error ?growth_allowed ?size ~hashable ~get_key rows = + match create_with_key ?growth_allowed ?size ~hashable ~get_key rows with + | `Ok t -> Result.Ok t + | `Duplicate_keys keys -> + let sexp_of_key = hashable.Hashable.sexp_of_t in + Or_error.error_s + (Sexp.message + "Hashtbl.create_with_key: duplicate keys" + [ "keys", sexp_of_list sexp_of_key keys ]) +;; + +let create_with_key_exn ?growth_allowed ?size ~hashable ~get_key rows = + Or_error.ok_exn (create_with_key_or_error ?growth_allowed ?size ~hashable ~get_key rows) +;; + +let merge = + let maybe_set t ~key ~f d = + match f ~key d with + | None -> () + | Some v -> set t ~key ~data:v + in + fun t_left t_right ~f -> + if not (Hashable.equal t_left.hashable t_right.hashable) + then invalid_arg "Hashtbl.merge: different 'hashable' values"; + let new_t = + create + ~growth_allowed:t_left.growth_allowed + ~hashable:t_left.hashable + ~size:t_left.length + () + in + without_mutating t_left (fun () -> + without_mutating t_right (fun () -> + iteri t_left ~f:(fun ~key ~data:left -> + match find t_right key with + | None -> maybe_set new_t ~key ~f (`Left left) + | Some right -> maybe_set new_t ~key ~f (`Both (left, right))); + iteri t_right ~f:(fun ~key ~data:right -> + match find t_left key with + | None -> maybe_set new_t ~key ~f (`Right right) + | Some _ -> () + (* already done above *)) [@nontail]) [@nontail]); + new_t +;; + +let merge_into ~src ~dst ~f = + iteri src ~f:(fun ~key ~data -> + let dst_data = find dst key in + let action = without_mutating dst (fun () -> f ~key data dst_data) in + match (action : _ Merge_into_action.t) with + | Remove -> remove dst key + | Set_to data -> + (match dst_data with + | None -> set dst ~key ~data + | Some dst_data -> if not (phys_equal dst_data data) then set dst ~key ~data)) [@nontail + ] +;; + +let filteri_inplace t ~f = + let to_remove = + fold t ~init:[] ~f:(fun ~key ~data ac -> if f ~key ~data then ac else key :: ac) + in + List.iter to_remove ~f:(fun key -> remove t key) +;; + +let filter_inplace t ~f = filteri_inplace t ~f:(fun ~key:_ ~data -> f data) [@nontail] +let filter_keys_inplace t ~f = filteri_inplace t ~f:(fun ~key ~data:_ -> f key) [@nontail] + +let filter_mapi_inplace t ~f = + let map_results = fold t ~init:[] ~f:(fun ~key ~data ac -> (key, f ~key ~data) :: ac) in + List.iter map_results ~f:(fun (key, result) -> + match result with + | None -> remove t key + | Some data -> set t ~key ~data) +;; + +let filter_map_inplace t ~f = + filter_mapi_inplace t ~f:(fun ~key:_ ~data -> f data) [@nontail] +;; + +let mapi_inplace t ~f = + ensure_mutation_allowed t; + without_mutating t (fun () -> + Array.iter t.table ~f:(Avltree.mapi_inplace ~f) [@nontail]) [@nontail] +;; + +let map_inplace t ~f = mapi_inplace t ~f:(fun ~key:_ ~data -> f data) [@nontail] + +let equal equal t t' = + length t = length t' + && (with_return (fun r -> + without_mutating t' (fun () -> + iteri t ~f:(fun ~key ~data -> + match find t' key with + | None -> r.return false + | Some data' -> if not (equal data data') then r.return false) [@nontail]); + true) [@nontail]) +;; + +let similar = equal + +module Accessors = struct + let invariant = invariant + let choose = choose + let choose_exn = choose_exn + let choose_randomly = choose_randomly + let choose_randomly_exn = choose_randomly_exn + let clear = clear + let copy = copy + let remove = remove + let set = set + let add = add + let add_exn = add_exn + let change = change + let update = update + let update_and_return = update_and_return + let add_multi = add_multi + let remove_multi = remove_multi + let find_multi = find_multi + let mem = mem + let iter_keys = iter_keys + let iter = iter + let iteri = iteri + let exists = exists + let existsi = existsi + let for_all = for_all + let for_alli = for_alli + let count = count + let counti = counti + let fold = fold + let length = length + let is_empty = is_empty + let map = map + let mapi = mapi + let filter_map = filter_map + let filter_mapi = filter_mapi + let filter_keys = filter_keys + let filter = filter + let filteri = filteri + let partition_map = partition_map + let partition_mapi = partition_mapi + let partition_tf = partition_tf + let partitioni_tf = partitioni_tf + let find_or_add = find_or_add + let findi_or_add = findi_or_add + let find = find + let find_exn = find_exn + let find_and_call = find_and_call + let find_and_call1 = find_and_call1 + let find_and_call2 = find_and_call2 + let findi_and_call = findi_and_call + let findi_and_call1 = findi_and_call1 + let findi_and_call2 = findi_and_call2 + let find_and_remove = find_and_remove + let to_alist = to_alist + let merge = merge + let merge_into = merge_into + let keys = keys + let data = data + let filter_keys_inplace = filter_keys_inplace + let filter_inplace = filter_inplace + let filteri_inplace = filteri_inplace + let map_inplace = map_inplace + let mapi_inplace = mapi_inplace + let filter_map_inplace = filter_map_inplace + let filter_mapi_inplace = filter_mapi_inplace + let equal = equal + let similar = similar + let incr = incr + let decr = decr + let sexp_of_key = sexp_of_key +end + +module Creators (Key : sig + type 'a t + + val hashable : 'a t Hashable.t +end) : sig + type ('a, 'b) t_ = ('a Key.t, 'b) t + + val t_of_sexp : (Sexp.t -> 'a Key.t) -> (Sexp.t -> 'b) -> Sexp.t -> ('a, 'b) t_ + + include + Creators_generic + with type ('a, 'b) t := ('a, 'b) t_ + with type 'a key := 'a Key.t + with type ('key, 'data, 'a) create_options := + ('key, 'data, 'a) create_options_without_first_class_module +end = struct + let hashable = Key.hashable + + type ('a, 'b) t_ = ('a Key.t, 'b) t + + let create ?growth_allowed ?size () = create ?growth_allowed ?size ~hashable () + let of_alist ?growth_allowed ?size l = of_alist ?growth_allowed ~hashable ?size l + + let of_alist_report_all_dups ?growth_allowed ?size l = + of_alist_report_all_dups ?growth_allowed ~hashable ?size l + ;; + + let of_alist_or_error ?growth_allowed ?size l = + of_alist_or_error ?growth_allowed ~hashable ?size l + ;; + + let of_alist_exn ?growth_allowed ?size l = + of_alist_exn ?growth_allowed ~hashable ?size l + ;; + + let t_of_sexp k_of_sexp d_of_sexp sexp = t_of_sexp ~hashable k_of_sexp d_of_sexp sexp + + let of_alist_multi ?growth_allowed ?size l = + of_alist_multi ?growth_allowed ~hashable ?size l + ;; + + let create_mapped ?growth_allowed ?size ~get_key ~get_data l = + create_mapped ?growth_allowed ~hashable ?size ~get_key ~get_data l + ;; + + let create_with_key ?growth_allowed ?size ~get_key l = + create_with_key ?growth_allowed ~hashable ?size ~get_key l + ;; + + let create_with_key_or_error ?growth_allowed ?size ~get_key l = + create_with_key_or_error ?growth_allowed ~hashable ?size ~get_key l + ;; + + let create_with_key_exn ?growth_allowed ?size ~get_key l = + create_with_key_exn ?growth_allowed ~hashable ?size ~get_key l + ;; + + let group ?growth_allowed ?size ~get_key ~get_data ~combine l = + group ?growth_allowed ~hashable ?size ~get_key ~get_data ~combine l + ;; +end + +module Poly = struct + type nonrec ('a, 'b) t = ('a, 'b) t + type 'a key = 'a + + let hashable = Hashable.poly + let capacity = capacity + + include Creators (struct + type 'a t = 'a + + let hashable = hashable + end) + + include Accessors + + let sexp_of_t = sexp_of_t + let t_sexp_grammar = t_sexp_grammar +end + +module Private = struct + module type Creators_generic = Creators_generic + module type Hashable = Hashable.Hashable + + type nonrec ('key, 'data, 'z) create_options_without_first_class_module = + ('key, 'data, 'z) create_options_without_first_class_module + + let hashable t = t.hashable +end + +let create ?growth_allowed ?size m = + create ~hashable:(Hashable.of_key m) ?growth_allowed ?size () +;; + +let of_alist ?growth_allowed ?size m l = + of_alist ~hashable:(Hashable.of_key m) ?growth_allowed ?size l +;; + +let of_alist_report_all_dups ?growth_allowed ?size m l = + of_alist_report_all_dups ~hashable:(Hashable.of_key m) ?growth_allowed ?size l +;; + +let of_alist_or_error ?growth_allowed ?size m l = + of_alist_or_error ~hashable:(Hashable.of_key m) ?growth_allowed ?size l +;; + +let of_alist_exn ?growth_allowed ?size m l = + of_alist_exn ~hashable:(Hashable.of_key m) ?growth_allowed ?size l +;; + +let of_alist_multi ?growth_allowed ?size m l = + of_alist_multi ~hashable:(Hashable.of_key m) ?growth_allowed ?size l +;; + +let create_mapped ?growth_allowed ?size m ~get_key ~get_data l = + create_mapped ~hashable:(Hashable.of_key m) ?growth_allowed ?size ~get_key ~get_data l +;; + +let create_with_key ?growth_allowed ?size m ~get_key l = + create_with_key ~hashable:(Hashable.of_key m) ?growth_allowed ?size ~get_key l +;; + +let create_with_key_or_error ?growth_allowed ?size m ~get_key l = + create_with_key_or_error ~hashable:(Hashable.of_key m) ?growth_allowed ?size ~get_key l +;; + +let create_with_key_exn ?growth_allowed ?size m ~get_key l = + create_with_key_exn ~hashable:(Hashable.of_key m) ?growth_allowed ?size ~get_key l +;; + +let group ?growth_allowed ?size m ~get_key ~get_data ~combine l = + group ~hashable:(Hashable.of_key m) ?growth_allowed ?size ~get_key ~get_data ~combine l +;; + +let hashable_s t = Hashable.to_key t.hashable + +module M (K : T.T) = struct + type nonrec 'v t = (K.t, 'v) t +end + +module type Sexp_of_m = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end + +module type M_of_sexp = sig + type t [@@deriving_inline of_sexp] + + val t_of_sexp : Sexplib0.Sexp.t -> t + + [@@@end] + + include Key.S with type t := t +end + +module type M_sexp_grammar = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] +end + +module type Equal_m = sig end + +let sexp_of_m__t (type k) (module K : Sexp_of_m with type t = k) sexp_of_v t = + sexp_of_t K.sexp_of_t sexp_of_v t +;; + +let m__t_of_sexp (type k) (module K : M_of_sexp with type t = k) v_of_sexp sexp = + t_of_sexp ~hashable:(Hashable.of_key (module K)) K.t_of_sexp v_of_sexp sexp +;; + +let m__t_sexp_grammar (type k) (module K : M_sexp_grammar with type t = k) v_grammar = + t_sexp_grammar K.t_sexp_grammar v_grammar +;; + +let equal_m__t (module _ : Equal_m) equal_v t1 t2 = equal equal_v t1 t2 diff --git a/unikernel/duniverse/base/src/hashtbl.mli b/unikernel/duniverse/base/src/hashtbl.mli new file mode 100644 index 00000000..e011dea0 --- /dev/null +++ b/unikernel/duniverse/base/src/hashtbl.mli @@ -0,0 +1 @@ +include Hashtbl_intf.Hashtbl (** @inline *) diff --git a/unikernel/duniverse/base/src/hashtbl_intf.ml b/unikernel/duniverse/base/src/hashtbl_intf.ml new file mode 100644 index 00000000..adb781af --- /dev/null +++ b/unikernel/duniverse/base/src/hashtbl_intf.ml @@ -0,0 +1,870 @@ +open! Import + +(** @canonical Base.Hashtbl.Key *) +module Key = struct + module type S = sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + (** Two [t]s that [compare] equal must have equal hashes for the hashtable + to behave properly. *) + val hash : t -> int + end + + type 'a t = (module S with type t = 'a) +end + +module Merge_into_action = Dictionary_mutable.Merge_into_action + +module type Accessors = sig + (** {2 Accessors} *) + + type ('a, 'b) t + type 'a key + + (** @inline *) + include + Dictionary_mutable.Accessors + with type 'key key := 'key key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, _, _, _) accessor := 'fn + + val sexp_of_key : ('a, _) t -> 'a key -> Sexp.t + val clear : (_, _) t -> unit + val copy : ('a, 'b) t -> ('a, 'b) t + + (** Attempting to modify ([set], [remove], etc.) the hashtable during iteration ([fold], + [iter], [iter_keys], [iteri]) will raise an exception. *) + val fold : ('a, 'b) t -> init:'acc -> f:(key:'a key -> data:'b -> 'acc -> 'acc) -> 'acc + + val iter_keys : ('a, _) t -> f:('a key -> unit) -> unit + val iter : (_, 'b) t -> f:('b -> unit) -> unit + + (** Iterates over both keys and values. + + Example: + + {v + let h = Hashtbl.of_alist_exn (module Int) [(1, 4); (5, 6)] in + Hashtbl.iteri h ~f:(fun ~key ~data -> + print_endline (Printf.sprintf "%d-%d" key data));; + 1-4 + 5-6 + - : unit = () + v} *) + val iteri : ('a, 'b) t -> f:(key:'a key -> data:'b -> unit) -> unit + + val existsi : ('a, 'b) t -> f:(key:'a key -> data:'b -> bool) -> bool + val exists : (_, 'b) t -> f:('b -> bool) -> bool + val for_alli : ('a, 'b) t -> f:(key:'a key -> data:'b -> bool) -> bool + val for_all : (_, 'b) t -> f:('b -> bool) -> bool + val counti : ('a, 'b) t -> f:(key:'a key -> data:'b -> bool) -> int + val count : (_, 'b) t -> f:('b -> bool) -> int + val length : (_, _) t -> int + val capacity : _ t -> int + val is_empty : (_, _) t -> bool + val mem : ('a, _) t -> 'a key -> bool + val remove : ('a, _) t -> 'a key -> unit + + (** Choose an arbitrary key/value pair of a hash table. Returns [None] if [t] is empty. + + The choice is deterministic. Calling [choose] multiple times on the same table + returns the same key/value pair, so long as the table is not mutated in between. + Beyond determinism, no guarantees are made about how the choice is made. Expect + bias toward certain hash values. + + This hash bias can lead to degenerate performance in some cases, such as clearing + a hash table using repeated [choose] and [remove]. At each iteration, finding the + next element may have to scan farther from its initial hash value. *) + val choose : ('a, 'b) t -> ('a key * 'b) option + + (** Like [choose]. Raises if [t] is empty. *) + val choose_exn : ('a, 'b) t -> 'a key * 'b + + (** Chooses a random key/value pair of a hash table. Returns [None] if [t] is empty. + + The choice is distributed uniformly across hash values, rather than across keys + themselves. As a consequence, the closer the keys are to evenly spaced out in the + table, the closer this function will be to a uniform choice of keys. + + This function may be preferable to [choose] when nondeterministic choice is + acceptable, and bias toward certain hash values is undesirable. *) + val choose_randomly + : ?random_state:Random.State.t (** default: [Random.State.default] *) + -> ('a, 'b) t + -> ('a key * 'b) option + + (** Like [choose_randomly]. Raises if [t] is empty. *) + val choose_randomly_exn + : ?random_state:Random.State.t (** default: [Random.State.default] *) + -> ('a, 'b) t + -> 'a key * 'b + + (** Sets the given [key] to [data]. *) + val set : ('a, 'b) t -> key:'a key -> data:'b -> unit + + (** [add] and [add_exn] leave the table unchanged if the key was already present. *) + val add : ('a, 'b) t -> key:'a key -> data:'b -> [ `Ok | `Duplicate ] + + val add_exn : ('a, 'b) t -> key:'a key -> data:'b -> unit + + (** [change t key ~f] changes [t]'s value for [key] to be [f (find t key)]. *) + val change : ('a, 'b) t -> 'a key -> f:('b option -> 'b option) -> unit + + (** [update t key ~f] is [change t key ~f:(fun o -> Some (f o))]. *) + val update : ('a, 'b) t -> 'a key -> f:('b option -> 'b) -> unit + + (** [update_and_return t key ~f] is [update], but returns the result of [f o]. *) + val update_and_return : ('a, 'b) t -> 'a key -> f:('b option -> 'b) -> 'b + + (** [map t f] returns a new table with values replaced by the result of applying [f] + to the current values. + + Example: + + {v + let h = Hashtbl.of_alist_exn (module Int) [(1, 4); (5, 6)] in + let h' = Hashtbl.map h ~f:(local_ (fun x -> x * 2)) in + Hashtbl.to_alist h';; + - : (int * int) list = [(5, 12); (1, 8)] + v} *) + val map : ('a, 'b) t -> f:('b -> 'c) -> ('a, 'c) t + + (** Like [map], but the function [f] takes both key and data as arguments. *) + val mapi : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'c) -> ('a, 'c) t + + (** Returns a new table by filtering the given table's values by [f]: the keys for which + [f] applied to the current value returns [Some] are kept, and those for which it + returns [None] are discarded. + + Example: + + {v + let h = Hashtbl.of_alist_exn (module Int) [(1, 4); (5, 6)] in + Hashtbl.filter_map h ~f:(local_ (fun x -> if x > 5 then Some x else None)) + |> Hashtbl.to_alist;; + - : (int * int) list = [(5, 6)] + v} *) + val filter_map : ('a, 'b) t -> f:('b -> 'c option) -> ('a, 'c) t + + (** Like [filter_map], but the function [f] takes both key and data as arguments. *) + val filter_mapi : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'c option) -> ('a, 'c) t + + val filter_keys : ('a, 'b) t -> f:('a key -> bool) -> ('a, 'b) t + val filter : ('a, 'b) t -> f:('b -> bool) -> ('a, 'b) t + val filteri : ('a, 'b) t -> f:(key:'a key -> data:'b -> bool) -> ('a, 'b) t + + (** Returns new tables with bound values partitioned by [f] applied to the bound + values. *) + val partition_map : ('a, 'b) t -> f:('b -> ('c, 'd) Either.t) -> ('a, 'c) t * ('a, 'd) t + + (** Like [partition_map], but the function [f] takes both key and data as arguments. *) + val partition_mapi + : ('a, 'b) t + -> f:(key:'a key -> data:'b -> ('c, 'd) Either.t) + -> ('a, 'c) t * ('a, 'd) t + + (** Returns a pair of tables [(t1, t2)], where [t1] contains all the elements of the + initial table which satisfy the predicate [f], and [t2] contains the rest. *) + val partition_tf : ('a, 'b) t -> f:('b -> bool) -> ('a, 'b) t * ('a, 'b) t + + (** Like [partition_tf], but the function [f] takes both key and data as arguments. *) + val partitioni_tf + : ('a, 'b) t + -> f:(key:'a key -> data:'b -> bool) + -> ('a, 'b) t * ('a, 'b) t + + (** [find_or_add t k ~default] returns the data associated with key [k] if it is in the + table [t], and otherwise assigns [k] the value returned by [default ()]. *) + val find_or_add : ('a, 'b) t -> 'a key -> default:(unit -> 'b) -> 'b + + (** Like [find_or_add] but [default] takes the key as an argument. *) + val findi_or_add : ('a, 'b) t -> 'a key -> default:('a key -> 'b) -> 'b + + (** [find t k] returns [Some] (the current binding) of [k] in [t], or [None] if no such + binding exists. *) + val find : ('a, 'b) t -> 'a key -> 'b option + + (** [find_exn t k] returns the current binding of [k] in [t], or raises [Stdlib.Not_found] + or [Not_found_s] if no such binding exists. *) + val find_exn : ('a, 'b) t -> 'a key -> 'b + + (** [find_and_call t k ~if_found ~if_not_found] + + is equivalent to: + + [match find t k with Some v -> if_found v | None -> if_not_found k] + + except that it doesn't allocate the option. *) + val find_and_call + : ('a, 'b) t + -> 'a key + -> if_found:('b -> 'c) + -> if_not_found:('a key -> 'c) + -> 'c + + (** Just like [find_and_call], but takes an extra argument which is passed to [if_found] + and [if_not_found], so that the client code can avoid allocating closures or using + refs to pass this additional information. This function is only useful in code + which tries to minimize heap allocation. *) + val find_and_call1 + : ('a, 'b) t + -> 'a key + -> a:'d + -> if_found:('b -> 'd -> 'c) + -> if_not_found:('a key -> 'd -> 'c) + -> 'c + + val find_and_call2 + : ('a, 'b) t + -> 'a key + -> a:'d + -> b:'e + -> if_found:('b -> 'd -> 'e -> 'c) + -> if_not_found:('a key -> 'd -> 'e -> 'c) + -> 'c + + val findi_and_call + : ('a, 'b) t + -> 'a key + -> if_found:(key:'a key -> data:'b -> 'c) + -> if_not_found:('a key -> 'c) + -> 'c + + val findi_and_call1 + : ('a, 'b) t + -> 'a key + -> a:'d + -> if_found:(key:'a key -> data:'b -> 'd -> 'c) + -> if_not_found:('a key -> 'd -> 'c) + -> 'c + + val findi_and_call2 + : ('a, 'b) t + -> 'a key + -> a:'d + -> b:'e + -> if_found:(key:'a key -> data:'b -> 'd -> 'e -> 'c) + -> if_not_found:('a key -> 'd -> 'e -> 'c) + -> 'c + + (** [find_and_remove t k] returns Some (the current binding) of k in t and removes it, + or None is no such binding exists. *) + val find_and_remove : ('a, 'b) t -> 'a key -> 'b option + + (** Merges two hashtables. + + The result of [merge f h1 h2] has as keys the set of all [k] in the union of the + sets of keys of [h1] and [h2] for which [d(k)] is not None, where: + + d(k) = + - [f ~key:k (`Left d1)] + if [k] in [h1] maps to d1, and [h2] does not have data for [k]; + + - [f ~key:k (`Right d2)] + if [k] in [h2] maps to d2, and [h1] does not have data for [k]; + + - [f ~key:k (`Both (d1, d2))] + otherwise, where [k] in [h1] maps to [d1] and [k] in [h2] maps to [d2]. + + Each key [k] is mapped to a single piece of data [x], where [d(k) = Some x]. + + Example: + + {v + let h1 = Hashtbl.of_alist_exn (module Int) [(1, 5); (2, 3232)] in + let h2 = Hashtbl.of_alist_exn (module Int) [(1, 3)] in + Hashtbl.merge h1 h2 ~f:(fun ~key:_ -> function + | `Left x -> Some (`Left x) + | `Right x -> Some (`Right x) + | `Both (x, y) -> if x=y then None else Some (`Both (x,y)) + ) |> Hashtbl.to_alist;; + - : (int * [> `Both of int * int | `Left of int | `Right of int ]) list = + [(2, `Left 3232); (1, `Both (5, 3))] + v} *) + val merge + : ('k, 'a) t + -> ('k, 'b) t + -> f:(key:'k key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) + -> ('k, 'c) t + + (** Every [key] in [src] will be removed or set in [dst] according to the return value + of [f]. *) + val merge_into + : src:('k, 'a) t + -> dst:('k, 'b) t + -> f:(key:'k key -> 'a -> 'b option -> 'b Dictionary_mutable.Merge_into_action.t) + -> unit + + (** Returns the list of all keys for given hashtable. *) + val keys : ('a, _) t -> 'a key list + + (** Returns the list of all data for given hashtable. *) + val data : (_, 'b) t -> 'b list + + (** [filter_inplace t ~f] removes all the elements from [t] that don't satisfy [f]. *) + val filter_keys_inplace : ('a, _) t -> f:('a key -> bool) -> unit + + val filter_inplace : (_, 'b) t -> f:('b -> bool) -> unit + val filteri_inplace : ('a, 'b) t -> f:(key:'a key -> data:'b -> bool) -> unit + + (** [map_inplace t ~f] applies [f] to all elements in [t], transforming them in + place. *) + val map_inplace : (_, 'b) t -> f:('b -> 'b) -> unit + + val mapi_inplace : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'b) -> unit + + (** [filter_map_inplace] combines the effects of [map_inplace] and [filter_inplace]. *) + val filter_map_inplace : (_, 'b) t -> f:('b -> 'b option) -> unit + + val filter_mapi_inplace : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'b option) -> unit + + (** [equal f t1 t2] and [similar f t1 t2] both return true iff [t1] and [t2] have the + same keys and for all keys [k], [f (find_exn t1 k) (find_exn t2 k)]. [equal] and + [similar] only differ in their types. *) + val equal : ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + + val similar : ('b1 -> 'b2 -> bool) -> ('a, 'b1) t -> ('a, 'b2) t -> bool + + (** Returns the list of all (key, data) pairs for given hashtable. *) + val to_alist : ('a, 'b) t -> ('a key * 'b) list + + (** [remove_if_zero]'s default is [false]. *) + val incr : ?by:int -> ?remove_if_zero:bool -> ('a, int) t -> 'a key -> unit + + val decr : ?by:int -> ?remove_if_zero:bool -> ('a, int) t -> 'a key -> unit +end + +module type Multi = sig + type ('a, 'b) t + type 'a key + + (** [add_multi t ~key ~data] if [key] is present in the table then cons + [data] on the list, otherwise add [key] with a single element list. *) + val add_multi : ('a, 'b list) t -> key:'a key -> data:'b -> unit + + (** [remove_multi t key] updates the table, removing the head of the list bound to + [key]. If the list has only one element (or is empty) then the binding is + removed. *) + val remove_multi : ('a, _ list) t -> 'a key -> unit + + (** [find_multi t key] returns the empty list if [key] is not present in the table, + returns [t]'s values for [key] otherwise. *) + val find_multi : ('a, 'b list) t -> 'a key -> 'b list +end + +type ('key, 'data, 'z) create_options = + ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'key Key.t + -> 'z + +type ('key, 'data, 'z) create_options_without_first_class_module = + ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'z + +module type Creators_generic = sig + type ('a, 'b) t + type 'a key + type ('key, 'data, 'z) create_options + + (** @inline *) + include + Dictionary_mutable.Creators + with type 'key key := 'key key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) creator := ('key key, 'data, 'fn) create_options + + val create : ('a key, 'b, unit -> ('a, 'b) t) create_options + + val of_alist + : ( 'a key + , 'b + , ('a key * 'b) list -> [ `Ok of ('a, 'b) t | `Duplicate_key of 'a key ] ) + create_options + + val of_alist_report_all_dups + : ( 'a key + , 'b + , ('a key * 'b) list -> [ `Ok of ('a, 'b) t | `Duplicate_keys of 'a key list ] ) + create_options + + val of_alist_or_error + : ('a key, 'b, ('a key * 'b) list -> ('a, 'b) t Or_error.t) create_options + + val of_alist_exn : ('a key, 'b, ('a key * 'b) list -> ('a, 'b) t) create_options + + val of_alist_multi + : ('a key, 'b list, ('a key * 'b) list -> ('a, 'b list) t) create_options + + (** {[ create_mapped get_key get_data [x1,...,xn] + = of_alist [get_key x1, get_data x1; ...; get_key xn, get_data xn] ]} *) + val create_mapped + : ( 'a key + , 'b + , get_key:('r -> 'a key) + -> get_data:('r -> 'b) + -> 'r list + -> [ `Ok of ('a, 'b) t | `Duplicate_keys of 'a key list ] ) + create_options + + (** {[ create_with_key ~get_key [x1,...,xn] + = of_alist [get_key x1, x1; ...; get_key xn, xn] ]} *) + val create_with_key + : ( 'a key + , 'r + , get_key:('r -> 'a key) + -> 'r list + -> [ `Ok of ('a, 'r) t | `Duplicate_keys of 'a key list ] ) + create_options + + val create_with_key_or_error + : ( 'a key + , 'r + , get_key:('r -> 'a key) -> 'r list -> ('a, 'r) t Or_error.t ) + create_options + + val create_with_key_exn + : ('a key, 'r, get_key:('r -> 'a key) -> 'r list -> ('a, 'r) t) create_options + + val group + : ( 'a key + , 'b + , get_key:('r -> 'a key) + -> get_data:('r -> 'b) + -> combine:('b -> 'b -> 'b) + -> 'r list + -> ('a, 'b) t ) + create_options +end + +module type Creators = sig + type ('a, 'b) t + + (** {2 Creators} *) + + (** The module you pass to [create] must have a type that is hashable, sexpable, and + comparable. + + Example: + + {v + Hashtbl.create (module Int);; + - : (int, '_a) Hashtbl.t = ;; + v} *) + val create + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> ('a, 'b) t + + (** Example: + + {v + Hashtbl.of_alist (module Int) [(3, "something"); (2, "whatever")] + - : [ `Duplicate_key of int | `Ok of (int, string) Hashtbl.t ] = `Ok + v} *) + val of_alist + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> ('a * 'b) list + -> [ `Ok of ('a, 'b) t | `Duplicate_key of 'a ] + + (** Whereas [of_alist] will report [Duplicate_key] no matter how many dups there are in + your list, [of_alist_report_all_dups] will report each and every duplicate entry. + + For example: + + {v + Hashtbl.of_alist (module Int) [(1, "foo"); (1, "bar"); (2, "foo"); (2, "bar")];; + - : [ `Duplicate_key of int | `Ok of (int, string) Hashtbl.t ] = `Duplicate_key 1 + + Hashtbl.of_alist_report_all_dups (module Int) [(1, "foo"); (1, "bar"); (2, "foo"); (2, "bar")];; + - : [ `Duplicate_keys of int list | `Ok of (int, string) Hashtbl.t ] = `Duplicate_keys [1; 2] + v} *) + val of_alist_report_all_dups + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> ('a * 'b) list + -> [ `Ok of ('a, 'b) t | `Duplicate_keys of 'a list ] + + val of_alist_or_error + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> ('a * 'b) list + -> ('a, 'b) t Or_error.t + + val of_alist_exn + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> ('a * 'b) list + -> ('a, 'b) t + + (** Creates a {{!Multi} "multi"} hashtable, i.e., a hashtable where each key points to a + list potentially containing multiple values. So instead of short-circuiting with a + [`Duplicate_key] variant on duplicates, as in [of_alist], [of_alist_multi] folds + those values into a list for the given key: + + {v + let h = Hashtbl.of_alist_multi (module Int) [(1, "a"); (1, "b"); (2, "c"); (2, "d")];; + val h : (int, string list) Hashtbl.t = + + Hashtbl.find_exn h 1;; + - : string list = ["b"; "a"] + v} *) + val of_alist_multi + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> ('a * 'b) list + -> ('a, 'b list) t + + (** Applies the [get_key] and [get_data] functions to the ['r list] to create the + initial keys and values, respectively, for the new hashtable. + + {[ create_mapped get_key get_data [x1;...;xn] + = of_alist [get_key x1, get_data x1; ...; get_key xn, get_data xn] + ]} + + Example: + + {v + let h = + Hashtbl.create_mapped (module Int) + ~get_key:(local_ (fun x -> x)) + ~get_data:(local_ (fun x -> x + 1)) + [1; 2; 3];; + val h : [ `Duplicate_keys of int list | `Ok of (int, int) Hashtbl.t ] = `Ok + + let h = + match h with + | `Ok x -> x + | `Duplicate_keys _ -> failwith "" + in + Hashtbl.find_exn h 1;; + - : int = 2 + v} *) + val create_mapped + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> get_key:('r -> 'a) + -> get_data:('r -> 'b) + -> 'r list + -> [ `Ok of ('a, 'b) t | `Duplicate_keys of 'a list ] + + (** {[ create_with_key ~get_key [x1;...;xn] + = of_alist [get_key x1, x1; ...; get_key xn, xn] ]} *) + val create_with_key + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> get_key:('r -> 'a) + -> 'r list + -> [ `Ok of ('a, 'r) t | `Duplicate_keys of 'a list ] + + val create_with_key_or_error + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> get_key:('r -> 'a) + -> 'r list + -> ('a, 'r) t Or_error.t + + val create_with_key_exn + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> get_key:('r -> 'a) + -> 'r list + -> ('a, 'r) t + + (** Like [create_mapped], applies the [get_key] and [get_data] functions to the ['r + list] to create the initial keys and values, respectively, for the new hashtable -- + and then, like [add_multi], folds together values belonging to the same keys. Here, + though, the function used for the folding is given by [combine] (instead of just + being a [cons]). + + Example: + + {v + Hashtbl.group (module Int) + ~get_key:(local_ (fun x -> x / 2)) + ~get_data:(local_ (fun x -> x)) + ~combine:(local_ (fun x y -> x * y)) + [ 1; 2; 3; 4] + |> Hashtbl.to_alist;; + - : (int * int) list = [(2, 4); (1, 6); (0, 1)] + v} *) + val group + : ?growth_allowed:bool (** defaults to [true] *) + -> ?size:int (** initial size -- default 0 *) + -> 'a Key.t + -> get_key:('r -> 'a) + -> get_data:('r -> 'b) + -> combine:('b -> 'b -> 'b) + -> 'r list + -> ('a, 'b) t +end + +module type S_without_submodules = sig + val hash : 'a -> int + val hash_param : int -> int -> 'a -> int + + type (!'a, !'b) t + + (** We provide a [sexp_of_t] but not a [t_of_sexp] for this type because one needs to be + explicit about the hash and comparison functions used when creating a hashtable. + Note that [Hashtbl.Poly.t] does have [[@@deriving sexp]], and uses OCaml's built-in + polymorphic comparison and and polymorphic hashing. *) + val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b) t -> Sexp.t + + include Creators with type ('a, 'b) t := ('a, 'b) t (** @inline *) + + include Accessors with type ('a, 'b) t := ('a, 'b) t with type 'a key = 'a + (** @inline *) + + include Multi with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a key + (** @inline *) + + val hashable_s : ('key, _) t -> 'key Key.t + + include Invariant.S2 with type ('a, 'b) t := ('a, 'b) t +end + +module type S_poly = sig + type ('a, 'b) t [@@deriving_inline sexp, sexp_grammar] + + include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t + + val t_sexp_grammar + : 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t + + [@@@end] + + val hashable : 'a Hashable.t + + include Invariant.S2 with type ('a, 'b) t := ('a, 'b) t + + include + Creators_generic + with type ('a, 'b) t := ('a, 'b) t + with type 'a key = 'a + with type ('key, 'data, 'z) create_options := + ('key, 'data, 'z) create_options_without_first_class_module + + include Accessors with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a key + include Multi with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a key +end + +module type For_deriving = sig + type ('k, 'v) t + + module type Sexp_of_m = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + end + + module type M_of_sexp = sig + type t [@@deriving_inline of_sexp] + + val t_of_sexp : Sexplib0.Sexp.t -> t + + [@@@end] + + include Key.S with type t := t + end + + module type M_sexp_grammar = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + end + + module type Equal_m = sig end + + val sexp_of_m__t + : (module Sexp_of_m with type t = 'k) + -> ('v -> Sexp.t) + -> ('k, 'v) t + -> Sexp.t + + val m__t_of_sexp + : (module M_of_sexp with type t = 'k) + -> (Sexp.t -> 'v) + -> Sexp.t + -> ('k, 'v) t + + val m__t_sexp_grammar + : (module M_sexp_grammar with type t = 'k) + -> 'v Sexplib0.Sexp_grammar.t + -> ('k, 'v) t Sexplib0.Sexp_grammar.t + + val equal_m__t + : (module Equal_m) + -> ('v -> 'v -> bool) + -> ('k, 'v) t + -> ('k, 'v) t + -> bool +end + +module type Hashtbl = sig + (** A hash table is a mutable data structure implementing a map between keys and values. + It supports constant-time lookup and in-place modification. + + {1 Usage} + + As a simple example, we'll create a hash table with string keys using the + {{!create}[create]} constructor, which expects a module defining the key's type: + + {[ + let h = Hashtbl.create (module String);; + val h : (string, '_a) Hashtbl.t = + ]} + + We can set the values of individual keys with {{!set}[set]}. If the key already has + a value, it will be overwritten. + + {v + Hashtbl.set h ~key:"foo" ~data:5;; + - : unit = () + + Hashtbl.set h ~key:"foo" ~data:6;; + - : unit = () + + Hashtbl.set h ~key:"bar" ~data:6;; + - : unit = () + v} + + We can access values by key, or dump all of the hash table's data: + + {v + Hashtbl.find h "foo";; + - : int option = Some 6 + + Hashtbl.find_exn h "foo";; + - : int = 6 + + Hashtbl.to_alist h;; + - : (string * int) list = [("foo", 6); ("bar", 6)] + v} + + {{!change}[change]} lets us change a key's value by applying the given function: + + {v + Hashtbl.change h "foo" (fun x -> + match x with + | Some x -> Some (x * 2) + | None -> None + );; + - : unit = () + + Hashtbl.to_alist h;; + - : (string * int) list = [("foo", 12); ("bar", 6)] + v} + + + We can use {{!merge}[merge]} to merge two hashtables with fine-grained control over + how we choose values when a key is present in the first ("left") hashtable, the + second ("right"), or both. Here, we'll cons the values when both hashtables have a + key: + + {v + let h1 = Hashtbl.of_alist_exn (module Int) [(1, 5); (2, 3232)] in + let h2 = Hashtbl.of_alist_exn (module Int) [(1, 3)] in + Hashtbl.merge h1 h2 ~f:(fun ~key:_ -> function + | `Left x -> Some (`Left x) + | `Right x -> Some (`Right x) + | `Both (x, y) -> if x=y then None else Some (`Both (x,y)) + ) |> Hashtbl.to_alist;; + - : (int * [> `Both of int * int | `Left of int | `Right of int ]) list = + [(2, `Left 3232); (1, `Both (5, 3))] + v} + + {1 Interface} *) + + include S_without_submodules (** @inline *) + + module type Accessors = Accessors + module type Creators = Creators + module type Multi = Multi + module type S_poly = S_poly + module type S_without_submodules = S_without_submodules + module type For_deriving = For_deriving + + module Key = Key + module Merge_into_action = Merge_into_action + + type nonrec ('key, 'data, 'z) create_options = ('key, 'data, 'z) create_options + + module Creators (Key : sig + type 'a t + + val hashable : 'a t Hashable.t + end) : sig + type ('a, 'b) t_ = ('a Key.t, 'b) t + + val t_of_sexp : (Sexp.t -> 'a Key.t) -> (Sexp.t -> 'b) -> Sexp.t -> ('a, 'b) t_ + + include + Creators_generic + with type ('a, 'b) t := ('a, 'b) t_ + with type 'a key := 'a Key.t + with type ('key, 'data, 'a) create_options := + ('key, 'data, 'a) create_options_without_first_class_module + end + + module Poly : S_poly with type ('a, 'b) t = ('a, 'b) t + + (** [M] is meant to be used in combination with OCaml applicative functor types: + + {[ + type string_to_int_table = int Hashtbl.M(String).t + ]} + + which stands for: + + {[ + type string_to_int_table = (String.t, int) Hashtbl.t + ]} + + The point is that [int Hashtbl.M(String).t] supports deriving, whereas the second + syntax doesn't (because [t_of_sexp] doesn't know what comparison/hash function to + use). *) + module M (K : T.T) : sig + type nonrec 'v t = (K.t, 'v) t + end + + include For_deriving with type ('a, 'b) t := ('a, 'b) t + + (**/**) + + (*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) + module Private : sig + module type Creators_generic = Creators_generic + + type nonrec ('key, 'data, 'z) create_options_without_first_class_module = + ('key, 'data, 'z) create_options_without_first_class_module + + val hashable : ('key, _) t -> 'key Hashable.t + end +end diff --git a/unikernel/duniverse/base/src/hex_lexer.mli b/unikernel/duniverse/base/src/hex_lexer.mli new file mode 100644 index 00000000..8b80d13f --- /dev/null +++ b/unikernel/duniverse/base/src/hex_lexer.mli @@ -0,0 +1,5 @@ +type result = + | Neg of string + | Pos of string + +val parse_hex : Lexing.lexbuf -> result diff --git a/unikernel/duniverse/base/src/hex_lexer.mll b/unikernel/duniverse/base/src/hex_lexer.mll new file mode 100644 index 00000000..0551e8d6 --- /dev/null +++ b/unikernel/duniverse/base/src/hex_lexer.mll @@ -0,0 +1,15 @@ +{ +type result = +| Neg of string +| Pos of string +} + +let hex_digit = ['0' - '9' 'A' - 'F' 'a' - 'f'] +let body = (hex_digit (hex_digit | '_')*) as body +let body_with_suffix = '0' ['X' 'x'] body +let pos = body_with_suffix +let neg = '-' body_with_suffix + +rule parse_hex = parse +| neg { Neg body } +| pos { Pos body } diff --git a/unikernel/duniverse/base/src/identifiable.ml b/unikernel/duniverse/base/src/identifiable.ml new file mode 100644 index 00000000..653e4ace --- /dev/null +++ b/unikernel/duniverse/base/src/identifiable.ml @@ -0,0 +1,18 @@ +open! Import +include Identifiable_intf + +module Make (T : Arg) = struct + include T + include Comparable.Make (T) + include Pretty_printer.Register (T) + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } +end + +module Make_using_comparator (T : Arg_with_comparator) = struct + include T + include Comparable.Make_using_comparator (T) + include Pretty_printer.Register (T) + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } +end diff --git a/unikernel/duniverse/base/src/identifiable.mli b/unikernel/duniverse/base/src/identifiable.mli new file mode 100644 index 00000000..ea3eb499 --- /dev/null +++ b/unikernel/duniverse/base/src/identifiable.mli @@ -0,0 +1 @@ +include Identifiable_intf.Identifiable (** @inline *) diff --git a/unikernel/duniverse/base/src/identifiable_intf.ml b/unikernel/duniverse/base/src/identifiable_intf.ml new file mode 100644 index 00000000..a33e34b2 --- /dev/null +++ b/unikernel/duniverse/base/src/identifiable_intf.ml @@ -0,0 +1,71 @@ +(** A signature combining functionality that is commonly used for types that are intended + to act as names or identifiers. + + Modules that satisfy [Identifiable] can be printed and parsed (both through string and + s-expression converters) and can be used in hash-based and comparison-based + containers (e.g., hashtables and maps). + + This module also provides functors for conveniently constructing identifiable + modules. *) + +open! Import + +module type Arg = sig + type t [@@deriving_inline compare, hash, sexp] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + include Sexplib0.Sexpable.S with type t := t + + [@@@end] + + include Stringable.S with type t := t + + (** For registering the pretty printer. *) + val module_name : string +end + +module type Arg_with_comparator = sig + include Arg + include Comparator.S with type t := t +end + +module type S = sig + type t [@@deriving_inline hash, sexp] + + include Ppx_hash_lib.Hashable.S with type t := t + include Sexplib0.Sexpable.S with type t := t + + [@@@end] + + include Stringable.S with type t := t + include Comparable.S with type t := t + include Pretty_printer.S with type t := t + + val hashable : t Hashable.t +end + +module type Identifiable = sig + module type Arg = Arg + module type Arg_with_comparator = Arg_with_comparator + module type S = S + + (** Used for making an Identifiable module. Here's an example. + + {[ + module Id = struct + module T = struct + type t = A | B [@@deriving compare, hash, sexp] + let of_string s = t_of_sexp (sexp_of_string s) + let to_string t = string_of_sexp (sexp_of_t t) + let module_name = "My_library.Id" + end + include T + include Identifiable.Make (T) + end + ]} *) + module Make (M : Arg) : S with type t := M.t + + module Make_using_comparator (M : Arg_with_comparator) : + S with type t := M.t with type comparator_witness := M.comparator_witness +end diff --git a/unikernel/duniverse/base/src/import.ml b/unikernel/duniverse/base/src/import.ml new file mode 100644 index 00000000..eb1215d3 --- /dev/null +++ b/unikernel/duniverse/base/src/import.ml @@ -0,0 +1,7 @@ +include Import0 +include Sexplib0.Sexp_conv +include Hash.Builtin +include Ppx_compare_lib.Builtin +include Globalize + +exception Not_found_s = Sexp.Not_found_s diff --git a/unikernel/duniverse/base/src/import0.ml b/unikernel/duniverse/base/src/import0.ml new file mode 100644 index 00000000..ab44ed57 --- /dev/null +++ b/unikernel/duniverse/base/src/import0.ml @@ -0,0 +1,369 @@ +(* This module is included in [Import]. It is aimed at modules that define the standard + combinators for [sexp_of], [of_sexp], [compare] and [hash] and are included in + [Import]. *) + +include ( + Shadow_stdlib : + module type of struct + include Shadow_stdlib + end + with type 'a ref := 'a ref + with type ('a, 'b, 'c) format := ('a, 'b, 'c) format + with type ('a, 'b, 'c, 'd) format4 := ('a, 'b, 'c, 'd) format4 + with type ('a, 'b, 'c, 'd, 'e, 'f) format6 := ('a, 'b, 'c, 'd, 'e, 'f) format6 + (* These modules are redefined in Base *) + with module Array := Shadow_stdlib.Array + with module Atomic := Shadow_stdlib.Atomic + with module Bool := Shadow_stdlib.Bool + with module Buffer := Shadow_stdlib.Buffer + with module Bytes := Shadow_stdlib.Bytes + with module Char := Shadow_stdlib.Char + with module Either := Shadow_stdlib.Either + with module Float := Shadow_stdlib.Float + with module Hashtbl := Shadow_stdlib.Hashtbl + with module Int := Shadow_stdlib.Int + with module Int32 := Shadow_stdlib.Int32 + with module Int64 := Shadow_stdlib.Int64 + with module Lazy := Shadow_stdlib.Lazy + with module List := Shadow_stdlib.List + with module Map := Shadow_stdlib.Map + with module Nativeint := Shadow_stdlib.Nativeint + with module Option := Shadow_stdlib.Option + with module Printf := Shadow_stdlib.Printf + with module Queue := Shadow_stdlib.Queue + with module Random := Shadow_stdlib.Random + with module Result := Shadow_stdlib.Result + with module Set := Shadow_stdlib.Set + with module Stack := Shadow_stdlib.Stack + with module String := Shadow_stdlib.String + with module Sys := Shadow_stdlib.Sys + with module Uchar := Shadow_stdlib.Uchar + with module Unit := Shadow_stdlib.Unit) +[@ocaml.warning "-3"] + +type 'a ref = 'a Stdlib.ref = { mutable contents : 'a } + +(* Reshuffle [Stdlib] so that we choose the modules using labels when available. *) +module Stdlib = struct + include Stdlib + include Stdlib.StdLabels + include Stdlib.MoreLabels +end + +external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply" + +(* These need to be declared as an external to get the lazy behavior *) +external ( && ) : (bool[@local_opt]) -> (bool[@local_opt]) -> bool = "%sequand" +external ( || ) : (bool[@local_opt]) -> (bool[@local_opt]) -> bool = "%sequor" +external not : (bool[@local_opt]) -> bool = "%boolnot" + +(* We use [Obj.magic] here as other implementations generate a conditional jump and the + performance difference is noticeable. *) +let bool_to_int (x : bool) : int = Stdlib.Obj.magic x + +(* This needs to be declared as an external for the warnings to work properly *) +external ignore : _ -> unit = "%ignore" + +let ( != ) = Stdlib.( != ) +let ( * ) = Stdlib.( * ) +let ( ** ) = Stdlib.( ** ) +let ( *. ) = Stdlib.( *. ) +let ( + ) = Stdlib.( + ) +let ( +. ) = Stdlib.( +. ) +let ( - ) = Stdlib.( - ) +let ( -. ) = Stdlib.( -. ) +let ( / ) = Stdlib.( / ) +let ( /. ) = Stdlib.( /. ) + +module Poly = Poly0 (** @canonical Base.Poly *) + +module Int_replace_polymorphic_compare = struct + (* Declared as externals so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) + external ( = ) : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%equal" + external ( <> ) : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%notequal" + external ( < ) : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%lessthan" + external ( > ) : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%greaterthan" + external ( <= ) : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%lessequal" + external ( >= ) : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%greaterequal" + external compare : (int[@local_opt]) -> (int[@local_opt]) -> int = "%compare" + external compare__local : (int[@local_opt]) -> (int[@local_opt]) -> int = "%compare" + external equal : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%equal" + external equal__local : (int[@local_opt]) -> (int[@local_opt]) -> bool = "%equal" + + let ascending (x : int) y = compare x y + let descending (x : int) y = compare y x + let max (x : int) y = Bool0.select (x >= y) x y + let min (x : int) y = Bool0.select (x <= y) x y +end + +include Int_replace_polymorphic_compare + +module Int32_replace_polymorphic_compare = struct + let ( < ) (x : Stdlib.Int32.t) y = Poly.( < ) x y + let ( <= ) (x : Stdlib.Int32.t) y = Poly.( <= ) x y + let ( <> ) (x : Stdlib.Int32.t) y = Poly.( <> ) x y + let ( = ) (x : Stdlib.Int32.t) y = Poly.( = ) x y + let ( > ) (x : Stdlib.Int32.t) y = Poly.( > ) x y + let ( >= ) (x : Stdlib.Int32.t) y = Poly.( >= ) x y + let ascending (x : Stdlib.Int32.t) y = Poly.ascending x y + let descending (x : Stdlib.Int32.t) y = Poly.descending x y + let compare (x : Stdlib.Int32.t) y = Poly.compare x y + let compare__local (x : Stdlib.Int32.t) y = Poly.compare x y + let equal (x : Stdlib.Int32.t) y = Poly.equal x y + let equal__local (x : Stdlib.Int32.t) y = Poly.equal x y + let max (x : Stdlib.Int32.t) y = Bool0.select (x >= y) x y + let min (x : Stdlib.Int32.t) y = Bool0.select (x <= y) x y +end + +module Int64_replace_polymorphic_compare = struct + (* Declared as externals so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) + external ( = ) + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%equal" + + external ( <> ) + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%notequal" + + external ( < ) + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%lessthan" + + external ( > ) + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%greaterthan" + + external ( <= ) + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%lessequal" + + external ( >= ) + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%greaterequal" + + external compare + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> int + = "%compare" + + external compare__local + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> int + = "%compare" + + external equal + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%equal" + + external equal__local + : (Stdlib.Int64.t[@local_opt]) + -> (Stdlib.Int64.t[@local_opt]) + -> bool + = "%equal" + + let ascending (x : Stdlib.Int64.t) y = Poly.ascending x y + let descending (x : Stdlib.Int64.t) y = Poly.descending x y + let max (x : Stdlib.Int64.t) y = Bool0.select (x >= y) x y + let min (x : Stdlib.Int64.t) y = Bool0.select (x <= y) x y +end + +module Nativeint_replace_polymorphic_compare = struct + let ( < ) (x : Stdlib.Nativeint.t) y = Poly.( < ) x y + let ( <= ) (x : Stdlib.Nativeint.t) y = Poly.( <= ) x y + let ( <> ) (x : Stdlib.Nativeint.t) y = Poly.( <> ) x y + let ( = ) (x : Stdlib.Nativeint.t) y = Poly.( = ) x y + let ( > ) (x : Stdlib.Nativeint.t) y = Poly.( > ) x y + let ( >= ) (x : Stdlib.Nativeint.t) y = Poly.( >= ) x y + let ascending (x : Stdlib.Nativeint.t) y = Poly.ascending x y + let descending (x : Stdlib.Nativeint.t) y = Poly.descending x y + let compare (x : Stdlib.Nativeint.t) y = Poly.compare x y + let compare__local (x : Stdlib.Nativeint.t) y = Poly.compare x y + let equal (x : Stdlib.Nativeint.t) y = Poly.equal x y + let equal__local (x : Stdlib.Nativeint.t) y = Poly.equal x y + let max (x : Stdlib.Nativeint.t) y = Bool0.select (x >= y) x y + let min (x : Stdlib.Nativeint.t) y = Bool0.select (x <= y) x y +end + +module Bool_replace_polymorphic_compare = struct + let ( < ) (x : bool) y = Poly.( < ) x y + let ( <= ) (x : bool) y = Poly.( <= ) x y + let ( <> ) (x : bool) y = Poly.( <> ) x y + let ( = ) (x : bool) y = Poly.( = ) x y + let ( > ) (x : bool) y = Poly.( > ) x y + let ( >= ) (x : bool) y = Poly.( >= ) x y + let ascending (x : bool) y = Poly.ascending x y + let descending (x : bool) y = Poly.descending x y + let compare (x : bool) y = Poly.compare x y + let compare__local (x : bool) y = Poly.compare x y + let equal (x : bool) y = Poly.equal x y + let equal__local (x : bool) y = Poly.equal x y + let max (x : bool) y = Bool0.select (x >= y) x y + let min (x : bool) y = Bool0.select (x <= y) x y +end + +module Char_replace_polymorphic_compare = struct + let ( < ) (x : char) y = Poly.( < ) x y + let ( <= ) (x : char) y = Poly.( <= ) x y + let ( <> ) (x : char) y = Poly.( <> ) x y + let ( = ) (x : char) y = Poly.( = ) x y + let ( > ) (x : char) y = Poly.( > ) x y + let ( >= ) (x : char) y = Poly.( >= ) x y + let ascending (x : char) y = Poly.ascending x y + let descending (x : char) y = Poly.descending x y + let compare (x : char) y = Poly.compare x y + let compare__local (x : char) y = Poly.compare x y + let equal (x : char) y = Poly.equal x y + let equal__local (x : char) y = Poly.equal x y + let max (x : char) y = Bool0.select (x >= y) x y + let min (x : char) y = Bool0.select (x <= y) x y +end + +module Uchar_replace_polymorphic_compare = struct + open struct + external i : (Stdlib.Uchar.t[@local_opt]) -> int = "%identity" + end + + let ( < ) (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.( < ) (i x) (i y) + let ( <= ) (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.( <= ) (i x) (i y) + let ( <> ) (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.( <> ) (i x) (i y) + let ( = ) (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.( = ) (i x) (i y) + let ( > ) (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.( > ) (i x) (i y) + let ( >= ) (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.( >= ) (i x) (i y) + + let ascending (x : Stdlib.Uchar.t) y = + Int_replace_polymorphic_compare.ascending (i x) (i y) + ;; + + let descending (x : Stdlib.Uchar.t) y = + Int_replace_polymorphic_compare.descending (i x) (i y) + ;; + + let compare (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.compare (i x) (i y) + let equal (x : Stdlib.Uchar.t) y = Int_replace_polymorphic_compare.equal (i x) (i y) + + let compare__local (x : Stdlib.Uchar.t) y = + Int_replace_polymorphic_compare.compare__local (i x) (i y) + ;; + + let equal__local (x : Stdlib.Uchar.t) y = + Int_replace_polymorphic_compare.equal__local (i x) (i y) + ;; + + let max (x : Stdlib.Uchar.t) y = Bool0.select (x >= y) x y + let min (x : Stdlib.Uchar.t) y = Bool0.select (x <= y) x y +end + +module Float_replace_polymorphic_compare = struct + external ( < ) : (float[@local_opt]) -> (float[@local_opt]) -> bool = "%lessthan" + external ( <= ) : (float[@local_opt]) -> (float[@local_opt]) -> bool = "%lessequal" + external ( <> ) : (float[@local_opt]) -> (float[@local_opt]) -> bool = "%notequal" + external ( = ) : (float[@local_opt]) -> (float[@local_opt]) -> bool = "%equal" + external ( > ) : (float[@local_opt]) -> (float[@local_opt]) -> bool = "%greaterthan" + external ( >= ) : (float[@local_opt]) -> (float[@local_opt]) -> bool = "%greaterequal" + external equal : (float[@local_opt]) -> (float[@local_opt]) -> bool = "%equal" + external compare : (float[@local_opt]) -> (float[@local_opt]) -> int = "%compare" + + let ascending (x : float) y = Poly.ascending x y + let descending (x : float) y = Poly.descending x y + let compare__local (x : float) y = Poly.compare x y + let equal__local (x : float) y = Poly.equal x y + let max (x : float) y = Bool0.select (x >= y) x y + let min (x : float) y = Bool0.select (x <= y) x y +end + +module String_replace_polymorphic_compare = struct + let ( < ) (x : string) y = Poly.( < ) x y + let ( <= ) (x : string) y = Poly.( <= ) x y + let ( <> ) (x : string) y = Poly.( <> ) x y + let ( = ) (x : string) y = Poly.( = ) x y + let ( > ) (x : string) y = Poly.( > ) x y + let ( >= ) (x : string) y = Poly.( >= ) x y + let ascending (x : string) y = Poly.ascending x y + let descending (x : string) y = Poly.descending x y + let compare (x : string) y = Poly.compare x y + let compare__local (x : string) y = Poly.compare x y + let equal (x : string) y = Poly.equal x y + let equal__local (x : string) y = Poly.equal x y + let max (x : string) y = Bool0.select (x >= y) x y + let min (x : string) y = Bool0.select (x <= y) x y +end + +module Bytes_replace_polymorphic_compare = struct + let ( < ) (x : bytes) y = Poly.( < ) x y + let ( <= ) (x : bytes) y = Poly.( <= ) x y + let ( <> ) (x : bytes) y = Poly.( <> ) x y + let ( = ) (x : bytes) y = Poly.( = ) x y + let ( > ) (x : bytes) y = Poly.( > ) x y + let ( >= ) (x : bytes) y = Poly.( >= ) x y + let ascending (x : bytes) y = Poly.ascending x y + let descending (x : bytes) y = Poly.descending x y + let compare (x : bytes) y = Poly.compare x y + let compare__local (x : bytes) y = Poly.compare x y + let equal (x : bytes) y = Poly.equal x y + let equal__local (x : bytes) y = Poly.equal x y + let max (x : bytes) y = Bool0.select (x >= y) x y + let min (x : bytes) y = Bool0.select (x <= y) x y +end + +(* This needs to be defined as an external so that the compiler can specialize it as a + direct set or caml_modify. *) +external ( := ) : ('a ref[@local_opt]) -> 'a -> unit = "%setfield0" + +(* These need to be defined as an external otherwise the compiler won't unbox + references. *) +external ( ! ) : ('a ref[@local_opt]) -> 'a = "%field0" +external ref : 'a -> ('a ref[@local_opt]) = "%makemutable" + +let ( @ ) = Stdlib.( @ ) +let ( ^ ) = Stdlib.( ^ ) +let ( ~- ) = Stdlib.( ~- ) +let ( ~-. ) = Stdlib.( ~-. ) +let ( asr ) = Stdlib.( asr ) +let ( land ) = Stdlib.( land ) +let lnot = Stdlib.lnot +let ( lor ) = Stdlib.( lor ) +let ( lsl ) = Stdlib.( lsl ) +let ( lsr ) = Stdlib.( lsr ) +let ( lxor ) = Stdlib.( lxor ) +let ( mod ) = Stdlib.( mod ) +let abs = Stdlib.abs +let failwith = Stdlib.failwith +let fst = Stdlib.fst +let invalid_arg = Stdlib.invalid_arg +let snd = Stdlib.snd + +(* [raise] needs to be defined as an external as the compiler automatically replaces + '%raise' by '%reraise' when appropriate. *) +external raise : exn -> _ = "%raise" +external phys_equal : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%eq" +external decr : (int ref[@local_opt]) -> unit = "%decr" +external incr : (int ref[@local_opt]) -> unit = "%incr" + +(* Used by sexp_conv, which float0 depends on through option. *) +let float_of_string = Stdlib.float_of_string + +(* [am_testing] is used in a few places to behave differently when in testing mode, such + as in [random.ml]. [am_testing] is implemented using [Base_am_testing], a weak C/js + primitive that returns [false], but when linking an inline-test-runner executable, is + overridden by another primitive that returns [true]. *) +external am_testing : unit -> bool = "Base_am_testing" + +let am_testing = am_testing () diff --git a/unikernel/duniverse/base/src/index.mld b/unikernel/duniverse/base/src/index.mld new file mode 100644 index 00000000..de14a22f --- /dev/null +++ b/unikernel/duniverse/base/src/index.mld @@ -0,0 +1,166 @@ +{0 Base} + +{b {{!Base} The full API is browsable here}}. + +Base is a standard library for OCaml. It provides a standard set of +general-purpose modules that are well tested, performant, and fully +portable across any environment that can run OCaml code. + +Unlike other standard library projects, Base is meant to be used as a +wholesale replacement of the standard library distributed with the +OCaml compiler. In particular, it makes different choices and doesn't +re-export features that are not fully portable such as I/O, which are +left to other libraries. + +Note that an API for OCaml's channel-based I/O can be found in the +{{!module:Stdio}[Stdio]} library. + +{1 Relationship to Core} + +- {b {!Base}}: Minimal stdlib replacement. Portable and lightweight and + intended to be highly stable. + +- {b {!Core}}: Extension of Base. More fully featured, with more + code and dependencies, and APIs that evolve more quickly. Portable, + and works on Javascript. + +{1 Using the OCaml standard library with Base} + +Base is intended as a full stdlib replacement. As a result, after an +[open Base], all the modules, values, types, etc., coming from the OCaml +standard library that one normally gets in the default environment are +deprecated. + +In order to access these values, one must use the [Stdlib] library, +which re-exports them all through the toplevel name +{{!module:Stdlib}[Stdlib]}: [Stdlib.String], [Stdlib.print_string], ... + +The new modules and values made available by Base are documented +{{!Base} here}. + +{1 Differences between Base and the OCaml standard library} + +Programmers who are used to the OCaml standard library should read +through this section to understand major differences between the two +libraries that one should be aware of when switching to Base. + +{2 Comparison operators} + +The comparison operators exposed by the OCaml standard library are +polymorphic: + +{[ +val compare : 'a -> 'a -> int +val ( <= ) : 'a -> 'a -> bool +(* ... *) +]} + +What they implement is structural comparison of the runtime +representation of values. Since these are often error-prone, +i.e., they don't correspond to what the user expects, they are not +exposed directly by Base. + +To use polymorphic comparison with Base, one should use the +{{!Base.Polymorphic_compare}[Polymorphic_compare]} module. The default +comparison operators exposed by Base are the integer ones, just like +the default arithmetic operators are the integer ones. + +The recommended way to compare arbitrary complex data structures is to +use the specific [compare] functions. For instance: + +{[ List.compare String.compare x y ]} + +The [ppx_compare] rewriter offers an alternative way to write this: + +{[ [%compare: string list] x y ]} + +{1 Base and ppx code generators} + +Base uses a few ppx code generators to implement: + +- reliable and customizable comparison of OCaml values; +- reliable and customizable hash of OCaml values; and +- conversions between OCaml values and s-expression. + +However, it doesn't need these code generators to build. Instead, it +uses ppx as a code verification tool during development. It works in a +very similar fashion to {{: https://github.com/janestreet/ppx_expect} +expect tests}. + +Whenever you see this in the code source: + +{[ +type t = ... [@@deriving_inline sexp_of] +let sexp_of_t = ... +[@@@end] +]} + +the code between the [[@@deriving_inline]] and the [[@@@end]] is +generated code. The generated code is currently quite big and hard to +read, however we are working on making it look like human-written +code. + +You can put the following elisp code in your [~/.emacs] file to hide +these blocks: + +{v +(defun deriving-inline-forward-sexp (&optional arg) + (search-forward-regexp "\\[@@@end\\]") nil nil arg) + +(defun setup-hide-deriving-inline () + (inline) + (hs-minor-mode t) + (let ((hs-hide-comments-when-hiding-all nil)) + (hs-hide-all))) + +(require 'hideshow) +(add-to-list 'hs-special-modes-alist + '(tuareg-mode "\\[@@deriving_inline[^]]*\\]" "\\[@@@end\\]" nil + deriving-inline-forward-sexp nil)) +(add-hook 'tuareg-mode-hook 'setup-hide-deriving-inline) +v} + +Things are not yet set up in the git repository to make it convenient +to change types and update the generated code, but they will be set up +soon. + +{1 Base coding rules} + +There are a few coding rules across the code base that are enforced by +lint tools. + +These rules are: + +{ul +{- Opening the [Stdlib] module is not allowed. Inside Base, the OCaml + stdlib is shadowed and accessible through the [Stdlib] module. We + forbid opening [Stdlib] so that we know exactly where things come + from.} +{- [Stdlib.Foo] modules cannot be aliased, one must use [Stdlib.Foo] + explicitly. This is to avoid having to remember a list of aliases + at the beginning of each file.} +{- For some modules that are both in the OCaml stdlib and Base, such as + [String], we define a module [String0] for common functions that + cannot be defined directly in [Base.String] to avoid creating a + circular dependency. Except for [String] itself, other modules + are not allowed to use [Stdlib.String] and must use either [String] or + [String0] instead.} +{- Indentation is exactly the one of [ocp-indent].} +{- A few other coding style rules enforced by + {{: https://github.com/janestreet/ppx_js_style} ppx_js_style}.} +} + + +The Base specific coding rules are checked by [ppx_base_lint], in the +[lint] subfolder. The indentation rules are checked by a wrapper around +[ocp-indent] and the coding style rules are checked by [ppx_js_style]. + +These checks are currently not run by [dune], but it will soon get a [-dev] flag +to run them automatically. + +{1 Roadmap} + +Base is still under active development and there are several missing +feature that are yet to be added. Consult the +{{:https://github.com/janestreet/base/blob/master/ROADMAP.md}roadmap} to +see what is happening. diff --git a/unikernel/duniverse/base/src/indexed_container.ml b/unikernel/duniverse/base/src/indexed_container.ml new file mode 100644 index 00000000..66e987f1 --- /dev/null +++ b/unikernel/duniverse/base/src/indexed_container.ml @@ -0,0 +1,181 @@ +open! Import +module Array = Array0 +include Indexed_container_intf + +let with_return = With_return.with_return + +let[@inline always] iteri ~fold t ~f = + ignore + (fold t ~init:0 ~f:(fun i x -> + f i x; + i + 1) + : int) +;; + +let foldi ~fold t ~init ~f = + let i = ref 0 in + fold t ~init ~f:(fun acc v -> + let acc = f !i acc v in + i := !i + 1; + acc) [@nontail] +;; + +let counti ~foldi t ~f = + foldi t ~init:0 ~f:(fun i n a -> if f i a then n + 1 else n) [@nontail] +;; + +let existsi ~iteri c ~f = + with_return (fun r -> + iteri c ~f:(fun i x -> if f i x then r.return true); + false) [@nontail] +;; + +let for_alli ~iteri c ~f = + with_return (fun r -> + iteri c ~f:(fun i x -> if not (f i x) then r.return false); + true) [@nontail] +;; + +let find_mapi ~iteri t ~f = + with_return (fun r -> + iteri t ~f:(fun i x -> + match f i x with + | None -> () + | Some _ as res -> r.return res); + None) [@nontail] +;; + +let findi ~iteri c ~f = + with_return (fun r -> + iteri c ~f:(fun i x -> if f i x then r.return (Some (i, x))); + None) [@nontail] +;; + +(* Allows [Make_gen] to share a [Container.Generic] implementation with, e.g., + [Container.Make_gen_with_creators]. *) +module Make_gen_with_container + (T : Make_gen_arg) + (C : Container.Generic + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt) : + Generic + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt = struct + include C + + let iteri = + match T.iteri with + | `Custom iteri -> iteri + | `Define_using_fold -> fun t ~f -> iteri ~fold t ~f + ;; + + let foldi = + match T.foldi with + | `Custom foldi -> foldi + | `Define_using_fold -> fun t ~init ~f -> foldi ~fold t ~init ~f + ;; + + let counti t ~f = counti ~foldi t ~f + let existsi t ~f = existsi ~iteri t ~f + let for_alli t ~f = for_alli ~iteri t ~f + let find_mapi t ~f = find_mapi ~iteri t ~f + let findi t ~f = findi ~iteri t ~f +end +[@@inline always] + +module Make_gen (T : Make_gen_arg) : + Generic + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt = struct + module C = Container.Make_gen (T) + include C + include Make_gen_with_container (T) (C) +end +[@@inline always] + +module Make (T : Make_arg) = struct + include Make_gen (struct + include T + + type ('a, _, _) t = 'a T.t + type 'a elt = 'a + end) +end +[@@inline always] + +module Make0 (T : Make0_arg) = struct + include Make_gen (struct + include T + + type (_, _, _) t = T.t + type 'a elt = T.Elt.t + end) + + let mem t x = mem t x ~equal:T.Elt.equal +end + +module Make_gen_with_creators (T : Make_gen_with_creators_arg) : + Generic_with_creators + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom1, 'phantom2) concat := ('a, 'phantom1, 'phantom2) T.concat = +struct + module C = Container.Make_gen_with_creators (T) + include C + include Make_gen_with_container (T) (C) + + let derived_init n ~f = of_array (Array.init n ~f) + + let init = + match T.init with + | `Custom init -> init + | `Define_using_of_array -> derived_init + ;; + + let derived_concat_mapi t ~f = concat (T.concat_of_array (Array.mapi (to_array t) ~f)) + + let concat_mapi = + match T.concat_mapi with + | `Custom concat_mapi -> concat_mapi + | `Define_using_concat -> derived_concat_mapi + ;; + + let filter_mapi t ~f = + concat_mapi t ~f:(fun i x -> + match f i x with + | None -> of_array [||] + | Some y -> of_array [| y |]) [@nontail] + ;; + + let mapi t ~f = filter_mapi t ~f:(fun i x -> Some (f i x)) [@nontail] + + let filteri t ~f = + filter_mapi t ~f:(fun i x -> if f i x then Some x else None) [@nontail] + ;; +end + +module Make_with_creators (T : Make_with_creators_arg) = struct + include Make_gen_with_creators (struct + include T + + type ('a, _, _) t = 'a T.t + type 'a elt = 'a + type ('a, _, _) concat = 'a T.t + + let concat_of_array = of_array + end) +end + +module Make0_with_creators (T : Make0_with_creators_arg) = struct + include Make_gen_with_creators (struct + include T + + type (_, _, _) t = T.t + type 'a elt = T.Elt.t + type ('a, _, _) concat = 'a list + + let concat_of_array = Array.to_list + end) + + let mem t x = mem t x ~equal:T.Elt.equal +end diff --git a/unikernel/duniverse/base/src/indexed_container.mli b/unikernel/duniverse/base/src/indexed_container.mli new file mode 100644 index 00000000..f5a29e5e --- /dev/null +++ b/unikernel/duniverse/base/src/indexed_container.mli @@ -0,0 +1 @@ +include Indexed_container_intf.Indexed_container (** @inline *) diff --git a/unikernel/duniverse/base/src/indexed_container_intf.ml b/unikernel/duniverse/base/src/indexed_container_intf.ml new file mode 100644 index 00000000..1ba9b4c1 --- /dev/null +++ b/unikernel/duniverse/base/src/indexed_container_intf.ml @@ -0,0 +1,238 @@ +type ('t, 'a, 'accum) fold = 't -> init:'accum -> f:('accum -> 'a -> 'accum) -> 'accum + +type ('t, 'a, 'accum) foldi = + 't -> init:'accum -> f:(int -> 'accum -> 'a -> 'accum) -> 'accum + +type ('t, 'a) iteri = 't -> f:(int -> 'a -> unit) -> unit + +module type S0 = sig + include Container.S0 + + (** These are all like their equivalents in [Container] except that an index starting at + 0 is added as the first argument to [f]. *) + + val foldi : (t, elt, _) foldi + val iteri : (t, elt) iteri + val existsi : t -> f:(int -> elt -> bool) -> bool + val for_alli : t -> f:(int -> elt -> bool) -> bool + val counti : t -> f:(int -> elt -> bool) -> int + val findi : t -> f:(int -> elt -> bool) -> (int * elt) option + val find_mapi : t -> f:(int -> elt -> 'a option) -> 'a option +end + +module type S1 = sig + include Container.S1 + + (** These are all like their equivalents in [Container] except that an index starting at + 0 is added as the first argument to [f]. *) + + val foldi : ('a t, 'a, _) foldi + val iteri : ('a t, 'a) iteri + val existsi : 'a t -> f:(int -> 'a -> bool) -> bool + val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool + val counti : 'a t -> f:(int -> 'a -> bool) -> int + val findi : 'a t -> f:(int -> 'a -> bool) -> (int * 'a) option + val find_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b option +end + +module type Generic = sig + include Container.Generic + + (** These are all like their equivalents in [Container] except that an index starting at + 0 is added as the first argument to [f]. *) + + val foldi : (('a, _, _) t, 'a elt, _) foldi + val iteri : (('a, _, _) t, 'a elt) iteri + val existsi : ('a, _, _) t -> f:(int -> 'a elt -> bool) -> bool + val for_alli : ('a, _, _) t -> f:(int -> 'a elt -> bool) -> bool + val counti : ('a, _, _) t -> f:(int -> 'a elt -> bool) -> int + val findi : ('a, _, _) t -> f:(int -> 'a elt -> bool) -> (int * 'a elt) option + val find_mapi : ('a, _, _) t -> f:(int -> 'a elt -> 'b option) -> 'b option +end + +module type S0_with_creators = sig + include Container.S0_with_creators + include S0 with type t := t and type elt := elt + + (** [init n ~f] is equivalent to [of_list [f 0; f 1; ...; f (n-1)]]. It raises an + exception if [n < 0]. *) + val init : int -> f:(int -> elt) -> t + + (** [mapi] is like map. Additionally, it passes in the index of each element as the + first argument to the mapped function. *) + val mapi : t -> f:(int -> elt -> elt) -> t + + val filteri : t -> f:(int -> elt -> bool) -> t + + (** filter_mapi is like [filter_map]. Additionally, it passes in the index of each + element as the first argument to the mapped function. *) + val filter_mapi : t -> f:(int -> elt -> elt option) -> t + + (** [concat_mapi t ~f] is like concat_map. Additionally, it passes the index as an + argument. *) + val concat_mapi : t -> f:(int -> elt -> t) -> t +end + +module type S1_with_creators = sig + include Container.S1_with_creators + include S1 with type 'a t := 'a t + + (** [init n ~f] is equivalent to [of_list [f 0; f 1; ...; f (n-1)]]. It raises an + exception if [n < 0]. *) + val init : int -> f:(int -> 'a) -> 'a t + + (** [mapi] is like map. Additionally, it passes in the index of each element as the + first argument to the mapped function. *) + val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t + + val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t + + (** filter_mapi is like [filter_map]. Additionally, it passes in the index of each + element as the first argument to the mapped function. *) + val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t + + (** [concat_mapi t ~f] is like concat_map. Additionally, it passes the index as an + argument. *) + val concat_mapi : 'a t -> f:(int -> 'a -> 'b t) -> 'b t +end + +module type Generic_with_creators = sig + include Container.Generic_with_creators + + include + Generic + with type 'a elt := 'a elt + and type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) t + + val init : int -> f:(int -> 'a elt) -> ('a, _, _) t + val mapi : ('a, 'p1, 'p2) t -> f:(int -> 'a elt -> 'b elt) -> ('b, 'p1, 'p2) t + val filteri : ('a, 'p1, 'p2) t -> f:(int -> 'a elt -> bool) -> ('a, 'p1, 'p2) t + + val filter_mapi + : ('a, 'p1, 'p2) t + -> f:(int -> 'a elt -> 'b elt option) + -> ('b, 'p1, 'p2) t + + val concat_mapi + : ('a, 'p1, 'p2) t + -> f:(int -> 'a elt -> ('b, 'p1, 'p2) t) + -> ('b, 'p1, 'p2) t +end + +module type Make_gen_arg = sig + include Container_intf.Make_gen_arg + + val iteri : [ `Define_using_fold | `Custom of (('a, _, _) t, 'a elt) iteri ] + val foldi : [ `Define_using_fold | `Custom of (('a, _, _) t, 'a elt, _) foldi ] +end + +module type Make_arg = sig + include Container_intf.Make_arg + include Make_gen_arg with type ('a, _, _) t := 'a t and type 'a elt := 'a +end + +module type Make0_arg = sig + include Container_intf.Make0_arg + include Make_gen_arg with type ('a, _, _) t := t and type 'a elt := Elt.t +end + +module type Make_common_with_creators_arg = sig + include Container_intf.Make_common_with_creators_arg + + include + Make_gen_arg with type ('a, 'p1, 'p2) t := ('a, 'p1, 'p2) t and type 'a elt := 'a elt + + val init + : [ `Define_using_of_array | `Custom of int -> f:(int -> 'a elt) -> ('a, _, _) t ] + + val concat_mapi + : [ `Define_using_concat + | `Custom of ('a, _, _) t -> f:(int -> 'a elt -> ('b, _, _) t) -> ('b, _, _) t + ] +end + +module type Make_gen_with_creators_arg = sig + include Container_intf.Make_gen_with_creators_arg + + include + Make_common_with_creators_arg + with type ('a, 'p1, 'p2) t := ('a, 'p1, 'p2) t + and type 'a elt := 'a elt + and type ('a, 'p1, 'p2) concat := ('a, 'p1, 'p2) concat +end + +module type Make_with_creators_arg = sig + include Container_intf.Make_with_creators_arg + + include + Make_common_with_creators_arg + with type ('a, _, _) t := 'a t + and type 'a elt := 'a + and type ('a, _, _) concat := 'a t +end + +module type Make0_with_creators_arg = sig + include Container_intf.Make0_with_creators_arg + + include + Make_common_with_creators_arg + with type ('a, _, _) t := t + and type 'a elt := Elt.t + and type ('a, _, _) concat := 'a list +end + +module type Derived = sig + (** Generic definitions of [foldi] and [iteri] in terms of [fold]. + + E.g., [iteri ~fold t ~f = ignore (fold t ~init:0 ~f:(local_ (fun i x -> f i x; i + 1)))]. *) + + val foldi : fold:('t, 'a, 'acc) fold -> ('t, 'a, 'acc) foldi + val iteri : fold:('t, 'a, int) fold -> ('t, 'a) iteri + + (** Generic definitions of indexed container operations in terms of [foldi]. *) + + val counti : foldi:('t, 'a, int) foldi -> 't -> f:(int -> 'a -> bool) -> int + + (** Generic definitions of indexed container operations in terms of [iteri]. *) + + val existsi : iteri:('t, 'a) iteri -> 't -> f:(int -> 'a -> bool) -> bool + val for_alli : iteri:('t, 'a) iteri -> 't -> f:(int -> 'a -> bool) -> bool + val findi : iteri:('t, 'a) iteri -> 't -> f:(int -> 'a -> bool) -> (int * 'a) option + val find_mapi : iteri:('t, 'a) iteri -> 't -> f:(int -> 'a -> 'b option) -> 'b option +end + +module type Indexed_container = sig + (** Provides generic signatures for containers that support indexed iteration ([iteri], + [foldi], ...). In principle, any container that has [iter] can also implement [iteri], + but the idea is that [Indexed_container_intf] should be included only for containers + that have a meaningful underlying ordering. *) + + module type Derived = Derived + module type Generic = Generic + module type Generic_with_creators = Generic_with_creators + module type S0 = S0 + module type S0_with_creators = S0_with_creators + module type S1 = S1 + module type S1_with_creators = S1_with_creators + + include Derived + module Make (T : Make_arg) : S1 with type 'a t := 'a T.t + module Make0 (T : Make0_arg) : S0 with type t := T.t and type elt := T.Elt.t + + module Make_gen (T : Make_gen_arg) : + Generic + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt + + module Make_with_creators (T : Make_with_creators_arg) : + S1_with_creators with type 'a t := 'a T.t + + module Make0_with_creators (T : Make0_with_creators_arg) : + S0_with_creators with type t := T.t and type elt := T.Elt.t + + module Make_gen_with_creators (T : Make_gen_with_creators_arg) : + Generic_with_creators + with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom1, 'phantom2) concat := ('a, 'phantom1, 'phantom2) T.concat +end diff --git a/unikernel/duniverse/base/src/info.ml b/unikernel/duniverse/base/src/info.ml new file mode 100644 index 00000000..2fafed3d --- /dev/null +++ b/unikernel/duniverse/base/src/info.ml @@ -0,0 +1,301 @@ +(* This module is trying to minimize dependencies on modules in Core, so as to allow + [Info], [Error], and [Or_error] to be used in as many places as possible. Please avoid + adding new dependencies. *) + +open! Import +include Info_intf +module String = String0 + +module Message = struct + type t = + | Could_not_construct of Sexp.t + | String of string + | Exn of exn + | Sexp of Sexp.t + | Tag_sexp of string * Sexp.t * Source_code_position0.t option + | Tag_t of string * t + | Tag_arg of string * Sexp.t * t + | Of_list of int option * t list + | With_backtrace of t * string (* backtrace *) + [@@deriving_inline sexp_of] + + let rec sexp_of_t = + (function + | Could_not_construct arg0__001_ -> + let res0__002_ = Sexp.sexp_of_t arg0__001_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Could_not_construct"; res0__002_ ] + | String arg0__003_ -> + let res0__004_ = sexp_of_string arg0__003_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "String"; res0__004_ ] + | Exn arg0__005_ -> + let res0__006_ = sexp_of_exn arg0__005_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Exn"; res0__006_ ] + | Sexp arg0__007_ -> + let res0__008_ = Sexp.sexp_of_t arg0__007_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Sexp"; res0__008_ ] + | Tag_sexp (arg0__009_, arg1__010_, arg2__011_) -> + let res0__012_ = sexp_of_string arg0__009_ + and res1__013_ = Sexp.sexp_of_t arg1__010_ + and res2__014_ = sexp_of_option Source_code_position0.sexp_of_t arg2__011_ in + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "Tag_sexp"; res0__012_; res1__013_; res2__014_ ] + | Tag_t (arg0__015_, arg1__016_) -> + let res0__017_ = sexp_of_string arg0__015_ + and res1__018_ = sexp_of_t arg1__016_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Tag_t"; res0__017_; res1__018_ ] + | Tag_arg (arg0__019_, arg1__020_, arg2__021_) -> + let res0__022_ = sexp_of_string arg0__019_ + and res1__023_ = Sexp.sexp_of_t arg1__020_ + and res2__024_ = sexp_of_t arg2__021_ in + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "Tag_arg"; res0__022_; res1__023_; res2__024_ ] + | Of_list (arg0__025_, arg1__026_) -> + let res0__027_ = sexp_of_option sexp_of_int arg0__025_ + and res1__028_ = sexp_of_list sexp_of_t arg1__026_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Of_list"; res0__027_; res1__028_ ] + | With_backtrace (arg0__029_, arg1__030_) -> + let res0__031_ = sexp_of_t arg0__029_ + and res1__032_ = sexp_of_string arg1__030_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "With_backtrace"; res0__031_; res1__032_ ] + : t -> Sexplib0.Sexp.t) + ;; + + [@@@end] + + let rec to_sexps_hum t ac = + match t with + | Could_not_construct _ as t -> sexp_of_t t :: ac + | String string -> Atom string :: ac + | Exn exn -> Exn.sexp_of_t exn :: ac + | Sexp sexp -> sexp :: ac + | Tag_sexp (tag, sexp, here) -> + List + (Atom tag + :: sexp + :: + (match here with + | None -> [] + | Some here -> [ Source_code_position0.sexp_of_t here ])) + :: ac + | Tag_t (tag, t) -> List (Atom tag :: to_sexps_hum t []) :: ac + | Tag_arg (tag, sexp, t) -> + let body = sexp :: to_sexps_hum t [] in + if String.length tag = 0 then List body :: ac else List (Atom tag :: body) :: ac + | With_backtrace (t, backtrace) -> + Sexp.List + [ to_sexp_hum t; sexp_of_list sexp_of_string (String.split_lines backtrace) ] + :: ac + | Of_list (_, ts) -> + List.fold (List.rev ts) ~init:ac ~f:(fun ac t -> to_sexps_hum t ac) + + and to_sexp_hum t = + match to_sexps_hum t [] with + | [ sexp ] -> sexp + | sexps -> Sexp.List sexps + ;; +end + +open Message + +module Computed = struct + (* Memoized, lazily-computed representation of messages. Maintains its own state to + avoid stack overflow from nested [Lazy.t]. *) + + (* We use a global [state ref] so we can mutate [state], but still [globalize] with no + cost and without duplicating state. *) + type info = { state : state ref } [@@unboxed] + + (* An [info] starts as a [constructor]. When forced, it is marked [Computing] to avoid + cycles. When finished, the final [message] is recorded. *) + and state = + | Initial of constructor + | Computing + | Final of Message.t + + (* Recursive constructors for [Info.t]. Others can be built directly as [Message.t]. *) + and constructor = + | Cons_lazy_info of info Lazy.t + | Cons_list of info list + | Cons_tag_arg of string * Sexp.t * info + | Cons_tag_t of string * info + + (* This is a no-op, since [info] is unboxed. *) + let globalize_info { state } = { state } + + (* We keep a list of stack_frames while computing, rather than using the call stack. *) + type stack_frame = + | In_info of info + | In_tag_arg of string * Sexp.t + | In_tag_t of string + | In_list of + { fwd_prefix : info list + ; rev_suffix : Message.t list + } + + (* The following mutually-recursive functions compute a [Message.t] from an [info]. + All calls below are tail calls: we want to avoid using the call stack in favor + of our own manual stack. *) + let rec compute_info info stack = + match !(info.state) with + | Initial cons -> + info.state := Computing; + compute_constructor cons (In_info info :: stack) + | Computing -> + compute_message (Could_not_construct (Atom "cycle while computing message")) stack + | Final message -> compute_message message stack + + and compute_info_list ~fwd_prefix ~rev_suffix stack = + match fwd_prefix with + | info :: fwd_prefix -> compute_info info (In_list { fwd_prefix; rev_suffix } :: stack) + | [] -> + let infos = + List.fold rev_suffix ~init:[] ~f:(fun tail message -> + match message with + | Of_list (_, messages) -> messages @ tail + | _ -> message :: tail) + in + compute_message (Of_list (None, infos)) stack + + and compute_constructor cons stack = + match cons with + | Cons_tag_arg (tag, arg, info) -> compute_info info (In_tag_arg (tag, arg) :: stack) + | Cons_tag_t (tag, info) -> compute_info info (In_tag_t tag :: stack) + | Cons_list infos -> compute_info_list ~fwd_prefix:infos ~rev_suffix:[] stack + | Cons_lazy_info lazy_info -> + (match Lazy.force lazy_info with + | info -> compute_info info stack + | exception exn -> compute_message (Could_not_construct (Exn.sexp_of_t exn)) stack) + + and compute_message message stack = + match stack with + | [] -> message + | In_info info :: stack -> + info.state := Final message; + compute_message message stack + | In_tag_arg (tag, arg) :: stack -> + compute_message (Tag_arg (tag, arg, message)) stack + | In_tag_t tag :: stack -> compute_message (Tag_t (tag, message)) stack + | In_list { fwd_prefix; rev_suffix } :: stack -> + compute_info_list ~fwd_prefix ~rev_suffix:(message :: rev_suffix) stack + ;; + + (* Helper functions for converting and constructing [info]. *) + + let to_message info = compute_info info [] + let of_message message = { state = ref (Final message) } + + let is_computed info = + match !(info.state) with + | Initial _ | Computing -> false + | Final _ -> true + ;; + + let of_cons cons = { state = ref (Initial cons) } + let of_lazy_info lazy_info = of_cons (Cons_lazy_info lazy_info) + + let of_lazy_cons lazy_cons = + of_cons (Cons_lazy_info (lazy (of_cons (Lazy.force lazy_cons)))) + ;; + + let of_lazy_message lazy_message = + of_cons (Cons_lazy_info (lazy (of_message (Lazy.force lazy_message)))) + ;; +end + +open Computed + +type t = Computed.info + +let globalize = Computed.globalize_info +let invariant _ = () + +(* It is OK to use [Message.to_sexp_hum], which is not stable, because [t_of_sexp] below + can handle any sexp. *) +let sexp_of_t t = Message.to_sexp_hum (to_message t) +let t_of_sexp sexp = of_message (Message.Sexp sexp) +let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = { untyped = Any "Info.t" } +let compare t1 t2 = Sexp.compare (sexp_of_t t1) (sexp_of_t t2) +let compare__local t1 t2 = compare (globalize t1) (globalize t2) +let equal t1 t2 = Sexp.equal (sexp_of_t t1) (sexp_of_t t2) +let equal__local t1 t2 = equal (globalize t1) (globalize t2) +let hash_fold_t state t = Sexp.hash_fold_t state (sexp_of_t t) +let hash t = Hash.run hash_fold_t t + +let to_string_hum t = + match to_message t with + | String s -> s + | message -> Sexp.to_string_hum (Message.to_sexp_hum message) +;; + +let to_string_mach t = Sexp.to_string_mach (sexp_of_t t) +let of_lazy l = of_lazy_message (lazy (String (Lazy.force l))) +let of_lazy_sexp l = of_lazy_message (lazy (Sexp (Lazy.force l))) +let of_lazy_t lazy_t = of_lazy_info lazy_t +let of_string message = of_message (String message) +let createf format = Printf.ksprintf of_string format +let of_thunk f = of_lazy_message (lazy (String (f ()))) + +let create ?here ?strict tag x sexp_of_x = + match strict with + | None -> of_lazy_message (lazy (Tag_sexp (tag, sexp_of_x x, here))) + | Some () -> of_message (Tag_sexp (tag, sexp_of_x x, here)) +;; + +let create_s sexp = of_message (Sexp sexp) +let tag t ~tag = of_cons (Cons_tag_t (tag, t)) +let tag_s_lazy t ~tag = of_lazy_cons (lazy (Cons_tag_arg ("", Lazy.force tag, t))) +let tag_s t ~tag = of_cons (Cons_tag_arg ("", tag, t)) +let tag_arg t tag x sexp_of_x = of_lazy_cons (lazy (Cons_tag_arg (tag, sexp_of_x x, t))) +let of_list ts = of_cons (Cons_list ts) + +exception Exn of t + +let () = + (* We install a custom exn-converter rather than use + [exception Exn of t [@@deriving_inline sexp] ... [@@@end]] to eliminate the extra + wrapping of "(Exn ...)". *) + Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Exn] (function + | Exn t -> sexp_of_t t + | _ -> + (* Reaching this branch indicates a bug in sexplib. *) + assert false) +;; + +let to_exn t = + if not (is_computed t) + then Exn t + else ( + match to_message t with + | Message.Exn exn -> exn + | _ -> Exn t) +;; + +let of_exn ?backtrace exn = + let backtrace = + match backtrace with + | None -> None + | Some `Get -> Some (Stdlib.Printexc.get_backtrace ()) + | Some (`This s) -> Some s + in + match exn, backtrace with + | Exn t, None -> t + | Exn t, Some backtrace -> + of_lazy_message (lazy (With_backtrace (to_message t, backtrace))) + | _, None -> of_message (Message.Exn exn) + | _, Some backtrace -> + of_lazy_message (lazy (With_backtrace (Sexp (Exn.sexp_of_t exn), backtrace))) +;; + +include Pretty_printer.Register_pp (struct + type nonrec t = t + + let module_name = "Base.Info" + let pp ppf t = Stdlib.Format.pp_print_string ppf (to_string_hum t) +end) + +module Internal_repr = struct + include Message + + let to_info = of_message + let of_info = to_message +end diff --git a/unikernel/duniverse/base/src/info.mli b/unikernel/duniverse/base/src/info.mli new file mode 100644 index 00000000..fc27b4a6 --- /dev/null +++ b/unikernel/duniverse/base/src/info.mli @@ -0,0 +1 @@ +include Info_intf.Info (** @inline *) diff --git a/unikernel/duniverse/base/src/info_intf.ml b/unikernel/duniverse/base/src/info_intf.ml new file mode 100644 index 00000000..5737c1ed --- /dev/null +++ b/unikernel/duniverse/base/src/info_intf.ml @@ -0,0 +1,155 @@ +(** [Info] is a library for lazily constructing human-readable information as a string + or sexp, with a primary use being error messages. + + Using [Info] is often preferable to [sprintf] or manually constructing strings + because you don't have to eagerly construct the string -- you only need to pay when + you actually want to display the info, which for many applications is rare. Using + [Info] is also better than creating custom exceptions because you have more control + over the format. + + Info is intended to be constructed in the following style; for simple info, you + write: + + {[Info.of_string "Unable to find file"]} + + Or for a more descriptive [Info] without attaching any content (but evaluating the + result eagerly): + + {[Info.createf "Process %s exited with code %d" process exit_code]} + + For info where you want to attach some content, you would write: + + {[Info.create "Unable to find file" filename [%sexp_of: string]]} + + Or even, + + {[ + Info.create "price too big" (price, [`Max max_price]) + [%sexp_of: float * [`Max of float]] + ]} + + Note that an [Info.t] can be created from any arbitrary sexp with [Info.t_of_sexp]. +*) + +open! Import + +module type S = sig + (** Serialization and comparison force the lazy message. *) + type t + [@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_compare_lib.Equal.S with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + + val globalize : t -> t + + include Ppx_hash_lib.Hashable.S with type t := t + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Invariant_intf.S with type t := t + + (** [to_string_hum] forces the lazy message, which might be an expensive operation. + + [to_string_hum] usually produces a sexp; however, it is guaranteed that + [to_string_hum (of_string s) = s]. + + If this string is going to go into a log file, you may find it useful to ensure that + the string is only one line long. To do this, use [to_string_mach t]. *) + val to_string_hum : t -> string + + (** [to_string_mach t] outputs [t] as a sexp on a single line. *) + val to_string_mach : t -> string + + val of_string : string -> t + + (** Be careful that the body of the lazy or thunk does not access mutable data, since it + will only be called at an undetermined later point. *) + + val of_lazy : string Lazy.t -> t + val of_lazy_sexp : Sexp.t Lazy.t -> t + val of_thunk : (unit -> string) -> t + val of_lazy_t : t Lazy.t -> t + + (** For [create message a sexp_of_a], [sexp_of_a a] is lazily computed, when the info is + converted to a sexp. So if [a] is mutated in the time between the call to [create] + and the sexp conversion, those mutations will be reflected in the sexp. Use + [~strict:()] to force [sexp_of_a a] to be computed immediately. *) + val create + : ?here:Source_code_position0.t + -> ?strict:unit + -> string + -> 'a + -> ('a -> Sexp.t) + -> t + + val create_s : Sexp.t -> t + + (** Constructs a [t] containing only a string from a format. This eagerly constructs + the string. *) + val createf : ('a, unit, string, t) format4 -> 'a + + (** Adds a string to the front. *) + val tag : t -> tag:string -> t + + (** Adds a sexp to the front. *) + val tag_s : t -> tag:Sexp.t -> t + + (** Adds a lazy sexp to the front. *) + val tag_s_lazy : t -> tag:Sexp.t Lazy.t -> t + + (** Adds a string and some other data in the form of an s-expression at the front. *) + val tag_arg : t -> string -> 'a -> ('a -> Sexp.t) -> t + + (** Combines multiple infos into one. *) + val of_list : t list -> t + + (** [of_exn] and [to_exn] are primarily used with [Error], but their definitions have to + be here because they refer to the underlying representation. + + [~backtrace:`Get] attaches the backtrace for the most recent exception. The same + caveats as for [Printexc.print_backtrace] apply. [~backtrace:(`This s)] attaches + the backtrace [s]. The default is no backtrace. *) + val of_exn : ?backtrace:[ `Get | `This of string ] -> exn -> t + + val to_exn : t -> exn + val pp : Formatter.t -> t -> unit + + module Internal_repr : sig + type info = t + + (** The internal representation. It is exposed so that we can write efficient + serializers outside of this module. *) + type t = + | Could_not_construct of Sexp.t + | String of string + | Exn of exn + | Sexp of Sexp.t + | Tag_sexp of string * Sexp.t * Source_code_position0.t option + | Tag_t of string * t + | Tag_arg of string * Sexp.t * t + | Of_list of int option * t list + | With_backtrace of t * string (** The second argument is the backtrace *) + [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + val of_info : info -> t + val to_info : t -> info + end + with type info := t +end + +module type Info = sig + module type S = S + + include S (** @inline *) +end diff --git a/unikernel/duniverse/base/src/int.ml b/unikernel/duniverse/base/src/int.ml new file mode 100644 index 00000000..f61fa80e --- /dev/null +++ b/unikernel/duniverse/base/src/int.ml @@ -0,0 +1,365 @@ +open! Import +include Int_intf +include Int0 + +module T = struct + type t = int [@@deriving_inline globalize, hash, sexp, sexp_grammar] + + let (globalize : t -> t) = (globalize_int : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int in + fun x -> func x + ;; + + let t_of_sexp = (int_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_int : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + let compare x y = Int_replace_polymorphic_compare.compare x y + + let of_string s = + try of_string s with + | _ -> Printf.failwithf "Int.of_string: %S" s () + ;; + + let to_string = to_string +end + +let num_bits = Int_conversions.num_bits_int +let float_lower_bound = Float0.lower_bound_for_int num_bits +let float_upper_bound = Float0.upper_bound_for_int num_bits +let to_float = Stdlib.float_of_int +let of_float_unchecked = Stdlib.int_of_float + +let of_float f = + if Float_replace_polymorphic_compare.( >= ) f float_lower_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + then Stdlib.int_of_float f + else + Printf.invalid_argf + "Int.of_float: argument (%f) is out of range or NaN" + (Float0.box f) + () +;; + +let zero = 0 +let one = 1 +let minus_one = -1 + +include T +include Comparator.Make (T) + +include Comparable.With_zero (struct + include T + + let zero = zero +end) + +module Conv = Int_conversions +include Int_string_conversions.Make (T) + +include Int_string_conversions.Make_hex (struct + open Int_replace_polymorphic_compare + + type t = int [@@deriving_inline compare ~localize, hash] + + let compare__local = (compare_int__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int in + fun x -> func x + ;; + + [@@@end] + + let zero = zero + let neg = ( ~- ) + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%x" i + let of_string s = Stdlib.Scanf.sscanf s "%x" Fn.id + let module_name = "Base.Int.Hex" +end) + +include Pretty_printer.Register (struct + type nonrec t = t + + let to_string = to_string + let module_name = "Base.Int" +end) + +(* Open replace_polymorphic_compare after including functor instantiations so + they do not shadow its definitions. This is here so that efficient versions + of the comparison functions are available within this module. *) +open! Int_replace_polymorphic_compare + +let invariant (_ : t) = () +let between t ~low ~high = low <= t && t <= high +let clamp_unchecked t ~min:min_ ~max:max_ = min t max_ |> max min_ + +let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max +;; + +let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) +;; + +external to_int32_trunc : (t[@local_opt]) -> (int32[@local_opt]) = "%int32_of_int" +external of_int32_trunc : (int32[@local_opt]) -> t = "%int32_to_int" +external of_int64_trunc : (int64[@local_opt]) -> t = "%int64_to_int" +external of_nativeint_trunc : (nativeint[@local_opt]) -> t = "%nativeint_to_int" + +let pred i = i - 1 +let succ i = i + 1 +let to_int i = i +let to_int_exn = to_int +let of_int i = i +let of_int_exn = of_int +let max_value = Stdlib.max_int +let min_value = Stdlib.min_int +let max_value_30_bits = 0x3FFF_FFFF +let of_int32 = Conv.int32_to_int +let of_int32_exn = Conv.int32_to_int_exn +let to_int32 = Conv.int_to_int32 +let to_int32_exn = Conv.int_to_int32_exn +let of_int64 = Conv.int64_to_int +let of_int64_exn = Conv.int64_to_int_exn +let to_int64 = Conv.int_to_int64 +let of_nativeint = Conv.nativeint_to_int +let of_nativeint_exn = Conv.nativeint_to_int_exn +let to_nativeint = Conv.int_to_nativeint +let to_nativeint_exn = to_nativeint +let abs x = abs x + +(* note that rem is not same as % *) +let rem a b = a mod b +let incr = Stdlib.incr +let decr = Stdlib.decr +let shift_right a b = a asr b +let shift_right_logical a b = a lsr b +let shift_left a b = a lsl b +let bit_not a = lnot a +let bit_or a b = a lor b +let bit_and a b = a land b +let bit_xor a b = a lxor b +let pow = Int_math.Private.int_pow +let ( ** ) b e = pow b e + +module Pow2 = struct + open! Import + + let raise_s = Error.raise_s + + let non_positive_argument () = + Printf.invalid_argf "argument must be strictly positive" () + ;; + + (** "ceiling power of 2" - Least power of 2 greater than or equal to x. *) + let ceil_pow2 x = + if x <= 0 then non_positive_argument (); + let x = x - 1 in + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + (* The next line is superfluous on 32-bit architectures, but it's faster to do it + anyway than to branch *) + let x = x lor (x lsr 32) in + x + 1 + ;; + + (** "floor power of 2" - Largest power of 2 less than or equal to x. *) + let floor_pow2 x = + if x <= 0 then non_positive_argument (); + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + (* The next line is superfluous on 32-bit architectures, but it's faster to do it + anyway than to branch *) + let x = x lor (x lsr 32) in + x - (x lsr 1) + ;; + + let is_pow2 x = + if x <= 0 then non_positive_argument (); + x land (x - 1) = 0 + ;; + + (* C stubs for int clz and ctz to use the CLZ/BSR/CTZ/BSF instruction where possible *) + external clz + : (* Note that we pass the tagged int here. See int_math_stubs.c for details on why + this is correct. *) + int + -> (int[@untagged]) + = "Base_int_math_int_clz" "Base_int_math_int_clz_untagged" + [@@noalloc] + + external ctz + : (int[@untagged]) + -> (int[@untagged]) + = "Base_int_math_int_ctz" "Base_int_math_int_ctz_untagged" + [@@noalloc] + + (** Hacker's Delight Second Edition p106 *) + let floor_log2 i = + if i <= 0 + then raise_s (Sexp.message "[Int.floor_log2] got invalid input" [ "", sexp_of_int i ]); + num_bits - 1 - clz i + ;; + + let ceil_log2 i = + if i <= 0 + then raise_s (Sexp.message "[Int.ceil_log2] got invalid input" [ "", sexp_of_int i ]); + if i = 1 then 0 else num_bits - clz (i - 1) + ;; +end + +include Pow2 + +let sign = Sign.of_int +let popcount = Popcount.int_popcount + +include Int_string_conversions.Make_binary (struct + type t = int [@@deriving_inline compare ~localize, equal ~localize, hash] + + let compare__local = (compare_int__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + let equal__local = (equal_int__local : t -> t -> bool) + let equal = (fun a b -> equal__local a b : t -> t -> bool) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int in + fun x -> func x + ;; + + [@@@end] + + let ( land ) = ( land ) + let ( lsr ) = ( lsr ) + let clz = clz + let num_bits = num_bits + let one = one + let to_int_exn = to_int_exn + let zero = zero +end) + +module Pre_O = struct + external ( + ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%addint" + external ( - ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%subint" + external ( * ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%mulint" + external ( / ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%divint" + external ( ~- ) : (t[@local_opt]) -> t = "%negint" + + let ( ** ) = ( ** ) + + include Int_replace_polymorphic_compare + + let abs = abs + + external neg : (t[@local_opt]) -> t = "%negint" + + let zero = zero + let of_int_exn = of_int_exn +end + +module O = struct + include Pre_O + + module F = Int_math.Make (struct + type nonrec t = t + + include Pre_O + + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) + + include F + + external bswap16 : (int[@local_opt]) -> int = "%bswap16" + + (* These inlined versions of (%), (/%), and (//) perform better than their functorized + counterparts in [F] (see benchmarks below). + + The reason these functions are inlined in [Int] but not in any of the other integer + modules is that they existed in [Int] and [Int] alone prior to the introduction of + the [Int_math.Make] functor, and we didn't want to degrade their performance. + + We won't pre-emptively do the same for new functions, unless someone cares, on a case + by case fashion. *) + + let ( % ) x y = + if y <= zero + then + Printf.invalid_argf + "%s %% %s in core_int.ml: modulus should be positive" + (to_string x) + (to_string y) + (); + let rval = rem x y in + if rval < zero then rval + y else rval + ;; + + let ( /% ) x y = + if y <= zero + then + Printf.invalid_argf + "%s /%% %s in core_int.ml: divisor should be positive" + (to_string x) + (to_string y) + (); + if x < zero then ((x + one) / y) - one else x / y + ;; + + let ( // ) x y = to_float x /. to_float y + + external ( land ) : (int[@local_opt]) -> (int[@local_opt]) -> int = "%andint" + external ( lor ) : (int[@local_opt]) -> (int[@local_opt]) -> int = "%orint" + external ( lxor ) : (int[@local_opt]) -> (int[@local_opt]) -> int = "%xorint" + + let lnot = lnot + + external ( lsl ) : (int[@local_opt]) -> (int[@local_opt]) -> int = "%lslint" + external ( lsr ) : (int[@local_opt]) -> (int[@local_opt]) -> int = "%lsrint" + external ( asr ) : (int[@local_opt]) -> (int[@local_opt]) -> int = "%asrint" +end + +include O + +(* [Int] and [Int.O] agree value-wise *) + +module Private = struct + module O_F = O.F +end + +(* Include type-specific [Replace_polymorphic_compare] at the end, after including functor + application that could shadow its definitions. This is here so that efficient versions + of the comparison functions are exported by this module. *) +include Int_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/int.mli b/unikernel/duniverse/base/src/int.mli new file mode 100644 index 00000000..6643709a --- /dev/null +++ b/unikernel/duniverse/base/src/int.mli @@ -0,0 +1 @@ +include Int_intf.Int (** @inline *) diff --git a/unikernel/duniverse/base/src/int0.ml b/unikernel/duniverse/base/src/int0.ml new file mode 100644 index 00000000..eefaca64 --- /dev/null +++ b/unikernel/duniverse/base/src/int0.ml @@ -0,0 +1,25 @@ +(* [Int0] defines integer functions that are primitives or can be simply + defined in terms of [Stdlib]. [Int0] is intended to completely express the + part of [Stdlib] that [Base] uses for integers -- no other file in Base other + than int0.ml should use these functions directly through [Stdlib]. [Int0] has + few dependencies, and so is available early in Base's build order. + + All Base files that need to use ints and come before [Base.Int] in build + order should do: + + {[ + module Int = Int0 + ]} + + Defining [module Int = Int0] is also necessary because it prevents ocamldep + from mistakenly causing a file to depend on [Base.Int]. *) + +let to_string = Stdlib.string_of_int +let of_string = Stdlib.int_of_string +let of_string_opt = Stdlib.int_of_string_opt +let to_float = Stdlib.float_of_int +let of_float = Stdlib.int_of_float +let max_value = Stdlib.max_int +let min_value = Stdlib.min_int +let succ = Stdlib.succ +let pred = Stdlib.pred diff --git a/unikernel/duniverse/base/src/int32.ml b/unikernel/duniverse/base/src/int32.ml new file mode 100644 index 00000000..936f39c1 --- /dev/null +++ b/unikernel/duniverse/base/src/int32.ml @@ -0,0 +1,337 @@ +open! Import +open! Stdlib.Int32 + +module T = struct + type t = int32 [@@deriving_inline globalize, hash, sexp, sexp_grammar] + + let (globalize : t -> t) = (globalize_int32 : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int32 + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int32 in + fun x -> func x + ;; + + let t_of_sexp = (int32_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_int32 : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int32_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + let compare (x : t) y = compare x y + let to_string = to_string + let of_string = of_string + let of_string_opt = of_string_opt +end + +include T +include Comparator.Make (T) + +let num_bits = 32 +let float_lower_bound = Float0.lower_bound_for_int num_bits +let float_upper_bound = Float0.upper_bound_for_int num_bits +let float_of_bits = float_of_bits +let bits_of_float = bits_of_float +let shift_right_logical = shift_right_logical +let shift_right = shift_right +let shift_left = shift_left +let bit_not = lognot +let bit_xor = logxor +let bit_or = logor +let bit_and = logand +let min_value = min_int +let max_value = max_int +let abs = abs +let pred = pred +let succ = succ +let rem = rem +let neg = neg +let minus_one = minus_one +let one = one +let zero = zero +let compare = compare +let compare__local = Stdlib.compare +let to_float = to_float +let of_float_unchecked = of_float + +let of_float f = + if Float_replace_polymorphic_compare.( >= ) f float_lower_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + then of_float f + else + Printf.invalid_argf + "Int32.of_float: argument (%f) is out of range or NaN" + (Float0.box f) + () +;; + +include Comparable.With_zero (struct + include T + + let zero = zero +end) + +module Infix_compare = struct + open Poly + + let ( >= ) (x : t) y = x >= y + let ( <= ) (x : t) y = x <= y + let ( = ) (x : t) y = x = y + let ( > ) (x : t) y = x > y + let ( < ) (x : t) y = x < y + let ( <> ) (x : t) y = x <> y +end + +module Compare = struct + include Infix_compare + + let compare = compare + let compare__local = compare__local + let ascending = compare + let descending x y = compare y x + let min x y = Bool0.select (x <= y) x y + let max x y = Bool0.select (x >= y) x y + let equal (x : t) y = x = y + let equal__local (x : t) y = Poly.equal x y + let between t ~low ~high = low <= t && t <= high + let clamp_unchecked t ~min:min_ ~max:max_ = min t max_ |> max min_ + + let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max + ;; + + let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) + ;; +end + +include Compare + +let invariant (_ : t) = () +let ( / ) = div +let ( * ) = mul +let ( - ) = sub +let ( + ) = add +let ( ~- ) = neg +let incr r = r := !r + one +let decr r = r := !r - one +let of_int32 t = t +let of_int32_exn = of_int32 +let to_int32 t = t +let to_int32_exn = to_int32 +let popcount = Popcount.int32_popcount + +module Conv = Int_conversions + +let of_int = Conv.int_to_int32 +let of_int_exn = Conv.int_to_int32_exn +let of_int_trunc = Conv.int_to_int32_trunc +let to_int = Conv.int32_to_int +let to_int_exn = Conv.int32_to_int_exn +let to_int_trunc = Conv.int32_to_int_trunc +let of_int64 = Conv.int64_to_int32 +let of_int64_exn = Conv.int64_to_int32_exn +let of_int64_trunc = Conv.int64_to_int32_trunc +let to_int64 = Conv.int32_to_int64 +let of_nativeint = Conv.nativeint_to_int32 +let of_nativeint_exn = Conv.nativeint_to_int32_exn +let of_nativeint_trunc = Conv.nativeint_to_int32_trunc +let to_nativeint = Conv.int32_to_nativeint +let to_nativeint_exn = to_nativeint +let pow b e = of_int_exn (Int_math.Private.int_pow (to_int_exn b) (to_int_exn e)) +let ( ** ) b e = pow b e + +external bswap32 : (t[@local_opt]) -> (t[@local_opt]) = "%bswap_int32" + +let bswap16 x = Stdlib.Int32.shift_right_logical (bswap32 x) 16 + +module Pow2 = struct + open! Import + open Int32_replace_polymorphic_compare + + let raise_s = Error.raise_s + + let non_positive_argument () = + Printf.invalid_argf "argument must be strictly positive" () + ;; + + let ( lor ) = Stdlib.Int32.logor + let ( lsr ) = Stdlib.Int32.shift_right_logical + let ( land ) = Stdlib.Int32.logand + + (** "ceiling power of 2" - Least power of 2 greater than or equal to x. *) + let ceil_pow2 x = + if x <= Stdlib.Int32.zero then non_positive_argument (); + let x = Stdlib.Int32.pred x in + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + Stdlib.Int32.succ x + ;; + + (** "floor power of 2" - Largest power of 2 less than or equal to x. *) + let floor_pow2 x = + if x <= Stdlib.Int32.zero then non_positive_argument (); + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + Stdlib.Int32.sub x (x lsr 1) + ;; + + let is_pow2 x = + if x <= Stdlib.Int32.zero then non_positive_argument (); + x land Stdlib.Int32.pred x = Stdlib.Int32.zero + ;; + + (* C stubs for int32 clz and ctz to use the CLZ/BSR/CTZ/BSF instruction where possible *) + external clz + : (int32[@unboxed]) + -> (int[@untagged]) + = "Base_int_math_int32_clz" "Base_int_math_int32_clz_unboxed" + [@@noalloc] + + external ctz + : (int32[@unboxed]) + -> (int[@untagged]) + = "Base_int_math_int32_ctz" "Base_int_math_int32_ctz_unboxed" + [@@noalloc] + + (** Hacker's Delight Second Edition p106 *) + let floor_log2 i = + if i <= Stdlib.Int32.zero + then + raise_s + (Sexp.message "[Int32.floor_log2] got invalid input" [ "", sexp_of_int32 i ]); + num_bits - 1 - clz i + ;; + + (** Hacker's Delight Second Edition p106 *) + let ceil_log2 i = + if i <= Stdlib.Int32.zero + then + raise_s (Sexp.message "[Int32.ceil_log2] got invalid input" [ "", sexp_of_int32 i ]); + (* The [i = 1] check is needed because clz(0) is undefined *) + if Stdlib.Int32.equal i Stdlib.Int32.one + then 0 + else num_bits - clz (Stdlib.Int32.pred i) + ;; +end + +include Pow2 +include Int_string_conversions.Make (T) + +include Int_string_conversions.Make_hex (struct + type t = int32 [@@deriving_inline compare ~localize, hash] + + let compare__local = (compare_int32__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int32 + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int32 in + fun x -> func x + ;; + + [@@@end] + + let zero = zero + let neg = ( ~- ) + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%lx" i + let of_string s = Stdlib.Scanf.sscanf s "%lx" Fn.id + let module_name = "Base.Int32.Hex" +end) + +include Int_string_conversions.Make_binary (struct + type t = int32 [@@deriving_inline compare ~localize, equal ~localize, hash] + + let compare__local = (compare_int32__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + let equal__local = (equal_int32__local : t -> t -> bool) + let equal = (fun a b -> equal__local a b : t -> t -> bool) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int32 + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int32 in + fun x -> func x + ;; + + [@@@end] + + let ( land ) = ( land ) + let ( lsr ) = ( lsr ) + let clz = clz + let num_bits = num_bits + let one = one + let to_int_exn = to_int_exn + let zero = zero +end) + +include Pretty_printer.Register (struct + type nonrec t = t + + let to_string = to_string + let module_name = "Base.Int32" +end) + +module Pre_O = struct + let ( + ) = ( + ) + let ( - ) = ( - ) + let ( * ) = ( * ) + let ( / ) = ( / ) + let ( ~- ) = ( ~- ) + let ( ** ) = ( ** ) + + include (Compare : Comparisons.Infix with type t := t) + + let abs = abs + let neg = neg + let zero = zero + let of_int_exn = of_int_exn +end + +module O = struct + include Pre_O + + include Int_math.Make (struct + type nonrec t = t + + include Pre_O + + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) + + let ( land ) = bit_and + let ( lor ) = bit_or + let ( lxor ) = bit_xor + let lnot = bit_not + let ( lsl ) = shift_left + let ( asr ) = shift_right + let ( lsr ) = shift_right_logical +end + +include O + +(* [Int32] and [Int32.O] agree value-wise *) diff --git a/unikernel/duniverse/base/src/int32.mli b/unikernel/duniverse/base/src/int32.mli new file mode 100644 index 00000000..49aa0fda --- /dev/null +++ b/unikernel/duniverse/base/src/int32.mli @@ -0,0 +1,67 @@ +(** An int of exactly 32 bits, regardless of the machine. + + Side note: There's not much reason to want an int of at least 32 bits (i.e., 32 on + 32-bit machines and 63 on 64-bit machines) because [Int63] is basically just as + efficient. + + Overflow issues are {i not} generally considered and explicitly handled. This may be + more of an issue for 32-bit ints than 64-bit ints. + + [Int32.t] is boxed on both 32-bit and 64-bit machines. *) + +open! Import + +type t = int32 [@@deriving_inline globalize] + +val globalize : t -> t + +[@@@end] + +include Int_intf.S with type t := t + +(** {2 Conversion functions} *) + +val of_int : int -> t option +val to_int : t -> int option +val of_int32 : int32 -> t +val to_int32 : t -> int32 +val of_nativeint : nativeint -> t option +val to_nativeint : t -> nativeint +val of_int64 : int64 -> t option + +(** {3 Truncating conversions} + + These functions return the least-significant bits of the input. In cases where + optional conversions return [Some x], truncating conversions return [x]. *) + +val of_int_trunc : int -> t +val to_int_trunc : t -> int +val of_nativeint_trunc : nativeint -> t +val of_int64_trunc : int64 -> t + +(** {3 Low-level float conversions} *) + +(** Rounds a regular 64-bit OCaml float to a 32-bit IEEE-754 "single" float, and returns + its bit representation. We make no promises about the exact rounding behavior, or + what happens in case of over- or underflow. *) +val bits_of_float : float -> t + +(** Creates a 32-bit IEEE-754 "single" float from the given bits, and converts it to a + regular 64-bit OCaml float. *) +val float_of_bits : t -> float + +(** {2 Byte swap operations} + + See {{!modtype:Int.Int_without_module_types}[Int]'s byte swap section} for + a description of Base's approach to exposing byte swap primitives. + + When compiling for 64-bit machines, if signedness of the output value does not matter, + use byteswap functions for [int64], if possible, for better performance. As of + writing, 32-bit byte swap operations on 64-bit machines have extra overhead for moving + to 32-bit registers and sign-extending values when returning to 64-bit registers. + + The x86 instruction sequence that demonstrates the overhead is in + [base/bench/bench_int.ml] *) + +val bswap16 : t -> t +val bswap32 : t -> t diff --git a/unikernel/duniverse/base/src/int63.ml b/unikernel/duniverse/base/src/int63.ml new file mode 100644 index 00000000..efa5d796 --- /dev/null +++ b/unikernel/duniverse/base/src/int63.ml @@ -0,0 +1,159 @@ +open! Import + +let raise_s = Error.raise_s + +module Repr = Int63_emul.Repr +include Sys0.Make_immediate64 (Int) (Int63_emul) + +module Backend = struct + module type S = sig + type t + + include Int_intf.S with type t := t + + val of_int : int -> t + val to_int : t -> int option + val to_int_trunc : t -> int + val of_int32 : int32 -> t + val to_int32 : t -> Int32.t option + val to_int32_trunc : t -> Int32.t + val of_int64 : Int64.t -> t option + val of_int64_trunc : Int64.t -> t + val of_nativeint : nativeint -> t option + val to_nativeint : t -> nativeint option + val of_nativeint_trunc : nativeint -> t + val to_nativeint_trunc : t -> nativeint + val of_float_unchecked : float -> t + val repr : (t, t) Int63_emul.Repr.t + val bswap16 : t -> t + val bswap32 : t -> t + val bswap48 : t -> t + end + with type t := t + + module Native = struct + include Int + + let to_int x = Some x + let to_int_trunc x = x + + (* [of_int32_exn] is a safe operation on platforms with 64-bit word sizes. *) + let of_int32 = of_int32_exn + let to_nativeint_trunc x = to_nativeint x + let to_nativeint x = Some (to_nativeint x) + let repr = Int63_emul.Repr.Int + let bswap32 t = Int64.to_int_trunc (Int64.bswap32 (Int64.of_int t)) + let bswap48 t = Int64.to_int_trunc (Int64.bswap48 (Int64.of_int t)) + end + + let impl : (module S) = + match repr with + | Immediate -> (module Native : S) + | Non_immediate -> (module Int63_emul : S) + ;; +end + +include (val Backend.impl : Backend.S) + +module Overflow_exn = struct + let ( + ) t u = + let sum = t + u in + if bit_or (bit_xor t u) (bit_xor t (bit_not sum)) < zero + then sum + else + raise_s + (Sexp.message + "( + ) overflow" + [ "t", sexp_of_t t; "u", sexp_of_t u; "sum", sexp_of_t sum ]) + ;; + + let ( - ) t u = + let diff = t - u in + let pos_diff = t > u in + if t <> u && Bool.( <> ) pos_diff (is_positive diff) + then + raise_s + (Sexp.message + "( - ) overflow" + [ "t", sexp_of_t t; "u", sexp_of_t u; "diff", sexp_of_t diff ]) + else diff + ;; + + let negative_one = of_int (-1) + let div_would_overflow t u = t = min_value && u = negative_one + + let ( * ) t u = + let product = t * u in + if u <> zero && (div_would_overflow product u || product / u <> t) + then + raise_s + (Sexp.message + "( * ) overflow" + [ "t", sexp_of_t t; "u", sexp_of_t u; "product", sexp_of_t product ]) + else product + ;; + + let ( / ) t u = + if div_would_overflow t u + then + raise_s + (Sexp.message + "( / ) overflow" + [ "t", sexp_of_t t; "u", sexp_of_t u; "product", sexp_of_t (t / u) ]) + else t / u + ;; + + let abs t = if t = min_value then failwith "abs overflow" else abs t + let neg t = if t = min_value then failwith "neg overflow" else neg t +end + +let () = assert (Int.( = ) num_bits 63) + +let random_of_int ?(state = Random.State.default) bound = + of_int (Random.State.int state (to_int_exn bound)) +;; + +let random_of_int64 ?(state = Random.State.default) bound = + of_int64_exn (Random.State.int64 state (to_int64 bound)) +;; + +let random = + match Word_size.word_size with + | W64 -> random_of_int + | W32 -> random_of_int64 +;; + +let random_incl_of_int ?(state = Random.State.default) lo hi = + of_int (Random.State.int_incl state (to_int_exn lo) (to_int_exn hi)) +;; + +let random_incl_of_int64 ?(state = Random.State.default) lo hi = + of_int64_exn (Random.State.int64_incl state (to_int64 lo) (to_int64 hi)) +;; + +let random_incl = + match Word_size.word_size with + | W64 -> random_incl_of_int + | W32 -> random_incl_of_int64 +;; + +let floor_log2 t = + match Word_size.word_size with + | W64 -> t |> to_int_exn |> Int.floor_log2 + | W32 -> + if t <= zero + then raise_s (Sexp.message "[Int.floor_log2] got invalid input" [ "", sexp_of_t t ]); + let floor_log2 = ref (Int.( - ) num_bits 2) in + while equal zero (bit_and t (shift_left one !floor_log2)) do + floor_log2 := Int.( - ) !floor_log2 1 + done; + !floor_log2 +;; + +module Private = struct + module Repr = Repr + + let repr = repr + + module Emul = Int63_emul +end diff --git a/unikernel/duniverse/base/src/int63.mli b/unikernel/duniverse/base/src/int63.mli new file mode 100644 index 00000000..e5425438 --- /dev/null +++ b/unikernel/duniverse/base/src/int63.mli @@ -0,0 +1,100 @@ +(** 63-bit integers. + + The size of Int63 is always 63 bits. On a 64-bit platform it is just an int + (63-bits), and on a 32-bit platform it is an int64 wrapped to respect the + semantics of 63-bit integers. + + Because [Int63] has different representations on 32-bit and 64-bit platforms, + marshalling [Int63] will not work between 32-bit and 64-bit platforms -- [unmarshal] + will segfault. *) + +open! Import + +(** The [@@immediate64] attribute is to indicate that [t] is implemented by a type that is + immediate only on 64 bit platforms. It is currently ignored by the compiler, however + we are hoping that one day it will be taken into account so that the compiler can omit + [caml_modify] when dealing with mutable data structures holding [Int63.t] values. *) +type t [@@immediate64] + +include Int_intf.S with type t := t + +(** {2 Arithmetic with overflow} + + Unlike the usual operations, these never overflow, preferring instead to raise. *) + +module Overflow_exn : sig + val ( + ) : t -> t -> t + val ( - ) : t -> t -> t + val ( * ) : t -> t -> t + val ( / ) : t -> t -> t + val abs : t -> t + val neg : t -> t +end + +(** {2 Conversion functions} *) + +val of_int : int -> t +val to_int : t -> int option +val of_int32 : Int32.t -> t +val to_int32 : t -> Int32.t option +val of_int64 : Int64.t -> t option +val of_nativeint : nativeint -> t option +val to_nativeint : t -> nativeint option + +(** {3 Truncating conversions} + + These functions return the least-significant bits of the input. In cases where + optional conversions return [Some x], truncating conversions return [x]. *) + +val to_int_trunc : t -> int +val to_int32_trunc : t -> Int32.t +val of_int64_trunc : Int64.t -> t +val of_nativeint_trunc : nativeint -> t +val to_nativeint_trunc : t -> nativeint + +(** {2 Byteswap functions} + + See {{!modtype:Int.Int_without_module_types}[Int]'s byte swap section} for + a description of Base's approach to exposing byte swap primitives. +*) + +val bswap16 : t -> t +val bswap32 : t -> t +val bswap48 : t -> t + +(** {2 Random generation} *) + +(** [random ~state bound] returns a random integer between 0 (inclusive) and [bound] + (exclusive). [bound] must be greater than 0. + + The default [~state] is [Random.State.default]. *) +val random : ?state:Random.State.t -> t -> t + +(** [random_incl ~state lo hi] returns a random integer between [lo] (inclusive) and [hi] + (inclusive). Raises if [lo > hi]. + + The default [~state] is [Random.State.default]. *) +val random_incl : ?state:Random.State.t -> t -> t -> t + +(** [floor_log2 x] returns the floor of log-base-2 of [x], and raises if [x <= 0]. *) +val floor_log2 : t -> int + +(**/**) + +(*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) +module Private : sig + (** [val repr] states how [Int63.t] is represented, i.e., as an [int] or an [int64], and + can be used for building [Int63] operations that behave differently depending on the + representation (e.g., see core_int63.ml). *) + module Repr : sig + type ('underlying_type, 'intermediate_type) t = + | Int : (int, int) t + | Int64 : (int64, Int63_emul.t) t + end + + val repr : (t, t) Repr.t + + module Emul = Int63_emul +end diff --git a/unikernel/duniverse/base/src/int63_emul.ml b/unikernel/duniverse/base/src/int63_emul.ml new file mode 100644 index 00000000..6293fb45 --- /dev/null +++ b/unikernel/duniverse/base/src/int63_emul.ml @@ -0,0 +1,498 @@ +(* A 63bit integer is a 64bit integer with its bits shifted to the left + and its lowest bit set to 0. + This is the same kind of encoding as OCaml int on 64bit architecture. + The only difference being the lowest bit (immediate bit) set to 1. *) + +open! Import +include Int64_replace_polymorphic_compare + +module T0 = struct + module T = struct + type t = int64 + [@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] + + let compare__local = (compare_int64__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + let (globalize : t -> t) = (globalize_int64 : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int64 + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int64 in + fun x -> func x + ;; + + let t_of_sexp = (int64_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_int64 : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int64_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + end + + include T + include Comparator.Make (T) +end + +module Conv = Int_conversions + +module W : sig + include module type of struct + include T0 + end + + type t = int64 + + val wrap_exn : Stdlib.Int64.t -> t + val wrap_modulo : Stdlib.Int64.t -> t + val unwrap : t -> Stdlib.Int64.t + + (** Returns a non-negative int64 that is equal to the input int63 modulo 2^63. *) + val unwrap_unsigned : t -> Stdlib.Int64.t + + val invariant : t -> unit + val add : t -> t -> t + val sub : t -> t -> t + val neg : t -> t + val abs : t -> t + val succ : t -> t + val pred : t -> t + val mul : t -> t -> t + val pow : t -> t -> t + val div : t -> t -> t + val rem : t -> t -> t + val popcount : t -> int + val bit_not : t -> t + val bit_xor : t -> t -> t + val bit_or : t -> t -> t + val bit_and : t -> t -> t + val shift_left : t -> int -> t + val shift_right : t -> int -> t + val shift_right_logical : t -> int -> t + val min_value : t + val max_value : t + val to_int64 : t -> Stdlib.Int64.t + val of_int64 : Stdlib.Int64.t -> t option + val of_int64_exn : Stdlib.Int64.t -> t + val of_int64_trunc : Stdlib.Int64.t -> t + val compare : t -> t -> int + val compare__local : t -> t -> int + val equal__local : t -> t -> bool + val ceil_pow2 : t -> t + val floor_pow2 : t -> t + val ceil_log2 : t -> int + val floor_log2 : t -> int + val is_pow2 : t -> bool + val clz : t -> int + val ctz : t -> int +end = struct + include T0 + + type t = int64 + + let wrap_exn x = + (* Raises if the int64 value does not fit on int63. *) + Conv.int64_fit_on_int63_exn x; + Stdlib.Int64.mul x 2L + ;; + + let wrap x = + if Conv.int64_is_representable_as_int63 x then Some (Stdlib.Int64.mul x 2L) else None + ;; + + let wrap_modulo x = Stdlib.Int64.mul x 2L + let unwrap x = Stdlib.Int64.shift_right x 1 + let unwrap_unsigned x = Stdlib.Int64.shift_right_logical x 1 + + (* This does not use wrap or unwrap to avoid generating exceptions in the case of + overflows. This is to preserve the semantics of int type on 64 bit architecture. *) + let f2 f a b = + Stdlib.Int64.mul (f (Stdlib.Int64.shift_right a 1) (Stdlib.Int64.shift_right b 1)) 2L + ;; + + let mask = 0xffff_ffff_ffff_fffeL + let m x = Stdlib.Int64.logand x mask + let invariant t = assert (m t = t) + let add x y = Stdlib.Int64.add x y + let sub x y = Stdlib.Int64.sub x y + let neg x = Stdlib.Int64.neg x + let abs x = Stdlib.Int64.abs x + let one = wrap_exn 1L + let succ a = add a one + let pred a = sub a one + let min_value = m Stdlib.Int64.min_int + let max_value = m Stdlib.Int64.max_int + let bit_not x = m (Stdlib.Int64.lognot x) + let bit_and = Stdlib.Int64.logand + let bit_xor = Stdlib.Int64.logxor + let bit_or = Stdlib.Int64.logor + let shift_left x i = Stdlib.Int64.shift_left x i + let shift_right x i = m (Stdlib.Int64.shift_right x i) + let shift_right_logical x i = m (Stdlib.Int64.shift_right_logical x i) + let pow = f2 Int_math.Private.int63_pow_on_int64 + let mul a b = Stdlib.Int64.mul a (Stdlib.Int64.shift_right b 1) + let div a b = wrap_modulo (Stdlib.Int64.div a b) + let rem a b = Stdlib.Int64.rem a b + let popcount x = Popcount.int64_popcount x + let to_int64 t = unwrap t + let of_int64 t = wrap t + let of_int64_exn t = wrap_exn t + let of_int64_trunc t = wrap_modulo t + let t_of_sexp x = wrap_exn (int64_of_sexp x) + let sexp_of_t x = sexp_of_int64 (unwrap x) + let compare (x : t) y = compare x y + let compare__local (x : t) y = compare__local x y + let equal__local (x : t) y = equal__local x y + let is_pow2 x = Int64.is_pow2 (unwrap x) + + let clz x = + (* We run Int64.clz directly on the wrapped int63 value. This is correct because the + bits of the int63_emul are left-aligned in the Int64. *) + Int64.clz x + ;; + + let ctz x = Int64.ctz (unwrap x) + let floor_pow2 x = Int64.floor_pow2 (unwrap x) |> wrap_exn + let ceil_pow2 x = Int64.floor_pow2 (unwrap x) |> wrap_exn + let floor_log2 x = Int64.floor_log2 (unwrap x) + let ceil_log2 x = Int64.ceil_log2 (unwrap x) +end + +open W + +module T = struct + type t = W.t [@@deriving_inline globalize, hash, sexp, sexp_grammar] + + let (globalize : t -> t) = (W.globalize : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + W.hash_fold_t + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = W.hash in + fun x -> func x + ;; + + let t_of_sexp = (W.t_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (W.sexp_of_t : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = W.t_sexp_grammar + + [@@@end] + + type comparator_witness = W.comparator_witness + + let comparator = W.comparator + let compare = W.compare + let compare__local = W.compare__local + let equal__local = W.equal__local + let invariant = W.invariant + + (* We don't expect [hash] to follow the behavior of int in 64bit architecture *) + let _ = hash + let hash (x : t) = Stdlib.Hashtbl.hash x + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + let invalid_str x = Printf.failwithf "Int63.of_string: invalid input %S" x () + + (* + "sign" refers to whether the number starts with a '-' + "signedness = false" means the rest of the number is parsed as unsigned and then cast + to signed with wrap-around modulo 2^i + "signedness = true" means no such craziness happens + + The terminology and the logic is due to the code in byterun/ints.c in ocaml 4.03 + ([parse_sign_and_base] function). + + Signedness equals true for plain decimal number (e.g. 1235, -6789) + + Signedness equals false in the following cases: + - [0xffff], [-0xffff] (hexadecimal representation) + - [0b0101], [-0b0101] (binary representation) + - [0o1237], [-0o1237] (octal representation) + - [0u9812], [-0u9812] (unsigned decimal representation - available from OCaml 4.03) *) + let sign_and_signedness x = + let len = String.length x in + let open Int_replace_polymorphic_compare in + let pos, sign = + if 0 < len + then ( + match x.[0] with + | '-' -> 1, `Neg + | '+' -> 1, `Pos + | _ -> 0, `Pos) + else 0, `Pos + in + if pos + 2 < len + then ( + let c1 = x.[pos] in + let c2 = x.[pos + 1] in + match c1, c2 with + | '0', '0' .. '9' -> sign, true + | '0', _ -> sign, false + | _ -> sign, true) + else sign, true + ;; + + let to_string x = Stdlib.Int64.to_string (unwrap x) + + let of_string_raw str = + let sign, signedness = sign_and_signedness str in + if signedness + then of_int64_exn (Stdlib.Int64.of_string str) + else ( + let pos_str = + match sign with + | `Neg -> String.sub str ~pos:1 ~len:(String.length str - 1) + | `Pos -> str + in + let int64 = Stdlib.Int64.of_string pos_str in + (* unsigned 63-bit int must parse as a positive signed 64-bit int *) + if Int64_replace_polymorphic_compare.( < ) int64 0L then invalid_str str; + let int63 = wrap_modulo int64 in + match sign with + | `Neg -> neg int63 + | `Pos -> int63) + ;; + + let of_string str = + try of_string_raw str with + | _ -> invalid_str str + ;; + + let of_string_opt str = + match of_string_raw str with + | t -> Some t + | exception _ -> None + ;; + + let bswap16 t = wrap_modulo (Int64.bswap16 (unwrap t)) + let bswap32 t = wrap_modulo (Int64.bswap32 (unwrap t)) + let bswap48 t = wrap_modulo (Int64.bswap48 (unwrap t)) +end + +include T + +let num_bits = 63 +let float_lower_bound = Float0.lower_bound_for_int num_bits +let float_upper_bound = Float0.upper_bound_for_int num_bits +let shift_right_logical = shift_right_logical +let shift_right = shift_right +let shift_left = shift_left +let bit_not = bit_not +let bit_xor = bit_xor +let bit_or = bit_or +let bit_and = bit_and +let popcount = popcount +let abs = abs +let pred = pred +let succ = succ +let pow = pow +let rem = rem +let neg = neg +let max_value = max_value +let min_value = min_value +let minus_one = wrap_exn Stdlib.Int64.minus_one +let one = wrap_exn Stdlib.Int64.one +let zero = wrap_exn Stdlib.Int64.zero +let is_pow2 = is_pow2 +let floor_pow2 = floor_pow2 +let ceil_pow2 = ceil_pow2 +let floor_log2 = floor_log2 +let ceil_log2 = ceil_log2 +let clz = clz +let ctz = ctz +let to_float x = Stdlib.Int64.to_float (unwrap x) +let of_float_unchecked x = wrap_modulo (Stdlib.Int64.of_float x) + +let of_float t = + let open Float_replace_polymorphic_compare in + if t >= float_lower_bound && t <= float_upper_bound + then wrap_modulo (Stdlib.Int64.of_float t) + else + Printf.invalid_argf + "Int63.of_float: argument (%f) is out of range or NaN" + (Float0.box t) + () +;; + +let of_int64 = of_int64 +let of_int64_exn = of_int64_exn +let of_int64_trunc = of_int64_trunc +let to_int64 = to_int64 + +include Comparable.With_zero (struct + include T + + let zero = zero +end) + +let between t ~low ~high = low <= t && t <= high +let clamp_unchecked t ~min:min_ ~max:max_ = min t max_ |> max min_ + +let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max +;; + +let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) +;; + +let ( / ) = div +let ( * ) = mul +let ( - ) = sub +let ( + ) = add +let ( ~- ) = neg +let ( ** ) b e = pow b e +let incr r = r := !r + one +let decr r = r := !r - one + +(* We can reuse conversion function from/to int64 here. *) +let of_int x = wrap_exn (Conv.int_to_int64 x) +let of_int_exn x = of_int x +let to_int x = Conv.int64_to_int (unwrap x) +let to_int_exn x = Conv.int64_to_int_exn (unwrap x) +let to_int_trunc x = Conv.int64_to_int_trunc (unwrap x) +let of_int32 x = wrap_exn (Conv.int32_to_int64 x) +let of_int32_exn x = of_int32 x +let to_int32 x = Conv.int64_to_int32 (unwrap x) +let to_int32_exn x = Conv.int64_to_int32_exn (unwrap x) +let to_int32_trunc x = Conv.int64_to_int32_trunc (unwrap x) +let of_nativeint x = of_int64 (Conv.nativeint_to_int64 x) +let of_nativeint_exn x = wrap_exn (Conv.nativeint_to_int64 x) +let of_nativeint_trunc x = of_int64_trunc (Conv.nativeint_to_int64 x) +let to_nativeint x = Conv.int64_to_nativeint (unwrap x) +let to_nativeint_exn x = Conv.int64_to_nativeint_exn (unwrap x) +let to_nativeint_trunc x = Conv.int64_to_nativeint_trunc (unwrap x) + +include Int_string_conversions.Make (T) + +include Int_string_conversions.Make_hex (struct + type t = T.t [@@deriving_inline compare ~localize, hash] + + let compare__local = (T.compare__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + T.hash_fold_t + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = T.hash in + fun x -> func x + ;; + + [@@@end] + + let zero = zero + let neg = ( ~- ) + let ( < ) = ( < ) + + let to_string i = + (* the use of [unwrap_unsigned] here is important for the case of [min_value] *) + Printf.sprintf "%Lx" (unwrap_unsigned i) + ;; + + let of_string s = of_string ("0x" ^ s) + let module_name = "Base.Int63.Hex" +end) + +include Pretty_printer.Register (struct + type nonrec t = t + + let to_string x = to_string x + let module_name = "Base.Int63" +end) + +module Pre_O = struct + let ( + ) = ( + ) + let ( - ) = ( - ) + let ( * ) = ( * ) + let ( / ) = ( / ) + let ( ~- ) = ( ~- ) + let ( ** ) = ( ** ) + + include (Int64_replace_polymorphic_compare : Comparisons.Infix with type t := t) + + let abs = abs + let neg = neg + let zero = zero + let of_int_exn = of_int_exn +end + +module O = struct + include Pre_O + + include Int_math.Make (struct + type nonrec t = t + + include Pre_O + + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) + + let ( land ) = bit_and + let ( lor ) = bit_or + let ( lxor ) = bit_xor + let lnot = bit_not + let ( lsl ) = shift_left + let ( asr ) = shift_right + let ( lsr ) = shift_right_logical +end + +include O + +include Int_string_conversions.Make_binary (struct + type t = T.t [@@deriving_inline compare ~localize, equal ~localize, hash] + + let compare__local = (T.compare__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + let equal__local = (T.equal__local : t -> t -> bool) + let equal = (fun a b -> equal__local a b : t -> t -> bool) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + T.hash_fold_t + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = T.hash in + fun x -> func x + ;; + + [@@@end] + + let ( land ) = ( land ) + let ( lsr ) = ( lsr ) + let clz = clz + let num_bits = num_bits + let one = one + let to_int_exn = to_int_exn + let zero = zero +end) + +(* [Int63] and [Int63.O] agree value-wise *) + +module Repr = struct + type emulated = t + + type ('underlying_type, 'intermediate_type) t = + | Int : (int, int) t + | Int64 : (int64, emulated) t +end + +let repr = Repr.Int64 + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Int64_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/int63_emul.mli b/unikernel/duniverse/base/src/int63_emul.mli new file mode 100644 index 00000000..82190bb0 --- /dev/null +++ b/unikernel/duniverse/base/src/int63_emul.mli @@ -0,0 +1,45 @@ +(** [Int63_emul] implements 63-bit integers using the [int64] type. It is is used to + implement [Int63] on 32-bit platforms; see [Int63_backends.Emulated]. *) + +open! Import + +type t [@@deriving_inline globalize] + +val globalize : t -> t + +[@@@end] + +include Int_intf.S with type t := t + +val of_int : int -> t +val to_int : t -> int option +val to_int_trunc : t -> int +val of_int32 : int32 -> t +val to_int32 : t -> Int32.t option +val to_int32_trunc : t -> Int32.t +val of_int64 : Int64.t -> t option +val of_int64_trunc : Int64.t -> t +val of_nativeint : nativeint -> t option +val to_nativeint : t -> nativeint option +val of_nativeint_trunc : nativeint -> t +val to_nativeint_trunc : t -> nativeint +val bswap16 : t -> t +val bswap32 : t -> t +val bswap48 : t -> t + +(*_ exported for Core *) +module W : sig + val wrap_exn : int64 -> t + val unwrap : t -> int64 +end + +module Repr : sig + type emulated = t + + type ('underlying_type, 'intermediate_type) t = + | Int : (int, int) t + | Int64 : (int64, emulated) t +end +with type emulated := t + +val repr : (t, t) Repr.t diff --git a/unikernel/duniverse/base/src/int64.ml b/unikernel/duniverse/base/src/int64.ml new file mode 100644 index 00000000..e13d9500 --- /dev/null +++ b/unikernel/duniverse/base/src/int64.ml @@ -0,0 +1,369 @@ +open! Import +open! Stdlib.Int64 + +module T = struct + type t = int64 [@@deriving_inline globalize, hash, sexp, sexp_grammar] + + let (globalize : t -> t) = (globalize_int64 : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int64 + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int64 in + fun x -> func x + ;; + + let t_of_sexp = (int64_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_int64 : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int64_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + let compare = Int64_replace_polymorphic_compare.compare + let to_string = to_string + let of_string = of_string + let of_string_opt = of_string_opt +end + +include T +include Comparator.Make (T) + +let num_bits = 64 +let float_lower_bound = Float0.lower_bound_for_int num_bits +let float_upper_bound = Float0.upper_bound_for_int num_bits + +external float_of_bits + : (int64[@local_opt]) + -> (float[@local_opt]) + = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed" + [@@unboxed] [@@noalloc] + +external bits_of_float + : (float[@local_opt]) + -> (int64[@local_opt]) + = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed" + [@@unboxed] [@@noalloc] + +let shift_right_logical = shift_right_logical +let shift_right = shift_right +let shift_left = shift_left +let bit_not = lognot +let bit_xor = logxor +let bit_or = logor +let bit_and = logand +let min_value = min_int +let max_value = max_int +let abs = abs +let pred = pred +let succ = succ +let pow = Int_math.Private.int64_pow +let rem = rem +let neg = neg +let minus_one = minus_one +let one = one +let zero = zero +let to_float = to_float +let of_float_unchecked = Stdlib.Int64.of_float + +let of_float f = + if Float_replace_polymorphic_compare.( >= ) f float_lower_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + then Stdlib.Int64.of_float f + else + Printf.invalid_argf + "Int64.of_float: argument (%f) is out of range or NaN" + (Float0.box f) + () +;; + +(* Not eta-expanding here can lead to less allocations: the function call sites can avoid + boxing the int64s more often. *) +let ( ** ) = pow + +external bswap64 : (t[@local_opt]) -> (t[@local_opt]) = "%bswap_int64" + +let[@inline always] bswap16 x = Stdlib.Int64.shift_right_logical (bswap64 x) 48 + +let[@inline always] bswap32 x = + (* This is strictly better than coercing to an int32 to perform byteswap. Coercing + from an int32 will add unnecessary shift operations to sign extend the number + appropriately. + *) + Stdlib.Int64.shift_right_logical (bswap64 x) 32 +;; + +let[@inline always] bswap48 x = Stdlib.Int64.shift_right_logical (bswap64 x) 16 + +include Comparable.With_zero (struct + include T + + let zero = zero +end) + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open Int64_replace_polymorphic_compare + +let invariant (_ : t) = () +let between t ~low ~high = low <= t && t <= high +let clamp_unchecked t ~min:min_ ~max:max_ = min t max_ |> max min_ + +let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max +;; + +let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) +;; + +let incr r = r := add !r one +let decr r = r := sub !r one + +external of_int64 : (t[@local_opt]) -> (t[@local_opt]) = "%identity" + +let of_int64_exn = of_int64 +let to_int64 t = t +let popcount = Popcount.int64_popcount + +module Conv = Int_conversions + +external to_int_trunc : (t[@local_opt]) -> int = "%int64_to_int" +external to_int32_trunc : (int64[@local_opt]) -> (int32[@local_opt]) = "%int64_to_int32" + +external to_nativeint_trunc + : (int64[@local_opt]) + -> (nativeint[@local_opt]) + = "%int64_to_nativeint" + +external of_int : (int[@local_opt]) -> (int64[@local_opt]) = "%int64_of_int" +external of_int32 : (int32[@local_opt]) -> (int64[@local_opt]) = "%int64_of_int32" + +let of_int_exn = of_int +let to_int = Conv.int64_to_int +let to_int_exn = Conv.int64_to_int_exn +let of_int32_exn = of_int32 +let to_int32 = Conv.int64_to_int32 +let to_int32_exn = Conv.int64_to_int32_exn + +external of_nativeint : (nativeint[@local_opt]) -> (t[@local_opt]) = "%int64_of_nativeint" + +let of_nativeint_exn = of_nativeint +let to_nativeint = Conv.int64_to_nativeint +let to_nativeint_exn = Conv.int64_to_nativeint_exn + +module Pow2 = struct + open! Import + open Int64_replace_polymorphic_compare + + let raise_s = Error.raise_s + + let non_positive_argument () = + Printf.invalid_argf "argument must be strictly positive" () + ;; + + let ( lor ) = Stdlib.Int64.logor + let ( lsr ) = Stdlib.Int64.shift_right_logical + let ( land ) = Stdlib.Int64.logand + + (** "ceiling power of 2" - Least power of 2 greater than or equal to x. *) + let ceil_pow2 x = + if x <= Stdlib.Int64.zero then non_positive_argument (); + let x = Stdlib.Int64.pred x in + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + let x = x lor (x lsr 32) in + Stdlib.Int64.succ x + ;; + + (** "floor power of 2" - Largest power of 2 less than or equal to x. *) + let floor_pow2 x = + if x <= Stdlib.Int64.zero then non_positive_argument (); + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + let x = x lor (x lsr 32) in + Stdlib.Int64.sub x (x lsr 1) + ;; + + let is_pow2 x = + if x <= Stdlib.Int64.zero then non_positive_argument (); + x land Stdlib.Int64.pred x = Stdlib.Int64.zero + ;; + + (* C stubs for int clz and ctz to use the CLZ/BSR/CTZ/BSF instruction where possible *) + external clz + : (int64[@unboxed]) + -> (int[@untagged]) + = "Base_int_math_int64_clz" "Base_int_math_int64_clz_unboxed" + [@@noalloc] + + external ctz + : (int64[@unboxed]) + -> (int[@untagged]) + = "Base_int_math_int64_ctz" "Base_int_math_int64_ctz_unboxed" + [@@noalloc] + + (** Hacker's Delight Second Edition p106 *) + let floor_log2 i = + if i <= Stdlib.Int64.zero + then + raise_s + (Sexp.message "[Int64.floor_log2] got invalid input" [ "", sexp_of_int64 i ]); + num_bits - 1 - clz i + ;; + + (** Hacker's Delight Second Edition p106 *) + let ceil_log2 i = + if Poly.( <= ) i Stdlib.Int64.zero + then + raise_s (Sexp.message "[Int64.ceil_log2] got invalid input" [ "", sexp_of_int64 i ]); + if Stdlib.Int64.equal i Stdlib.Int64.one + then 0 + else num_bits - clz (Stdlib.Int64.pred i) + ;; +end + +include Pow2 +include Int_string_conversions.Make (T) + +include Int_string_conversions.Make_hex (struct + type t = int64 [@@deriving_inline compare ~localize, hash] + + let compare__local = (compare_int64__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int64 + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int64 in + fun x -> func x + ;; + + [@@@end] + + let zero = zero + let neg = neg + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%Lx" i + let of_string s = Stdlib.Scanf.sscanf s "%Lx" Fn.id + let module_name = "Base.Int64.Hex" +end) + +include Int_string_conversions.Make_binary (struct + type t = int64 [@@deriving_inline compare ~localize, equal ~localize, hash] + + let compare__local = (compare_int64__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + let equal__local = (equal_int64__local : t -> t -> bool) + let equal = (fun a b -> equal__local a b : t -> t -> bool) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int64 + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int64 in + fun x -> func x + ;; + + [@@@end] + + let ( land ) = ( land ) + let ( lsr ) = ( lsr ) + let clz = clz + let num_bits = num_bits + let one = one + let to_int_exn = to_int_exn + let zero = zero +end) + +include Pretty_printer.Register (struct + type nonrec t = t + + let to_string = to_string + let module_name = "Base.Int64" +end) + +module Pre_O = struct + external ( + ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_add" + external ( - ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_sub" + external ( * ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_mul" + external ( / ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_div" + external ( ~- ) : (t[@local_opt]) -> (t[@local_opt]) = "%int64_neg" + + let ( ** ) = ( ** ) + + include Int64_replace_polymorphic_compare + + let abs = abs + + external neg : (t[@local_opt]) -> (t[@local_opt]) = "%int64_neg" + + let zero = zero + let of_int_exn = of_int_exn +end + +module O = struct + include Pre_O + + include Int_math.Make (struct + type nonrec t = t + + include Pre_O + + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) + + external ( land ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_and" + external ( lor ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_or" + external ( lxor ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_xor" + + let lnot = bit_not + + external ( lsl ) + : (t[@local_opt]) + -> (int[@local_opt]) + -> (t[@local_opt]) + = "%int64_lsl" + + external ( asr ) + : (t[@local_opt]) + -> (int[@local_opt]) + -> (t[@local_opt]) + = "%int64_asr" + + external ( lsr ) + : (t[@local_opt]) + -> (int[@local_opt]) + -> (t[@local_opt]) + = "%int64_lsr" +end + +include O + +(* [Int64] and [Int64.O] agree value-wise *) + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Int64_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/int64.mli b/unikernel/duniverse/base/src/int64.mli new file mode 100644 index 00000000..ecc94af6 --- /dev/null +++ b/unikernel/duniverse/base/src/int64.mli @@ -0,0 +1,122 @@ +(** 64-bit integers. *) + +open! Import + +type t = int64 [@@deriving_inline globalize] + +val globalize : t -> t + +[@@@end] + +include Int_intf.S with type t := t + +module O : sig + (*_ Declared as externals + so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) + external ( + ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_add" + external ( - ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_sub" + external ( * ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_mul" + external ( / ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_div" + external ( ~- ) : (t[@local_opt]) -> (t[@local_opt]) = "%int64_neg" + val ( ** ) : t -> t -> t + external ( = ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%equal" + external ( <> ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%notequal" + external ( < ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%lessthan" + external ( > ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%greaterthan" + external ( <= ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%lessequal" + external ( >= ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%greaterequal" + external ( land ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_and" + external ( lor ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_or" + external ( lxor ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_xor" + val lnot : t -> t + val abs : t -> t + external neg : t -> t = "%int64_neg" + val zero : t + val ( % ) : t -> t -> t + val ( /% ) : t -> t -> t + val ( // ) : t -> t -> float + + external ( lsl ) + : (t[@local_opt]) + -> (int[@local_opt]) + -> (t[@local_opt]) + = "%int64_lsl" + + external ( asr ) + : (t[@local_opt]) + -> (int[@local_opt]) + -> (t[@local_opt]) + = "%int64_asr" + + external ( lsr ) + : (t[@local_opt]) + -> (int[@local_opt]) + -> (t[@local_opt]) + = "%int64_lsr" +end + +include module type of O + +(** {2 Conversion functions} *) + +(*_ Declared as externals so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) +external of_int : (int[@local_opt]) -> (t[@local_opt]) = "%int64_of_int" +external of_int32 : (int32[@local_opt]) -> (t[@local_opt]) = "%int64_of_int32" +external of_int64 : (t[@local_opt]) -> (t[@local_opt]) = "%identity" +val to_int : t -> int option +val to_int32 : t -> int32 option +external of_nativeint : (nativeint[@local_opt]) -> (t[@local_opt]) = "%int64_of_nativeint" +val to_nativeint : t -> nativeint option + +(** {3 Truncating conversions} + + These functions return the least-significant bits of the input. In cases where + optional conversions return [Some x], truncating conversions return [x]. *) + +(*_ Declared as externals so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) +external to_int_trunc : (t[@local_opt]) -> int = "%int64_to_int" +external to_int32_trunc : (int64[@local_opt]) -> (int32[@local_opt]) = "%int64_to_int32" + +external to_nativeint_trunc + : (int64[@local_opt]) + -> (nativeint[@local_opt]) + = "%int64_to_nativeint" + +(** {3 Low-level float conversions} *) + +(** [bits_of_float] will always allocate its result on the heap unless the [_unboxed] + C function call is chosen by the compiler. *) +external bits_of_float + : (float[@local_opt]) + -> (int64[@local_opt]) + = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed" + [@@unboxed] [@@noalloc] + +(** [float_of_bits] will always allocate its result on the heap unless the [_unboxed] + C function call is chosen by the compiler. *) +external float_of_bits + : (int64[@local_opt]) + -> (float[@local_opt]) + = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed" + [@@unboxed] [@@noalloc] + +(** {2 Byte swap operations} + + See {{!modtype:Int.Int_without_module_types}[Int]'s byte swap section} for + a description of Base's approach to exposing byte swap primitives. + + As of writing, these operations do not sign extend unnecessarily on 64 bit machines, + unlike their int32 counterparts, and hence, are more performant. See the {!Int32} + module for more details of the overhead entailed by the int32 byteswap functions. +*) + +val bswap16 : t -> t +val bswap32 : t -> t +val bswap48 : t -> t + +(*_ Declared as an external so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) +external bswap64 : (t[@local_opt]) -> (t[@local_opt]) = "%bswap_int64" diff --git a/unikernel/duniverse/base/src/int_conversions.ml b/unikernel/duniverse/base/src/int_conversions.ml new file mode 100644 index 00000000..e845c0d2 --- /dev/null +++ b/unikernel/duniverse/base/src/int_conversions.ml @@ -0,0 +1,220 @@ +open! Import +module Int = Int0 +module Sys = Sys0 + +let convert_failure x a b to_string = + Printf.failwithf + "conversion from %s to %s failed: %s is out of range" + a + b + (to_string x) + () + [@@cold] [@@inline never] [@@local never] [@@specialise never] +;; + +let num_bits_int = Sys.int_size_in_bits +let num_bits_int32 = 32 +let num_bits_int64 = 64 +let num_bits_nativeint = Word_size.num_bits Word_size.word_size +let () = assert (num_bits_int = 63 || num_bits_int = 31 || num_bits_int = 32) +let min_int32 = Stdlib.Int32.min_int +let max_int32 = Stdlib.Int32.max_int +let min_int64 = Stdlib.Int64.min_int +let max_int64 = Stdlib.Int64.max_int +let min_nativeint = Stdlib.Nativeint.min_int +let max_nativeint = Stdlib.Nativeint.max_int +let int_to_string = Stdlib.string_of_int +let int32_to_string = Stdlib.Int32.to_string +let int64_to_string = Stdlib.Int64.to_string +let nativeint_to_string = Stdlib.Nativeint.to_string + +(* int <-> int32 *) + +let int_to_int32_failure x = convert_failure x "int" "int32" int_to_string +let int32_to_int_failure x = convert_failure x "int32" "int" int32_to_string +let int32_to_int_trunc = Stdlib.Int32.to_int +let int_to_int32_trunc = Stdlib.Int32.of_int + +let int_is_representable_as_int32 = + if num_bits_int <= num_bits_int32 + then fun _ -> true + else ( + let min = int32_to_int_trunc min_int32 in + let max = int32_to_int_trunc max_int32 in + fun x -> compare_int min x <= 0 && compare_int x max <= 0) +;; + +let int32_is_representable_as_int = + if num_bits_int32 <= num_bits_int + then fun _ -> true + else ( + let min = int_to_int32_trunc Int.min_value in + let max = int_to_int32_trunc Int.max_value in + fun x -> compare_int32 min x <= 0 && compare_int32 x max <= 0) +;; + +let int_to_int32 x = + if int_is_representable_as_int32 x then Some (int_to_int32_trunc x) else None +;; + +let int32_to_int x = + if int32_is_representable_as_int x then Some (int32_to_int_trunc x) else None +;; + +let int_to_int32_exn x = + if int_is_representable_as_int32 x then int_to_int32_trunc x else int_to_int32_failure x +;; + +let int32_to_int_exn x = + if int32_is_representable_as_int x then int32_to_int_trunc x else int32_to_int_failure x +;; + +(* int <-> int64 *) + +let[@cold] int64_to_int_failure x = + convert_failure + (Stdlib.Int64.add x 0L (* force int64 boxing to be here under flambda2 *)) + "int64" + "int" + int64_to_string +;; + +let () = assert (num_bits_int < num_bits_int64) +let int_to_int64 = Stdlib.Int64.of_int +let int64_to_int_trunc = Stdlib.Int64.to_int + +let int64_is_representable_as_int = + let min = int_to_int64 Int.min_value in + let max = int_to_int64 Int.max_value in + fun x -> compare_int64 min x <= 0 && compare_int64 x max <= 0 +;; + +let int64_to_int x = + if int64_is_representable_as_int x then Some (int64_to_int_trunc x) else None +;; + +let int64_to_int_exn x = + if int64_is_representable_as_int x then int64_to_int_trunc x else int64_to_int_failure x +;; + +(* int <-> nativeint *) + +let nativeint_to_int_failure x = convert_failure x "nativeint" "int" nativeint_to_string +let () = assert (num_bits_int <= num_bits_nativeint) +let int_to_nativeint = Stdlib.Nativeint.of_int +let nativeint_to_int_trunc = Stdlib.Nativeint.to_int + +let nativeint_is_representable_as_int = + if num_bits_nativeint <= num_bits_int + then fun _ -> true + else ( + let min = int_to_nativeint Int.min_value in + let max = int_to_nativeint Int.max_value in + fun x -> compare_nativeint min x <= 0 && compare_nativeint x max <= 0) +;; + +let nativeint_to_int x = + if nativeint_is_representable_as_int x then Some (nativeint_to_int_trunc x) else None +;; + +let nativeint_to_int_exn x = + if nativeint_is_representable_as_int x + then nativeint_to_int_trunc x + else nativeint_to_int_failure x +;; + +(* int32 <-> int64 *) + +let int64_to_int32_failure x = convert_failure x "int64" "int32" int64_to_string +let () = assert (num_bits_int32 < num_bits_int64) +let int32_to_int64 = Stdlib.Int64.of_int32 +let int64_to_int32_trunc = Stdlib.Int64.to_int32 + +let int64_is_representable_as_int32 = + let min = int32_to_int64 min_int32 in + let max = int32_to_int64 max_int32 in + fun x -> compare_int64 min x <= 0 && compare_int64 x max <= 0 +;; + +let int64_to_int32 x = + if int64_is_representable_as_int32 x then Some (int64_to_int32_trunc x) else None +;; + +let int64_to_int32_exn x = + if int64_is_representable_as_int32 x + then int64_to_int32_trunc x + else int64_to_int32_failure x +;; + +(* int32 <-> nativeint *) + +let nativeint_to_int32_failure x = + convert_failure x "nativeint" "int32" nativeint_to_string +;; + +let () = assert (num_bits_int32 <= num_bits_nativeint) +let int32_to_nativeint = Stdlib.Nativeint.of_int32 +let nativeint_to_int32_trunc = Stdlib.Nativeint.to_int32 + +let nativeint_is_representable_as_int32 = + if num_bits_nativeint <= num_bits_int32 + then fun _ -> true + else ( + let min = int32_to_nativeint min_int32 in + let max = int32_to_nativeint max_int32 in + fun x -> compare_nativeint min x <= 0 && compare_nativeint x max <= 0) +;; + +let nativeint_to_int32 x = + if nativeint_is_representable_as_int32 x + then Some (nativeint_to_int32_trunc x) + else None +;; + +let nativeint_to_int32_exn x = + if nativeint_is_representable_as_int32 x + then nativeint_to_int32_trunc x + else nativeint_to_int32_failure x +;; + +(* int64 <-> nativeint *) + +let int64_to_nativeint_failure x = convert_failure x "int64" "nativeint" int64_to_string +let () = assert (num_bits_int64 >= num_bits_nativeint) +let int64_to_nativeint_trunc = Stdlib.Int64.to_nativeint +let nativeint_to_int64 = Stdlib.Int64.of_nativeint + +let int64_is_representable_as_nativeint = + if num_bits_int64 <= num_bits_nativeint + then fun _ -> true + else ( + let min = nativeint_to_int64 min_nativeint in + let max = nativeint_to_int64 max_nativeint in + fun x -> compare_int64 min x <= 0 && compare_int64 x max <= 0) +;; + +let int64_to_nativeint x = + if int64_is_representable_as_nativeint x + then Some (int64_to_nativeint_trunc x) + else None +;; + +let int64_to_nativeint_exn x = + if int64_is_representable_as_nativeint x + then int64_to_nativeint_trunc x + else int64_to_nativeint_failure x +;; + +(* int64 <-> int63 *) + +let int64_to_int63_failure x = convert_failure x "int64" "int63" int64_to_string + +let int64_is_representable_as_int63 = + let min = Stdlib.Int64.shift_right min_int64 1 in + let max = Stdlib.Int64.shift_right max_int64 1 in + fun x -> compare_int64 min x <= 0 && compare_int64 x max <= 0 +;; + +let int64_fit_on_int63_exn x = + if int64_is_representable_as_int63 x then () else int64_to_int63_failure x +;; diff --git a/unikernel/duniverse/base/src/int_conversions.mli b/unikernel/duniverse/base/src/int_conversions.mli new file mode 100644 index 00000000..079d70b6 --- /dev/null +++ b/unikernel/duniverse/base/src/int_conversions.mli @@ -0,0 +1,70 @@ +(** Conversions between various integer types *) + +open! Import + +(** Ocaml has the following integer types, with the following bit widths + on 32-bit and 64-bit architectures. + + {v + arch arch + type 32b 64b + ---------------------- + int 31 63 (32 when compiled to JavaScript) + nativeint 32 64 + int32 32 32 + int64 64 64 + v} + + In both cases, the following inequalities hold: + + {[ + width(int) < width(nativeint) + && width(int32) <= width(nativeint) <= width(int64) + ]} + + The conversion functions come in one of two flavors. + + If width(foo) <= width(bar) on both 32-bit and 64-bit architectures, then we have + + {[ val foo_to_bar : foo -> bar ]} + + otherwise we have + + {[ + val foo_to_bar : foo -> bar option + val foo_to_bar_exn : foo -> bar + ]} *) +val int_to_int32 : int -> int32 option + +val int_to_int32_exn : int -> int32 +val int_to_int32_trunc : int -> int32 +val int_to_int64 : int -> int64 +val int_to_nativeint : int -> nativeint +val int32_to_int : int32 -> int option +val int32_to_int_exn : int32 -> int +val int32_to_int_trunc : int32 -> int +val int32_to_int64 : int32 -> int64 +val int32_to_nativeint : int32 -> nativeint +val int32_is_representable_as_int : int32 -> bool +val int64_to_int : int64 -> int option +val int64_to_int_exn : int64 -> int +val int64_to_int_trunc : int64 -> int +val int64_to_int32 : int64 -> int32 option +val int64_to_int32_exn : int64 -> int32 +val int64_to_int32_trunc : int64 -> int32 +val int64_to_nativeint : int64 -> nativeint option +val int64_to_nativeint_exn : int64 -> nativeint +val int64_to_nativeint_trunc : int64 -> nativeint +val int64_fit_on_int63_exn : int64 -> unit +val int64_is_representable_as_int63 : int64 -> bool +val nativeint_to_int : nativeint -> int option +val nativeint_to_int_exn : nativeint -> int +val nativeint_to_int_trunc : nativeint -> int +val nativeint_to_int32 : nativeint -> int32 option +val nativeint_to_int32_exn : nativeint -> int32 +val nativeint_to_int32_trunc : nativeint -> int32 +val nativeint_to_int64 : nativeint -> int64 +val num_bits_int : int +val num_bits_int32 : int +val num_bits_int64 : int +val num_bits_nativeint : int diff --git a/unikernel/duniverse/base/src/int_intf.ml b/unikernel/duniverse/base/src/int_intf.ml new file mode 100644 index 00000000..d7711e03 --- /dev/null +++ b/unikernel/duniverse/base/src/int_intf.ml @@ -0,0 +1,461 @@ +(** An interface to use for int-like types, e.g., {{!Base.Int}[Int]} and + {{!Base.Int64}[Int64]}. *) + +open! Import + +module type Round = sig + type t + + (** [round] rounds an int to a multiple of a given [to_multiple_of] argument, according + to a direction [dir], with default [dir] being [`Nearest]. [round] will raise if + [to_multiple_of <= 0]. If the result overflows (too far positive or too far + negative), [round] returns an incorrect result. + + {v + | `Down | rounds toward Int.neg_infinity | + | `Up | rounds toward Int.infinity | + | `Nearest | rounds to the nearest multiple, or `Up in case of a tie | + | `Zero | rounds toward zero | + v} + + Here are some examples for [round ~to_multiple_of:10] for each direction: + + {v + | `Down | {10 .. 19} --> 10 | { 0 ... 9} --> 0 | {-10 ... -1} --> -10 | + | `Up | { 1 .. 10} --> 10 | {-9 ... 0} --> 0 | {-19 .. -10} --> -10 | + | `Zero | {10 .. 19} --> 10 | {-9 ... 9} --> 0 | {-19 .. -10} --> -10 | + | `Nearest | { 5 .. 14} --> 10 | {-5 ... 4} --> 0 | {-15 ... -6} --> -10 | + v} + + For convenience and performance, there are variants of [round] with [dir] + hard-coded. If you are writing performance-critical code you should use these. *) + + val round : ?dir:[ `Zero | `Nearest | `Up | `Down ] -> t -> to_multiple_of:t -> t + val round_towards_zero : t -> to_multiple_of:t -> t + val round_down : t -> to_multiple_of:t -> t + val round_up : t -> to_multiple_of:t -> t + val round_nearest : t -> to_multiple_of:t -> t +end + +(** String format for integers, [to_string] / [sexp_of_t] direction only. Includes + comparisons and hash functions for [[@@deriving]]. *) +module type To_string_format = sig + type t [@@deriving_inline sexp_of, compare ~localize, hash] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + + [@@@end] + + val to_string : t -> string + val to_string_hum : ?delimiter:char -> t -> string +end + +(** String format for integers, including both [to_string] / [sexp_of_t] and [of_string] / + [t_of_sexp] directions. Includes comparisons and hash functions for [[@@deriving]]. *) +module type String_format = sig + type t [@@deriving_inline sexp, sexp_grammar, compare ~localize, hash] + + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + + [@@@end] + + include Stringable.S with type t := t + + val to_string_hum : ?delimiter:char -> t -> string +end + +(** Binary format for integers, unsigned and starting with [0b]. *) +module type Binaryable = sig + type t + + module Binary : To_string_format with type t = t +end + +(** Hex format for integers, signed and starting with [0x]. *) +module type Hexable = sig + type t + + module Hex : String_format with type t = t +end + +module type S_common = sig + type t [@@deriving_inline sexp, sexp_grammar] + + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Floatable.S with type t := t + include Intable.S with type t := t + include Identifiable.S with type t := t + include Comparable.With_zero with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + include Invariant.S with type t := t + include Hexable with type t := t + include Binaryable with type t := t + + val of_string_opt : string -> t option + + (** [delimiter] is an underscore by default. *) + val to_string_hum : ?delimiter:char -> t -> string + + (** {2 Infix operators and constants} *) + + val zero : t + val one : t + val minus_one : t + val ( + ) : t -> t -> t + val ( - ) : t -> t -> t + val ( * ) : t -> t -> t + + (** Integer exponentiation *) + val ( ** ) : t -> t -> t + + (** Negation *) + + val neg : t -> t + val ( ~- ) : t -> t + + (** There are two pairs of integer division and remainder functions, [/%] and [%], and + [/] and [rem]. They both satisfy the same equation relating the quotient and the + remainder: + + {[ + x = (x /% y) * y + (x % y); + x = (x / y) * y + (rem x y); + ]} + + The functions return the same values if [x] and [y] are positive. They all raise + if [y = 0]. + + The functions differ if [x < 0] or [y < 0]. + + If [y < 0], then [%] and [/%] raise, whereas [/] and [rem] do not. + + [x % y] always returns a value between 0 and [y - 1], even when [x < 0]. On the + other hand, [rem x y] returns a negative value if and only if [x < 0]; that value + satisfies [abs (rem x y) <= abs y - 1]. *) + + val ( /% ) : t -> t -> t + val ( % ) : t -> t -> t + val ( / ) : t -> t -> t + val rem : t -> t -> t + + (** Float division of integers. *) + val ( // ) : t -> t -> float + + (** Same as [bit_and]. *) + val ( land ) : t -> t -> t + + (** Same as [bit_or]. *) + val ( lor ) : t -> t -> t + + (** Same as [bit_xor]. *) + val ( lxor ) : t -> t -> t + + (** Same as [bit_not]. *) + val lnot : t -> t + + (** Same as [shift_left]. *) + val ( lsl ) : t -> int -> t + + (** Same as [shift_right]. *) + val ( asr ) : t -> int -> t + + (** {2 Other common functions} *) + + include Round with type t := t + + (** Returns the absolute value of the argument. May be negative if the input is + [min_value]. *) + val abs : t -> t + + (** {2 Successor and predecessor functions} *) + + val succ : t -> t + val pred : t -> t + + (** {2 Exponentiation} *) + + (** [pow base exponent] returns [base] raised to the power of [exponent]. It is OK if + [base <= 0]. [pow] raises if [exponent < 0], or an integer overflow would occur. *) + val pow : t -> t -> t + + (** {2 Bit-wise logical operations } *) + + (** These are identical to [land], [lor], etc. except they're not infix and have + different names. *) + val bit_and : t -> t -> t + + val bit_or : t -> t -> t + val bit_xor : t -> t -> t + val bit_not : t -> t + + (** Returns the number of 1 bits in the binary representation of the input. *) + val popcount : t -> int + + (** {2 Bit-shifting operations } + + The results are unspecified for negative shifts and shifts [>= num_bits]. *) + + (** Shifts left, filling in with zeroes. *) + val shift_left : t -> int -> t + + (** Shifts right, preserving the sign of the input. *) + val shift_right : t -> int -> t + + (** {2 Increment and decrement functions for integer references } *) + + val decr : t ref -> unit + val incr : t ref -> unit + + (** {2 Conversion functions to related integer types} *) + + val of_int32_exn : int32 -> t + val to_int32_exn : t -> int32 + val of_int64_exn : int64 -> t + val to_int64 : t -> int64 + val of_nativeint_exn : nativeint -> t + val to_nativeint_exn : t -> nativeint + + (** [of_float_unchecked] truncates the given floating point number to an integer, + rounding towards zero. + The result is unspecified if the argument is nan or falls outside the range + of representable integers. *) + val of_float_unchecked : float -> t +end + +module type Operators_unbounded = sig + type t + + val ( + ) : t -> t -> t + val ( - ) : t -> t -> t + val ( * ) : t -> t -> t + val ( / ) : t -> t -> t + val ( ~- ) : t -> t + val ( ** ) : t -> t -> t + + include Comparisons.Infix with type t := t + + val abs : t -> t + val neg : t -> t + val zero : t + val ( % ) : t -> t -> t + val ( /% ) : t -> t -> t + val ( // ) : t -> t -> float + val ( land ) : t -> t -> t + val ( lor ) : t -> t -> t + val ( lxor ) : t -> t -> t + val lnot : t -> t + val ( lsl ) : t -> int -> t + val ( asr ) : t -> int -> t +end + +module type Operators = sig + include Operators_unbounded + + val ( lsr ) : t -> int -> t +end + +(** [S_unbounded] is a generic interface for unbounded integers, e.g. [Bignum.Bigint]. + [S_unbounded] is a restriction of [S] (below) that omits values that depend on + fixed-size integers. *) +module type S_unbounded = sig + include S_common (** @inline *) + + (** A sub-module designed to be opened to make working with ints more convenient. *) + module O : Operators_unbounded with type t := t +end + +(** [S] is a generic interface for fixed-size integers. *) +module type S = sig + include S_common (** @inline *) + + (** The number of bits available in this integer type. Note that the integer + representations are signed. *) + val num_bits : int + + (** The largest representable integer. *) + val max_value : t + + (** The smallest representable integer. *) + val min_value : t + + (** Same as [shift_right_logical]. *) + val ( lsr ) : t -> int -> t + + (** Shifts right, filling in with zeroes, which will not preserve the sign of the + input. *) + val shift_right_logical : t -> int -> t + + (** [ceil_pow2 x] returns the smallest power of 2 that is greater than or equal to [x]. + The implementation may only be called for [x > 0]. Example: [ceil_pow2 17 = 32] *) + val ceil_pow2 : t -> t + + (** [floor_pow2 x] returns the largest power of 2 that is less than or equal to [x]. The + implementation may only be called for [x > 0]. Example: [floor_pow2 17 = 16] *) + val floor_pow2 : t -> t + + (** [ceil_log2 x] returns the ceiling of log-base-2 of [x], and raises if [x <= 0]. *) + val ceil_log2 : t -> int + + (** [floor_log2 x] returns the floor of log-base-2 of [x], and raises if [x <= 0]. *) + val floor_log2 : t -> int + + (** [is_pow2 x] returns true iff [x] is a power of 2. [is_pow2] raises if [x <= 0]. *) + val is_pow2 : t -> bool + + (** Returns the number of leading zeros in the binary representation of the input, as an + integer between 0 and one less than [num_bits]. + + The results are unspecified for [t = 0]. *) + val clz : t -> int + + (** Returns the number of trailing zeros in the binary representation of the input, as + an integer between 0 and one less than [num_bits]. + + The results are unspecified for [t = 0]. *) + val ctz : t -> int + + (** A sub-module designed to be opened to make working with ints more convenient. *) + module O : Operators with type t := t +end + +module type Int_without_module_types = sig + (** OCaml's native integer type. + + The number of bits in an integer is platform dependent, being 31-bits on a 32-bit + platform, and 63-bits on a 64-bit platform. [int] is a signed integer type. [int]s + are also subject to overflow, meaning that [Int.max_value + 1 = Int.min_value]. + + [int]s always fit in a machine word. *) + + type t = int [@@deriving_inline globalize] + + val globalize : t -> t + + [@@@end] + + include S with type t := t (** @inline *) + + module O : sig + (*_ Declared as externals so that the compiler skips the caml_apply_X wrapping even + when compiling without cross library inlining. *) + external ( + ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%addint" + external ( - ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%subint" + external ( * ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%mulint" + external ( / ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%divint" + external ( ~- ) : (t[@local_opt]) -> t = "%negint" + val ( ** ) : t -> t -> t + external ( = ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%equal" + external ( <> ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%notequal" + external ( < ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%lessthan" + external ( > ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%greaterthan" + external ( <= ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%lessequal" + external ( >= ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%greaterequal" + external ( land ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%andint" + external ( lor ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%orint" + external ( lxor ) : (t[@local_opt]) -> (t[@local_opt]) -> t = "%xorint" + val lnot : t -> t + val abs : t -> t + external neg : (t[@local_opt]) -> t = "%negint" + val zero : t + val ( % ) : t -> t -> t + val ( /% ) : t -> t -> t + val ( // ) : t -> t -> float + external ( lsl ) : (t[@local_opt]) -> (int[@local_opt]) -> t = "%lslint" + external ( asr ) : (t[@local_opt]) -> (int[@local_opt]) -> t = "%asrint" + external ( lsr ) : (t[@local_opt]) -> (int[@local_opt]) -> t = "%lsrint" + end + + include module type of O + + (** [max_value_30_bits = 2^30 - 1]. It is useful for writing tests that work on both + 64-bit and 32-bit platforms. *) + val max_value_30_bits : t + + (** {2 Conversion functions} *) + + val of_int : int -> t + val to_int : t -> int + val of_int32 : int32 -> t option + val to_int32 : t -> int32 option + val of_int64 : int64 -> t option + val of_nativeint : nativeint -> t option + val to_nativeint : t -> nativeint + + (** {3 Truncating conversions} + + These functions return the least-significant bits of the input. In cases + where optional conversions return [Some x], truncating conversions return [x]. *) + + (*_ Declared as externals so that the compiler skips the caml_apply_X wrapping even when + compiling without cross library inlining. *) + external to_int32_trunc : (t[@local_opt]) -> (int32[@local_opt]) = "%int32_of_int" + external of_int32_trunc : (int32[@local_opt]) -> t = "%int32_to_int" + external of_int64_trunc : (int64[@local_opt]) -> t = "%int64_to_int" + external of_nativeint_trunc : (nativeint[@local_opt]) -> t = "%nativeint_to_int" + + (** {2 Byte swap operations} + + Byte swap operations reverse the order of bytes in an integer. For + example, {!Int32.bswap32} reorders the bottom 32 bits (or 4 bytes), + turning [0x1122_3344] to [0x4433_2211]. Byte swap functions exposed by + Base use OCaml primitives to generate assembly instructions to perform + the relevant byte swaps. + + For a more extensive list of byteswap functions, see {!Int32} and + {!Int64}. + *) + + (** Byte swaps bottom 16 bits (2 bytes). The values of the remaining bytes + are undefined. *) + external bswap16 : (int[@local_opt]) -> int = "%bswap16" + (*_ Declared as an external so that the compiler skips the caml_apply_X wrapping even + when compiling without cross library inlining. *) + + (**/**) + + (*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) + module Private : sig + (*_ For ../bench/bench_int.ml *) + module O_F : sig + val ( % ) : int -> int -> int + val ( /% ) : int -> int -> int + val ( // ) : int -> int -> float + end + end +end + +module type Int = sig + include Int_without_module_types (** @inline *) + + (** {2 Module types specifying integer operations.} *) + + module type Binaryable = Binaryable + module type Hexable = Hexable + module type Int_without_module_types = Int_without_module_types + module type Operators = Operators + module type Operators_unbounded = Operators_unbounded + module type Round = Round + module type S = S + module type S_common = S_common + module type S_unbounded = S_unbounded + module type String_format = String_format + module type To_string_format = To_string_format +end diff --git a/unikernel/duniverse/base/src/int_math.ml b/unikernel/duniverse/base/src/int_math.ml new file mode 100644 index 00000000..a04cc055 --- /dev/null +++ b/unikernel/duniverse/base/src/int_math.ml @@ -0,0 +1,152 @@ +open! Import + +let invalid_argf = Printf.invalid_argf +let negative_exponent () = Printf.invalid_argf "exponent can not be negative" () +let overflow () = Printf.invalid_argf "integer overflow in pow" () + +(* To implement [int64_pow], we use C code rather than OCaml to eliminate allocation. *) +external int_math_int_pow : int -> int -> int = "Base_int_math_int_pow_stub" [@@noalloc] + +external int_math_int64_pow + : int64 + -> int64 + -> int64 + = "Base_int_math_int64_pow_stub" "Base_int_math_int64_pow_stub_unboxed" + [@@unboxed] [@@noalloc] + +let int_pow base exponent = + if exponent < 0 then negative_exponent (); + if abs base > 1 + && (exponent > 63 + || abs base > Pow_overflow_bounds.int_positive_overflow_bounds.(exponent)) + then overflow (); + int_math_int_pow base exponent +;; + +module Int64_with_comparisons = struct + include Stdlib.Int64 + + external ( < ) : (int64[@local_opt]) -> (int64[@local_opt]) -> bool = "%lessthan" + external ( > ) : (int64[@local_opt]) -> (int64[@local_opt]) -> bool = "%greaterthan" + external ( >= ) : (int64[@local_opt]) -> (int64[@local_opt]) -> bool = "%greaterequal" +end + +(* we don't do [abs] in int64 case to avoid allocation *) +let int64_pow base exponent = + let open Int64_with_comparisons in + if exponent < 0L then negative_exponent (); + if (base > 1L || base < -1L) + && (exponent > 63L + || (base >= 0L + && base + > Pow_overflow_bounds.int64_positive_overflow_bounds.(to_int exponent)) + || (base < 0L + && base + < Pow_overflow_bounds.int64_negative_overflow_bounds.(to_int exponent))) + then overflow (); + int_math_int64_pow base exponent +;; + +let int63_pow_on_int64 base exponent = + let open Int64_with_comparisons in + if exponent < 0L then negative_exponent (); + if abs base > 1L + && (exponent > 63L + || abs base + > Pow_overflow_bounds.int63_on_int64_positive_overflow_bounds.(to_int exponent) + ) + then overflow (); + int_math_int64_pow base exponent +;; + +module type Make_arg = sig + type t + + include Floatable.S with type t := t + include Stringable.S with type t := t + + val ( + ) : t -> t -> t + val ( - ) : t -> t -> t + val ( * ) : t -> t -> t + val ( / ) : t -> t -> t + val ( ~- ) : t -> t + + include Comparisons.Infix with type t := t + + val abs : t -> t + val neg : t -> t + val zero : t + val of_int_exn : int -> t + val rem : t -> t -> t +end + +module Make (X : Make_arg) = struct + open X + + let ( % ) x y = + if y <= zero + then + invalid_argf + "%s %% %s in core_int.ml: modulus should be positive" + (to_string x) + (to_string y) + (); + let rval = X.rem x y in + if rval < zero then rval + y else rval + ;; + + let one = of_int_exn 1 + + let ( /% ) x y = + if y <= zero + then + invalid_argf + "%s /%% %s in core_int.ml: divisor should be positive" + (to_string x) + (to_string y) + (); + if x < zero then ((x + one) / y) - one else x / y + ;; + + (** float division of integers *) + let ( // ) x y = to_float x /. to_float y + + let round_down i ~to_multiple_of:modulus = i - (i % modulus) + + let round_up i ~to_multiple_of:modulus = + let remainder = i % modulus in + if remainder = zero then i else i + modulus - remainder + ;; + + let round_towards_zero i ~to_multiple_of = + if i = zero + then zero + else if i > zero + then round_down i ~to_multiple_of + else round_up i ~to_multiple_of + ;; + + let round_nearest i ~to_multiple_of:modulus = + let remainder = i % modulus in + let modulus_minus_remainder = modulus - remainder in + if modulus_minus_remainder <= remainder + then i + modulus_minus_remainder + else i - remainder + ;; + + let[@inline always] round ?(dir = `Nearest) i ~to_multiple_of = + match dir with + | `Nearest -> round_nearest i ~to_multiple_of + | `Down -> round_down i ~to_multiple_of + | `Up -> round_up i ~to_multiple_of + | `Zero -> round_towards_zero i ~to_multiple_of + ;; +end + +module Private = struct + let int_pow = int_pow + let int64_pow = int64_pow + let int63_pow_on_int64 = int63_pow_on_int64 + + module Pow_overflow_bounds = Pow_overflow_bounds +end diff --git a/unikernel/duniverse/base/src/int_math.mli b/unikernel/duniverse/base/src/int_math.mli new file mode 100644 index 00000000..5d554283 --- /dev/null +++ b/unikernel/duniverse/base/src/int_math.mli @@ -0,0 +1,48 @@ +(** This module implements derived integer operations (e.g., modulo, rounding to + multiples) based on other basic operations. *) + +open! Import + +module type Make_arg = sig + type t + + include Floatable.S with type t := t + include Stringable.S with type t := t + + val ( + ) : t -> t -> t + val ( - ) : t -> t -> t + val ( * ) : t -> t -> t + val ( / ) : t -> t -> t + val ( ~- ) : t -> t + + include Comparisons.Infix with type t := t + + val abs : t -> t + val neg : t -> t + val zero : t + val of_int_exn : int -> t + val rem : t -> t -> t +end + +(** Derived operations common to various integer modules. + + See {{!Base.Int.S_common}[Int.S_common]} for a description of the operations derived + by this module. *) +module Make (X : Make_arg) : sig + val ( % ) : X.t -> X.t -> X.t + val ( /% ) : X.t -> X.t -> X.t + val ( // ) : X.t -> X.t -> float + + include Int_intf.Round with type t := X.t +end + +(*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) +module Private : sig + val int_pow : int -> int -> int + val int64_pow : int64 -> int64 -> int64 + val int63_pow_on_int64 : int64 -> int64 -> int64 + + module Pow_overflow_bounds = Pow_overflow_bounds +end diff --git a/unikernel/duniverse/base/src/int_math_stubs.c b/unikernel/duniverse/base/src/int_math_stubs.c new file mode 100644 index 00000000..d128e41b --- /dev/null +++ b/unikernel/duniverse/base/src/int_math_stubs.c @@ -0,0 +1,196 @@ +#include +#include +#include +#include +#include +#include + +#ifdef _MSC_VER + +#include + +#define __builtin_popcountll __popcnt64 +#define __builtin_popcount __popcnt + +static int __inline __builtin_clz(uint32_t x) { + int r = 0; + _BitScanReverse(&r, x); + return r; +} + +static int __inline __builtin_clzll(uint64_t x) { + int r = 0; +#ifdef _WIN64 + _BitScanReverse64(&r, x); +#else + if (!_BitScanReverse(&r, (uint32_t)x) && + _BitScanReverse(&r, (uint32_t)(x >> 32))) { + r += 32; + } +#endif + return r; +} + +static int __inline __builtin_ctz(uint32_t x) { + int r = 0; + _BitScanForward(&r, x); + return r; +} + +static int __inline __builtin_ctzll(uint64_t x) { + int r = 0; +#ifdef _WIN64 + _BitScanForward64(&r, x); +#else + if (_BitScanForward(&r, (uint32_t)(x >> 32))) { + r += 32; + } else { + _BitScanForward(&r, (uint32_t)x); + } +#endif + return r; +} + +#endif + +static int64_t int_pow(int64_t base, int64_t exponent) { + int64_t ret = 1; + int64_t mul[4]; + mul[0] = 1; + mul[1] = base; + mul[3] = 1; + + while (exponent != 0) { + mul[1] *= mul[3]; + mul[2] = mul[1] * mul[1]; + mul[3] = mul[2] * mul[1]; + ret *= mul[exponent & 3]; + exponent >>= 2; + } + + return ret; +} + +CAMLprim value Base_int_math_int_pow_stub(value base, value exponent) { + return (Val_long(int_pow(Long_val(base), Long_val(exponent)))); +} + +CAMLprim int64_t Base_int_math_int64_pow_stub_unboxed(int64_t base, + int64_t exponent) { + return int_pow(base, exponent); +} + +CAMLprim value Base_int_math_int64_pow_stub(value base, value exponent) { + CAMLparam2(base, exponent); + CAMLreturn(caml_copy_int64(Base_int_math_int64_pow_stub_unboxed( + Int64_val(base), Int64_val(exponent)))); +} + +/* This implementation is faster than [__builtin_popcount(v) - 1], even though + * it seems more complicated. The [&] clears the shifted sign bit after + * [Long_val] or [Int_val]. */ +CAMLprim value Base_int_math_int_popcount(value v) { +#ifdef ARCH_SIXTYFOUR + return Val_int(__builtin_popcountll(Long_val(v) & ~((uint64_t)1 << 63))); +#else + return Val_int(__builtin_popcount(Int_val(v) & ~((uint32_t)1 << 31))); +#endif +} + +/* The specification of all below [clz] and [ctz] functions are undefined for [v + * = 0]. */ + +/* + * For an int [x] in the [2n + 1] representation: + * + * clz(x) = __builtin_clz(x >> 1) - 1 + * + * If [x] is negative, then the macro [Int_val] would perform a arithmetic + * shift right, rather than a logical shift right, and sign extend the number. + * Therefore + * + * __builtin_clz(Int_val(x)) + * + * would always be zero, so + * + * clz(x) = __builtin_clz(Int_val(x)) - 1 + * + * would always be -1. This is not what we want. + * + * The logical shift right adds a leading zero to the argument of + * __builtin_clz, which the -1 accounts for. Rather than adding the leading + * zero and subtracting, we can just compute the clz of the tagged + * representation, and that should be equivalent, while also handing negative + * inputs correctly (the result will now be 0). + */ +intnat Base_int_math_int_clz_untagged(value v) { +#ifdef ARCH_SIXTYFOUR + return __builtin_clzll(v); +#else + return __builtin_clz(v); +#endif +} + +CAMLprim value Base_int_math_int_clz(value v) { + return Val_int(Base_int_math_int_clz_untagged(v)); +} + +intnat Base_int_math_int32_clz_unboxed(int32_t v) { return __builtin_clz(v); } + +CAMLprim value Base_int_math_int32_clz(value v) { + return Val_int(Base_int_math_int32_clz_unboxed(Int32_val(v))); +} + +intnat Base_int_math_int64_clz_unboxed(int64_t v) { return __builtin_clzll(v); } + +CAMLprim value Base_int_math_int64_clz(value v) { + return Val_int(Base_int_math_int64_clz_unboxed(Int64_val(v))); +} + +intnat Base_int_math_nativeint_clz_unboxed(intnat v) { +#ifdef ARCH_SIXTYFOUR + return __builtin_clzll(v); +#else + return __builtin_clz(v); +#endif +} + +CAMLprim value Base_int_math_nativeint_clz(value v) { + return Val_int(Base_int_math_nativeint_clz_unboxed(Nativeint_val(v))); +} + +intnat Base_int_math_int_ctz_untagged(intnat v) { +#ifdef ARCH_SIXTYFOUR + return __builtin_ctzll(v); +#else + return __builtin_ctz(v); +#endif +} + +CAMLprim value Base_int_math_int_ctz(value v) { + return Val_int(Base_int_math_int_ctz_untagged(Int_val(v))); +} + +intnat Base_int_math_int32_ctz_unboxed(int32_t v) { return __builtin_ctz(v); } + +CAMLprim value Base_int_math_int32_ctz(value v) { + return Val_int(Base_int_math_int32_ctz_unboxed(Int32_val(v))); +} + +intnat Base_int_math_int64_ctz_unboxed(int64_t v) { return __builtin_ctzll(v); } + +CAMLprim value Base_int_math_int64_ctz(value v) { + return Val_int(Base_int_math_int64_ctz_unboxed(Int64_val(v))); +} + +intnat Base_int_math_nativeint_ctz_unboxed(intnat v) { +#ifdef ARCH_SIXTYFOUR + return __builtin_ctzll(v); +#else + return __builtin_ctz(v); +#endif +} + +CAMLprim value Base_int_math_nativeint_ctz(value v) { + return Val_int(Base_int_math_nativeint_ctz_unboxed(Nativeint_val(v))); +} diff --git a/unikernel/duniverse/base/src/int_string_conversions.ml b/unikernel/duniverse/base/src/int_string_conversions.ml new file mode 100644 index 00000000..3717ab4d --- /dev/null +++ b/unikernel/duniverse/base/src/int_string_conversions.ml @@ -0,0 +1,201 @@ +open! Import + +(* string conversions *) + +let insert_delimiter_every input ~delimiter ~chars_per_delimiter = + let input_length = String.length input in + if input_length <= chars_per_delimiter + then input + else ( + let has_sign = + match input.[0] with + | '+' | '-' -> true + | _ -> false + in + let num_digits = if has_sign then input_length - 1 else input_length in + let num_delimiters = (num_digits - 1) / chars_per_delimiter in + let output_length = input_length + num_delimiters in + let output = Bytes.create output_length in + let input_pos = ref (input_length - 1) in + let output_pos = ref (output_length - 1) in + let num_chars_until_delimiter = ref chars_per_delimiter in + let first_digit_pos = if has_sign then 1 else 0 in + while !input_pos >= first_digit_pos do + if !num_chars_until_delimiter = 0 + then ( + Bytes.set output !output_pos delimiter; + decr output_pos; + num_chars_until_delimiter := chars_per_delimiter); + Bytes.set output !output_pos input.[!input_pos]; + decr input_pos; + decr output_pos; + decr num_chars_until_delimiter + done; + if has_sign then Bytes.set output 0 input.[0]; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:output) +;; + +let insert_delimiter input ~delimiter = + insert_delimiter_every input ~delimiter ~chars_per_delimiter:3 +;; + +let insert_underscores input = insert_delimiter input ~delimiter:'_' +let sexp_of_int_style = Sexp.of_int_style + +module Make (I : sig + type t + + val to_string : t -> string +end) = +struct + open I + + let chars_per_delimiter = 3 + + let to_string_hum ?(delimiter = '_') t = + insert_delimiter_every (to_string t) ~delimiter ~chars_per_delimiter + ;; + + let sexp_of_t t = + let s = to_string t in + Sexp.Atom + (match !sexp_of_int_style with + | `Underscores -> insert_delimiter_every s ~chars_per_delimiter ~delimiter:'_' + | `No_underscores -> s) + ;; +end + +module Make_hex (I : sig + type t [@@deriving_inline compare ~localize, hash] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + + [@@@end] + + val to_string : t -> string + val of_string : string -> t + val zero : t + val ( < ) : t -> t -> bool + val neg : t -> t + val module_name : string +end) = +struct + module T_hex = struct + type t = I.t [@@deriving_inline compare ~localize, hash] + + let compare__local = (I.compare__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + I.hash_fold_t + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = I.hash in + fun x -> func x + ;; + + [@@@end] + + let chars_per_delimiter = 4 + + let to_string' ?delimiter t = + let make_suffix = + match delimiter with + | None -> I.to_string + | Some delimiter -> + fun t -> insert_delimiter_every (I.to_string t) ~delimiter ~chars_per_delimiter + in + if I.( < ) t I.zero then "-0x" ^ make_suffix (I.neg t) else "0x" ^ make_suffix t + ;; + + let to_string t = to_string' t ?delimiter:None + let to_string_hum ?(delimiter = '_') t = to_string' t ~delimiter + + let invalid str = + Printf.failwithf "%s.of_string: invalid input %S" I.module_name str () + ;; + + let of_string_with_delimiter str = + I.of_string (String.filter str ~f:(fun c -> Char.( <> ) c '_')) + ;; + + let of_string str = + let module L = Hex_lexer in + let lex = Stdlib.Lexing.from_string str in + let result = Option.try_with (fun () -> L.parse_hex lex) in + if lex.lex_curr_pos = lex.lex_buffer_len + then ( + match result with + | None -> invalid str + | Some (Neg body) -> I.neg (of_string_with_delimiter body) + | Some (Pos body) -> of_string_with_delimiter body) + else invalid str + ;; + end + + module Hex = struct + include T_hex + include Sexpable.Of_stringable (T_hex) + end +end + +module Make_binary (I : sig + type t [@@deriving_inline compare ~localize, equal ~localize, hash] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_compare_lib.Equal.S with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + + [@@@end] + + val clz : t -> int + val ( lsr ) : t -> int -> t + val ( land ) : t -> t -> t + val to_int_exn : t -> int + val num_bits : int + val zero : t + val one : t +end) = +struct + module Binary = struct + type t = I.t [@@deriving_inline compare ~localize, hash] + + let compare__local = (I.compare__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + I.hash_fold_t + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = I.hash in + fun x -> func x + ;; + + [@@@end] + + let bits t = if I.equal__local t I.zero then 0 else I.num_bits - I.clz t + + let to_string_suffix (t : t) = + let bits = bits t in + if bits = 0 + then "0" + else + String.init bits ~f:(fun char_index -> + let bit_index = bits - char_index - 1 in + let bit = I.((t lsr bit_index) land one) in + Char.unsafe_of_int (Char.to_int '0' + I.to_int_exn bit)) + ;; + + let to_string (t : t) = "0b" ^ to_string_suffix t + + let to_string_hum ?(delimiter = '_') t = + "0b" ^ insert_delimiter_every (to_string_suffix t) ~delimiter ~chars_per_delimiter:4 + ;; + + let sexp_of_t (t : t) : Sexp.t = Atom (to_string_hum t) + end +end diff --git a/unikernel/duniverse/base/src/int_string_conversions.mli b/unikernel/duniverse/base/src/int_string_conversions.mli new file mode 100644 index 00000000..0b958cc7 --- /dev/null +++ b/unikernel/duniverse/base/src/int_string_conversions.mli @@ -0,0 +1,71 @@ +(** human-friendly string (and possibly sexp) conversions *) +module Make (I : sig + type t + + val to_string : t -> string +end) : sig + val to_string_hum : ?delimiter:char (** defaults to ['_'] *) -> I.t -> string + val sexp_of_t : I.t -> Sexp.t +end + +(** in the output, [to_string], [of_string], [sexp_of_t], and [t_of_sexp] convert + between [t] and signed hexadecimal with an optional "0x" or "0X" prefix. *) +module Make_hex (I : sig + type t [@@deriving_inline compare ~localize, hash] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + + [@@@end] + + (** [to_string] and [of_string] convert between [t] and unsigned, + unprefixed hexadecimal. + They must be able to handle all non-negative values and also + [min_value]. [to_string min_value] must write a positive hex + representation. *) + val to_string : t -> string + + val of_string : string -> t + val zero : t + val ( < ) : t -> t -> bool + val neg : t -> t + val module_name : string +end) : Int_intf.Hexable with type t := I.t + +(** in the output, [to_string], [to_string_hum], and [sexp_of_t] convert [t] to an + unsigned binary representation with an "0b" prefix. *) +module Make_binary (I : sig + type t [@@deriving_inline compare ~localize, equal ~localize, hash] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_compare_lib.Equal.S with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + + [@@@end] + + val clz : t -> int + val ( lsr ) : t -> int -> t + val ( land ) : t -> t -> t + val to_int_exn : t -> int + val num_bits : int + val one : t + val zero : t +end) : Int_intf.Binaryable with type t := I.t + +(** global ref affecting whether the [sexp_of_t] returned by [Make] + is consistent with the [to_string] input or the [to_string_hum] output *) +val sexp_of_int_style : [ `No_underscores | `Underscores ] ref + +(** utility for defining to_string_hum on numeric types -- takes a string matching + (-|+)?[0-9a-fA-F]+ and puts [delimiter] every [chars_per_delimiter] characters + starting from the right. *) +val insert_delimiter_every : string -> delimiter:char -> chars_per_delimiter:int -> string + +(** [insert_delimiter_every ~chars_per_delimiter:3] *) +val insert_delimiter : string -> delimiter:char -> string + +(** [insert_delimiter ~delimiter:'_'] *) +val insert_underscores : string -> string diff --git a/unikernel/duniverse/base/src/intable.ml b/unikernel/duniverse/base/src/intable.ml new file mode 100644 index 00000000..9cb95eac --- /dev/null +++ b/unikernel/duniverse/base/src/intable.ml @@ -0,0 +1,10 @@ +(** Functor that adds integer conversion functions to a module. *) + +open! Import + +module type S = sig + type t + + val of_int_exn : int -> t + val to_int_exn : t -> int +end diff --git a/unikernel/duniverse/base/src/invariant.ml b/unikernel/duniverse/base/src/invariant.ml new file mode 100644 index 00000000..5b5eeda1 --- /dev/null +++ b/unikernel/duniverse/base/src/invariant.ml @@ -0,0 +1,25 @@ +open! Import +include Invariant_intf + +let raise_s = Error.raise_s + +let invariant here t sexp_of_t f : unit = + try f () with + | exn -> + raise_s + (Sexp.message + "invariant failed" + [ "", Source_code_position0.sexp_of_t here + ; "exn", sexp_of_exn exn + ; "", sexp_of_t t + ]) +;; + +let check_field t f field = + try f (Field.get field t) with + | exn -> + raise_s + (Sexp.message + "problem with field" + [ "field", sexp_of_string (Field.name field); "exn", sexp_of_exn exn ]) +;; diff --git a/unikernel/duniverse/base/src/invariant.mli b/unikernel/duniverse/base/src/invariant.mli new file mode 100644 index 00000000..23ca91bc --- /dev/null +++ b/unikernel/duniverse/base/src/invariant.mli @@ -0,0 +1 @@ +include Invariant_intf.Invariant (** @inline *) diff --git a/unikernel/duniverse/base/src/invariant_intf.ml b/unikernel/duniverse/base/src/invariant_intf.ml new file mode 100644 index 00000000..b0b2f559 --- /dev/null +++ b/unikernel/duniverse/base/src/invariant_intf.ml @@ -0,0 +1,100 @@ +open! Import + +type 'a t = 'a -> unit +type 'a inv = 'a t + +module type S = sig + type t + + val invariant : t inv +end + +module type S1 = sig + type 'a t + + val invariant : 'a inv -> 'a t inv +end + +module type S2 = sig + type ('a, 'b) t + + val invariant : 'a inv -> 'b inv -> ('a, 'b) t inv +end + +module type S3 = sig + type ('a, 'b, 'c) t + + val invariant : 'a inv -> 'b inv -> 'c inv -> ('a, 'b, 'c) t inv +end + +module type Invariant = sig + (** This module defines signatures that are to be included in other signatures to ensure + a consistent interface to invariant-style functions. There is a signature ([S], + [S1], [S2], [S3]) for each arity of type. Usage looks like: + + {[ + type t + include Invariant.S with type t := t + ]} + + or + + {[ + type 'a t + include Invariant.S1 with type 'a t := 'a t + ]} + *) + + type nonrec 'a t = 'a t + + module type S = S + module type S1 = S1 + module type S2 = S2 + module type S3 = S3 + + (** [invariant here t sexp_of_t f] runs [f ()], and if [f] raises, wraps the exception + in an [Error.t] that states "invariant failed" and includes both the exception + raised by [f], as well as [sexp_of_t t]. Idiomatic usage looks like: + + {[ + invariant [%here] t [%sexp_of: t] (fun () -> + ... check t's invariants ... ) + ]} + + For polymorphic types: + + {[ + let invariant check_a t = + Invariant.invariant [%here] t [%sexp_of: _ t] (fun () -> ... ) + ]} + + It's okay to use [ [%sexp_of: _ t] ] because the exceptions raised by [check_a] will + show the parts that are opaque at top-level. *) + val invariant + : Source_code_position0.t + -> 'a + -> ('a -> Sexp.t) + -> (unit -> unit) + -> unit + + (** [check_field] is used when checking invariants using [Fields.iter]. It wraps an + exception raised when checking a field with the field's name. Idiomatic usage looks + like: + + {[ + type t = + { foo : Foo.t; + bar : Bar.t; + } + [@@deriving fields] + + let invariant t : unit = + Invariant.invariant [%here] t [%sexp_of: t] (fun () -> + let check f = Invariant.check_field t f in + Fields.iter + ~foo:(check Foo.invariant) + ~bar:(check Bar.invariant)) + ;; + ]} *) + val check_field : 'a -> 'b t -> ('a, 'b) Field.t -> unit +end diff --git a/unikernel/duniverse/base/src/lazy.ml b/unikernel/duniverse/base/src/lazy.ml new file mode 100644 index 00000000..8d244cdb --- /dev/null +++ b/unikernel/duniverse/base/src/lazy.ml @@ -0,0 +1,49 @@ +open! Import +include Stdlib.Lazy + +type 'a t = 'a lazy_t [@@deriving_inline sexp, sexp_grammar] + +let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = lazy_t_of_sexp +let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = sexp_of_lazy_t + +let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> lazy_t_sexp_grammar _'a_sexp_grammar +;; + +[@@@end] + +external force : ('a t[@local_opt]) -> 'a = "%lazy_force" + +let globalize = Globalize.globalize_lazy_t +let map t ~f = lazy (f (force t)) + +let compare__local compare_a t1 t2 = + if phys_equal t1 t2 then 0 else compare_a (force t1) (force t2) +;; + +let compare compare_a t1 t2 = compare__local compare_a t1 t2 + +let equal__local equal_a t1 t2 = + if phys_equal t1 t2 then true else equal_a (force t1) (force t2) +;; + +let equal equal_a t1 t2 = equal__local equal_a t1 t2 +let hash_fold_t = Hash.Builtin.hash_fold_lazy_t +let peek t = if is_val t then Some (force t) else None + +include Monad.Make (struct + type nonrec 'a t = 'a t + + let return x = from_val x + let bind t ~f = lazy (force (f (force t))) + let map = map + let map = `Custom map +end) + +module T_unforcing = struct + type nonrec 'a t = 'a t + + let sexp_of_t sexp_of_a t = + if is_val t then sexp_of_a (force t) else sexp_of_string "" + ;; +end diff --git a/unikernel/duniverse/base/src/lazy.mli b/unikernel/duniverse/base/src/lazy.mli new file mode 100644 index 00000000..dbd5575a --- /dev/null +++ b/unikernel/duniverse/base/src/lazy.mli @@ -0,0 +1,86 @@ +(** A value of type ['a Lazy.t] is a deferred computation, called a suspension, that has a + result of type ['a]. + + The special expression syntax [lazy (expr)] makes a suspension of the computation of + [expr], without computing [expr] itself yet. "Forcing" the suspension will then + compute [expr] and return its result. + + Note: [lazy_t] is the built-in type constructor used by the compiler for the [lazy] + keyword. You should not use it directly. Always use [Lazy.t] instead. + + Note: [Lazy.force] is not thread-safe. If you use this module in a multi-threaded + program, you will need to add some locks. + + Note: if the program is compiled with the [-rectypes] option, ill-founded recursive + definitions of the form [let rec x = lazy x] or [let rec x = lazy(lazy(...(lazy x)))] + are accepted by the type-checker and lead, when forced, to ill-formed values that + trigger infinite loops in the garbage collector and other parts of the run-time + system. Without the [-rectypes] option, such ill-founded recursive definitions are + rejected by the type-checker. *) + +open! Import + +type 'a t = 'a lazy_t +[@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t + +val globalize : ('a -> 'a) -> 'a t -> 'a t + +include Ppx_hash_lib.Hashable.S1 with type 'a t := 'a t +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Monad.S with type 'a t := 'a t + +exception Undefined + +(** [force x] forces the suspension [x] and returns its result. If [x] has already been + forced, [Lazy.force x] returns the same value again without recomputing it. If it + raised an exception, the same exception is raised again. Raise [Undefined] if the + forcing of [x] tries to force [x] itself recursively. *) +external force : ('a t[@local_opt]) -> 'a = "%lazy_force" + +(** Like [force] except that [force_val x] does not use an exception handler, so it may be + more efficient. However, if the computation of [x] raises an exception, it is + unspecified whether [force_val x] raises the same exception or [Undefined]. *) +val force_val : 'a t -> 'a + +(** [from_fun f] is the same as [lazy (f ())] but slightly more efficient if [f] is a + variable. [from_fun] should only be used if the function [f] is already defined. In + particular it is always less efficient to write [from_fun (fun () -> expr)] than [lazy + expr]. *) +val from_fun : (unit -> 'a) -> 'a t + +(** [from_val v] returns an already-forced suspension of [v] (where [v] can be any + expression). Essentially, [from_val expr] is the same as [let var = expr in lazy + var]. *) +val from_val : 'a -> 'a t + +(** [is_val x] returns [true] if [x] has already been forced and did not raise an + exception. *) +val is_val : 'a t -> bool + +(** [peek x] returns None if [x] has never been forced or [Some v] if [x] was forced + to value [v] *) +val peek : 'a t -> 'a option + +(** This type offers a serialization function [sexp_of_t] that won't force its argument. + Instead, it will serialize the ['a] if it is available, or just use a custom string + indicating it is not forced. Note that this is not a round-trippable type, thus the + type does not expose [of_sexp]. To be used in debug code, while tracking a Heisenbug, + etc. *) +module T_unforcing : sig + type nonrec 'a t = 'a t [@@deriving_inline sexp_of] + + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + + [@@@end] +end diff --git a/unikernel/duniverse/base/src/linked_queue.ml b/unikernel/duniverse/base/src/linked_queue.ml new file mode 100644 index 00000000..f3ba30df --- /dev/null +++ b/unikernel/duniverse/base/src/linked_queue.ml @@ -0,0 +1,161 @@ +open! Import +include Linked_queue0 + +let enqueue t x = Linked_queue0.push x t +let dequeue t = if is_empty t then None else Some (Linked_queue0.pop t) +let dequeue_exn = Linked_queue0.pop +let dequeue_and_ignore_exn (type elt) (t : elt t) = ignore (dequeue_exn t : elt) +let peek t = if is_empty t then None else Some (Linked_queue0.peek t) +let peek_exn = Linked_queue0.peek + +let drain t ~f ~while_ = + while (not (is_empty t)) && while_ (peek_exn t) do + f (dequeue_exn t) + done +;; + +module C = Indexed_container.Make (struct + type nonrec 'a t = 'a t + + let fold = fold + let iter = `Custom iter + let length = `Custom length + let foldi = `Define_using_fold + let iteri = `Define_using_fold +end) + +let count = C.count +let exists = C.exists +let find = C.find +let find_map = C.find_map +let fold_result = C.fold_result +let fold_until = C.fold_until +let for_all = C.for_all +let max_elt = C.max_elt +let mem = C.mem +let min_elt = C.min_elt +let sum = C.sum +let to_list = C.to_list +let counti = C.counti +let existsi = C.existsi +let find_mapi = C.find_mapi +let findi = C.findi +let foldi = C.foldi +let for_alli = C.for_alli +let iteri = C.iteri +let transfer ~src ~dst = Linked_queue0.transfer src dst + +let concat_map t ~f = + let res = create () in + iter t ~f:(fun a -> List.iter (f a) ~f:(fun b -> enqueue res b)); + res +;; + +let concat_mapi t ~f = + let res = create () in + iteri t ~f:(fun i a -> List.iter (f i a) ~f:(fun b -> enqueue res b)); + res +;; + +let filter_map t ~f = + let res = create () in + iter t ~f:(fun a -> + match f a with + | None -> () + | Some b -> enqueue res b); + res +;; + +let filter_mapi t ~f = + let res = create () in + iteri t ~f:(fun i a -> + match f i a with + | None -> () + | Some b -> enqueue res b); + res +;; + +let filter t ~f = + let res = create () in + iter t ~f:(fun a -> if f a then enqueue res a); + res +;; + +let filteri t ~f = + let res = create () in + iteri t ~f:(fun i a -> if f i a then enqueue res a); + res +;; + +let map t ~f = + let res = create () in + iter t ~f:(fun a -> enqueue res (f a)); + res +;; + +let mapi t ~f = + let res = create () in + iteri t ~f:(fun i a -> enqueue res (f i a)); + res +;; + +let filter_inplace q ~f = + let q' = filter q ~f in + clear q; + transfer ~src:q' ~dst:q +;; + +let filteri_inplace q ~f = + let q' = filteri q ~f in + clear q; + transfer ~src:q' ~dst:q +;; + +let enqueue_all t list = List.iter list ~f:(fun x -> enqueue t x) + +let of_list list = + let t = create () in + List.iter list ~f:(fun x -> enqueue t x); + t +;; + +let of_array array = + let t = create () in + Array.iter array ~f:(fun x -> enqueue t x); + t +;; + +let init len ~f = + let t = create () in + for i = 0 to len - 1 do + enqueue t (f i) + done; + t +;; + +let to_array t = + match length t with + | 0 -> [||] + | len -> + let arr = Array.create ~len (peek_exn t) in + let i = ref 0 in + iter t ~f:(fun v -> + arr.(!i) <- v; + incr i); + arr +;; + +let t_of_sexp a_of_sexp sexp = of_list (list_of_sexp a_of_sexp sexp) +let sexp_of_t sexp_of_a t = sexp_of_list sexp_of_a (to_list t) + +let t_sexp_grammar (type a) (grammar : a Sexplib0.Sexp_grammar.t) + : a t Sexplib0.Sexp_grammar.t + = + Sexplib0.Sexp_grammar.coerce (List.t_sexp_grammar grammar) +;; + +let singleton a = + let t = create () in + enqueue t a; + t +;; diff --git a/unikernel/duniverse/base/src/linked_queue.mli b/unikernel/duniverse/base/src/linked_queue.mli new file mode 100644 index 00000000..aa57c571 --- /dev/null +++ b/unikernel/duniverse/base/src/linked_queue.mli @@ -0,0 +1,19 @@ +(** This module is a Base-style wrapper around OCaml's standard [Queue] module. *) + +open! Import + +include Queue_intf.S with type 'a t = 'a Stdlib.Queue.t (** @inline *) + +(** [create ()] returns an empty queue. *) +val create : unit -> _ t + +(** [transfer ~src ~dst] adds all of the elements of [src] to the end of [dst], then + clears [src]. It is equivalent to the sequence: + + {[ + iter ~src ~f:(enqueue dst); + clear src + ]} + + but runs in constant time. *) +val transfer : src:'a t -> dst:'a t -> unit diff --git a/unikernel/duniverse/base/src/linked_queue0.ml b/unikernel/duniverse/base/src/linked_queue0.ml new file mode 100644 index 00000000..bf5f88d1 --- /dev/null +++ b/unikernel/duniverse/base/src/linked_queue0.ml @@ -0,0 +1,27 @@ +open! Import0 + +type 'a t = 'a Stdlib.Queue.t + +let create = Stdlib.Queue.create +let clear = Stdlib.Queue.clear +let copy = Stdlib.Queue.copy +let is_empty = Stdlib.Queue.is_empty +let length = Stdlib.Queue.length +let peek = Stdlib.Queue.peek +let pop = Stdlib.Queue.pop +let push = Stdlib.Queue.push +let transfer = Stdlib.Queue.transfer + +let iter t ~(f : _ -> _) = + let caml_iter : ('a -> unit) -> 'a t -> unit = + Stdlib.Obj.magic (Stdlib.Queue.iter : ('a -> unit) -> 'a t -> unit) + in + caml_iter f t +;; + +let fold t ~init ~(f : _ -> _ -> _) = + let caml_fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b = + Stdlib.Obj.magic (Stdlib.Queue.fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b) + in + caml_fold f init t +;; diff --git a/unikernel/duniverse/base/src/list.ml b/unikernel/duniverse/base/src/list.ml new file mode 100644 index 00000000..5cd98e9d --- /dev/null +++ b/unikernel/duniverse/base/src/list.ml @@ -0,0 +1,1613 @@ +open! Import +module Array = Array0 +module Either = Either0 +include List1 + +(* This itself includes [List0]. *) + +let invalid_argf = Printf.invalid_argf + +module T = struct + type 'a t = 'a list [@@deriving_inline globalize, sexp, sexp_grammar] + + let globalize : 'a. ('a -> 'a) -> 'a t -> 'a t = + fun (type a__001_) : ((a__001_ -> a__001_) -> a__001_ t -> a__001_ t) -> + globalize_list + ;; + + let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = list_of_sexp + let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = sexp_of_list + + let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> list_sexp_grammar _'a_sexp_grammar + ;; + + [@@@end] +end + +module Or_unequal_lengths = struct + type 'a t = + | Ok of 'a + | Unequal_lengths + [@@deriving_inline compare ~localize, sexp_of] + + let compare__local : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = + fun _cmp__a a__014_ b__015_ -> + if Stdlib.( == ) a__014_ b__015_ + then 0 + else ( + match a__014_, b__015_ with + | Ok _a__016_, Ok _b__017_ -> _cmp__a _a__016_ _b__017_ + | Ok _, _ -> -1 + | _, Ok _ -> 1 + | Unequal_lengths, Unequal_lengths -> 0) + ;; + + let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = + fun _cmp__a a__010_ b__011_ -> + if Stdlib.( == ) a__010_ b__011_ + then 0 + else ( + match a__010_, b__011_ with + | Ok _a__012_, Ok _b__013_ -> _cmp__a _a__012_ _b__013_ + | Ok _, _ -> -1 + | _, Ok _ -> 1 + | Unequal_lengths, Unequal_lengths -> 0) + ;; + + let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + fun (type a__021_) : ((a__021_ -> Sexplib0.Sexp.t) -> a__021_ t -> Sexplib0.Sexp.t) -> + fun _of_a__018_ -> function + | Ok arg0__019_ -> + let res0__020_ = _of_a__018_ arg0__019_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; res0__020_ ] + | Unequal_lengths -> Sexplib0.Sexp.Atom "Unequal_lengths" + ;; + + [@@@end] +end + +include T + +let invariant f t = iter t ~f +let of_list t = t +let singleton x = [ x ] + +let range' ~compare ~stride ?(start = `inclusive) ?(stop = `exclusive) start_i stop_i = + let next_i = stride start_i in + let order x y = Ordering.of_int (compare x y) in + let raise_stride_cannot_return_same_value () = + invalid_arg "List.range': stride function cannot return the same value" + in + let initial_stride_order = + match order start_i next_i with + | Equal -> raise_stride_cannot_return_same_value () + | Less -> `Less + | Greater -> `Greater + in + let[@tail_mod_cons] rec loop i = + let i_to_stop_order = order i stop_i in + match i_to_stop_order, initial_stride_order with + | Less, `Less | Greater, `Greater -> + (* haven't yet reached [stop_i]. Continue. *) + let next_i = stride i in + (match order i next_i, initial_stride_order with + | Equal, _ -> (raise_stride_cannot_return_same_value [@tailcall false]) () + | Less, `Greater | Greater, `Less -> + invalid_arg "List.range': stride function cannot change direction" + | Less, `Less | Greater, `Greater -> i :: loop next_i) + | Less, `Greater | Greater, `Less -> + (* stepped past [stop_i]. Finished. *) + [] + | Equal, _ -> + (* reached [stop_i]. Finished. *) + (match stop with + | `inclusive -> [ i ] + | `exclusive -> []) + in + let start_i = + match start with + | `inclusive -> start_i + | `exclusive -> next_i + in + loop start_i [@nontail] +;; + +let range ?(stride = 1) ?(start = `inclusive) ?(stop = `exclusive) start_i stop_i = + if stride = 0 then invalid_arg "List.range: stride must be non-zero"; + range' ~compare ~stride:(fun x -> x + stride) ~start ~stop start_i stop_i +;; + +let hd t = + match t with + | [] -> None + | x :: _ -> Some x +;; + +let tl t = + match t with + | [] -> None + | _ :: t' -> Some t' +;; + +let nth t n = + if n < 0 + then None + else ( + let rec nth_aux t n = + match t with + | [] -> None + | a :: t -> if n = 0 then Some a else nth_aux t (n - 1) + in + nth_aux t n) +;; + +let nth_exn t n = + match nth t n with + | None -> invalid_argf "List.nth_exn %d called on list of length %d" n (length t) () + | Some a -> a +;; + +let unordered_append l1 l2 = + match l1, l2 with + | [], l | l, [] -> l + | _ -> rev_append l1 l2 +;; + +module Check_length2 = struct + type ('a, 'b) t = + | Same_length of int + | Unequal_lengths of + { shared_length : int + ; tail_of_a : 'a list + ; tail_of_b : 'b list + } + + (* In the [Unequal_lengths] case, at least one of the tails will be non-empty. *) + let of_lists l1 l2 = + let rec loop a b shared_length = + match a, b with + | [], [] -> Same_length shared_length + | _ :: a, _ :: b -> loop a b (shared_length + 1) + | [], _ | _, [] -> Unequal_lengths { shared_length; tail_of_a = a; tail_of_b = b } + in + loop l1 l2 0 + ;; +end + +let check_length2_exn name l1 l2 = + match Check_length2.of_lists l1 l2 with + | Same_length _ -> () + | Unequal_lengths { shared_length; tail_of_a; tail_of_b } -> + invalid_argf + "length mismatch in %s: %d <> %d" + name + (shared_length + length tail_of_a) + (shared_length + length tail_of_b) + () +;; + +let check_length2 l1 l2 ~f = + match Check_length2.of_lists l1 l2 with + | Same_length _ -> Or_unequal_lengths.Ok (f l1 l2) + | Unequal_lengths _ -> Unequal_lengths +;; + +module Check_length3 = struct + type ('a, 'b, 'c) t = + | Same_length of int + | Unequal_lengths of + { shared_length : int + ; tail_of_a : 'a list + ; tail_of_b : 'b list + ; tail_of_c : 'c list + } + + (* In the [Unequal_lengths] case, at least one of the tails will be non-empty. *) + let of_lists l1 l2 l3 = + let rec loop a b c shared_length = + match a, b, c with + | [], [], [] -> Same_length shared_length + | _ :: a, _ :: b, _ :: c -> loop a b c (shared_length + 1) + | [], _, _ | _, [], _ | _, _, [] -> + Unequal_lengths { shared_length; tail_of_a = a; tail_of_b = b; tail_of_c = c } + in + loop l1 l2 l3 0 + ;; +end + +let check_length3_exn name l1 l2 l3 = + match Check_length3.of_lists l1 l2 l3 with + | Same_length _ -> () + | Unequal_lengths { shared_length; tail_of_a; tail_of_b; tail_of_c } -> + let n1 = shared_length + length tail_of_a in + let n2 = shared_length + length tail_of_b in + let n3 = shared_length + length tail_of_c in + invalid_argf "length mismatch in %s: %d <> %d || %d <> %d" name n1 n2 n2 n3 () +;; + +let check_length3 l1 l2 l3 ~f = + match Check_length3.of_lists l1 l2 l3 with + | Same_length _ -> Or_unequal_lengths.Ok (f l1 l2 l3) + | Unequal_lengths _ -> Unequal_lengths +;; + +let iter2 l1 l2 ~f = check_length2 l1 l2 ~f:(iter2_ok ~f) [@nontail] + +let iter2_exn l1 l2 ~f = + check_length2_exn "iter2_exn" l1 l2; + iter2_ok l1 l2 ~f +;; + +let rev_map2 l1 l2 ~f = check_length2 l1 l2 ~f:(rev_map2_ok ~f) [@nontail] + +let rev_map2_exn l1 l2 ~f = + check_length2_exn "rev_map2_exn" l1 l2; + rev_map2_ok l1 l2 ~f +;; + +let fold2 l1 l2 ~init ~f = check_length2 l1 l2 ~f:(fold2_ok ~init ~f) [@nontail] + +let fold2_exn l1 l2 ~init ~f = + check_length2_exn "fold2_exn" l1 l2; + fold2_ok l1 l2 ~init ~f +;; + +let fold_right2 l1 l2 ~f ~init = + check_length2 l1 l2 ~f:(fold_right2_ok ~f ~init) [@nontail] +;; + +let fold_right2_exn l1 l2 ~f ~init = + check_length2_exn "fold_right2_exn" l1 l2; + fold_right2_ok l1 l2 ~f ~init +;; + +let for_all2 l1 l2 ~f = check_length2 l1 l2 ~f:(for_all2_ok ~f) [@nontail] + +let for_all2_exn l1 l2 ~f = + check_length2_exn "for_all2_exn" l1 l2; + for_all2_ok l1 l2 ~f +;; + +let exists2 l1 l2 ~f = check_length2 l1 l2 ~f:(exists2_ok ~f) [@nontail] + +let exists2_exn l1 l2 ~f = + check_length2_exn "exists2_exn" l1 l2; + exists2_ok l1 l2 ~f +;; + +let mem t a ~equal = + let rec loop equal a = function + | [] -> false + | b :: bs -> equal a b || loop equal a bs + in + loop equal a t +;; + +(* This is a copy of the code from the standard library, with an extra eta-expansion to + avoid creating partial closures (showed up for [filter]) in profiling). *) +let rev_filter t ~f = + let rec find ~f accu = function + | [] -> accu + | x :: l -> if f x then find ~f (x :: accu) l else find ~f accu l + in + find ~f [] t +;; + +let[@tail_mod_cons] rec filter l ~f = + match l with + | [] -> [] + | hd :: tl -> if f hd then hd :: filter tl ~f else filter tl ~f +;; + +let find_map t ~f = + let rec loop = function + | [] -> None + | x :: l -> + (match f x with + | None -> loop l + | Some _ as r -> r) + in + loop t [@nontail] +;; + +let find_map_exn = + let not_found = Not_found_s (Atom "List.find_map_exn: not found") in + let find_map_exn t ~f = + match find_map t ~f with + | None -> raise not_found + | Some x -> x + in + (* named to preserve symbol in compiled binary *) + find_map_exn +;; + +let find t ~f = + let rec loop = function + | [] -> None + | x :: l -> if f x then Some x else loop l + in + loop t [@nontail] +;; + +let find_exn = + let not_found = Not_found_s (Atom "List.find_exn: not found") in + let rec find_exn t ~f = + match t with + | [] -> raise not_found + | x :: t -> if f x then x else find_exn t ~f + in + (* named to preserve symbol in compiled binary *) + find_exn +;; + +let findi t ~f = + let rec loop i t = + match t with + | [] -> None + | x :: l -> if f i x then Some (i, x) else loop (i + 1) l + in + loop 0 t [@nontail] +;; + +let findi_exn = + let not_found = Not_found_s (Atom "List.findi_exn: not found") in + let findi_exn t ~f = + match findi t ~f with + | None -> raise not_found + | Some x -> x + in + findi_exn +;; + +let find_mapi t ~f = + let rec loop i t = + match t with + | [] -> None + | x :: l -> + (match f i x with + | Some _ as result -> result + | None -> loop (i + 1) l) + in + loop 0 t [@nontail] +;; + +let find_mapi_exn = + let not_found = Not_found_s (Atom "List.find_mapi_exn: not found") in + let find_mapi_exn t ~f = + match find_mapi t ~f with + | None -> raise not_found + | Some x -> x + in + (* named to preserve symbol in compiled binary *) + find_mapi_exn +;; + +let for_alli t ~f = + let rec loop i t = + match t with + | [] -> true + | hd :: tl -> f i hd && loop (i + 1) tl + in + loop 0 t [@nontail] +;; + +let existsi t ~f = + let rec loop i t = + match t with + | [] -> false + | hd :: tl -> f i hd || loop (i + 1) tl + in + loop 0 t [@nontail] +;; + +(** For the container interface. *) +let fold_left = fold + +let of_array = Array.to_list +let to_array = Array.of_list +let to_list t = t + +(** Tail recursive versions of standard [List] module *) + +let[@tail_mod_cons] rec append_loop l1 l2 = + match l1 with + | [] -> l2 + | [ x1 ] -> x1 :: l2 + | [ x1; x2 ] -> x1 :: x2 :: l2 + | [ x1; x2; x3 ] -> x1 :: x2 :: x3 :: l2 + | [ x1; x2; x3; x4 ] -> x1 :: x2 :: x3 :: x4 :: l2 + | x1 :: x2 :: x3 :: x4 :: x5 :: tl -> + x1 :: x2 :: x3 :: x4 :: x5 :: (append_loop [@tailcall]) tl l2 +;; + +let append l1 l2 = + match l2 with + | [] -> l1 + | _ :: _ -> append_loop l1 l2 +;; + +let[@tail_mod_cons] rec map l ~f = + match l with + | [] -> [] + | x :: tl -> f x :: (map [@tailcall]) tl ~f +;; + +let folding_map t ~init ~f = + let acc = ref init in + map t ~f:(fun x -> + let new_acc, y = f !acc x in + acc := new_acc; + y) [@nontail] +;; + +let fold_map t ~init ~f = + let acc = ref init in + let result = + map t ~f:(fun x -> + let new_acc, y = f !acc x in + acc := new_acc; + y) + in + !acc, result +;; + +let ( >>| ) l f = map l ~f + +let[@tail_mod_cons] rec map2_ok l1 l2 ~f = + match l1, l2 with + | [], [] -> [] + | x1 :: l1, x2 :: l2 -> f x1 x2 :: map2_ok l1 l2 ~f + | _, _ -> invalid_arg "List.map2" +;; + +let map2 l1 l2 ~f = check_length2 l1 l2 ~f:(map2_ok ~f) [@nontail] + +let map2_exn l1 l2 ~f = + check_length2_exn "map2_exn" l1 l2; + map2_ok l1 l2 ~f +;; + +let rev_map3_ok l1 l2 l3 ~f = + let rec loop l1 l2 l3 ac = + match l1, l2, l3 with + | [], [], [] -> ac + | x1 :: l1, x2 :: l2, x3 :: l3 -> loop l1 l2 l3 (f x1 x2 x3 :: ac) + | _ -> assert false + in + loop l1 l2 l3 [] [@nontail] +;; + +let rev_map3 l1 l2 l3 ~f = check_length3 l1 l2 l3 ~f:(rev_map3_ok ~f) [@nontail] + +let rev_map3_exn l1 l2 l3 ~f = + check_length3_exn "rev_map3_exn" l1 l2 l3; + rev_map3_ok l1 l2 l3 ~f +;; + +let[@tail_mod_cons] rec map3_ok l1 l2 l3 ~f = + match l1, l2, l3 with + | [], [], [] -> [] + | x1 :: l1, x2 :: l2, x3 :: l3 -> f x1 x2 x3 :: map3_ok l1 l2 l3 ~f + | _, _, _ -> invalid_arg "List.map3" +;; + +let map3 l1 l2 l3 ~f = check_length3 l1 l2 l3 ~f:(map3_ok ~f) [@nontail] + +let map3_exn l1 l2 l3 ~f = + check_length3_exn "map3_exn" l1 l2 l3; + map3_ok l1 l2 l3 ~f +;; + +let rec rev_map_append l1 l2 ~f = + match l1 with + | [] -> l2 + | h :: t -> rev_map_append ~f t (f h :: l2) +;; + +let unzip list = + let rec loop list l1 l2 = + match list with + | [] -> l1, l2 + | (x, y) :: tl -> loop tl (x :: l1) (y :: l2) + in + loop (rev list) [] [] +;; + +let unzip3 list = + let rec loop list l1 l2 l3 = + match list with + | [] -> l1, l2, l3 + | (x, y, z) :: tl -> loop tl (x :: l1) (y :: l2) (z :: l3) + in + loop (rev list) [] [] [] +;; + +let zip_exn l1 l2 = + try map2_ok ~f:(fun a b -> a, b) l1 l2 with + | _ -> invalid_argf "length mismatch in zip_exn: %d <> %d" (length l1) (length l2) () +;; + +let zip l1 l2 = map2 ~f:(fun a b -> a, b) l1 l2 + +(** Additional list operations *) + +let rev_mapi l ~f = + let rec loop i acc = function + | [] -> acc + | h :: t -> loop (i + 1) (f i h :: acc) t + in + loop 0 [] l [@nontail] +;; + +let mapi l ~f = + let[@tail_mod_cons] rec loop i = function + | [] -> [] + | h :: t -> f i h :: loop (i + 1) t + in + loop 0 l [@nontail] +;; + +let folding_mapi t ~init ~f = + let acc = ref init in + mapi t ~f:(fun i x -> + let new_acc, y = f i !acc x in + acc := new_acc; + y) [@nontail] +;; + +let fold_mapi t ~init ~f = + let acc = ref init in + let result = + mapi t ~f:(fun i x -> + let new_acc, y = f i !acc x in + acc := new_acc; + y) + in + !acc, result +;; + +let iteri l ~f = + ignore + (fold l ~init:0 ~f:(fun i x -> + f i x; + i + 1) + : int) +;; + +let foldi t ~init ~f = + snd (fold t ~init:(0, init) ~f:(fun (i, acc) v -> i + 1, f i acc v)) +;; + +let filteri l ~f = + let[@tail_mod_cons] rec loop pos l = + match l with + | [] -> [] + | hd :: tl -> if f pos hd then hd :: loop (pos + 1) tl else loop (pos + 1) tl + in + loop 0 l [@nontail] +;; + +let reduce l ~f = + match l with + | [] -> None + | hd :: tl -> Some (fold ~init:hd ~f tl) +;; + +let reduce_exn l ~f = + match reduce l ~f with + | None -> invalid_arg "List.reduce_exn" + | Some v -> v +;; + +let reduce_balanced l ~f = + (* Call the "size" of a value the number of list elements that have been combined into + it via calls to [f]. We proceed by using [f] to combine elements in the accumulator + of the same size until we can't combine any more, then getting a new element from the + input list and repeating. + + With this strategy, in the accumulator: + - we only ever have elements of sizes a power of two + - we never have more than one element of each size + - the sum of all the element sizes is equal to the number of elements consumed + + These conditions enforce that list of elements of each size is precisely the binary + expansion of the number of elements consumed: if you've consumed 13 = 0b1101 + elements, you have one element of size 8, one of size 4, and one of size 1. Hence + when a new element comes along, the number of combinings you need to do is the number + of trailing 1s in the binary expansion of [num], the number of elements that have + already gone into the accumulator. The accumulator is in ascending order of size, so + the next element to combine with is always the head of the list. *) + let rec step_accum num acc x = + if num land 1 = 0 + then x :: acc + else ( + match acc with + | [] -> assert false + (* New elements from later in the input list go on the front of the accumulator, so + the accumulator is in reverse order wrt the original list order, hence [f y x] + instead of [f x y]. *) + | y :: ys -> step_accum (num asr 1) ys (f y x)) + in + (* Experimentally, inlining [foldi] and unrolling this loop a few times can reduce + runtime down to a third and allocation to 1/16th or so in the microbenchmarks below. + However, in most use cases [f] is likely to be expensive (otherwise why do you care + about the order of reduction?) so the overhead of this function itself doesn't really + matter. If you come up with a use-case where it does, then that's something you might + want to try: see hg log -pr 49ef065f429d. *) + match foldi l ~init:[] ~f:step_accum with + | [] -> None + | x :: xs -> Some (fold xs ~init:x ~f:(fun x y -> f y x)) +;; + +let reduce_balanced_exn l ~f = + match reduce_balanced l ~f with + | None -> invalid_arg "List.reduce_balanced_exn" + | Some v -> v +;; + +let groupi l ~break = + (* We allocate shared position and list references so we can make the inner loop use + [[@tail_mod_cons]], and still return back information about position and where in the + list we left off. *) + let pos = ref 0 in + let l = ref l in + (* As a result of using local references, our inner loop does not need arguments. *) + let[@tail_mod_cons] rec take_group () = + match !l with + | ([] | [ _ ]) as group -> + l := []; + group + | x :: (y :: _ as tl) -> + pos := !pos + 1; + l := tl; + if break !pos x y then [ x ] else x :: take_group () + in + (* Our outer loop does not need arguments, either. *) + let[@tail_mod_cons] rec groups () = + if is_empty !l + then [] + else ( + let group = take_group () in + group :: groups ()) + in + groups () [@nontail] +;; + +let group l ~break = groupi l ~break:(fun _ x y -> break x y) [@nontail] + +let[@tail_mod_cons] rec merge l1 l2 ~compare = + match l1, l2 with + | [], l2 -> l2 + | l1, [] -> l1 + | h1 :: t1, h2 :: t2 -> + if compare h1 h2 <= 0 then h1 :: merge t1 l2 ~compare else h2 :: merge l1 t2 ~compare +;; + +let stable_sort l ~compare:cmp = + let rec rev_merge cmp l1 l2 accu = + match l1, l2 with + | [], l2 -> rev_append l2 accu + | l1, [] -> rev_append l1 accu + | h1 :: t1, h2 :: t2 -> + if cmp h1 h2 <= 0 + then rev_merge cmp t1 l2 (h1 :: accu) + else rev_merge cmp l1 t2 (h2 :: accu) + in + let rec rev_merge_rev cmp l1 l2 accu = + match l1, l2 with + | [], l2 -> rev_append l2 accu + | l1, [] -> rev_append l1 accu + | h1 :: t1, h2 :: t2 -> + if cmp h1 h2 > 0 + then rev_merge_rev cmp t1 l2 (h1 :: accu) + else rev_merge_rev cmp l1 t2 (h2 :: accu) + in + let rec sort n l = + match n, l with + | 2, x1 :: x2 :: tl -> + let s = if cmp x1 x2 <= 0 then [ x1; x2 ] else [ x2; x1 ] in + s, tl + | 3, x1 :: x2 :: x3 :: tl -> + let s = + if cmp x1 x2 <= 0 + then + if cmp x2 x3 <= 0 + then [ x1; x2; x3 ] + else if cmp x1 x3 <= 0 + then [ x1; x3; x2 ] + else [ x3; x1; x2 ] + else if cmp x1 x3 <= 0 + then [ x2; x1; x3 ] + else if cmp x2 x3 <= 0 + then [ x2; x3; x1 ] + else [ x3; x2; x1 ] + in + s, tl + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = rev_sort n1 l in + let s2, tl = rev_sort n2 l2 in + rev_merge_rev cmp s1 s2 [], tl + and rev_sort n l = + match n, l with + | 2, x1 :: x2 :: tl -> + let s = if cmp x1 x2 > 0 then [ x1; x2 ] else [ x2; x1 ] in + s, tl + | 3, x1 :: x2 :: x3 :: tl -> + let s = + if cmp x1 x2 > 0 + then + if cmp x2 x3 > 0 + then [ x1; x2; x3 ] + else if cmp x1 x3 > 0 + then [ x1; x3; x2 ] + else [ x3; x1; x2 ] + else if cmp x1 x3 > 0 + then [ x2; x1; x3 ] + else if cmp x2 x3 > 0 + then [ x2; x3; x1 ] + else [ x3; x2; x1 ] + in + s, tl + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = sort n1 l in + let s2, tl = sort n2 l2 in + rev_merge cmp s1 s2 [], tl + in + let len = length l in + if len < 2 then l else fst (sort len l) +;; + +let sort = stable_sort + +let sort_and_group l ~compare = + (l |> stable_sort ~compare |> group ~break:(fun x y -> compare x y <> 0)) [@nontail] +;; + +let dedup_and_sort l ~compare:cmp = + let rec rev_merge cmp l1 l2 accu = + match l1, l2 with + | [], l2 -> rev_append l2 accu + | l1, [] -> rev_append l1 accu + | h1 :: t1, h2 :: t2 -> + (match cmp h1 h2 with + | c when c < 0 -> rev_merge cmp t1 l2 (h1 :: accu) + | c when c > 0 -> rev_merge cmp l1 t2 (h2 :: accu) + | _ -> rev_merge cmp t1 l2 accu) + in + let rec rev_merge_rev cmp l1 l2 accu = + match l1, l2 with + | [], l2 -> rev_append l2 accu + | l1, [] -> rev_append l1 accu + | h1 :: t1, h2 :: t2 -> + (match cmp h1 h2 with + | c when c > 0 -> rev_merge_rev cmp t1 l2 (h1 :: accu) + | c when c < 0 -> rev_merge_rev cmp l1 t2 (h2 :: accu) + | _ -> rev_merge_rev cmp t1 l2 accu) + in + let rec sort n l = + match n, l with + | 2, x1 :: x2 :: tl -> + let s = + match cmp x1 x2 with + | c when c < 0 -> [ x1; x2 ] + | c when c > 0 -> [ x2; x1 ] + | _ -> [ x2 ] + in + s, tl + | 3, x1 :: x2 :: x3 :: tl -> + let s = + match cmp x1 x2 with + | c when c < 0 -> + (match cmp x2 x3 with + | c when c < 0 -> [ x1; x2; x3 ] + | c when c > 0 -> + (match cmp x1 x3 with + | c when c < 0 -> [ x1; x3; x2 ] + | c when c > 0 -> [ x3; x1; x2 ] + | _ -> [ x3; x2 ]) + | _ -> [ x1; x3 ]) + | c when c > 0 -> + (match cmp x1 x3 with + | c when c < 0 -> [ x2; x1; x3 ] + | c when c > 0 -> + (match cmp x2 x3 with + | c when c < 0 -> [ x2; x3; x1 ] + | c when c > 0 -> [ x3; x2; x1 ] + | _ -> [ x3; x1 ]) + | _ -> [ x2; x3 ]) + | _ -> + (match cmp x2 x3 with + | c when c < 0 -> [ x2; x3 ] + | c when c > 0 -> [ x3; x2 ] + | _ -> [ x3 ]) + in + s, tl + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = rev_sort n1 l in + let s2, tl = rev_sort n2 l2 in + rev_merge_rev cmp s1 s2 [], tl + and rev_sort n l = + match n, l with + | 2, x1 :: x2 :: tl -> + let s = + match cmp x1 x2 with + | c when c > 0 -> [ x1; x2 ] + | c when c < 0 -> [ x2; x1 ] + | _ -> [ x2 ] + in + s, tl + | 3, x1 :: x2 :: x3 :: tl -> + let s = + match cmp x1 x2 with + | c when c > 0 -> + (match cmp x2 x3 with + | c when c > 0 -> [ x1; x2; x3 ] + | c when c < 0 -> + (match cmp x1 x3 with + | c when c > 0 -> [ x1; x3; x2 ] + | c when c < 0 -> [ x3; x1; x2 ] + | _ -> [ x3; x2 ]) + | _ -> [ x1; x3 ]) + | c when c < 0 -> + (match cmp x1 x3 with + | c when c > 0 -> [ x2; x1; x3 ] + | c when c < 0 -> + (match cmp x2 x3 with + | c when c > 0 -> [ x2; x3; x1 ] + | c when c < 0 -> [ x3; x2; x1 ] + | _ -> [ x3; x1 ]) + | _ -> [ x2; x3 ]) + | _ -> + (match cmp x2 x3 with + | c when c > 0 -> [ x2; x3 ] + | c when c < 0 -> [ x3; x2 ] + | _ -> [ x3 ]) + in + s, tl + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = sort n1 l in + let s2, tl = sort n2 l2 in + rev_merge cmp s1 s2 [], tl + in + let len = length l in + if len < 2 then l else fst (sort len l) +;; + +let stable_dedup list ~compare = + match list with + | [] | [ _ ] -> list (* special case for performance *) + | _ :: _ :: _ -> + let open struct + type 'a dedup = + { elt : 'a + ; mutable dup : bool + } + end in + (* [stable_dedup] keeps the first of each set of duplicates. [dedup_and_sort] keeps + the last. We define one in terms of the other by passing the values in reverse + order, hence the [rev_map] in the definition of [dedups]. We restore the order in + the final [fold]. *) + let dedups = rev_map list ~f:(fun elt -> { elt; dup = true }) in + let unique = dedup_and_sort dedups ~compare:(fun x y -> compare x.elt y.elt) in + iter unique ~f:(fun dedup -> dedup.dup <- false); + fold dedups ~init:[] ~f:(fun acc dedup -> if dedup.dup then acc else dedup.elt :: acc) +;; + +let concat_mapi l ~f = + let[@tail_mod_cons] rec outer_loop pos = function + | [] -> [] + | [ hd ] -> (f [@tailcall false]) pos hd + | hd :: (_ :: _ as tl) -> inner_loop (pos + 1) (f pos hd) tl + and[@tail_mod_cons] inner_loop pos l1 l2 = + match l1 with + | [] -> outer_loop pos l2 + | [ x1 ] -> x1 :: outer_loop pos l2 + | [ x1; x2 ] -> x1 :: x2 :: outer_loop pos l2 + | [ x1; x2; x3 ] -> x1 :: x2 :: x3 :: outer_loop pos l2 + | [ x1; x2; x3; x4 ] -> x1 :: x2 :: x3 :: x4 :: outer_loop pos l2 + | x1 :: x2 :: x3 :: x4 :: x5 :: tl -> + x1 :: x2 :: x3 :: x4 :: x5 :: inner_loop pos tl l2 + in + outer_loop 0 l [@nontail] +;; + +let concat_map l ~f = concat_mapi l ~f:(fun _ x -> f x) [@nontail] + +module Cartesian_product = struct + (* We are explicit about what we export from functors so that we don't accidentally + rebind more efficient list-specific functions. *) + + let bind = concat_map + let map = map + let map2 a b ~f = concat_map a ~f:(fun x -> map b ~f:(fun y -> f x y)) + let return = singleton + let ( >>| ) = ( >>| ) + let ( >>= ) t f = bind t ~f + + open struct + module Applicative = Applicative.Make_using_map2 (struct + type 'a t = 'a list + + let return = return + let map = `Custom map + let map2 = map2 + end) + + module Monad = Monad.Make (struct + type 'a t = 'a list + + let return = return + let map = `Custom map + let bind = bind + end) + end + + let all = Monad.all + let all_unit = Monad.all_unit + let ignore_m = Monad.ignore_m + let join = Monad.join + + module Monad_infix = struct + let ( >>| ) = ( >>| ) + let ( >>= ) = ( >>= ) + end + + let apply = Applicative.apply + let both = Applicative.both + let map3 = Applicative.map3 + let ( <*> ) = Applicative.( <*> ) + let ( *> ) = Applicative.( *> ) + let ( <* ) = Applicative.( <* ) + + module Applicative_infix = struct + let ( >>| ) = ( >>| ) + let ( <*> ) = Applicative.( <*> ) + let ( *> ) = Applicative.( *> ) + let ( <* ) = Applicative.( <* ) + end + + module Let_syntax = struct + let return = return + let ( >>| ) = ( >>| ) + let ( >>= ) = ( >>= ) + + module Let_syntax = struct + let return = return + let bind = bind + let map = map + let both = both + + module Open_on_rhs = struct end + end + end +end + +include (Cartesian_product : Monad.S_local with type 'a t := 'a t) + +(** returns final element of list *) +let rec last_exn list = + match list with + | [ x ] -> x + | _ :: tl -> last_exn tl + | [] -> invalid_arg "List.last" +;; + +(** optionally returns final element of list *) +let rec last list = + match list with + | [ x ] -> Some x + | _ :: tl -> last tl + | [] -> None +;; + +let rec is_prefix list ~prefix ~equal = + match prefix with + | [] -> true + | hd :: tl -> + (match list with + | [] -> false + | hd' :: tl' -> equal hd hd' && is_prefix tl' ~prefix:tl ~equal) +;; + +let find_consecutive_duplicate t ~equal = + match t with + | [] -> None + | a1 :: t -> + let rec loop a1 t = + match t with + | [] -> None + | a2 :: t -> if equal a1 a2 then Some (a1, a2) else loop a2 t + in + loop a1 t [@nontail] +;; + +(* returns list without adjacent duplicates *) +let remove_consecutive_duplicates ?(which_to_keep = `Last) list ~equal = + let rec loop to_keep accum = function + | [] -> to_keep :: accum + | hd :: tl -> + if equal hd to_keep + then ( + let to_keep = + match which_to_keep with + | `First -> to_keep + | `Last -> hd + in + loop to_keep accum tl) + else loop hd (to_keep :: accum) tl + in + match list with + | [] -> [] + | hd :: tl -> rev (loop hd [] tl) +;; + +let find_a_dup l ~compare = + let sorted = sort l ~compare in + let rec loop l = + match l with + | [] | [ _ ] -> None + | hd1 :: (hd2 :: _ as tl) -> if compare hd1 hd2 = 0 then Some hd1 else loop tl + in + loop sorted [@nontail] +;; + +let contains_dup lst ~compare = + match find_a_dup lst ~compare with + | Some _ -> true + | None -> false +;; + +let find_all_dups l ~compare = + let sorted = sort ~compare l in + (* Walk the list and record the first of each consecutive run of identical elements *) + let[@tail_mod_cons] rec loop sorted prev ~already_recorded = + match sorted with + | [] -> [] + | hd :: tl -> + if compare prev hd <> 0 + then loop tl hd ~already_recorded:false + else if already_recorded + then loop tl hd ~already_recorded:true + else hd :: loop tl hd ~already_recorded:true + in + match sorted with + | [] -> [] + | hd :: tl -> loop tl hd ~already_recorded:false [@nontail] +;; + +let rec all_equal_to t v ~equal = + match t with + | [] -> true + | x :: xs -> equal x v && all_equal_to xs v ~equal +;; + +let all_equal t ~equal = + match t with + | [] -> None + | x :: xs -> if all_equal_to xs x ~equal then Some x else None +;; + +let count t ~f = Container.count ~fold t ~f +let sum m t ~f = Container.sum ~fold m t ~f +let min_elt t ~compare = Container.min_elt ~fold t ~compare +let max_elt t ~compare = Container.max_elt ~fold t ~compare + +let counti t ~f = + foldi t ~init:0 ~f:(fun idx count a -> if f idx a then count + 1 else count) [@nontail] +;; + +let init n ~f = + if n < 0 then invalid_argf "List.init %d" n (); + let rec loop i accum = + assert (i >= 0); + if i = 0 then accum else loop (i - 1) (f (i - 1) :: accum) + in + loop n [] [@nontail] +;; + +let rev_filter_map l ~f = + let rec loop l accum = + match l with + | [] -> accum + | hd :: tl -> + (match f hd with + | Some x -> loop tl (x :: accum) + | None -> loop tl accum) + in + loop l [] [@nontail] +;; + +let[@tail_mod_cons] rec filter_map l ~f = + match l with + | [] -> [] + | hd :: tl -> + (match f hd with + | None -> filter_map tl ~f + | Some x -> x :: filter_map tl ~f) +;; + +let rev_filter_mapi l ~f = + let rec loop i l accum = + match l with + | [] -> accum + | hd :: tl -> + (match f i hd with + | Some x -> loop (i + 1) tl (x :: accum) + | None -> loop (i + 1) tl accum) + in + loop 0 l [] [@nontail] +;; + +let filter_mapi l ~f = + let[@tail_mod_cons] rec loop pos l = + match l with + | [] -> [] + | hd :: tl -> + (match f pos hd with + | None -> loop (pos + 1) tl + | Some x -> x :: loop (pos + 1) tl) + in + loop 0 l [@nontail] +;; + +let filter_opt l = filter_map l ~f:Fn.id + +let partition3_map t ~f = + let rec loop t fst snd trd = + match t with + | [] -> rev fst, rev snd, rev trd + | x :: t -> + (match f x with + | `Fst y -> loop t (y :: fst) snd trd + | `Snd y -> loop t fst (y :: snd) trd + | `Trd y -> loop t fst snd (y :: trd)) + in + loop t [] [] [] [@nontail] +;; + +let partition_tf t ~f = + let f x : _ Either.t = if f x then First x else Second x in + partition_map t ~f [@nontail] +;; + +let partition_result t = partition_map t ~f:Result.to_either + +module Assoc = struct + type 'a key = ('a[@tag Sexplib0.Sexp_grammar.assoc_key_tag = List []]) + [@@deriving_inline sexp, sexp_grammar] + + let key_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a key = + fun _of_a__022_ -> _of_a__022_ + ;; + + let sexp_of_key : 'a. ('a -> Sexplib0.Sexp.t) -> 'a key -> Sexplib0.Sexp.t = + fun _of_a__024_ -> _of_a__024_ + ;; + + let key_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a key Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> + { untyped = + Tagged + { key = Sexplib0.Sexp_grammar.assoc_key_tag + ; value = List [] + ; grammar = _'a_sexp_grammar.untyped + } + } + ;; + + [@@@end] + + type 'a value = ('a[@tag Sexplib0.Sexp_grammar.assoc_value_tag = List []]) + [@@deriving_inline sexp, sexp_grammar] + + let value_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a value = + fun _of_a__025_ -> _of_a__025_ + ;; + + let sexp_of_value : 'a. ('a -> Sexplib0.Sexp.t) -> 'a value -> Sexplib0.Sexp.t = + fun _of_a__027_ -> _of_a__027_ + ;; + + let value_sexp_grammar : + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a value Sexplib0.Sexp_grammar.t + = + fun _'a_sexp_grammar -> + { untyped = + Tagged + { key = Sexplib0.Sexp_grammar.assoc_value_tag + ; value = List [] + ; grammar = _'a_sexp_grammar.untyped + } + } + ;; + + [@@@end] + + type ('a, 'b) t = + (('a key * 'b value) list[@tag Sexplib0.Sexp_grammar.assoc_tag = List []]) + [@@deriving_inline sexp, sexp_grammar] + + let t_of_sexp : + 'a 'b. + (Sexplib0.Sexp.t -> 'a) + -> (Sexplib0.Sexp.t -> 'b) + -> Sexplib0.Sexp.t + -> ('a, 'b) t + = + let error_source__036_ = "list.ml.Assoc.t" in + fun _of_a__028_ _of_b__029_ x__037_ -> + list_of_sexp + (function + | Sexplib0.Sexp.List [ arg0__031_; arg1__032_ ] -> + let res0__033_ = key_of_sexp _of_a__028_ arg0__031_ + and res1__034_ = value_of_sexp _of_b__029_ arg1__032_ in + res0__033_, res1__034_ + | sexp__035_ -> + Sexplib0.Sexp_conv_error.tuple_of_size_n_expected + error_source__036_ + 2 + sexp__035_) + x__037_ + ;; + + let sexp_of_t : + 'a 'b. + ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t + = + fun _of_a__038_ _of_b__039_ x__044_ -> + sexp_of_list + (fun (arg0__040_, arg1__041_) -> + let res0__042_ = sexp_of_key _of_a__038_ arg0__040_ + and res1__043_ = sexp_of_value _of_b__039_ arg1__041_ in + Sexplib0.Sexp.List [ res0__042_; res1__043_ ]) + x__044_ + ;; + + let t_sexp_grammar : + 'a 'b. + 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t + = + fun _'a_sexp_grammar _'b_sexp_grammar -> + { untyped = + Tagged + { key = Sexplib0.Sexp_grammar.assoc_tag + ; value = List [] + ; grammar = + (list_sexp_grammar + { untyped = + List + (Cons + ( (key_sexp_grammar _'a_sexp_grammar).untyped + , Cons ((value_sexp_grammar _'b_sexp_grammar).untyped, Empty) )) + }) + .untyped + } + } + ;; + + [@@@end] + + let pair_of_group = function + | [] -> assert false + | (k, _) :: _ as list -> k, map list ~f:snd + ;; + + let group alist ~equal = + group alist ~break:(fun (x, _) (y, _) -> not (equal x y)) |> map ~f:pair_of_group + ;; + + let sort_and_group alist ~compare = + sort_and_group alist ~compare:(fun (x, _) (y, _) -> compare x y) + |> map ~f:pair_of_group + ;; + + let find t ~equal key = + match find t ~f:(fun (key', _) -> equal key key') with + | None -> None + | Some x -> Some (snd x) + ;; + + let find_exn = + let not_found = Not_found_s (Atom "List.Assoc.find_exn: not found") in + let rec find_exn t ~equal key = + match t with + | [] -> raise not_found + | (key', value) :: t -> if equal key key' then value else find_exn t ~equal key + in + (* named to preserve symbol in compiled binary *) + find_exn + ;; + + let mem t ~equal key = + match find t ~equal key with + | None -> false + | Some _ -> true + ;; + + let remove t ~equal key = filter t ~f:(fun (key', _) -> not (equal key key')) [@nontail] + + let add t ~equal key value = + (* the remove doesn't change the map semantics, but keeps the list small *) + (key, value) :: remove t ~equal key + ;; + + let inverse t = map t ~f:(fun (x, y) -> y, x) + let map t ~f = map t ~f:(fun (key, value) -> key, f value) [@nontail] +end + +let sub l ~pos ~len = + (* We use [pos > length l - len] rather than [pos + len > length l] to avoid the + possibility of overflow. *) + if pos < 0 || len < 0 || pos > length l - len then invalid_arg "List.sub"; + let stop = pos + len in + let[@tail_mod_cons] rec loop i l = + match l with + | [] -> [] + | hd :: tl -> + if i < pos then loop (i + 1) tl else if i < stop then hd :: loop (i + 1) tl else [] + in + loop 0 l [@nontail] +;; + +let split_n t_orig n = + if n <= 0 + then [], t_orig + else ( + let rec loop n t accum = + match t with + | [] -> t_orig, [] (* in this case, t_orig = rev accum *) + | hd :: tl -> if n = 0 then rev accum, t else loop (n - 1) tl (hd :: accum) + in + loop n t_orig []) +;; + +(* copied from [split_n] to avoid allocating a tuple *) +let take t_orig n = + if n <= 0 + then [] + else ( + let rec loop n t accum = + match t with + | [] -> t_orig + | hd :: tl -> if n = 0 then rev accum else loop (n - 1) tl (hd :: accum) + in + loop n t_orig []) +;; + +let rec drop t n = + match t with + | _ :: tl when n > 0 -> drop tl (n - 1) + | t -> t +;; + +let chunks_of l ~length = + if length <= 0 then invalid_argf "List.chunks_of: Expected length > 0, got %d" length (); + let rec aux length acc l = + match l with + | [] -> rev acc + | _ :: _ -> + let sublist, l = split_n l length in + aux length (sublist :: acc) l + in + aux length [] l +;; + +let split_while xs ~f = + let rec loop acc = function + | hd :: tl when f hd -> loop (hd :: acc) tl + | t -> rev acc, t + in + loop [] xs [@nontail] +;; + +(* copied from [split_while] to avoid allocating a tuple *) +let take_while xs ~f = + let rec loop acc = function + | hd :: tl when f hd -> loop (hd :: acc) tl + | _ -> rev acc + in + loop [] xs [@nontail] +;; + +let rec drop_while t ~f = + match t with + | hd :: tl when f hd -> drop_while tl ~f + | t -> t +;; + +let drop_last t = + match rev t with + | [] -> None + | _ :: lst -> Some (rev lst) +;; + +let drop_last_exn t = + match drop_last t with + | None -> failwith "List.drop_last_exn: empty list" + | Some lst -> lst +;; + +let cartesian_product list1 list2 = + if is_empty list2 + then [] + else ( + let[@tail_mod_cons] rec outer_loop l1 = + match l1 with + | [] -> [] + | x1 :: l1 -> inner_loop x1 l1 list2 + and[@tail_mod_cons] inner_loop x1 l1 l2 = + match l2 with + | [] -> outer_loop l1 + | x2 :: l2 -> (x1, x2) :: inner_loop x1 l1 l2 + in + outer_loop list1 [@nontail]) +;; + +let concat l = fold_right l ~init:[] ~f:append +let concat_no_order l = fold l ~init:[] ~f:(fun acc l -> rev_append l acc) +let cons x l = x :: l + +let is_sorted l ~compare = + let rec loop l = + match l with + | [] | [ _ ] -> true + | x1 :: (x2 :: _ as rest) -> compare x1 x2 <= 0 && loop rest + in + loop l [@nontail] +;; + +let is_sorted_strictly l ~compare = + let rec loop l = + match l with + | [] | [ _ ] -> true + | x1 :: (x2 :: _ as rest) -> compare x1 x2 < 0 && loop rest + in + loop l [@nontail] +;; + +module Infix = struct + let ( @ ) = append +end + +let permute ?(random_state = Random.State.default) list = + match list with + (* special cases to speed things up in trivial cases *) + | [] | [ _ ] -> list + | [ x; y ] -> if Random.State.bool random_state then [ y; x ] else list + | _ -> + let arr = Array.of_list list in + Array_permute.permute arr ~random_state; + Array.to_list arr +;; + +let random_element_exn ?(random_state = Random.State.default) list = + if is_empty list + then failwith "List.random_element_exn: empty list" + else nth_exn list (Random.State.int random_state (length list)) +;; + +let random_element ?(random_state = Random.State.default) list = + try Some (random_element_exn ~random_state list) with + | _ -> None +;; + +let rec compare cmp a b = + match a, b with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | x :: xs, y :: ys -> + let n = cmp x y in + if n = 0 then compare cmp xs ys else n +;; + +let rec compare__local cmp a b = + match a, b with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | x :: xs, y :: ys -> + let n = cmp x y in + if n = 0 then compare__local cmp xs ys else n +;; + +let hash_fold_t = hash_fold_list + +let equal_with_local_closure (equal : _ -> _ -> _) t1 t2 = + let rec loop ~equal t1 t2 = + match t1, t2 with + | [], [] -> true + | x1 :: t1, x2 :: t2 -> equal x1 x2 && loop ~equal t1 t2 + | _ -> false + in + loop ~equal t1 t2 +;; + +let equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = + fun f x y -> equal_with_local_closure f x y +;; + +let equal__local equal_a__local t1 t2 = + let rec loop ~equal_a__local t1 t2 = + match t1, t2 with + | [], [] -> true + | x1 :: t1, x2 :: t2 -> equal_a__local x1 x2 && loop ~equal_a__local t1 t2 + | _ -> false + in + loop ~equal_a__local t1 t2 [@nontail] +;; + +let transpose = + let rec split_off_first_column t column_acc trimmed found_empty = + match t with + | [] -> column_acc, trimmed, found_empty + | [] :: tl -> split_off_first_column tl column_acc trimmed true + | (x :: xs) :: tl -> + split_off_first_column tl (x :: column_acc) (xs :: trimmed) found_empty + in + let split_off_first_column rows = split_off_first_column rows [] [] false in + let rec loop rows columns do_rev = + match split_off_first_column rows with + | [], [], _ -> Some (rev columns) + | column, trimmed_rows, found_empty -> + if found_empty + then None + else ( + let column = if do_rev then rev column else column in + loop trimmed_rows (column :: columns) (not do_rev)) + in + fun t -> loop t [] true +;; + +exception Transpose_got_lists_of_different_lengths of int list [@@deriving_inline sexp] + +let () = + Sexplib0.Sexp_conv.Exn_converter.add + [%extension_constructor Transpose_got_lists_of_different_lengths] + (function + | Transpose_got_lists_of_different_lengths arg0__045_ -> + let res0__046_ = sexp_of_list sexp_of_int arg0__045_ in + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "list.ml.Transpose_got_lists_of_different_lengths" + ; res0__046_ + ] + | _ -> assert false) +;; + +[@@@end] + +let transpose_exn l = + match transpose l with + | Some l -> l + | None -> raise (Transpose_got_lists_of_different_lengths (map l ~f:(length :> _ -> _))) +;; + +let intersperse t ~sep = + match t with + | [] -> [] + | x :: xs -> x :: fold_right xs ~init:[] ~f:(fun y acc -> sep :: y :: acc) +;; + +let fold_result t ~init ~f = Container.fold_result ~fold ~init ~f t +let fold_until t ~init ~f ~finish = Container.fold_until ~fold ~init ~f t ~finish + +let is_suffix list ~suffix ~equal:(equal_elt : _ -> _ -> _) = + let list_len = length list in + let suffix_len = length suffix in + list_len >= suffix_len + && equal_with_local_closure equal_elt (drop list (list_len - suffix_len)) suffix +;; diff --git a/unikernel/duniverse/base/src/list.mli b/unikernel/duniverse/base/src/list.mli new file mode 100644 index 00000000..00cee4f8 --- /dev/null +++ b/unikernel/duniverse/base/src/list.mli @@ -0,0 +1,515 @@ +(** Immutable, singly-linked lists, giving fast access to the front of the list, and slow + (i.e., O(n)) access to the back of the list. The comparison functions on lists are + lexicographic. *) + +open! Import + +type 'a t = 'a list +[@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] + +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + +val globalize : ('a -> 'a) -> 'a t -> 'a t + +include Ppx_hash_lib.Hashable.S1 with type 'a t := 'a t +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Indexed_container.S1_with_creators with type 'a t := 'a t + +val length : 'a t -> int + +include Invariant_intf.S1 with type 'a t := 'a t + +(** Implements cartesian-product behavior for [map] and [bind]. **) +module Cartesian_product : sig + include Applicative.S with type 'a t := 'a t + include Monad.S_local with type 'a t := 'a t +end + +(** The monad portion of [Cartesian_product] is re-exported at top level. *) +include Monad.S_local with type 'a t := 'a t + +(** [Or_unequal_lengths] is used for functions that take multiple lists and that only make + sense if all the lists have the same length, e.g., [iter2], [map3]. Such functions + check the list lengths prior to doing anything else, and return [Unequal_lengths] if + not all the lists have the same length. *) +module Or_unequal_lengths : sig + type 'a t = + | Ok of 'a + | Unequal_lengths + [@@deriving_inline compare ~localize, sexp_of] + + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + + [@@@end] +end + +(** [singleton x] returns a list with a single element [x]. *) +val singleton : 'a -> 'a t + +val nth : 'a t -> int -> 'a option + +(** Return the [n]-th element of the given list. The first element (head of the list) is + at position 0. Raise if the list is too short or [n] is negative. *) +val nth_exn : 'a t -> int -> 'a + +(** List reversal. *) +val rev : 'a t -> 'a t + +(** [rev_append l1 l2] reverses [l1] and concatenates it to [l2]. This is equivalent + to [(]{!List.rev}[ l1) @ l2], but [rev_append] is more efficient. *) +val rev_append : 'a t -> 'a t -> 'a t + +(** [unordered_append l1 l2] has the same elements as [l1 @ l2], but in some + unspecified order. Generally takes time proportional to length of first list, but is + O(1) if either list is empty. *) +val unordered_append : 'a t -> 'a t -> 'a t + +(** [rev_map l ~f] gives the same result as {!List.rev}[ (]{!ListLabels.map}[ f l)], + but is more efficient. *) +val rev_map : 'a t -> f:('a -> 'b) -> 'b t + +(** [iter2 [a1; ...; an] [b1; ...; bn] ~f] calls in turn [f a1 b1; ...; f an bn]. + The exn version will raise if the two lists have different lengths. *) +val iter2_exn : 'a t -> 'b t -> f:('a -> 'b -> unit) -> unit + +val iter2 : 'a t -> 'b t -> f:('a -> 'b -> unit) -> unit Or_unequal_lengths.t + +(** [rev_map2_exn l1 l2 ~f] gives the same result as [List.rev (List.map2_exn l1 l2 + ~f)], but is more efficient. *) +val rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + +val rev_map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + +(** [fold2 ~f ~init:a [b1; ...; bn] [c1; ...; cn]] is [f (... (f (f a b1 c1) b2 c2) + ...) bn cn]. The exn version will raise if the two lists have different lengths. *) +val fold2_exn : 'a t -> 'b t -> init:'acc -> f:('acc -> 'a -> 'b -> 'acc) -> 'acc + +val fold2 + : 'a t + -> 'b t + -> init:'acc + -> f:('acc -> 'a -> 'b -> 'acc) + -> 'acc Or_unequal_lengths.t + +(** [fold_right2 ~f [a1; ...; an] [b1; ...; bn] ~init:c] is + [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. + The exn version will raise if the two lists have different lengths. *) +val fold_right2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'acc -> 'acc) -> init:'acc -> 'acc + +val fold_right2 + : 'a t + -> 'b t + -> f:('a -> 'b -> 'acc -> 'acc) + -> init:'acc + -> 'acc Or_unequal_lengths.t + +(** Like {!List.for_all}, but for a two-argument predicate. The exn version will raise if + the two lists have different lengths. *) +val for_all2_exn : 'a t -> 'b t -> f:('a -> 'b -> bool) -> bool + +val for_all2 : 'a t -> 'b t -> f:('a -> 'b -> bool) -> bool Or_unequal_lengths.t + +(** Like {!List.exists}, but for a two-argument predicate. The exn version will raise if + the two lists have different lengths. *) +val exists2_exn : 'a t -> 'b t -> f:('a -> 'b -> bool) -> bool + +val exists2 : 'a t -> 'b t -> f:('a -> 'b -> bool) -> bool Or_unequal_lengths.t + +(** Like [filter], but reverses the order of the input list. *) +val rev_filter : 'a t -> f:('a -> bool) -> 'a t + +val partition3_map + : 'a t + -> f:('a -> [ `Fst of 'b | `Snd of 'c | `Trd of 'd ]) + -> 'b t * 'c t * 'd t + +(** [partition_result l] returns a pair of lists [(l1, l2)], where [l1] is the + list of all [Ok] elements in [l] and [l2] is the list of all [Error] + elements. + The order of elements in the input list is preserved. *) +val partition_result : ('ok, 'error) Result.t t -> 'ok t * 'error t + +(** [split_n \[e1; ...; em\] n] is [(\[e1; ...; en\], \[en+1; ...; em\])]. + + - If [n >= m], [(\[e1; ...; em\], \[\])] is returned. + - If [n <= 0], [(\[\], \[e1; ...; em\])] is returned. + + In either of these cases, the input list is returned as one side of the pair, rather + than being copied. *) +val split_n : 'a t -> int -> 'a t * 'a t + +(** Sort a list in increasing order according to a comparison function. The comparison + function must return 0 if its arguments compare as equal, a positive integer if the + first is greater, and a negative integer if the first is smaller (see [Array.sort] for + a complete specification). For example, {!Poly.compare} is a suitable + comparison function. + + The current implementation uses Merge Sort. It runs in linear heap space and + logarithmic stack space. + + Presently, the sort is stable, meaning that two equal elements in the input will be in + the same order in the output. *) +val sort : 'a t -> compare:('a -> 'a -> int) -> 'a t + +(** Like [sort], but guaranteed to be stable. *) +val stable_sort : 'a t -> compare:('a -> 'a -> int) -> 'a t + +(** Merges two lists: assuming that [l1] and [l2] are sorted according to the comparison + function [compare], [merge compare l1 l2] will return a sorted list containing all the + elements of [l1] and [l2]. If several elements compare equal, the elements of [l1] + will be before the elements of [l2]. *) +val merge : 'a t -> 'a t -> compare:('a -> 'a -> int) -> 'a t + +val hd : 'a t -> 'a option +val tl : 'a t -> 'a t option + +(** Returns the first element of the given list. Raises if the list is empty. *) +val hd_exn : 'a t -> 'a + +(** Returns the given list without its first element. Raises if the list is empty. *) +val tl_exn : 'a t -> 'a t + +(** Like [find_exn], but passes the index as an argument. *) +val findi_exn : 'a t -> f:(int -> 'a -> bool) -> int * 'a + +(** [find_exn t ~f] returns the first element of [t] that satisfies [f]. It raises + [Stdlib.Not_found] or [Not_found_s] if there is no such element. *) +val find_exn : 'a t -> f:('a -> bool) -> 'a + +(** Returns the first evaluation of [f] that returns [Some]. Raises [Stdlib.Not_found] or + [Not_found_s] if [f] always returns [None]. *) +val find_map_exn : 'a t -> f:('a -> 'b option) -> 'b + +(** Like [find_map_exn], but passes the index as an argument. *) +val find_mapi_exn : 'a t -> f:(int -> 'a -> 'b option) -> 'b + +(** [folding_map] is a version of [map] that threads an accumulator through calls to + [f]. *) + +val folding_map : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc * 'b) -> 'b t +val folding_mapi : 'a t -> init:'acc -> f:(int -> 'acc -> 'a -> 'acc * 'b) -> 'b t + +(** [fold_map] is a combination of [fold] and [map] that threads an accumulator through + calls to [f]. *) + +val fold_map : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc * 'b) -> 'acc * 'b t +val fold_mapi : 'a t -> init:'acc -> f:(int -> 'acc -> 'a -> 'acc * 'b) -> 'acc * 'b t + +(** [map2 [a1; ...; an] [b1; ...; bn] ~f] is [[f a1 b1; ...; f an bn]]. The exn + version will raise if the two lists have different lengths. *) + +val map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t +val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + +(** Analogous to [rev_map2]. *) + +val rev_map3_exn : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t + +val rev_map3 + : 'a t + -> 'b t + -> 'c t + -> f:('a -> 'b -> 'c -> 'd) + -> 'd t Or_unequal_lengths.t + +(** Analogous to [map2]. *) + +val map3_exn : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t +val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t Or_unequal_lengths.t + +(** [rev_map_append l1 l2 ~f] reverses [l1] mapping [f] over each element, and appends the + result to the front of [l2]. *) +val rev_map_append : 'a t -> 'b t -> f:('a -> 'b) -> 'b t + +(** [fold_right [a1; ...; an] ~f ~init:b] is [f a1 (f a2 (... (f an b) ...))]. *) +val fold_right : 'a t -> f:('a -> 'acc -> 'acc) -> init:'acc -> 'acc + +(** [fold_left] is the same as {!Container.S1.fold}, and one should always use + [fold] rather than [fold_left], except in functors that are parameterized + over a more general signature where this equivalence does not hold. *) +val fold_left : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc + +(** Transform a list of pairs into a pair of lists: [unzip [(a1,b1); ...; (an,bn)]] is + [([a1; ...; an], [b1; ...; bn])]. *) + +val unzip : ('a * 'b) t -> 'a t * 'b t +val unzip3 : ('a * 'b * 'c) t -> 'a t * 'b t * 'c t + +(** Transform a pair of lists into an (optional) list of pairs: [zip [a1; ...; an] [b1; + ...; bn]] is [[(a1,b1); ...; (an,bn)]]. Returns [Unequal_lengths] if the two lists + have different lengths. *) + +val zip : 'a t -> 'b t -> ('a * 'b) t Or_unequal_lengths.t +val zip_exn : 'a t -> 'b t -> ('a * 'b) t +val rev_mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t + +(** [reduce_exn [a1; ...; an] ~f] is [f (... (f (f a1 a2) a3) ...) an]. It fails on the + empty list. Tail recursive. *) +val reduce_exn : 'a t -> f:('a -> 'a -> 'a) -> 'a + +val reduce : 'a t -> f:('a -> 'a -> 'a) -> 'a option + +(** [reduce_balanced] returns the same value as [reduce] when [f] is associative, but + differs in that the tree of nested applications of [f] has logarithmic depth. + + This is useful when your ['a] grows in size as you reduce it and [f] becomes more + expensive with bigger inputs. For example, [reduce_balanced ~f:(^)] takes [n*log(n)] + time, while [reduce ~f:(^)] takes quadratic time. *) +val reduce_balanced : 'a t -> f:('a -> 'a -> 'a) -> 'a option + +val reduce_balanced_exn : 'a t -> f:('a -> 'a -> 'a) -> 'a + +(** [group l ~break] returns a list of lists (i.e., groups) whose concatenation is equal + to the original list. Each group is broken where [break] returns true on a pair of + successive elements. + + Example: + + {[ + group ~break:(<>) ['M';'i';'s';'s';'i';'s';'s';'i';'p';'p';'i'] -> + + [['M'];['i'];['s';'s'];['i'];['s';'s'];['i'];['p';'p'];['i']] ]} *) +val group : 'a t -> break:('a -> 'a -> bool) -> 'a t t + +(** This is just like [group], except that you get the index in the original list of the + current element along with the two elements. + + Example, group the chars of ["Mississippi"] into triples: + + {[ + groupi ~break:(fun i _ _ -> i mod 3 = 0) + ['M';'i';'s';'s';'i';'s';'s';'i';'p';'p';'i'] -> + + [['M'; 'i'; 's']; ['s'; 'i'; 's']; ['s'; 'i'; 'p']; ['p'; 'i']] ]} +*) +val groupi : 'a t -> break:(int -> 'a -> 'a -> bool) -> 'a t t + +(** Group equal elements into the same buckets. Sorting is stable. *) +val sort_and_group : 'a t -> compare:('a -> 'a -> int) -> 'a t t + +(** [chunks_of l ~length] returns a list of lists whose concatenation is equal to the + original list. Every list has [length] elements, except for possibly the last list, + which may have fewer. [chunks_of] raises if [length <= 0]. *) +val chunks_of : 'a t -> length:int -> 'a t t + +(** The final element of a list. The [_exn] version raises on the empty list. *) +val last : 'a t -> 'a option + +val last_exn : 'a t -> 'a + +(** [is_prefix xs ~prefix] returns [true] if [xs] starts with [prefix]. *) +val is_prefix : 'a t -> prefix:'a t -> equal:('a -> 'a -> bool) -> bool + +(** [is_suffix xs ~suffix] returns [true] if [xs] ends with [suffix]. *) +val is_suffix : 'a t -> suffix:'a t -> equal:('a -> 'a -> bool) -> bool + +(** [find_consecutive_duplicate t ~equal] returns the first pair of consecutive elements + [(a1, a2)] in [t] such that [equal a1 a2]. They are returned in the same order as + they appear in [t]. [equal] need not be an equivalence relation; it is simply used as + a predicate on consecutive elements. *) +val find_consecutive_duplicate : 'a t -> equal:('a -> 'a -> bool) -> ('a * 'a) option + +(** Returns the given list with consecutive duplicates removed. The relative order of the + other elements is unaffected. The element kept from a run of duplicates is determined + by [which_to_keep]. *) +val remove_consecutive_duplicates + : ?which_to_keep:[ `First | `Last ] (** default = `Last *) + -> 'a t + -> equal:('a -> 'a -> bool) + -> 'a t + +(** Returns the given list with duplicates removed and in sorted order. + Of duplicates in the original list, the element occurring last in + the original list is kept. *) +val dedup_and_sort : 'a t -> compare:('a -> 'a -> int) -> 'a t + +(** Returns the original list, dropping all occurrences of duplicates after the first. *) +val stable_dedup : 'a t -> compare:('a -> 'a -> int) -> 'a t + +(** [find_a_dup] returns a duplicate from the list (with no guarantees about which + duplicate you get), or [None] if there are no dups. *) +val find_a_dup : 'a t -> compare:('a -> 'a -> int) -> 'a option + +(** Returns true if there are any two elements in the list which are the same. O(n log n) + time complexity. *) +val contains_dup : 'a t -> compare:('a -> 'a -> int) -> bool + +(** [find_all_dups] returns a list of all elements that occur more than once, with + no guarantees about order. O(n log n) time complexity. *) +val find_all_dups : 'a t -> compare:('a -> 'a -> int) -> 'a list + +(** [all_equal] returns a single element of the list that is equal to all other elements, + or [None] if no such element exists. *) +val all_equal : 'a t -> equal:('a -> 'a -> bool) -> 'a option + +(** [range ?stride ?start ?stop start_i stop_i] is the list of integers from [start_i] to + [stop_i], stepping by [stride]. If [stride] < 0 then we need [start_i] > [stop_i] for + the result to be nonempty (or [start_i] = [stop_i] in the case where both bounds are + inclusive). *) +val range + : ?stride:int (** default = 1 *) + -> ?start:[ `inclusive | `exclusive ] (** default = `inclusive *) + -> ?stop:[ `inclusive | `exclusive ] (** default = `exclusive *) + -> int + -> int + -> int t + +(** [range'] is analogous to [range] for general start/stop/stride types. [range'] raises + if [stride x] returns [x] or if the direction that [stride x] moves [x] changes from + one call to the next. *) +val range' + : compare:('a -> 'a -> int) + -> stride:('a -> 'a) + -> ?start:[ `inclusive | `exclusive ] (** default = `inclusive *) + -> ?stop:[ `inclusive | `exclusive ] (** default = `exclusive *) + -> 'a + -> 'a + -> 'a t + +(** [rev_filter_map l ~f] is the reversed sublist of [l] containing only elements for + which [f] returns [Some e]. *) +val rev_filter_map : 'a t -> f:('a -> 'b option) -> 'b t + +(** rev_filter_mapi is just like [rev_filter_map], but it also passes in the index of each + element as the first argument to the mapped function. Tail-recursive. *) +val rev_filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t + +(** [filter_opt l] is the sublist of [l] containing only elements which are [Some e]. In + other words, [filter_opt l] = [filter_map ~f:Fn.id l]. *) +val filter_opt : 'a option t -> 'a t + +(** Interpret a list of (key, value) pairs as a map in which only the first occurrence of + a key affects the semantics, i.e.: + + {[List.Assoc.xxx alist ...args... ]} + + is always the same as (or at least sort of isomorphic to): + + {[ Map.xxx (alist |> Map.of_alist_multi |> Map.map ~f:List.hd) ...args... ]} *) +module Assoc : sig + type ('a, 'b) t = ('a * 'b) list [@@deriving_inline sexp, sexp_grammar] + + include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t + + val t_sexp_grammar + : 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t + + [@@@end] + + (** Removes all existing entries with the same key before adding. *) + val add : ('a, 'b) t -> equal:('a -> 'a -> bool) -> 'a -> 'b -> ('a, 'b) t + + val find : ('a, 'b) t -> equal:('a -> 'a -> bool) -> 'a -> 'b option + val find_exn : ('a, 'b) t -> equal:('a -> 'a -> bool) -> 'a -> 'b + val mem : ('a, 'b) t -> equal:('a -> 'a -> bool) -> 'a -> bool + val remove : ('a, 'b) t -> equal:('a -> 'a -> bool) -> 'a -> ('a, 'b) t + val map : ('a, 'b) t -> f:('b -> 'c) -> ('a, 'c) t + + (** Bijectivity is not guaranteed because we allow a key to appear more than once. *) + val inverse : ('a, 'b) t -> ('b, 'a) t + + (** Converts an association list with potential consecutive duplicate keys into an + association list of (non-empty) lists with no (consecutive) duplicate keys. Any + non-consecutive duplicate keys in the input will remain in the output. *) + val group : ('a * 'b) list -> equal:('a -> 'a -> bool) -> ('a, 'b list) t + + (** Converts an association list with potential duplicate keys into an association list + of (non-empty) lists with no duplicate keys. *) + val sort_and_group : ('a * 'b) list -> compare:('a -> 'a -> int) -> ('a, 'b list) t +end + +(** [sub pos len l] is the [len]-element sublist of [l], starting at [pos]. *) +val sub : 'a t -> pos:int -> len:int -> 'a t + +(** [take l n] returns the first [n] elements of [l], or all of [l] if [n > length l]. + [take l n = fst (split_n l n)]. If [n >= length l], returns [l] rather than a copy. *) +val take : 'a t -> int -> 'a t + +(** [drop l n] returns [l] without the first [n] elements, or the empty list if [n > + length l]. [drop l n] is equivalent to [snd (split_n l n)]. If [n <= 0], returns [l] + rather than a copy. *) +val drop : 'a t -> int -> 'a t + +(** [take_while l ~f] returns the longest prefix of [l] for which [f] is [true]. *) +val take_while : 'a t -> f:('a -> bool) -> 'a t + +(** [drop_while l ~f] drops the longest prefix of [l] for which [f] is [true]. *) +val drop_while : 'a t -> f:('a -> bool) -> 'a t + +(** [split_while xs ~f = (take_while xs ~f, drop_while xs ~f)]. *) +val split_while : 'a t -> f:('a -> bool) -> 'a t * 'a t + +(** [drop_last l] drops the last element of [l], returning [None] if [l] is [empty]. *) +val drop_last : 'a t -> 'a t option + +val drop_last_exn : 'a t -> 'a t + +(** Like [concat], but faster and without preserving any ordering (i.e., for lists that + are essentially viewed as multi-sets). *) +val concat_no_order : 'a t t -> 'a t + +val cons : 'a -> 'a t -> 'a t + +(** Returns a list with all possible pairs -- if the input lists have length [len1] and + [len2], the resulting list will have length [len1 * len2]. *) +val cartesian_product : 'a t -> 'b t -> ('a * 'b) t + +(** [permute ?random_state t] returns a permutation of [t]. + + [permute] side-effects [random_state] by repeated calls to [Random.State.int]. If + [random_state] is not supplied, [permute] uses [Random.State.default]. *) +val permute : ?random_state:Random.State.t -> 'a t -> 'a t + +(** [random_element ?random_state t] is [None] if [t] is empty, else it is [Some x] for + some [x] chosen uniformly at random from [t]. + + [random_element] side-effects [random_state] by calling [Random.State.int]. If + [random_state] is not supplied, [random_element] uses [Random.State.default]. *) +val random_element : ?random_state:Random.State.t -> 'a t -> 'a option + +val random_element_exn : ?random_state:Random.State.t -> 'a t -> 'a + +(** [is_sorted t ~compare] returns [true] iff for all adjacent [a1; a2] in [t], [compare + a1 a2 <= 0]. + + [is_sorted_strictly] is similar, except it uses [<] instead of [<=]. *) +val is_sorted : 'a t -> compare:('a -> 'a -> int) -> bool + +val is_sorted_strictly : 'a t -> compare:('a -> 'a -> int) -> bool +val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool +val equal__local : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + +module Infix : sig + val ( @ ) : 'a t -> 'a t -> 'a t +end + +(** [transpose m] transposes the rows and columns of the matrix [m], + considered as either a row of column lists or (dually) a column of row lists. + + Example: + + {[transpose [[1;2;3];[4;5;6]] = [[1;4];[2;5];[3;6]]]} + + On non-empty rectangular matrices, [transpose] is an involution (i.e., [transpose + (transpose m) = m]). Transpose returns [None] when called on lists of lists with + non-uniform lengths. *) +val transpose : 'a t t -> 'a t t option + +(** [transpose_exn] transposes the rows and columns of its argument, throwing an exception + if the list is not rectangular. *) +val transpose_exn : 'a t t -> 'a t t + +(** [intersperse xs ~sep] places [sep] between adjacent elements of [xs]. For example, + [intersperse [1;2;3] ~sep:0 = [1;0;2;0;3]]. *) +val intersperse : 'a t -> sep:'a -> 'a t diff --git a/unikernel/duniverse/base/src/list0.ml b/unikernel/duniverse/base/src/list0.ml new file mode 100644 index 00000000..3861c4d5 --- /dev/null +++ b/unikernel/duniverse/base/src/list0.ml @@ -0,0 +1,123 @@ +(* [List0] defines list functions that are primitives or can be simply defined in terms of + [Stdlib.List]. [List0] is intended to completely express the part of [Stdlib.List] that + [Base] uses -- no other file in Base other than list0.ml should use [Stdlib.List]. + [List0] has few dependencies, and so is available early in Base's build order. All + Base files that need to use lists and come before [Base.List] in build order should do + [module List = List0]. Defining [module List = List0] is also necessary because it + prevents ocamldep from mistakenly causing a file to depend on [Base.List]. *) + +open! Import0 + +let hd_exn = Stdlib.List.hd +let rev_append = Stdlib.List.rev_append +let tl_exn = Stdlib.List.tl +let unzip = Stdlib.List.split + +(* Some of these are eta expanded in order to permute parameter order to follow Base + conventions. *) + +let length = + let rec length_aux len = function + | [] -> len + | _ :: l -> length_aux (len + 1) l + in + fun l -> length_aux 0 l +;; + +let rec exists t ~f = + match t with + | [] -> false + | x :: xs -> if f x then true else exists xs ~f +;; + +let rec exists2_ok l1 l2 ~(f : _ -> _ -> _) = + match l1, l2 with + | [], [] -> false + | a1 :: l1, a2 :: l2 -> f a1 a2 || exists2_ok l1 l2 ~f + | _, _ -> invalid_arg "List.exists2" +;; + +let rec fold t ~init ~(f : _ -> _ -> _) = + match t with + | [] -> init + | a :: l -> fold l ~init:(f init a) ~f +;; + +let rec fold2_ok l1 l2 ~init ~(f : _ -> _ -> _ -> _) = + match l1, l2 with + | [], [] -> init + | a1 :: l1, a2 :: l2 -> fold2_ok l1 l2 ~f ~init:(f init a1 a2) + | _, _ -> invalid_arg "List.fold_left2" +;; + +let for_all t ~f = not (exists t ~f:(fun x -> not (f x))) + +let rec for_all2_ok l1 l2 ~(f : _ -> _ -> _) = + match l1, l2 with + | [], [] -> true + | a1 :: l1, a2 :: l2 -> f a1 a2 && for_all2_ok l1 l2 ~f + | _, _ -> invalid_arg "List.for_all2" +;; + +let rec iter t ~(f : _ -> _) = + match t with + | [] -> () + | a :: l -> + f a; + iter l ~f +;; + +let rec iter2_ok l1 l2 ~(f : _ -> _ -> unit) = + match l1, l2 with + | [], [] -> () + | a1 :: l1, a2 :: l2 -> + f a1 a2; + iter2_ok l1 l2 ~f + | _, _ -> invalid_arg "List.iter2" +;; + +let rec nontail_map t ~f = + match t with + | [] -> [] + | x :: xs -> + let y = f x in + y :: nontail_map xs ~f +;; + +let nontail_mapi t ~f = Stdlib.List.mapi t ~f +let partition t ~f = Stdlib.List.partition t ~f + +let rev_map = + let rec rmap_f f accu = function + | [] -> accu + | a :: l -> rmap_f f (f a :: accu) l + in + fun l ~f -> rmap_f f [] l +;; + +let rev_map2_ok = + let rec rmap2_f f accu l1 l2 = + match l1, l2 with + | [], [] -> accu + | a1 :: l1, a2 :: l2 -> rmap2_f f (f a1 a2 :: accu) l1 l2 + | _, _ -> invalid_arg "List.rev_map2" + in + fun l1 l2 ~(f : _ -> _ -> _) -> rmap2_f f [] l1 l2 +;; + +let rev = function + | ([] | [ _ ]) as res -> res + | x :: y :: rest -> rev_append rest [ y; x ] +;; + +let fold_right l ~(f : _ -> _ -> _) ~init = + match l with + | [] -> init (* avoid the allocation of [~f] below *) + | _ -> fold ~f:(fun a b -> f b a) ~init (rev l) [@nontail] +;; + +let fold_right2_ok l1 l2 ~(f : _ -> _ -> _ -> _) ~init = + match l1, l2 with + | [], [] -> init (* avoid the allocation of [~f] below *) + | _, _ -> fold2_ok ~f:(fun a b c -> f b c a) ~init (rev l1) (rev l2) [@nontail] +;; diff --git a/unikernel/duniverse/base/src/list1.ml b/unikernel/duniverse/base/src/list1.ml new file mode 100644 index 00000000..354f184c --- /dev/null +++ b/unikernel/duniverse/base/src/list1.ml @@ -0,0 +1,19 @@ +open! Import +include List0 + +let is_empty = function + | [] -> true + | _ -> false +;; + +let partition_map t ~f = + let rec loop t fst snd = + match t with + | [] -> rev fst, rev snd + | x :: t -> + (match (f x : _ Either0.t) with + | First y -> loop t (y :: fst) snd + | Second y -> loop t fst (y :: snd)) + in + loop t [] [] [@nontail] +;; diff --git a/unikernel/duniverse/base/src/map.ml b/unikernel/duniverse/base/src/map.ml new file mode 100644 index 00000000..61e62561 --- /dev/null +++ b/unikernel/duniverse/base/src/map.ml @@ -0,0 +1,3339 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Apache 2.0 license. See ../THIRD-PARTY.txt *) +(* for details. *) +(* *) +(***********************************************************************) + +open! Import +module List = List0 +include Map_intf + +module Finished_or_unfinished = struct + include Map_intf.Finished_or_unfinished + + (* These two functions are tested in [test_map.ml] to make sure our use of + [Stdlib.Obj.magic] is correct and safe. *) + let of_continue_or_stop : Continue_or_stop.t -> t = Stdlib.Obj.magic + let to_continue_or_stop : t -> Continue_or_stop.t = Stdlib.Obj.magic +end + +module Merge_element = struct + include Map_intf.Merge_element + + let left = function + | `Right _ -> None + | `Left left | `Both (left, _) -> Some left + ;; + + let right = function + | `Left _ -> None + | `Right right | `Both (_, right) -> Some right + ;; + + let left_value t ~default = + match t with + | `Right _ -> default + | `Left left | `Both (left, _) -> left + ;; + + let right_value t ~default = + match t with + | `Left _ -> default + | `Right right | `Both (_, right) -> right + ;; + + let values t ~left_default ~right_default = + match t with + | `Left left -> left, right_default + | `Right right -> left_default, right + | `Both (left, right) -> left, right + ;; +end + +let with_return = With_return.with_return + +exception Duplicate [@@deriving_inline sexp] + +let () = + Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Duplicate] (function + | Duplicate -> Sexplib0.Sexp.Atom "map.ml.Duplicate" + | _ -> assert false) +;; + +[@@@end] + +(* [With_length.t] allows us to store length information on the stack while + keeping the tree global. This saves up to O(log n) blocks of heap allocation. *) +module With_length : sig + type 'a t = private + { tree : 'a + ; length : int + } + + val with_length : 'a -> int -> 'a t + val with_length_global : 'a -> int -> 'a t + val globalize : 'a t -> 'a t +end = struct + type 'a t = + { tree : 'a + ; length : int + } + + let with_length tree length = { tree; length } + let with_length_global tree length = { tree; length } + let globalize { tree; length } = { tree; length } +end + +open With_length + +module Tree0 = struct + type ('k, 'v) t = + | Empty + | Leaf of + { key : 'k + ; data : 'v + } + | Node of + { left : ('k, 'v) t + ; key : 'k + ; data : 'v + ; right : ('k, 'v) t + ; height : int + } + + type ('k, 'v) tree = ('k, 'v) t + + let height = function + | Empty -> 0 + | Leaf _ -> 1 + | Node { left = _; key = _; data = _; right = _; height = h } -> h + ;; + + let invariants = + let in_range lower upper compare_key k = + (match lower with + | None -> true + | Some lower -> compare_key lower k < 0) + && + match upper with + | None -> true + | Some upper -> compare_key k upper < 0 + in + let rec loop lower upper compare_key t = + match t with + | Empty -> true + | Leaf { key = k; data = _ } -> in_range lower upper compare_key k + | Node { left = l; key = k; data = _; right = r; height = h } -> + let hl = height l + and hr = height r in + abs (hl - hr) <= 2 + && h = max hl hr + 1 + && in_range lower upper compare_key k + && loop lower (Some k) compare_key l + && loop (Some k) upper compare_key r + in + fun t ~compare_key -> loop None None compare_key t + ;; + + (* preconditions: |height(l) - height(r)| <= 2, hl = height(l), hr = height(r) *) + let[@inline] create_with_heights ~hl ~hr l x d r = + if hl = 0 && hr = 0 + then Leaf { key = x; data = d } + else + Node + { left = l + ; key = x + ; data = d + ; right = r + ; height = (if hl >= hr then hl + 1 else hr + 1) + } + ;; + + (* precondition: |height(l) - height(r)| <= 2 *) + let create l x d r = create_with_heights ~hl:(height l) ~hr:(height r) l x d r + let singleton key data = Leaf { key; data } + + (* We must call [f] with increasing indexes, because the bin_prot reader in + Core.Map needs it. *) + let of_increasing_iterator_unchecked ~len ~f = + let rec loop n ~f i : (_, _) t = + match n with + | 0 -> Empty + | 1 -> + let k, v = f i in + Leaf { key = k; data = v } + | 2 -> + let kl, vl = f i in + let k, v = f (i + 1) in + Node + { left = Leaf { key = kl; data = vl } + ; key = k + ; data = v + ; right = Empty + ; height = 2 + } + | 3 -> + let kl, vl = f i in + let k, v = f (i + 1) in + let kr, vr = f (i + 2) in + Node + { left = Leaf { key = kl; data = vl } + ; key = k + ; data = v + ; right = Leaf { key = kr; data = vr } + ; height = 2 + } + | n -> + let left_length = n lsr 1 in + let right_length = n - left_length - 1 in + let left = loop left_length ~f i in + let k, v = f (i + left_length) in + let right = loop right_length ~f (i + left_length + 1) in + create left k v right + in + loop len ~f 0 + ;; + + let of_sorted_array_unchecked array ~compare_key = + let array_length = Array.length array in + let next = + if array_length < 2 + || + let k0, _ = array.(0) in + let k1, _ = array.(1) in + compare_key k0 k1 < 0 + then fun i -> array.(i) + else fun i -> array.(array_length - 1 - i) + in + with_length (of_increasing_iterator_unchecked ~len:array_length ~f:next) array_length + ;; + + let of_sorted_array array ~compare_key = + match array with + | [||] | [| _ |] -> + Result.Ok (of_sorted_array_unchecked array ~compare_key |> globalize) + | _ -> + with_return (fun r -> + let increasing = + match compare_key (fst array.(0)) (fst array.(1)) with + | 0 -> r.return (Or_error.error_string "of_sorted_array: duplicated elements") + | i -> i < 0 + in + for i = 1 to Array.length array - 2 do + match compare_key (fst array.(i)) (fst array.(i + 1)) with + | 0 -> r.return (Or_error.error_string "of_sorted_array: duplicated elements") + | i -> + if Poly.( <> ) (i < 0) increasing + then + r.return (Or_error.error_string "of_sorted_array: elements are not ordered") + done; + Result.Ok (of_sorted_array_unchecked array ~compare_key |> globalize)) + ;; + + (* precondition: |height(l) - height(r)| <= 3 *) + let[@inline] bal l x d r = + let hl = height l in + let hr = height r in + if hl > hr + 2 + then ( + match l with + | Empty -> invalid_arg "Map.bal" + | Leaf _ -> assert false (* height(Leaf) = 1 && 1 is not larger than hr + 2 *) + | Node { left = ll; key = lv; data = ld; right = lr; height = _ } -> + if height ll >= height lr + then create ll lv ld (create lr x d r) + else ( + match lr with + | Empty -> invalid_arg "Map.bal" + | Leaf { key = lrv; data = lrd } -> + create (create ll lv ld Empty) lrv lrd (create Empty x d r) + | Node { left = lrl; key = lrv; data = lrd; right = lrr; height = _ } -> + create (create ll lv ld lrl) lrv lrd (create lrr x d r))) + else if hr > hl + 2 + then ( + match r with + | Empty -> invalid_arg "Map.bal" + | Leaf _ -> assert false (* height(Leaf) = 1 && 1 is not larger than hl + 2 *) + | Node { left = rl; key = rv; data = rd; right = rr; height = _ } -> + if height rr >= height rl + then create (create l x d rl) rv rd rr + else ( + match rl with + | Empty -> invalid_arg "Map.bal" + | Leaf { key = rlv; data = rld } -> + create (create l x d Empty) rlv rld (create Empty rv rd rr) + | Node { left = rll; key = rlv; data = rld; right = rlr; height = _ } -> + create (create l x d rll) rlv rld (create rlr rv rd rr))) + else create_with_heights ~hl ~hr l x d r + ;; + + let empty = Empty + + let is_empty = function + | Empty -> true + | _ -> false + ;; + + let raise_key_already_present ~key ~sexp_of_key = + Error.raise_s + (Sexp.message "[Map.add_exn] got key already present" [ "key", key |> sexp_of_key ]) + ;; + + module Add_or_set = struct + type t = + | Add_exn_internal + | Add_exn + | Set + end + + let rec find_and_add_or_set + t + ~length + ~key:x + ~data + ~compare_key + ~sexp_of_key + ~(add_or_set : Add_or_set.t) + = + match t with + | Empty -> with_length (Leaf { key = x; data }) (length + 1) + | Leaf { key = v; data = d } -> + let c = compare_key x v in + if c = 0 + then ( + match add_or_set with + | Add_exn_internal -> Exn.raise_without_backtrace Duplicate + | Add_exn -> raise_key_already_present ~key:x ~sexp_of_key + | Set -> with_length (Leaf { key = x; data }) length) + else if c < 0 + then + with_length + (Node + { left = Leaf { key = x; data } + ; key = v + ; data = d + ; right = Empty + ; height = 2 + }) + (length + 1) + else + with_length + (Node + { left = Empty + ; key = v + ; data = d + ; right = Leaf { key = x; data } + ; height = 2 + }) + (length + 1) + | Node { left = l; key = v; data = d; right = r; height = h } -> + let c = compare_key x v in + if c = 0 + then ( + match add_or_set with + | Add_exn_internal -> Exn.raise_without_backtrace Duplicate + | Add_exn -> raise_key_already_present ~key:x ~sexp_of_key + | Set -> + with_length (Node { left = l; key = x; data; right = r; height = h }) length) + else ( + let l, r, length = + if c < 0 + then ( + let { tree = l; length } = + find_and_add_or_set + ~length + ~key:x + ~data + l + ~compare_key + ~sexp_of_key + ~add_or_set + in + l, r, length) + else ( + let { tree = r; length } = + find_and_add_or_set + ~length + ~key:x + ~data + r + ~compare_key + ~sexp_of_key + ~add_or_set + in + l, r, length) + in + with_length (bal l v d r) length) + ;; + + (* specialization of [set'] for the case when [key] is less than all the existing keys *) + let rec set_min key data t = + match t with + | Empty -> Leaf { key; data } + | Leaf { key = v; data = d } -> + Node { left = Leaf { key; data }; key = v; data = d; right = Empty; height = 2 } + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let l = set_min key data l in + bal l v d r + ;; + + (* specialization of [set'] for the case when [key] is greater than all the + existing keys *) + let rec set_max t key data = + match t with + | Empty -> Leaf { key; data } + | Leaf { key = v; data = d } -> + Node { left = Empty; key = v; data = d; right = Leaf { key; data }; height = 2 } + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let r = set_max r key data in + bal l v d r + ;; + + let add_exn t ~length ~key ~data ~compare_key ~sexp_of_key = + find_and_add_or_set t ~length ~key ~data ~compare_key ~sexp_of_key ~add_or_set:Add_exn + ;; + + let add_exn_internal t ~length ~key ~data ~compare_key ~sexp_of_key = + find_and_add_or_set + t + ~length + ~key + ~data + ~compare_key + ~sexp_of_key + ~add_or_set:Add_exn_internal + ;; + + let set t ~length ~key ~data ~compare_key = + find_and_add_or_set + t + ~length + ~key + ~data + ~compare_key + ~sexp_of_key:(fun _ -> List []) + ~add_or_set:Set + ;; + + let set' t key data ~compare_key = (set t ~length:0 ~key ~data ~compare_key).tree + + module Build_increasing : sig + type ('k, 'd) t + + val empty : ('k, 'd) t + val max_key : ('k, 'd) t -> 'k option + val add_unchecked : ('k, 'd) t -> key:'k -> data:'d -> ('k, 'd) t + val to_tree_unchecked : ('k, 'd) t -> ('k, 'd) tree + end = struct + type ('k, 'd) t = ('k * 'd) list + + let empty = [] + + let max_key = function + | [] -> None + | (key, _) :: _ -> Some key + ;; + + let add_unchecked t ~key ~data = (key, data) :: t + + let to_tree_unchecked = function + | [] -> Empty + | [ (key, data) ] -> Leaf { key; data } + | list -> + let len = List.length list in + let list = ref list in + let rec loop len = + match len, !list with + | 1, (key, data) :: tail -> + list := tail; + Leaf { key; data } + | 2, (k2, d2) :: (k1, d1) :: tail -> + list := tail; + Node + { left = Empty + ; key = k1 + ; data = d1 + ; right = Leaf { key = k2; data = d2 } + ; height = 2 + } + | 3, (k3, d3) :: (k2, d2) :: (k1, d1) :: tail -> + list := tail; + Node + { left = Leaf { key = k1; data = d1 } + ; key = k2 + ; data = d2 + ; right = Leaf { key = k3; data = d3 } + ; height = 2 + } + | _, _ -> + let nr = len / 2 in + let nl = len - nr - 1 in + let r = loop nr in + (match !list with + | [] -> assert false + | (k, d) :: tail -> + list := tail; + let l = loop nl in + create l k d r) + in + loop len [@nontail] + ;; + end + + let of_increasing_sequence seq ~compare_key = + with_return (fun { return } -> + let { tree = builder; length } = + Sequence.fold + seq + ~init:(with_length_global Build_increasing.empty 0) + ~f:(fun { tree = builder; length } (key, data) -> + match Build_increasing.max_key builder with + | Some prev_key when compare_key prev_key key >= 0 -> + return (Or_error.error_string "of_increasing_sequence: non-increasing key") + | _ -> + with_length_global + (Build_increasing.add_unchecked builder ~key ~data) + (length + 1)) + in + Ok (with_length_global (Build_increasing.to_tree_unchecked builder) length)) + ;; + + (* Like [bal] but allows any difference in height between [l] and [r]. + + O(|height l - height r|) *) + let rec join l k d r = + match l, r with + | Empty, _ -> set_min k d r + | _, Empty -> set_max l k d + | Leaf { key = lk; data = ld }, _ -> set_min lk ld (set_min k d r) + | _, Leaf { key = rk; data = rd } -> set_max (set_max l k d) rk rd + | ( Node { left = ll; key = lk; data = ld; right = lr; height = lh } + , Node { left = rl; key = rk; data = rd; right = rr; height = rh } ) -> + let l, k, d, r = + (* [bal] requires height difference <= 3. *) + if lh > rh + 3 + (* [height lr >= height r], + therefore [height (join lr k d r ...)] is [height rl + 1] or [height rl] + therefore the height difference with [ll] will be <= 3 *) + then ll, lk, ld, join lr k d r + else if rh > lh + 3 + then join l k d rl, rk, rd, rr + else l, k, d, r + in + bal l k d r + ;; + + let[@inline] rec split_gen t x ~compare_key = + match t with + | Empty -> Empty, None, Empty + | Leaf { key = k; data = d } -> + let cmp = compare_key k in + if cmp = 0 + then Empty, Some (k, d), Empty + else if cmp < 0 + then Empty, None, t + else t, None, Empty + | Node { left = l; key = k; data = d; right = r; height = _ } -> + let cmp = compare_key k in + if cmp = 0 + then l, Some (k, d), r + else if cmp < 0 + then ( + let ll, maybe, lr = split_gen l x ~compare_key in + ll, maybe, join lr k d r) + else ( + let rl, maybe, rr = split_gen r x ~compare_key in + join l k d rl, maybe, rr) + ;; + + let split t x ~compare_key = split_gen t x ~compare_key:(fun y -> compare_key x y) + + (* This function does not really reinsert [x], but just arranges so that [split] + produces the equivalent tree in the first place. *) + let split_and_reinsert_boundary t ~into x ~compare_key = + let left, boundary_opt, right = + split_gen + t + x + ~compare_key: + (match into with + | `Left -> + fun y -> + (match compare_key x y with + | 0 -> 1 + | res -> res) + | `Right -> + fun y -> + (match compare_key x y with + | 0 -> -1 + | res -> res)) + in + assert (Option.is_none boundary_opt); + left, right + ;; + + let split_range + t + ~(lower_bound : 'a Maybe_bound.t) + ~(upper_bound : 'a Maybe_bound.t) + ~compare_key + = + if Maybe_bound.bounds_crossed + ~compare:compare_key + ~lower:lower_bound + ~upper:upper_bound + then empty, empty, empty + else ( + let left, mid_and_right = + match lower_bound with + | Unbounded -> empty, t + | Incl lb -> split_and_reinsert_boundary ~into:`Right t lb ~compare_key + | Excl lb -> split_and_reinsert_boundary ~into:`Left t lb ~compare_key + in + let mid, right = + match upper_bound with + | Unbounded -> mid_and_right, empty + | Incl lb -> split_and_reinsert_boundary ~into:`Left mid_and_right lb ~compare_key + | Excl lb -> + split_and_reinsert_boundary ~into:`Right mid_and_right lb ~compare_key + in + left, mid, right) + ;; + + let rec find t x ~compare_key = + match t with + | Empty -> None + | Leaf { key = v; data = d } -> if compare_key x v = 0 then Some d else None + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let c = compare_key x v in + if c = 0 then Some d else find (if c < 0 then l else r) x ~compare_key + ;; + + let add_multi t ~length ~key ~data ~compare_key = + let data = data :: Option.value (find t key ~compare_key) ~default:[] in + set ~length ~key ~data t ~compare_key + ;; + + let find_multi t x ~compare_key = + match find t x ~compare_key with + | None -> [] + | Some l -> l + ;; + + let find_exn = + let if_not_found key ~sexp_of_key = + raise (Not_found_s (List [ Atom "Map.find_exn: not found"; sexp_of_key key ])) + in + let rec find_exn t x ~compare_key ~sexp_of_key = + match t with + | Empty -> if_not_found x ~sexp_of_key + | Leaf { key = v; data = d } -> + if compare_key x v = 0 then d else if_not_found x ~sexp_of_key + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let c = compare_key x v in + if c = 0 then d else find_exn (if c < 0 then l else r) x ~compare_key ~sexp_of_key + in + (* named to preserve symbol in compiled binary *) + find_exn + ;; + + let mem t x ~compare_key = Option.is_some (find t x ~compare_key) + + let rec min_elt = function + | Empty -> None + | Leaf { key = k; data = d } -> Some (k, d) + | Node { left = Empty; key = k; data = d; right = _; height = _ } -> Some (k, d) + | Node { left = l; key = _; data = _; right = _; height = _ } -> min_elt l + ;; + + exception Map_min_elt_exn_of_empty_map [@@deriving_inline sexp] + + let () = + Sexplib0.Sexp_conv.Exn_converter.add + [%extension_constructor Map_min_elt_exn_of_empty_map] + (function + | Map_min_elt_exn_of_empty_map -> + Sexplib0.Sexp.Atom "map.ml.Tree0.Map_min_elt_exn_of_empty_map" + | _ -> assert false) + ;; + + [@@@end] + + exception Map_max_elt_exn_of_empty_map [@@deriving_inline sexp] + + let () = + Sexplib0.Sexp_conv.Exn_converter.add + [%extension_constructor Map_max_elt_exn_of_empty_map] + (function + | Map_max_elt_exn_of_empty_map -> + Sexplib0.Sexp.Atom "map.ml.Tree0.Map_max_elt_exn_of_empty_map" + | _ -> assert false) + ;; + + [@@@end] + + let min_elt_exn t = + match min_elt t with + | None -> raise Map_min_elt_exn_of_empty_map + | Some v -> v + ;; + + let rec max_elt = function + | Empty -> None + | Leaf { key = k; data = d } -> Some (k, d) + | Node { left = _; key = k; data = d; right = Empty; height = _ } -> Some (k, d) + | Node { left = _; key = _; data = _; right = r; height = _ } -> max_elt r + ;; + + let max_elt_exn t = + match max_elt t with + | None -> raise Map_max_elt_exn_of_empty_map + | Some v -> v + ;; + + let rec remove_min_elt t = + match t with + | Empty -> invalid_arg "Map.remove_min_elt" + | Leaf _ -> Empty + | Node { left = Empty; key = _; data = _; right = r; height = _ } -> r + | Node { left = l; key = x; data = d; right = r; height = _ } -> + bal (remove_min_elt l) x d r + ;; + + let append ~lower_part ~upper_part ~compare_key = + match max_elt lower_part, min_elt upper_part with + | None, _ -> `Ok upper_part + | _, None -> `Ok lower_part + | Some (max_lower, _), Some (min_upper, v) when compare_key max_lower min_upper < 0 -> + let upper_part_without_min = remove_min_elt upper_part in + `Ok (join lower_part min_upper v upper_part_without_min) + | _ -> `Overlapping_key_ranges + ;; + + let fold_range_inclusive = + (* This assumes that min <= max, which is checked by the outer function. *) + let rec go t ~min ~max ~init ~f ~compare_key = + match t with + | Empty -> init + | Leaf { key = k; data = d } -> + if compare_key k min < 0 || compare_key k max > 0 + then (* k < min || k > max *) + init + else f ~key:k ~data:d init + | Node { left = l; key = k; data = d; right = r; height = _ } -> + let c_min = compare_key k min in + if c_min < 0 + then + (* if k < min, then this node and its left branch are outside our range *) + go r ~min ~max ~init ~f ~compare_key + else if c_min = 0 + then + (* if k = min, then this node's left branch is outside our range *) + go r ~min ~max ~init:(f ~key:k ~data:d init) ~f ~compare_key + else ( + (* k > min *) + let z = go l ~min ~max ~init ~f ~compare_key in + let c_max = compare_key k max in + (* if k > max, we're done *) + if c_max > 0 + then z + else ( + let z = f ~key:k ~data:d z in + (* if k = max, then we fold in this one last value and we're done *) + if c_max = 0 then z else go r ~min ~max ~init:z ~f ~compare_key)) + in + fun t ~min ~max ~init ~f ~compare_key -> + if compare_key min max <= 0 then go t ~min ~max ~init ~f ~compare_key else init + ;; + + let range_to_alist t ~min ~max ~compare_key = + List.rev + (fold_range_inclusive + t + ~min + ~max + ~init:[] + ~f:(fun ~key ~data l -> (key, data) :: l) + ~compare_key) + ;; + + (* preconditions: + - all elements in t1 are less than elements in t2 + - |height(t1) - height(t2)| <= 2 *) + let concat_unchecked t1 t2 = + match t1, t2 with + | Empty, t -> t + | t, Empty -> t + | _, _ -> + let x, d = min_elt_exn t2 in + bal t1 x d (remove_min_elt t2) + ;; + + (* similar to [concat_unchecked], and balances trees of arbitrary height differences *) + let concat_and_balance_unchecked t1 t2 = + match t1, t2 with + | Empty, t -> t + | t, Empty -> t + | _, _ -> + let x, d = min_elt_exn t2 in + join t1 x d (remove_min_elt t2) + ;; + + let rec remove t x ~length ~compare_key = + match t with + | Empty -> with_length t length + | Leaf { key = v; data = _ } -> + if compare_key x v = 0 then with_length Empty (length - 1) else with_length t length + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let c = compare_key x v in + if c = 0 + then with_length (concat_unchecked l r) (length - 1) + else ( + let l, r, length' = + if c < 0 + then ( + let { tree = l; length = length' } = remove l x ~length ~compare_key in + l, r, length') + else ( + let { tree = r; length = length' } = remove r x ~length ~compare_key in + l, r, length') + in + if length = length' + then with_length t length + else with_length (bal l v d r) length') + ;; + + let rec change t key ~f ~length ~compare_key = + match t with + | Empty -> + (match f None with + | None -> with_length Empty length + | Some data -> with_length (Leaf { key; data }) (length + 1)) + | Leaf { key = v; data = d } -> + let c = compare_key key v in + if c = 0 + then ( + match f (Some d) with + | None -> with_length Empty (length - 1) + | Some d' -> with_length (Leaf { key = v; data = d' }) length) + else if c < 0 + then ( + let { tree = l'; length } = change Empty key ~f ~length ~compare_key in + if phys_equal l' t + then with_length t length + else with_length (bal l' v d Empty) length) + else ( + let { tree = r'; length } = change Empty key ~f ~length ~compare_key in + if phys_equal r' t + then with_length t length + else with_length (bal Empty v d r') length) + | Node { left = l; key = v; data = d; right = r; height = h } -> + let c = compare_key key v in + if c = 0 + then ( + match f (Some d) with + | None -> with_length (concat_unchecked l r) (length - 1) + | Some data -> + with_length (Node { left = l; key; data; right = r; height = h }) length) + else if c < 0 + then ( + let { tree = l'; length } = change l key ~f ~length ~compare_key in + if phys_equal l' l + then with_length t length + else with_length (bal l' v d r) length) + else ( + let { tree = r'; length } = change r key ~f ~length ~compare_key in + if phys_equal r' r + then with_length t length + else with_length (bal l v d r') length) + ;; + + let rec update t key ~f ~length ~compare_key = + match t with + | Empty -> + let data = f None in + with_length (Leaf { key; data }) (length + 1) + | Leaf { key = v; data = d } -> + let c = compare_key key v in + if c = 0 + then ( + let d' = f (Some d) in + with_length (Leaf { key = v; data = d' }) length) + else if c < 0 + then ( + let { tree = l; length } = update Empty key ~f ~length ~compare_key in + with_length (bal l v d Empty) length) + else ( + let { tree = r; length } = update Empty key ~f ~length ~compare_key in + with_length (bal Empty v d r) length) + | Node { left = l; key = v; data = d; right = r; height = h } -> + let c = compare_key key v in + if c = 0 + then ( + let data = f (Some d) in + with_length (Node { left = l; key; data; right = r; height = h }) length) + else if c < 0 + then ( + let { tree = l; length } = update l key ~f ~length ~compare_key in + with_length (bal l v d r) length) + else ( + let { tree = r; length } = update r key ~f ~length ~compare_key in + with_length (bal l v d r) length) + ;; + + let remove_multi t key ~length ~compare_key = + change t key ~length ~compare_key ~f:(function + | None | Some ([] | [ _ ]) -> None + | Some (_ :: (_ :: _ as non_empty_tail)) -> Some non_empty_tail) + ;; + + let rec iter_keys t ~f = + match t with + | Empty -> () + | Leaf { key = v; data = _ } -> f v + | Node { left = l; key = v; data = _; right = r; height = _ } -> + iter_keys ~f l; + f v; + iter_keys ~f r + ;; + + let rec iter t ~f = + match t with + | Empty -> () + | Leaf { key = _; data = d } -> f d + | Node { left = l; key = _; data = d; right = r; height = _ } -> + iter ~f l; + f d; + iter ~f r + ;; + + let rec iteri t ~f = + match t with + | Empty -> () + | Leaf { key = v; data = d } -> f ~key:v ~data:d + | Node { left = l; key = v; data = d; right = r; height = _ } -> + iteri ~f l; + f ~key:v ~data:d; + iteri ~f r + ;; + + let iteri_until = + let rec iteri_until_loop t ~f : Continue_or_stop.t = + match t with + | Empty -> Continue + | Leaf { key = v; data = d } -> f ~key:v ~data:d + | Node { left = l; key = v; data = d; right = r; height = _ } -> + (match iteri_until_loop ~f l with + | Stop -> Stop + | Continue -> + (match f ~key:v ~data:d with + | Stop -> Stop + | Continue -> iteri_until_loop ~f r)) + in + fun t ~f -> Finished_or_unfinished.of_continue_or_stop (iteri_until_loop t ~f) + ;; + + let rec map t ~f = + match t with + | Empty -> Empty + | Leaf { key = v; data = d } -> Leaf { key = v; data = f d } + | Node { left = l; key = v; data = d; right = r; height = h } -> + let l' = map ~f l in + let d' = f d in + let r' = map ~f r in + Node { left = l'; key = v; data = d'; right = r'; height = h } + ;; + + let rec mapi t ~f = + match t with + | Empty -> Empty + | Leaf { key = v; data = d } -> Leaf { key = v; data = f ~key:v ~data:d } + | Node { left = l; key = v; data = d; right = r; height = h } -> + let l' = mapi ~f l in + let d' = f ~key:v ~data:d in + let r' = mapi ~f r in + Node { left = l'; key = v; data = d'; right = r'; height = h } + ;; + + let rec fold t ~init:accu ~f = + match t with + | Empty -> accu + | Leaf { key = v; data = d } -> f ~key:v ~data:d accu + | Node { left = l; key = v; data = d; right = r; height = _ } -> + fold ~f r ~init:(f ~key:v ~data:d (fold ~f l ~init:accu)) + ;; + + let fold_until t ~init ~f ~finish = + let rec fold_until_loop t ~acc ~f : (_, _) Container.Continue_or_stop.t = + match t with + | Empty -> Continue acc + | Leaf { key = v; data = d } -> f ~key:v ~data:d acc + | Node { left = l; key = v; data = d; right = r; height = _ } -> + (match fold_until_loop l ~acc ~f with + | Stop final -> Stop final + | Continue acc -> + (match f ~key:v ~data:d acc with + | Stop final -> Stop final + | Continue acc -> fold_until_loop r ~acc ~f)) + in + match fold_until_loop t ~acc:init ~f with + | Continue acc -> finish acc [@nontail] + | Stop stop -> stop + ;; + + let rec fold_right t ~init:accu ~f = + match t with + | Empty -> accu + | Leaf { key = v; data = d } -> f ~key:v ~data:d accu + | Node { left = l; key = v; data = d; right = r; height = _ } -> + fold_right ~f l ~init:(f ~key:v ~data:d (fold_right ~f r ~init:accu)) + ;; + + let rec filter_mapi t ~f ~len = + match t with + | Empty -> Empty + | Leaf { key = v; data = d } -> + (match f ~key:v ~data:d with + | Some new_data -> Leaf { key = v; data = new_data } + | None -> + decr len; + Empty) + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let l' = filter_mapi l ~f ~len in + let new_data = f ~key:v ~data:d in + let r' = filter_mapi r ~f ~len in + (match new_data with + | Some new_data -> join l' v new_data r' + | None -> + decr len; + concat_and_balance_unchecked l' r') + ;; + + let rec filteri t ~f ~len = + match t with + | Empty -> Empty + | Leaf { key = v; data = d } -> + (match f ~key:v ~data:d with + | true -> t + | false -> + decr len; + Empty) + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let l' = filteri l ~f ~len in + let keep_data = f ~key:v ~data:d in + let r' = filteri r ~f ~len in + if phys_equal l l' && keep_data && phys_equal r r' + then t + else ( + match keep_data with + | true -> join l' v d r' + | false -> + decr len; + concat_and_balance_unchecked l' r') + ;; + + let filter t ~f ~len = filteri t ~len ~f:(fun ~key:_ ~data -> f data) [@nontail] + let filter_keys t ~f ~len = filteri t ~len ~f:(fun ~key ~data:_ -> f key) [@nontail] + let filter_map t ~f ~len = filter_mapi t ~len ~f:(fun ~key:_ ~data -> f data) [@nontail] + + let partition_mapi t ~f = + let t1, t2 = + fold + t + ~init:(Build_increasing.empty, Build_increasing.empty) + ~f:(fun ~key ~data (t1, t2) -> + match (f ~key ~data : _ Either.t) with + | First x -> Build_increasing.add_unchecked t1 ~key ~data:x, t2 + | Second y -> t1, Build_increasing.add_unchecked t2 ~key ~data:y) + in + Build_increasing.to_tree_unchecked t1, Build_increasing.to_tree_unchecked t2 + ;; + + let partition_map t ~f = partition_mapi t ~f:(fun ~key:_ ~data -> f data) [@nontail] + + let partitioni_tf t ~f = + let rec loop t ~f = + match t with + | Empty -> Empty, Empty + | Leaf { key = v; data = d } -> + (match f ~key:v ~data:d with + | true -> t, Empty + | false -> Empty, t) + | Node { left = l; key = v; data = d; right = r; height = _ } -> + let l't, l'f = loop l ~f in + let keep_data_t = f ~key:v ~data:d in + let r't, r'f = loop r ~f in + let mk l' keep_data r' = + if phys_equal l l' && keep_data && phys_equal r r' + then t + else ( + match keep_data with + | true -> join l' v d r' + | false -> concat_and_balance_unchecked l' r') + in + mk l't keep_data_t r't, mk l'f (not keep_data_t) r'f + in + loop t ~f + ;; + + let partition_tf t ~f = partitioni_tf t ~f:(fun ~key:_ ~data -> f data) [@nontail] + + module Enum = struct + type increasing + type decreasing + + type ('k, 'v, 'direction) t = + | End + | More of 'k * 'v * ('k, 'v) tree * ('k, 'v, 'direction) t + + let rec cons t (e : (_, _, increasing) t) : (_, _, increasing) t = + match t with + | Empty -> e + | Leaf { key = v; data = d } -> More (v, d, Empty, e) + | Node { left = l; key = v; data = d; right = r; height = _ } -> + cons l (More (v, d, r, e)) + ;; + + let rec cons_right t (e : (_, _, decreasing) t) : (_, _, decreasing) t = + match t with + | Empty -> e + | Leaf { key = v; data = d } -> More (v, d, Empty, e) + | Node { left = l; key = v; data = d; right = r; height = _ } -> + cons_right r (More (v, d, l, e)) + ;; + + let of_tree tree : (_, _, increasing) t = cons tree End + let of_tree_right tree : (_, _, decreasing) t = cons_right tree End + + let starting_at_increasing t key compare : (_, _, increasing) t = + let rec loop t e = + match t with + | Empty -> e + | Leaf { key = v; data = d } -> + loop (Node { left = Empty; key = v; data = d; right = Empty; height = 1 }) e + | Node { left = _; key = v; data = _; right = r; height = _ } + when compare v key < 0 -> loop r e + | Node { left = l; key = v; data = d; right = r; height = _ } -> + loop l (More (v, d, r, e)) + in + loop t End + ;; + + let starting_at_decreasing t key compare : (_, _, decreasing) t = + let rec loop t e = + match t with + | Empty -> e + | Leaf { key = v; data = d } -> + loop (Node { left = Empty; key = v; data = d; right = Empty; height = 1 }) e + | Node { left = l; key = v; data = _; right = _; height = _ } + when compare v key > 0 -> loop l e + | Node { left = l; key = v; data = d; right = r; height = _ } -> + loop r (More (v, d, l, e)) + in + loop t End + ;; + + let step_deeper_exn tree e = + match tree with + | Empty -> assert false + | Leaf { key = v; data = d } -> Empty, More (v, d, Empty, e) + | Node { left = l; key = v; data = d; right = r; height = _ } -> l, More (v, d, r, e) + ;; + + (* [drop_phys_equal_prefix tree1 acc1 tree2 acc2] drops the largest physically-equal + prefix of tree1 and tree2 that they share, and then prepends the remaining data + into acc1 and acc2, respectively. + This can be asymptotically faster than [cons] even if it skips a small proportion + of the tree because [cons] is always O(log(n)) in the size of the tree, while + this function is O(log(n/m)) where [m] is the size of the part of the tree that + is skipped. *) + let rec drop_phys_equal_prefix tree1 acc1 tree2 acc2 = + if phys_equal tree1 tree2 + then acc1, acc2 + else ( + let h2 = height tree2 in + let h1 = height tree1 in + if h2 = h1 + then ( + let tree1, acc1 = step_deeper_exn tree1 acc1 in + let tree2, acc2 = step_deeper_exn tree2 acc2 in + drop_phys_equal_prefix tree1 acc1 tree2 acc2) + else if h2 > h1 + then ( + let tree2, acc2 = step_deeper_exn tree2 acc2 in + drop_phys_equal_prefix tree1 acc1 tree2 acc2) + else ( + let tree1, acc1 = step_deeper_exn tree1 acc1 in + drop_phys_equal_prefix tree1 acc1 tree2 acc2)) + ;; + + let compare compare_key compare_data t1 t2 = + let rec loop t1 t2 = + match t1, t2 with + | End, End -> 0 + | End, _ -> -1 + | _, End -> 1 + | More (v1, d1, r1, e1), More (v2, d2, r2, e2) -> + let c = compare_key v1 v2 in + if c <> 0 + then c + else ( + let c = compare_data d1 d2 in + if c <> 0 + then c + else ( + let e1, e2 = drop_phys_equal_prefix r1 e1 r2 e2 in + loop e1 e2)) + in + loop t1 t2 + ;; + + let equal compare_key data_equal t1 t2 = + let rec loop t1 t2 = + match t1, t2 with + | End, End -> true + | End, _ | _, End -> false + | More (v1, d1, r1, e1), More (v2, d2, r2, e2) -> + compare_key v1 v2 = 0 + && data_equal d1 d2 + && + let e1, e2 = drop_phys_equal_prefix r1 e1 r2 e2 in + loop e1 e2 + in + loop t1 t2 + ;; + + let rec fold ~init ~f = function + | End -> init + | More (key, data, tree, enum) -> + let next = f ~key ~data init in + fold (cons tree enum) ~init:next ~f + ;; + + let fold2 compare_key t1 t2 ~init ~f = + let rec loop t1 t2 curr = + match t1, t2 with + | End, End -> curr + | End, _ -> + fold t2 ~init:curr ~f:(fun ~key ~data acc -> f ~key ~data:(`Right data) acc) [@nontail + ] + | _, End -> + fold t1 ~init:curr ~f:(fun ~key ~data acc -> f ~key ~data:(`Left data) acc) [@nontail + ] + | More (k1, v1, tree1, enum1), More (k2, v2, tree2, enum2) -> + let compare_result = compare_key k1 k2 in + if compare_result = 0 + then ( + let next = f ~key:k1 ~data:(`Both (v1, v2)) curr in + loop (cons tree1 enum1) (cons tree2 enum2) next) + else if compare_result < 0 + then ( + let next = f ~key:k1 ~data:(`Left v1) curr in + loop (cons tree1 enum1) t2 next) + else ( + let next = f ~key:k2 ~data:(`Right v2) curr in + loop t1 (cons tree2 enum2) next) + in + loop t1 t2 init [@nontail] + ;; + + let symmetric_diff t1 t2 ~compare_key ~data_equal = + let step state = + match state with + | End, End -> Sequence.Step.Done + | End, More (key, data, tree, enum) -> + Sequence.Step.Yield { value = key, `Right data; state = End, cons tree enum } + | More (key, data, tree, enum), End -> + Sequence.Step.Yield { value = key, `Left data; state = cons tree enum, End } + | (More (k1, v1, tree1, enum1) as left), (More (k2, v2, tree2, enum2) as right) -> + let compare_result = compare_key k1 k2 in + if compare_result = 0 + then ( + let next_state = drop_phys_equal_prefix tree1 enum1 tree2 enum2 in + if data_equal v1 v2 + then Sequence.Step.Skip { state = next_state } + else Sequence.Step.Yield { value = k1, `Unequal (v1, v2); state = next_state }) + else if compare_result < 0 + then + Sequence.Step.Yield { value = k1, `Left v1; state = cons tree1 enum1, right } + else + Sequence.Step.Yield { value = k2, `Right v2; state = left, cons tree2 enum2 } + in + Sequence.unfold_step ~init:(drop_phys_equal_prefix t1 End t2 End) ~f:step + ;; + + let fold_symmetric_diff t1 t2 ~compare_key ~data_equal ~init ~f = + let add acc k v = f acc (k, `Right v) in + let remove acc k v = f acc (k, `Left v) in + let rec loop left right acc = + match left, right with + | End, enum -> + fold enum ~init:acc ~f:(fun ~key ~data acc -> add acc key data) [@nontail] + | enum, End -> + fold enum ~init:acc ~f:(fun ~key ~data acc -> remove acc key data) [@nontail] + | (More (k1, v1, tree1, enum1) as left), (More (k2, v2, tree2, enum2) as right) -> + let compare_result = compare_key k1 k2 in + if compare_result = 0 + then ( + let acc = if data_equal v1 v2 then acc else f acc (k1, `Unequal (v1, v2)) in + let enum1, enum2 = drop_phys_equal_prefix tree1 enum1 tree2 enum2 in + loop enum1 enum2 acc) + else if compare_result < 0 + then ( + let acc = remove acc k1 v1 in + loop (cons tree1 enum1) right acc) + else ( + let acc = add acc k2 v2 in + loop left (cons tree2 enum2) acc) + in + let left, right = drop_phys_equal_prefix t1 End t2 End in + loop left right init [@nontail] + ;; + end + + let to_sequence_increasing comparator ~from_key t = + let next enum = + match enum with + | Enum.End -> Sequence.Step.Done + | Enum.More (k, v, t, e) -> + Sequence.Step.Yield { value = k, v; state = Enum.cons t e } + in + let init = + match from_key with + | None -> Enum.of_tree t + | Some key -> Enum.starting_at_increasing t key comparator.Comparator.compare + in + Sequence.unfold_step ~init ~f:next + ;; + + let to_sequence_decreasing comparator ~from_key t = + let next enum = + match enum with + | Enum.End -> Sequence.Step.Done + | Enum.More (k, v, t, e) -> + Sequence.Step.Yield { value = k, v; state = Enum.cons_right t e } + in + let init = + match from_key with + | None -> Enum.of_tree_right t + | Some key -> Enum.starting_at_decreasing t key comparator.Comparator.compare + in + Sequence.unfold_step ~init ~f:next + ;; + + let to_sequence + comparator + ?(order = `Increasing_key) + ?keys_greater_or_equal_to + ?keys_less_or_equal_to + t + = + let inclusive_bound side t bound = + let compare_key = comparator.Comparator.compare in + let l, maybe, r = split t bound ~compare_key in + let t = side (l, r) in + match maybe with + | None -> t + | Some (key, data) -> set' t key data ~compare_key + in + match order with + | `Increasing_key -> + let t = Option.fold keys_less_or_equal_to ~init:t ~f:(inclusive_bound fst) in + to_sequence_increasing comparator ~from_key:keys_greater_or_equal_to t + | `Decreasing_key -> + let t = Option.fold keys_greater_or_equal_to ~init:t ~f:(inclusive_bound snd) in + to_sequence_decreasing comparator ~from_key:keys_less_or_equal_to t + ;; + + let compare compare_key compare_data t1 t2 = + let e1, e2 = Enum.drop_phys_equal_prefix t1 End t2 End in + Enum.compare compare_key compare_data e1 e2 + ;; + + let equal compare_key compare_data t1 t2 = + let e1, e2 = Enum.drop_phys_equal_prefix t1 End t2 End in + Enum.equal compare_key compare_data e1 e2 + ;; + + let iter2 t1 t2 ~f ~compare_key = + Enum.fold2 + compare_key + (Enum.of_tree t1) + (Enum.of_tree t2) + ~init:() + ~f:(fun ~key ~data () -> f ~key ~data) [@nontail] + ;; + + let fold2 t1 t2 ~init ~f ~compare_key = + Enum.fold2 compare_key (Enum.of_tree t1) (Enum.of_tree t2) ~f ~init + ;; + + let symmetric_diff = Enum.symmetric_diff + + let fold_symmetric_diff t1 t2 ~compare_key ~data_equal ~init ~f = + (* [Enum.fold_diffs] is a correct implementation of this function, but is considerably + slower, as we have to allocate quite a lot of state to track enumeration of a tree. + Avoid if we can. + *) + let slow x y ~init = Enum.fold_symmetric_diff x y ~compare_key ~data_equal ~f ~init in + let add acc k v = f acc (k, `Right v) in + let remove acc k v = f acc (k, `Left v) in + let delta acc k v v' = if data_equal v v' then acc else f acc (k, `Unequal (v, v')) in + (* If two trees have the same structure at the root (and the same key, if they're + [Node]s) we can trivially diff each subpart in obvious ways. *) + let rec loop t t' acc = + if phys_equal t t' + then acc + else ( + match t, t' with + | Empty, new_vals -> + fold new_vals ~init:acc ~f:(fun ~key ~data acc -> add acc key data) [@nontail] + | old_vals, Empty -> + fold old_vals ~init:acc ~f:(fun ~key ~data acc -> remove acc key data) [@nontail] + | Leaf { key = k; data = v }, Leaf { key = k'; data = v' } -> + (match compare_key k k' with + | x when x = 0 -> delta acc k v v' + | x when x < 0 -> + let acc = remove acc k v in + add acc k' v' + | _ (* when x > 0 *) -> + let acc = add acc k' v' in + remove acc k v) + | ( Node { left = l; key = k; data = v; right = r; height = _ } + , Node { left = l'; key = k'; data = v'; right = r'; height = _ } ) + when compare_key k k' = 0 -> + let acc = loop l l' acc in + let acc = delta acc k v v' in + loop r r' acc + (* Our roots aren't the same key. Fallback to the slow mode. Trees with small + diffs will only do this on very small parts of the tree (hopefully - if the + overall root is rebalanced, we'll eat the whole cost, unfortunately.) *) + | Node _, Node _ | Node _, Leaf _ | Leaf _, Node _ -> slow t t' ~init:acc) + in + loop t1 t2 init [@nontail] + ;; + + let rec length = function + | Empty -> 0 + | Leaf _ -> 1 + | Node { left = l; key = _; data = _; right = r; height = _ } -> + length l + length r + 1 + ;; + + let hash_fold_t_ignoring_structure hash_fold_key hash_fold_data state t = + fold + t + ~init:(hash_fold_int state (length t)) + ~f:(fun ~key ~data state -> hash_fold_data (hash_fold_key state key) data) + ;; + + let keys t = fold_right ~f:(fun ~key ~data:_ list -> key :: list) t ~init:[] + let data t = fold_right ~f:(fun ~key:_ ~data list -> data :: list) t ~init:[] + + module type Foldable = sig + val name : string + + type 'a t + + val fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc + end + + let[@inline always] of_foldable' ~fold foldable ~init ~f ~compare_key = + (fold [@inlined hint]) + foldable + ~init:(with_length_global empty 0) + ~f:(fun { tree = accum; length } (key, data) -> + let prev_data = + match find accum key ~compare_key with + | None -> init + | Some prev -> prev + in + let data = f prev_data data in + (set accum ~length ~key ~data ~compare_key |> globalize) [@nontail]) [@nontail] + ;; + + module Of_foldable (M : Foldable) = struct + let of_foldable_fold foldable ~init ~f ~compare_key = + of_foldable' ~fold:M.fold foldable ~init ~f ~compare_key + ;; + + let of_foldable_reduce foldable ~f ~compare_key = + M.fold + foldable + ~init:(with_length_global empty 0) + ~f:(fun { tree = accum; length } (key, data) -> + let new_data = + match find accum key ~compare_key with + | None -> data + | Some prev -> f prev data + in + (set accum ~length ~key ~data:new_data ~compare_key |> globalize) [@nontail]) [@nontail + ] + ;; + + let of_foldable foldable ~compare_key = + with_return (fun r -> + let map = + M.fold + foldable + ~init:(with_length_global empty 0) + ~f:(fun { tree = t; length } (key, data) -> + let ({ tree = _; length = length' } as acc) = + set ~length ~key ~data t ~compare_key + in + if length = length' + then r.return (`Duplicate_key key) + else globalize acc [@nontail]) + in + `Ok map) + ;; + + let of_foldable_or_error foldable ~comparator = + match of_foldable foldable ~compare_key:comparator.Comparator.compare with + | `Ok x -> Result.Ok x + | `Duplicate_key key -> + Or_error.error + ("Map.of_" ^ M.name ^ "_or_error: duplicate key") + key + comparator.sexp_of_t + ;; + + let of_foldable_exn foldable ~comparator = + match of_foldable foldable ~compare_key:comparator.Comparator.compare with + | `Ok x -> x + | `Duplicate_key key -> + Error.create ("Map.of_" ^ M.name ^ "_exn: duplicate key") key comparator.sexp_of_t + |> Error.raise + ;; + + (* Reverse the input, then fold from left to right. The resulting map uses the first + instance of each key from the input list. The relative ordering of elements in each + output list is the same as in the input list. *) + let of_foldable_multi foldable ~compare_key = + let alist = M.fold foldable ~init:[] ~f:(fun l x -> x :: l) in + of_foldable' alist ~fold:List.fold ~init:[] ~f:(fun l x -> x :: l) ~compare_key + ;; + end + + module Of_alist = Of_foldable (struct + let name = "alist" + + type 'a t = 'a list + + let fold = List.fold + end) + + let of_alist_fold = Of_alist.of_foldable_fold + let of_alist_reduce = Of_alist.of_foldable_reduce + let of_alist = Of_alist.of_foldable + let of_alist_or_error = Of_alist.of_foldable_or_error + let of_alist_exn = Of_alist.of_foldable_exn + let of_alist_multi = Of_alist.of_foldable_multi + + module Of_sequence = Of_foldable (struct + let name = "sequence" + + type 'a t = 'a Sequence.t + + let fold = Sequence.fold + end) + + let of_sequence_fold = Of_sequence.of_foldable_fold + let of_sequence_reduce = Of_sequence.of_foldable_reduce + let of_sequence = Of_sequence.of_foldable + let of_sequence_or_error = Of_sequence.of_foldable_or_error + let of_sequence_exn = Of_sequence.of_foldable_exn + let of_sequence_multi = Of_sequence.of_foldable_multi + + let of_list_with_key list ~get_key ~compare_key = + with_return (fun r -> + let map = + List.fold + list + ~init:(with_length_global empty 0) + ~f:(fun { tree = t; length } data -> + let key = get_key data in + let ({ tree = _; length = new_length } as acc) = + set ~length ~key ~data t ~compare_key + in + if length = new_length + then r.return (`Duplicate_key key) + else globalize acc [@nontail]) + in + `Ok map) [@nontail] + ;; + + let of_list_with_key_or_error list ~get_key ~comparator = + match of_list_with_key list ~get_key ~compare_key:comparator.Comparator.compare with + | `Ok x -> Result.Ok x + | `Duplicate_key key -> + Or_error.error + "Map.of_list_with_key_or_error: duplicate key" + key + comparator.sexp_of_t + ;; + + let of_list_with_key_exn list ~get_key ~comparator = + match of_list_with_key list ~get_key ~compare_key:comparator.Comparator.compare with + | `Ok x -> x + | `Duplicate_key key -> + Error.create "Map.of_list_with_key_exn: duplicate key" key comparator.sexp_of_t + |> Error.raise + ;; + + let of_list_with_key_multi list ~get_key ~compare_key = + let list = List.rev list in + List.fold list ~init:(with_length_global empty 0) ~f:(fun { tree = t; length } data -> + let key = get_key data in + (update t key ~length ~compare_key ~f:(fun option -> + let list = Option.value option ~default:[] in + data :: list) + |> globalize) [@nontail]) [@nontail] + ;; + + let of_list_with_key_fold list ~get_key ~init ~f ~compare_key = + List.fold list ~init:(with_length_global empty 0) ~f:(fun { tree = t; length } data -> + let key = get_key data in + (update t key ~length ~compare_key ~f:(function + | None -> f init data + | Some prev -> f prev data) + |> globalize) [@nontail]) [@nontail] + ;; + + let of_list_with_key_reduce list ~get_key ~f ~compare_key = + List.fold list ~init:(with_length_global empty 0) ~f:(fun { tree = t; length } data -> + let key = get_key data in + (update t key ~length ~compare_key ~f:(function + | None -> data + | Some prev -> f prev data) + |> globalize) [@nontail]) [@nontail] + ;; + + let for_all t ~f = + with_return (fun r -> + iter t ~f:(fun data -> if not (f data) then r.return false); + true) [@nontail] + ;; + + let for_alli t ~f = + with_return (fun r -> + iteri t ~f:(fun ~key ~data -> if not (f ~key ~data) then r.return false); + true) [@nontail] + ;; + + let exists t ~f = + with_return (fun r -> + iter t ~f:(fun data -> if f data then r.return true); + false) [@nontail] + ;; + + let existsi t ~f = + with_return (fun r -> + iteri t ~f:(fun ~key ~data -> if f ~key ~data then r.return true); + false) [@nontail] + ;; + + let count t ~f = + fold t ~init:0 ~f:(fun ~key:_ ~data acc -> if f data then acc + 1 else acc) [@nontail] + ;; + + let counti t ~f = + fold t ~init:0 ~f:(fun ~key ~data acc -> if f ~key ~data then acc + 1 else acc) [@nontail + ] + ;; + + let sum (type a) (module M : Container.Summable with type t = a) t ~f = + fold t ~init:M.zero ~f:(fun ~key:_ ~data acc -> M.( + ) (f data) acc) [@nontail] + ;; + + let sumi (type a) (module M : Container.Summable with type t = a) t ~f = + fold t ~init:M.zero ~f:(fun ~key ~data acc -> M.( + ) (f ~key ~data) acc) [@nontail] + ;; + + let to_alist ?(key_order = `Increasing) t = + match key_order with + | `Increasing -> fold_right t ~init:[] ~f:(fun ~key ~data x -> (key, data) :: x) + | `Decreasing -> fold t ~init:[] ~f:(fun ~key ~data x -> (key, data) :: x) + ;; + + let merge t1 t2 ~f ~compare_key = + let elts = Uniform_array.unsafe_create_uninitialized ~len:(length t1 + length t2) in + let i = ref 0 in + iter2 t1 t2 ~compare_key ~f:(fun ~key ~data:values -> + match f ~key values with + | Some value -> + Uniform_array.set elts !i (key, value); + incr i + | None -> ()); + let len = !i in + let get i = Uniform_array.get elts i in + let tree = of_increasing_iterator_unchecked ~len ~f:get in + with_length tree len + ;; + + let merge_skewed = + let merge_large_first length_large t_large t_small ~call ~combine ~compare_key = + fold + t_small + ~init:(with_length_global t_large length_large) + ~f:(fun ~key ~data:data' { tree = t; length } -> + (update t key ~length ~compare_key ~f:(function + | None -> data' + | Some data -> call combine ~key data data') + |> globalize) [@nontail]) [@nontail] + in + let call f ~key x y = f ~key x y in + let swap f ~key x y = f ~key y x in + fun t1 t2 ~length1 ~length2 ~combine ~compare_key -> + if length2 <= length1 + then merge_large_first length1 t1 t2 ~call ~combine ~compare_key + else merge_large_first length2 t2 t1 ~call:swap ~combine ~compare_key + ;; + + let merge_disjoint_exn t1 t2 ~length1 ~length2 ~(comparator : _ Comparator.t) = + merge_skewed + t1 + t2 + ~length1 + ~length2 + ~compare_key:comparator.compare + ~combine:(fun ~key _ _ -> + Error.create "Map.merge_disjoint_exn: duplicate key" key comparator.sexp_of_t + |> Error.raise) + ;; + + module Closest_key_impl = struct + (* [marker] and [repackage] allow us to create "logical" options without actually + allocating any options. Passing [Found key value] to a function is equivalent to + passing [Some (key, value)]; passing [Missing () ()] is equivalent to passing + [None]. *) + type ('k, 'v, 'k_opt, 'v_opt) marker = + | Missing : ('k, 'v, unit, unit) marker + | Found : ('k, 'v, 'k, 'v) marker + + let repackage + (type k v k_opt v_opt) + (marker : (k, v, k_opt, v_opt) marker) + (k : k_opt) + (v : v_opt) + : (k * v) option + = + match marker with + | Missing -> None + | Found -> Some (k, v) + ;; + + (* The type signature is explicit here to allow polymorphic recursion. *) + let rec loop : + 'k 'v 'k_opt 'v_opt. + ('k, 'v) tree + -> [ `Greater_or_equal_to | `Greater_than | `Less_or_equal_to | `Less_than ] + -> 'k + -> compare_key:('k -> 'k -> int) + -> ('k, 'v, 'k_opt, 'v_opt) marker + -> 'k_opt + -> 'v_opt + -> ('k * 'v) option + = + fun t dir k ~compare_key found_marker found_key found_value -> + match t with + | Empty -> repackage found_marker found_key found_value + | Leaf { key = k'; data = v' } -> + let c = compare_key k' k in + if match dir with + | `Greater_or_equal_to -> c >= 0 + | `Greater_than -> c > 0 + | `Less_or_equal_to -> c <= 0 + | `Less_than -> c < 0 + then Some (k', v') + else repackage found_marker found_key found_value + | Node { left = l; key = k'; data = v'; right = r; height = _ } -> + let c = compare_key k' k in + if c = 0 + then ( + (* This is a base case (no recursive call). *) + match dir with + | `Greater_or_equal_to | `Less_or_equal_to -> Some (k', v') + | `Greater_than -> + if is_empty r then repackage found_marker found_key found_value else min_elt r + | `Less_than -> + if is_empty l then repackage found_marker found_key found_value else max_elt l) + else ( + (* We are guaranteed here that k' <> k. *) + (* This is the only recursive case. *) + match dir with + | `Greater_or_equal_to | `Greater_than -> + if c > 0 + then loop l dir k ~compare_key Found k' v' + else loop r dir k ~compare_key found_marker found_key found_value + | `Less_or_equal_to | `Less_than -> + if c < 0 + then loop r dir k ~compare_key Found k' v' + else loop l dir k ~compare_key found_marker found_key found_value) + ;; + + let closest_key t dir k ~compare_key = loop t dir k ~compare_key Missing () () + end + + let closest_key = Closest_key_impl.closest_key + + let rec rank t k ~compare_key = + match t with + | Empty -> None + | Leaf { key = k'; data = _ } -> if compare_key k' k = 0 then Some 0 else None + | Node { left = l; key = k'; data = _; right = r; height = _ } -> + let c = compare_key k' k in + if c = 0 + then Some (length l) + else if c > 0 + then rank l k ~compare_key + else Option.map (rank r k ~compare_key) ~f:(fun rank -> rank + 1 + length l) + ;; + + (* this could be implemented using [Sequence] interface but the following implementation + allocates only 2 words and doesn't require write-barrier *) + let rec nth' num_to_search = function + | Empty -> None + | Leaf { key = k; data = v } -> + if !num_to_search = 0 + then Some (k, v) + else ( + decr num_to_search; + None) + | Node { left = l; key = k; data = v; right = r; height = _ } -> + (match nth' num_to_search l with + | Some _ as some -> some + | None -> + if !num_to_search = 0 + then Some (k, v) + else ( + decr num_to_search; + nth' num_to_search r)) + ;; + + let nth t n = nth' (ref n) t + + let rec find_first_satisfying t ~f = + match t with + | Empty -> None + | Leaf { key = k; data = v } -> if f ~key:k ~data:v then Some (k, v) else None + | Node { left = l; key = k; data = v; right = r; height = _ } -> + if f ~key:k ~data:v + then ( + match find_first_satisfying l ~f with + | None -> Some (k, v) + | Some _ as x -> x) + else find_first_satisfying r ~f + ;; + + let rec find_last_satisfying t ~f = + match t with + | Empty -> None + | Leaf { key = k; data = v } -> if f ~key:k ~data:v then Some (k, v) else None + | Node { left = l; key = k; data = v; right = r; height = _ } -> + if f ~key:k ~data:v + then ( + match find_last_satisfying r ~f with + | None -> Some (k, v) + | Some _ as x -> x) + else find_last_satisfying l ~f + ;; + + let binary_search t ~compare how v = + match how with + | `Last_strictly_less_than -> + find_last_satisfying t ~f:(fun ~key ~data -> compare ~key ~data v < 0) [@nontail] + | `Last_less_than_or_equal_to -> + find_last_satisfying t ~f:(fun ~key ~data -> compare ~key ~data v <= 0) [@nontail] + | `First_equal_to -> + (match find_first_satisfying t ~f:(fun ~key ~data -> compare ~key ~data v >= 0) with + | Some (key, data) as pair when compare ~key ~data v = 0 -> pair + | None | Some _ -> None) + | `Last_equal_to -> + (match find_last_satisfying t ~f:(fun ~key ~data -> compare ~key ~data v <= 0) with + | Some (key, data) as pair when compare ~key ~data v = 0 -> pair + | None | Some _ -> None) + | `First_greater_than_or_equal_to -> + find_first_satisfying t ~f:(fun ~key ~data -> compare ~key ~data v >= 0) [@nontail] + | `First_strictly_greater_than -> + find_first_satisfying t ~f:(fun ~key ~data -> compare ~key ~data v > 0) [@nontail] + ;; + + let binary_search_segmented t ~segment_of how = + let is_left ~key ~data = + match segment_of ~key ~data with + | `Left -> true + | `Right -> false + in + let is_right ~key ~data = not (is_left ~key ~data) in + match how with + | `Last_on_left -> find_last_satisfying t ~f:is_left [@nontail] + | `First_on_right -> find_first_satisfying t ~f:is_right [@nontail] + ;; + + (* [binary_search_one_sided_bound] finds the key in [t] which satisfies [maybe_bound] + and the relevant one of [if_exclusive] or [if_inclusive], as judged by [compare]. *) + let binary_search_one_sided_bound t maybe_bound ~compare ~if_exclusive ~if_inclusive = + let find_bound t how bound ~compare : _ Maybe_bound.t option = + match binary_search t how bound ~compare with + | Some (bound, _) -> Some (Incl bound) + | None -> None + in + match (maybe_bound : _ Maybe_bound.t) with + | Excl bound -> find_bound t if_exclusive bound ~compare + | Incl bound -> find_bound t if_inclusive bound ~compare + | Unbounded -> Some Unbounded + ;; + + (* [binary_search_two_sided_bounds] finds the (not necessarily distinct) keys in [t] + which most closely approach (but do not cross) [lower_bound] and [upper_bound], as + judged by [compare]. It returns [None] if no keys in [t] are within that range. *) + let binary_search_two_sided_bounds t ~compare ~lower_bound ~upper_bound = + let find_lower_bound t maybe_bound ~compare = + binary_search_one_sided_bound + t + maybe_bound + ~compare + ~if_exclusive:`First_strictly_greater_than + ~if_inclusive:`First_greater_than_or_equal_to + in + let find_upper_bound t maybe_bound ~compare = + binary_search_one_sided_bound + t + maybe_bound + ~compare + ~if_exclusive:`Last_strictly_less_than + ~if_inclusive:`Last_less_than_or_equal_to + in + match find_lower_bound t lower_bound ~compare with + | None -> None + | Some lower_bound -> + (match find_upper_bound t upper_bound ~compare with + | None -> None + | Some upper_bound -> Some (lower_bound, upper_bound)) + ;; + + type ('k, 'v) acc = + { mutable bad_key : 'k option + ; mutable map_length : ('k, 'v) t With_length.t + } + + let of_iteri ~iteri ~compare_key = + let acc = { bad_key = None; map_length = with_length_global empty 0 } in + iteri ~f:(fun ~key ~data -> + let { tree = map; length } = acc.map_length in + let ({ tree = _; length = length' } as pair) = + set ~length ~key ~data map ~compare_key + in + if length = length' && Option.is_none acc.bad_key + then acc.bad_key <- Some key + else acc.map_length <- globalize pair); + match acc.bad_key with + | None -> `Ok acc.map_length + | Some key -> `Duplicate_key key + ;; + + let of_iteri_exn ~iteri ~(comparator : _ Comparator.t) = + match of_iteri ~iteri ~compare_key:comparator.compare with + | `Ok v -> v + | `Duplicate_key key -> + Error.create "Map.of_iteri_exn: duplicate key" key comparator.sexp_of_t + |> Error.raise + ;; + + let t_of_sexp_direct key_of_sexp value_of_sexp sexp ~(comparator : _ Comparator.t) = + let alist = list_of_sexp (pair_of_sexp key_of_sexp value_of_sexp) sexp in + let compare_key = comparator.compare in + match of_alist alist ~compare_key with + | `Ok v -> v + | `Duplicate_key k -> + (* find the sexp of a duplicate key, so the error is narrowed to a key and not + the whole map *) + let alist_sexps = list_of_sexp (pair_of_sexp Fn.id Fn.id) sexp in + let found_first_k = ref false in + List.iter2_ok alist alist_sexps ~f:(fun (k2, _) (k2_sexp, _) -> + if compare_key k k2 = 0 + then + if !found_first_k + then of_sexp_error "Map.t_of_sexp_direct: duplicate key" k2_sexp + else found_first_k := true); + assert false + ;; + + let sexp_of_t sexp_of_key sexp_of_value t = + let f ~key ~data acc = Sexp.List [ sexp_of_key key; sexp_of_value data ] :: acc in + Sexp.List (fold_right ~f t ~init:[]) + ;; + + let combine_errors t ~sexp_of_key = + let oks, errors = partition_map t ~f:Result.to_either in + if is_empty errors + then Ok oks + else Or_error.error_s (sexp_of_t sexp_of_key Error.sexp_of_t errors) + ;; + + let unzip t = map t ~f:fst, map t ~f:snd + + let map_keys + t1 + ~f + ~comparator:({ compare = compare_key; sexp_of_t = sexp_of_key } : _ Comparator.t) + = + with_return (fun { return } -> + `Ok + (fold + t1 + ~init:(with_length_global empty 0) + ~f:(fun ~key ~data { tree = t2; length } -> + let key = f key in + try + add_exn_internal t2 ~length ~key ~data ~compare_key ~sexp_of_key |> globalize + with + | Duplicate -> return (`Duplicate_key key)))) [@nontail] + ;; + + let map_keys_exn t ~f ~comparator = + match map_keys t ~f ~comparator with + | `Ok result -> result + | `Duplicate_key key -> + let sexp_of_key = comparator.Comparator.sexp_of_t in + Error.raise_s + (Sexp.message "Map.map_keys_exn: duplicate key" [ "key", key |> sexp_of_key ]) + ;; + + let transpose_keys ~outer_comparator ~inner_comparator outer_t = + fold + outer_t + ~init:(with_length_global empty 0) + ~f:(fun ~key:outer_key ~data:inner_t acc -> + fold + inner_t + ~init:acc + ~f:(fun ~key:inner_key ~data { tree = acc; length = acc_len } -> + (update + acc + inner_key + ~length:acc_len + ~compare_key:inner_comparator.Comparator.compare + ~f:(function + | None -> with_length_global (singleton outer_key data) 1 + | Some { tree = elt; length = elt_len } -> + (set + elt + ~key:outer_key + ~data + ~length:elt_len + ~compare_key:outer_comparator.Comparator.compare + |> globalize) [@nontail]) + |> globalize) [@nontail])) + ;; + + module Make_applicative_traversals (A : Applicative.Lazy_applicative) = struct + let rec mapi t ~f = + match t with + | Empty -> A.return Empty + | Leaf { key = v; data = d } -> + A.map (f ~key:v ~data:d) ~f:(fun new_data -> Leaf { key = v; data = new_data }) + | Node { left = l; key = v; data = d; right = r; height = h } -> + let l' = A.of_thunk (fun () -> mapi ~f l) in + let d' = f ~key:v ~data:d in + let r' = A.of_thunk (fun () -> mapi ~f r) in + A.map3 l' d' r' ~f:(fun l' d' r' -> + Node { left = l'; key = v; data = d'; right = r'; height = h }) + ;; + + (* In theory the computation of length on-the-fly is not necessary here because it can + be done by wrapping the applicative [A] with length-computing logic. However, + introducing an applicative transformer like that makes the map benchmarks in + async_kernel/bench/src/bench_deferred_map.ml noticeably slower. *) + let filter_mapi t ~f = + let rec tree_filter_mapi t ~f = + match t with + | Empty -> A.return (with_length_global Empty 0) + | Leaf { key = v; data = d } -> + A.map (f ~key:v ~data:d) ~f:(function + | Some new_data -> with_length_global (Leaf { key = v; data = new_data }) 1 + | None -> with_length_global Empty 0) + | Node { left = l; key = v; data = d; right = r; height = _ } -> + A.map3 + (A.of_thunk (fun () -> tree_filter_mapi l ~f)) + (f ~key:v ~data:d) + (A.of_thunk (fun () -> tree_filter_mapi r ~f)) + ~f: + (fun + { tree = l'; length = l_len } new_data { tree = r'; length = r_len } -> + match new_data with + | Some new_data -> + with_length_global (join l' v new_data r') (l_len + r_len + 1) + | None -> + with_length_global (concat_and_balance_unchecked l' r') (l_len + r_len)) + in + tree_filter_mapi t ~f + ;; + end +end + +type ('k, 'v, 'comparator) t = + { (* [comparator] is the first field so that polymorphic equality fails on a map due + to the functional value in the comparator. + Note that this does not affect polymorphic [compare]: that still produces + nonsense. *) + comparator : ('k, 'comparator) Comparator.t + ; tree : ('k, 'v) Tree0.t + ; length : int + } + +type ('k, 'v, 'comparator) tree = ('k, 'v) Tree0.t + +let compare_key t = t.comparator.Comparator.compare + +let like { tree = _; length = _; comparator } ({ tree; length } : _ With_length.t) = + { tree; length; comparator } +;; + +let like_maybe_no_op + ({ tree = old_tree; length = _; comparator } as old_t) + ({ tree; length } : _ With_length.t) + = + if phys_equal old_tree tree then old_t else { tree; length; comparator } +;; + +let with_same_length { tree = _; comparator; length } tree = { tree; comparator; length } +let of_like_tree t tree = { tree; comparator = t.comparator; length = Tree0.length tree } + +let of_like_tree_maybe_no_op t tree = + if phys_equal t.tree tree + then t + else { tree; comparator = t.comparator; length = Tree0.length tree } +;; + +let of_tree ~comparator tree = { tree; comparator; length = Tree0.length tree } + +(* Exposing this function would make it very easy for the invariants + of this module to be broken. *) +let of_tree_unsafe ~comparator ~length tree = { tree; comparator; length } + +module Accessors = struct + let comparator t = t.comparator + let to_tree t = t.tree + + let invariants t = + Tree0.invariants t.tree ~compare_key:(compare_key t) && Tree0.length t.tree = t.length + ;; + + let is_empty t = Tree0.is_empty t.tree + let length t = t.length + + let set t ~key ~data = + like + t + (Tree0.set t.tree ~length:t.length ~key ~data ~compare_key:(compare_key t)) + [@nontail] + ;; + + let add_exn t ~key ~data = + like + t + (Tree0.add_exn + t.tree + ~length:t.length + ~key + ~data + ~compare_key:(compare_key t) + ~sexp_of_key:t.comparator.sexp_of_t) [@nontail] + ;; + + let add_exn_internal t ~key ~data = + like + t + (Tree0.add_exn_internal + t.tree + ~length:t.length + ~key + ~data + ~compare_key:(compare_key t) + ~sexp_of_key:t.comparator.sexp_of_t) [@nontail] + ;; + + let add t ~key ~data = + match add_exn_internal t ~key ~data with + | result -> `Ok result + | exception Duplicate -> `Duplicate + ;; + + let add_multi t ~key ~data = + like + t + (Tree0.add_multi t.tree ~length:t.length ~key ~data ~compare_key:(compare_key t)) + [@nontail] + ;; + + let remove_multi t key = + like + t + (Tree0.remove_multi t.tree ~length:t.length key ~compare_key:(compare_key t)) + [@nontail] + ;; + + let find_multi t key = Tree0.find_multi t.tree key ~compare_key:(compare_key t) + + let change t key ~f = + like + t + (Tree0.change t.tree key ~f ~length:t.length ~compare_key:(compare_key t)) + [@nontail] + ;; + + let update t key ~f = + like + t + (Tree0.update t.tree key ~f ~length:t.length ~compare_key:(compare_key t)) + [@nontail] + ;; + + let find_exn t key = + Tree0.find_exn + t.tree + key + ~compare_key:(compare_key t) + ~sexp_of_key:t.comparator.sexp_of_t + ;; + + let find t key = Tree0.find t.tree key ~compare_key:(compare_key t) + + let remove t key = + like_maybe_no_op + t + (Tree0.remove t.tree key ~length:t.length ~compare_key:(compare_key t)) [@nontail] + ;; + + let mem t key = Tree0.mem t.tree key ~compare_key:(compare_key t) + let iter_keys t ~f = Tree0.iter_keys t.tree ~f + let iter t ~f = Tree0.iter t.tree ~f + let iteri t ~f = Tree0.iteri t.tree ~f + let iteri_until t ~f = Tree0.iteri_until t.tree ~f + let iter2 t1 t2 ~f = Tree0.iter2 t1.tree t2.tree ~f ~compare_key:(compare_key t1) + let map t ~f = with_same_length t (Tree0.map t.tree ~f) + let mapi t ~f = with_same_length t (Tree0.mapi t.tree ~f) + let fold t ~init ~f = Tree0.fold t.tree ~f ~init + let fold_until t ~init ~f ~finish = Tree0.fold_until t.tree ~init ~f ~finish + let fold_right t ~init ~f = Tree0.fold_right t.tree ~f ~init + + let fold2 t1 t2 ~init ~f = + Tree0.fold2 t1.tree t2.tree ~init ~f ~compare_key:(compare_key t1) + ;; + + let filter_keys t ~f = + let len = ref t.length in + let tree = Tree0.filter_keys t.tree ~f ~len in + like_maybe_no_op t (with_length tree !len) [@nontail] + ;; + + let filter t ~f = + let len = ref t.length in + let tree = Tree0.filter t.tree ~f ~len in + like_maybe_no_op t (with_length tree !len) [@nontail] + ;; + + let filteri t ~f = + let len = ref t.length in + let tree = Tree0.filteri t.tree ~f ~len in + like_maybe_no_op t (with_length tree !len) [@nontail] + ;; + + let filter_map t ~f = + let len = ref t.length in + let tree = Tree0.filter_map t.tree ~f ~len in + like t (with_length tree !len) [@nontail] + ;; + + let filter_mapi t ~f = + let len = ref t.length in + let tree = Tree0.filter_mapi t.tree ~f ~len in + like t (with_length tree !len) [@nontail] + ;; + + let of_like_tree2 t (t1, t2) = of_like_tree t t1, of_like_tree t t2 + + let of_like_tree2_maybe_no_op t (t1, t2) = + of_like_tree_maybe_no_op t t1, of_like_tree_maybe_no_op t t2 + ;; + + let partition_mapi t ~f = of_like_tree2 t (Tree0.partition_mapi t.tree ~f) + let partition_map t ~f = of_like_tree2 t (Tree0.partition_map t.tree ~f) + let partitioni_tf t ~f = of_like_tree2_maybe_no_op t (Tree0.partitioni_tf t.tree ~f) + let partition_tf t ~f = of_like_tree2_maybe_no_op t (Tree0.partition_tf t.tree ~f) + + let combine_errors t = + Or_error.map + ~f:(of_like_tree t) + (Tree0.combine_errors t.tree ~sexp_of_key:t.comparator.sexp_of_t) + ;; + + let unzip t = of_like_tree2 t (Tree0.unzip t.tree) + + let compare_direct compare_data t1 t2 = + Tree0.compare (compare_key t1) compare_data t1.tree t2.tree + ;; + + let equal compare_data t1 t2 = Tree0.equal (compare_key t1) compare_data t1.tree t2.tree + let keys t = Tree0.keys t.tree + let data t = Tree0.data t.tree + let to_alist ?key_order t = Tree0.to_alist ?key_order t.tree + + let symmetric_diff t1 t2 ~data_equal = + Tree0.symmetric_diff t1.tree t2.tree ~compare_key:(compare_key t1) ~data_equal + ;; + + let fold_symmetric_diff t1 t2 ~data_equal ~init ~f = + Tree0.fold_symmetric_diff + t1.tree + t2.tree + ~compare_key:(compare_key t1) + ~data_equal + ~init + ~f + ;; + + let merge t1 t2 ~f = + like t1 (Tree0.merge t1.tree t2.tree ~f ~compare_key:(compare_key t1)) [@nontail] + ;; + + let merge_disjoint_exn t1 t2 = + like + t1 + (Tree0.merge_disjoint_exn + t1.tree + t2.tree + ~length1:t1.length + ~length2:t2.length + ~comparator:t1.comparator) [@nontail] + ;; + + let merge_skewed t1 t2 ~combine = + (* This is only a no-op in the case where at least one of the maps is empty. *) + like_maybe_no_op + (if t2.length <= t1.length then t1 else t2) + (Tree0.merge_skewed + t1.tree + t2.tree + ~length1:t1.length + ~length2:t2.length + ~combine + ~compare_key:(compare_key t1)) + ;; + + let min_elt t = Tree0.min_elt t.tree + let min_elt_exn t = Tree0.min_elt_exn t.tree + let max_elt t = Tree0.max_elt t.tree + let max_elt_exn t = Tree0.max_elt_exn t.tree + let for_all t ~f = Tree0.for_all t.tree ~f + let for_alli t ~f = Tree0.for_alli t.tree ~f + let exists t ~f = Tree0.exists t.tree ~f + let existsi t ~f = Tree0.existsi t.tree ~f + let count t ~f = Tree0.count t.tree ~f + let counti t ~f = Tree0.counti t.tree ~f + let sum m t ~f = Tree0.sum m t.tree ~f + let sumi m t ~f = Tree0.sumi m t.tree ~f + + let split t k = + let l, maybe, r = Tree0.split t.tree k ~compare_key:(compare_key t) in + let comparator = comparator t in + (* Try to traverse the least amount possible to calculate the length, + using height as a heuristic. *) + let both_len = if Option.is_some maybe then t.length - 1 else t.length in + if Tree0.height l < Tree0.height r + then ( + let l = of_tree l ~comparator in + l, maybe, of_tree_unsafe r ~comparator ~length:(both_len - length l)) + else ( + let r = of_tree r ~comparator in + of_tree_unsafe l ~comparator ~length:(both_len - length r), maybe, r) + ;; + + let split_and_reinsert_boundary t ~into k = + let l, r = + Tree0.split_and_reinsert_boundary t.tree ~into k ~compare_key:(compare_key t) + in + let comparator = comparator t in + (* Try to traverse the least amount possible to calculate the length, + using height as a heuristic. *) + if Tree0.height l < Tree0.height r + then ( + let l = of_tree l ~comparator in + l, of_tree_unsafe r ~comparator ~length:(t.length - length l)) + else ( + let r = of_tree r ~comparator in + of_tree_unsafe l ~comparator ~length:(t.length - length r), r) + ;; + + let split_le_gt t k = split_and_reinsert_boundary t ~into:`Left k + let split_lt_ge t k = split_and_reinsert_boundary t ~into:`Right k + + let subrange t ~lower_bound ~upper_bound = + let left, mid, right = + Tree0.split_range t.tree ~lower_bound ~upper_bound ~compare_key:(compare_key t) + in + (* Try to traverse the least amount possible to calculate the length, + using height as a heuristic. *) + let outer_joined_height = + let h_l = Tree0.height left + and h_r = Tree0.height right in + if h_l = h_r then h_l + 1 else max h_l h_r + in + if outer_joined_height < Tree0.height mid + then ( + let mid_length = t.length - (Tree0.length left + Tree0.length right) in + of_tree_unsafe mid ~comparator:(comparator t) ~length:mid_length) + else of_tree mid ~comparator:(comparator t) + ;; + + let append ~lower_part ~upper_part = + match + Tree0.append + ~compare_key:(compare_key lower_part) + ~lower_part:lower_part.tree + ~upper_part:upper_part.tree + with + | `Ok tree -> + `Ok + (of_tree_unsafe + tree + ~comparator:(comparator lower_part) + ~length:(lower_part.length + upper_part.length)) + | `Overlapping_key_ranges -> `Overlapping_key_ranges + ;; + + let fold_range_inclusive t ~min ~max ~init ~f = + Tree0.fold_range_inclusive t.tree ~min ~max ~init ~f ~compare_key:(compare_key t) + ;; + + let range_to_alist t ~min ~max = + Tree0.range_to_alist t.tree ~min ~max ~compare_key:(compare_key t) + ;; + + let closest_key t dir key = + Tree0.closest_key t.tree dir key ~compare_key:(compare_key t) + ;; + + let nth t n = Tree0.nth t.tree n + let nth_exn t n = Option.value_exn (nth t n) + let rank t key = Tree0.rank t.tree key ~compare_key:(compare_key t) + let sexp_of_t sexp_of_k sexp_of_v _ t = Tree0.sexp_of_t sexp_of_k sexp_of_v t.tree + + let to_sequence ?order ?keys_greater_or_equal_to ?keys_less_or_equal_to t = + Tree0.to_sequence + t.comparator + ?order + ?keys_greater_or_equal_to + ?keys_less_or_equal_to + t.tree + ;; + + let binary_search t ~compare how v = Tree0.binary_search t.tree ~compare how v + + let binary_search_segmented t ~segment_of how = + Tree0.binary_search_segmented t.tree ~segment_of how + ;; + + let hash_fold_direct hash_fold_key hash_fold_data state t = + Tree0.hash_fold_t_ignoring_structure hash_fold_key hash_fold_data state t.tree + ;; + + let binary_search_subrange t ~compare ~lower_bound ~upper_bound = + match + Tree0.binary_search_two_sided_bounds t.tree ~compare ~lower_bound ~upper_bound + with + | Some (lower_bound, upper_bound) -> subrange t ~lower_bound ~upper_bound + | None -> like_maybe_no_op t (with_length Tree0.Empty 0) [@nontail] + ;; + + module Make_applicative_traversals (A : Applicative.Lazy_applicative) = struct + module Tree_traversals = Tree0.Make_applicative_traversals (A) + + let mapi t ~f = + A.map (Tree_traversals.mapi t.tree ~f) ~f:(fun new_tree -> + with_same_length t new_tree) + ;; + + let filter_mapi t ~f = + A.map (Tree_traversals.filter_mapi t.tree ~f) ~f:(fun new_tree_with_length -> + like t new_tree_with_length) + ;; + end +end + +(* [0] is used as the [length] argument everywhere in this module, since trees do not + have their lengths stored at the root, unlike maps. The values are discarded always. *) +module Tree = struct + type ('k, 'v, 'comparator) t = ('k, 'v, 'comparator) tree + + let empty_without_value_restriction = Tree0.empty + let empty ~comparator:_ = empty_without_value_restriction + let of_tree ~comparator:_ tree = tree + let singleton ~comparator:_ k v = Tree0.singleton k v + + let of_sorted_array_unchecked ~comparator array = + (Tree0.of_sorted_array_unchecked array ~compare_key:comparator.Comparator.compare) + .tree + ;; + + let of_sorted_array ~comparator array = + Tree0.of_sorted_array array ~compare_key:comparator.Comparator.compare + |> Or_error.map ~f:(fun (x : ('k, 'v) Tree0.t With_length.t) -> x.tree) + ;; + + let of_alist ~comparator alist = + match Tree0.of_alist alist ~compare_key:comparator.Comparator.compare with + | `Duplicate_key _ as d -> d + | `Ok { tree; length = _ } -> `Ok tree + ;; + + let of_alist_or_error ~comparator alist = + Tree0.of_alist_or_error alist ~comparator + |> Or_error.map ~f:(fun (x : ('k, 'v) Tree0.t With_length.t) -> x.tree) + ;; + + let of_alist_exn ~comparator alist = (Tree0.of_alist_exn alist ~comparator).tree + + let of_alist_multi ~comparator alist = + (Tree0.of_alist_multi alist ~compare_key:comparator.Comparator.compare).tree + ;; + + let of_alist_fold ~comparator alist ~init ~f = + (Tree0.of_alist_fold alist ~init ~f ~compare_key:comparator.Comparator.compare).tree + ;; + + let of_alist_reduce ~comparator alist ~f = + (Tree0.of_alist_reduce alist ~f ~compare_key:comparator.Comparator.compare).tree + ;; + + let of_iteri ~comparator ~iteri = + match Tree0.of_iteri ~iteri ~compare_key:comparator.Comparator.compare with + | `Ok { tree; length = _ } -> `Ok tree + | `Duplicate_key _ as d -> d + ;; + + let of_iteri_exn ~comparator ~iteri = (Tree0.of_iteri_exn ~iteri ~comparator).tree + + let of_increasing_iterator_unchecked ~comparator:_required_by_intf ~len ~f = + Tree0.of_increasing_iterator_unchecked ~len ~f + ;; + + let of_increasing_sequence ~comparator seq = + Or_error.map + ~f:(fun (x : ('k, 'v) Tree0.t With_length.t) -> x.tree) + (Tree0.of_increasing_sequence seq ~compare_key:comparator.Comparator.compare) + ;; + + let of_sequence ~comparator seq = + match Tree0.of_sequence seq ~compare_key:comparator.Comparator.compare with + | `Duplicate_key _ as d -> d + | `Ok { tree; length = _ } -> `Ok tree + ;; + + let of_sequence_or_error ~comparator seq = + Tree0.of_sequence_or_error seq ~comparator + |> Or_error.map ~f:(fun (x : ('k, 'v) Tree0.t With_length.t) -> x.tree) + ;; + + let of_sequence_exn ~comparator seq = (Tree0.of_sequence_exn seq ~comparator).tree + + let of_sequence_multi ~comparator seq = + (Tree0.of_sequence_multi seq ~compare_key:comparator.Comparator.compare).tree + ;; + + let of_sequence_fold ~comparator seq ~init ~f = + (Tree0.of_sequence_fold seq ~init ~f ~compare_key:comparator.Comparator.compare).tree + ;; + + let of_sequence_reduce ~comparator seq ~f = + (Tree0.of_sequence_reduce seq ~f ~compare_key:comparator.Comparator.compare).tree + ;; + + let of_list_with_key ~comparator list ~get_key = + match + Tree0.of_list_with_key list ~get_key ~compare_key:comparator.Comparator.compare + with + | `Duplicate_key _ as d -> d + | `Ok { tree; length = _ } -> `Ok tree + ;; + + let of_list_with_key_or_error ~comparator list ~get_key = + Tree0.of_list_with_key_or_error list ~get_key ~comparator + |> Or_error.map ~f:(fun (x : ('k, 'v) Tree0.t With_length.t) -> x.tree) + ;; + + let of_list_with_key_exn ~comparator list ~get_key = + (Tree0.of_list_with_key_exn list ~get_key ~comparator).tree + ;; + + let of_list_with_key_multi ~comparator list ~get_key = + (Tree0.of_list_with_key_multi + list + ~get_key + ~compare_key:comparator.Comparator.compare) + .tree + ;; + + let of_list_with_key_fold ~comparator list ~get_key ~init ~f = + (Tree0.of_list_with_key_fold + list + ~get_key + ~init + ~f + ~compare_key:comparator.Comparator.compare) + .tree + ;; + + let of_list_with_key_reduce ~comparator list ~get_key ~f = + (Tree0.of_list_with_key_reduce + list + ~get_key + ~f + ~compare_key:comparator.Comparator.compare) + .tree + ;; + + let to_tree t = t + + let invariants ~comparator t = + Tree0.invariants t ~compare_key:comparator.Comparator.compare + ;; + + let is_empty t = Tree0.is_empty t + let length t = Tree0.length t + + let set ~comparator t ~key ~data = + (Tree0.set t ~key ~data ~length:0 ~compare_key:comparator.Comparator.compare).tree + ;; + + let add_exn ~comparator t ~key ~data = + (Tree0.add_exn + t + ~key + ~data + ~length:0 + ~compare_key:comparator.Comparator.compare + ~sexp_of_key:comparator.sexp_of_t) + .tree + ;; + + let add_exn_internal ~comparator t ~key ~data = + (Tree0.add_exn_internal + t + ~key + ~data + ~length:0 + ~compare_key:comparator.Comparator.compare + ~sexp_of_key:comparator.sexp_of_t) + .tree + ;; + + let add ~comparator t ~key ~data = + try `Ok (add_exn_internal t ~comparator ~key ~data) with + | _ -> `Duplicate + ;; + + let add_multi ~comparator t ~key ~data = + (Tree0.add_multi t ~key ~data ~length:0 ~compare_key:comparator.Comparator.compare) + .tree + ;; + + let remove_multi ~comparator t key = + (Tree0.remove_multi t key ~length:0 ~compare_key:comparator.Comparator.compare).tree + ;; + + let find_multi ~comparator t key = + Tree0.find_multi t key ~compare_key:comparator.Comparator.compare + ;; + + let change ~comparator t key ~f = + (Tree0.change t key ~f ~length:0 ~compare_key:comparator.Comparator.compare).tree + ;; + + let update ~comparator t key ~f = + change ~comparator t key ~f:(fun data -> Some (f data)) [@nontail] + ;; + + let find_exn ~comparator t key = + Tree0.find_exn + t + key + ~compare_key:comparator.Comparator.compare + ~sexp_of_key:comparator.Comparator.sexp_of_t + ;; + + let find ~comparator t key = Tree0.find t key ~compare_key:comparator.Comparator.compare + + let remove ~comparator t key = + (Tree0.remove t key ~length:0 ~compare_key:comparator.Comparator.compare).tree + ;; + + let mem ~comparator t key = Tree0.mem t key ~compare_key:comparator.Comparator.compare + let iter_keys t ~f = Tree0.iter_keys t ~f + let iter t ~f = Tree0.iter t ~f + let iteri t ~f = Tree0.iteri t ~f + let iteri_until t ~f = Tree0.iteri_until t ~f + + let iter2 ~comparator t1 t2 ~f = + Tree0.iter2 t1 t2 ~f ~compare_key:comparator.Comparator.compare + ;; + + let map t ~f = Tree0.map t ~f + let mapi t ~f = Tree0.mapi t ~f + let fold t ~init ~f = Tree0.fold t ~f ~init + let fold_until t ~init ~f ~finish = Tree0.fold_until t ~f ~init ~finish + let fold_right t ~init ~f = Tree0.fold_right t ~f ~init + + let fold2 ~comparator t1 t2 ~init ~f = + Tree0.fold2 t1 t2 ~init ~f ~compare_key:comparator.Comparator.compare + ;; + + let filter_keys t ~f = Tree0.filter_keys t ~f ~len:(ref 0) [@nontail] + let filter t ~f = Tree0.filter t ~f ~len:(ref 0) [@nontail] + let filteri t ~f = Tree0.filteri t ~f ~len:(ref 0) [@nontail] + let filter_map t ~f = Tree0.filter_map t ~f ~len:(ref 0) [@nontail] + let filter_mapi t ~f = Tree0.filter_mapi t ~f ~len:(ref 0) [@nontail] + let partition_mapi t ~f = Tree0.partition_mapi t ~f + let partition_map t ~f = Tree0.partition_map t ~f + let partitioni_tf t ~f = Tree0.partitioni_tf t ~f + let partition_tf t ~f = Tree0.partition_tf t ~f + + let combine_errors ~comparator t = + Tree0.combine_errors t ~sexp_of_key:comparator.Comparator.sexp_of_t + ;; + + let unzip = Tree0.unzip + + let compare_direct ~comparator compare_data t1 t2 = + Tree0.compare comparator.Comparator.compare compare_data t1 t2 + ;; + + let equal ~comparator compare_data t1 t2 = + Tree0.equal comparator.Comparator.compare compare_data t1 t2 + ;; + + let keys t = Tree0.keys t + let data t = Tree0.data t + let to_alist ?key_order t = Tree0.to_alist ?key_order t + + let symmetric_diff ~comparator t1 t2 ~data_equal = + Tree0.symmetric_diff t1 t2 ~compare_key:comparator.Comparator.compare ~data_equal + ;; + + let fold_symmetric_diff ~comparator t1 t2 ~data_equal ~init ~f = + Tree0.fold_symmetric_diff + t1 + t2 + ~compare_key:comparator.Comparator.compare + ~data_equal + ~init + ~f + ;; + + let merge ~comparator t1 t2 ~f = + (Tree0.merge t1 t2 ~f ~compare_key:comparator.Comparator.compare).tree + ;; + + let merge_disjoint_exn ~comparator t1 t2 = + (Tree0.merge_disjoint_exn t1 t2 ~length1:(length t1) ~length2:(length t2) ~comparator) + .tree + ;; + + let merge_skewed ~comparator t1 t2 ~combine = + (* Length computation makes this significantly slower than [merge_skewed] on a map + with a [length] field, but does preserve amount of allocation. *) + (Tree0.merge_skewed + t1 + t2 + ~length1:(length t1) + ~length2:(length t2) + ~combine + ~compare_key:comparator.Comparator.compare) + .tree + ;; + + let min_elt t = Tree0.min_elt t + let min_elt_exn t = Tree0.min_elt_exn t + let max_elt t = Tree0.max_elt t + let max_elt_exn t = Tree0.max_elt_exn t + let for_all t ~f = Tree0.for_all t ~f + let for_alli t ~f = Tree0.for_alli t ~f + let exists t ~f = Tree0.exists t ~f + let existsi t ~f = Tree0.existsi t ~f + let count t ~f = Tree0.count t ~f + let counti t ~f = Tree0.counti t ~f + let sum m t ~f = Tree0.sum m t ~f + let sumi m t ~f = Tree0.sumi m t ~f + let split ~comparator t k = Tree0.split t k ~compare_key:comparator.Comparator.compare + + let split_le_gt ~comparator t k = + Tree0.split_and_reinsert_boundary + t + ~into:`Left + k + ~compare_key:comparator.Comparator.compare + ;; + + let split_lt_ge ~comparator t k = + Tree0.split_and_reinsert_boundary + t + ~into:`Right + k + ~compare_key:comparator.Comparator.compare + ;; + + let append ~comparator ~lower_part ~upper_part = + Tree0.append ~lower_part ~upper_part ~compare_key:comparator.Comparator.compare + ;; + + let subrange ~comparator t ~lower_bound ~upper_bound = + let _, ret, _ = + Tree0.split_range + t + ~lower_bound + ~upper_bound + ~compare_key:comparator.Comparator.compare + in + ret + ;; + + let fold_range_inclusive ~comparator t ~min ~max ~init ~f = + Tree0.fold_range_inclusive + t + ~min + ~max + ~init + ~f + ~compare_key:comparator.Comparator.compare + ;; + + let range_to_alist ~comparator t ~min ~max = + Tree0.range_to_alist t ~min ~max ~compare_key:comparator.Comparator.compare + ;; + + let closest_key ~comparator t dir key = + Tree0.closest_key t dir key ~compare_key:comparator.Comparator.compare + ;; + + let nth t n = Tree0.nth t n + let nth_exn t n = Option.value_exn (nth t n) + let rank ~comparator t key = Tree0.rank t key ~compare_key:comparator.Comparator.compare + let sexp_of_t sexp_of_k sexp_of_v _ t = Tree0.sexp_of_t sexp_of_k sexp_of_v t + + let t_of_sexp_direct ~comparator k_of_sexp v_of_sexp sexp = + (Tree0.t_of_sexp_direct k_of_sexp v_of_sexp sexp ~comparator).tree + ;; + + let to_sequence ~comparator ?order ?keys_greater_or_equal_to ?keys_less_or_equal_to t = + Tree0.to_sequence comparator ?order ?keys_greater_or_equal_to ?keys_less_or_equal_to t + ;; + + let binary_search ~comparator:_ t ~compare how v = Tree0.binary_search t ~compare how v + + let binary_search_segmented ~comparator:_ t ~segment_of how = + Tree0.binary_search_segmented t ~segment_of how + ;; + + let binary_search_subrange ~comparator t ~compare ~lower_bound ~upper_bound = + match Tree0.binary_search_two_sided_bounds t ~compare ~lower_bound ~upper_bound with + | Some (lower_bound, upper_bound) -> subrange ~comparator t ~lower_bound ~upper_bound + | None -> Empty + ;; + + module Make_applicative_traversals (A : Applicative.Lazy_applicative) = struct + module Tree0_traversals = Tree0.Make_applicative_traversals (A) + + let mapi t ~f = Tree0_traversals.mapi t ~f + + let filter_mapi t ~f = + A.map + (Tree0_traversals.filter_mapi t ~f) + ~f:(fun (x : ('k, 'v) Tree0.t With_length.t) -> x.tree) + ;; + end + + let map_keys ~comparator t ~f = + match Tree0.map_keys ~comparator t ~f with + | `Ok { tree = t; length = _ } -> `Ok t + | `Duplicate_key _ as dup -> dup + ;; + + let map_keys_exn ~comparator t ~f = (Tree0.map_keys_exn ~comparator t ~f).tree + + (* This calling convention of [~comparator ~comparator] is confusing. It is required + because [access_options] and [create_options] both demand a [~comparator] argument in + [Map.Using_comparator.Tree]. + + Making it less confusing would require some unnecessary complexity in signatures. + Better to just live with an undesirable interface in a function that will probably + never be called directly. *) + let transpose_keys ~comparator:outer_comparator ~comparator:inner_comparator t = + (Tree0.transpose_keys ~outer_comparator ~inner_comparator t).tree + |> map ~f:(fun (x : ('k, 'v) Tree0.t With_length.t) -> x.tree) + ;; + + module Build_increasing = struct + type ('k, 'v, 'w) t = ('k, 'v) Tree0.Build_increasing.t + + let empty = Tree0.Build_increasing.empty + + let add_exn t ~comparator ~key ~data = + match Tree0.Build_increasing.max_key t with + | Some prev_key when comparator.Comparator.compare prev_key key >= 0 -> + Error.raise_s (Sexp.Atom "Map.Build_increasing.add: non-increasing key") + | _ -> Tree0.Build_increasing.add_unchecked t ~key ~data + ;; + + let to_tree t = Tree0.Build_increasing.to_tree_unchecked t + end +end + +module Using_comparator = struct + type nonrec ('k, 'v, 'cmp) t = ('k, 'v, 'cmp) t + + include Accessors + + let empty ~comparator = { tree = Tree0.empty; comparator; length = 0 } + let singleton ~comparator k v = { comparator; tree = Tree0.singleton k v; length = 1 } + + let of_tree0 ~comparator ({ tree; length } : _ With_length.t) = + { comparator; tree; length } + ;; + + let of_tree ~comparator tree = + of_tree0 ~comparator (with_length tree (Tree0.length tree)) [@nontail] + ;; + + let to_tree = to_tree + + let of_sorted_array_unchecked ~comparator array = + of_tree0 + ~comparator + (Tree0.of_sorted_array_unchecked array ~compare_key:comparator.Comparator.compare) + [@nontail] + ;; + + let of_sorted_array ~comparator array = + Or_error.map + (Tree0.of_sorted_array array ~compare_key:comparator.Comparator.compare) + ~f:(fun tree -> of_tree0 ~comparator tree) + ;; + + let of_alist ~comparator alist = + match Tree0.of_alist alist ~compare_key:comparator.Comparator.compare with + | `Ok { tree; length } -> `Ok { comparator; tree; length } + | `Duplicate_key _ as z -> z + ;; + + let of_alist_or_error ~comparator alist = + Result.map (Tree0.of_alist_or_error alist ~comparator) ~f:(fun tree -> + of_tree0 ~comparator tree) + ;; + + let of_alist_exn ~comparator alist = + of_tree0 ~comparator (Tree0.of_alist_exn alist ~comparator) + ;; + + let of_alist_multi ~comparator alist = + of_tree0 + ~comparator + (Tree0.of_alist_multi alist ~compare_key:comparator.Comparator.compare) + ;; + + let of_alist_fold ~comparator alist ~init ~f = + of_tree0 + ~comparator + (Tree0.of_alist_fold alist ~init ~f ~compare_key:comparator.Comparator.compare) + ;; + + let of_alist_reduce ~comparator alist ~f = + of_tree0 + ~comparator + (Tree0.of_alist_reduce alist ~f ~compare_key:comparator.Comparator.compare) + ;; + + let of_iteri ~comparator ~iteri = + match Tree0.of_iteri ~compare_key:comparator.Comparator.compare ~iteri with + | `Ok tree_length -> `Ok (of_tree0 ~comparator tree_length) + | `Duplicate_key _ as z -> z + ;; + + let of_iteri_exn ~comparator ~iteri = + of_tree0 ~comparator (Tree0.of_iteri_exn ~comparator ~iteri) + ;; + + let of_increasing_iterator_unchecked ~comparator ~len ~f = + of_tree0 + ~comparator + (with_length (Tree0.of_increasing_iterator_unchecked ~len ~f) len) [@nontail] + ;; + + let of_increasing_sequence ~comparator seq = + Or_error.map + ~f:(fun x -> of_tree0 ~comparator x) + (Tree0.of_increasing_sequence seq ~compare_key:comparator.Comparator.compare) + ;; + + let of_sequence ~comparator seq = + match Tree0.of_sequence seq ~compare_key:comparator.Comparator.compare with + | `Ok { tree; length } -> `Ok { comparator; tree; length } + | `Duplicate_key _ as z -> z + ;; + + let of_sequence_or_error ~comparator seq = + Result.map (Tree0.of_sequence_or_error seq ~comparator) ~f:(fun tree -> + of_tree0 ~comparator tree) + ;; + + let of_sequence_exn ~comparator seq = + of_tree0 ~comparator (Tree0.of_sequence_exn seq ~comparator) + ;; + + let of_sequence_multi ~comparator seq = + of_tree0 + ~comparator + (Tree0.of_sequence_multi seq ~compare_key:comparator.Comparator.compare) + ;; + + let of_sequence_fold ~comparator seq ~init ~f = + of_tree0 + ~comparator + (Tree0.of_sequence_fold seq ~init ~f ~compare_key:comparator.Comparator.compare) + ;; + + let of_sequence_reduce ~comparator seq ~f = + of_tree0 + ~comparator + (Tree0.of_sequence_reduce seq ~f ~compare_key:comparator.Comparator.compare) + ;; + + let of_list_with_key ~comparator list ~get_key = + match + Tree0.of_list_with_key list ~get_key ~compare_key:comparator.Comparator.compare + with + | `Ok { tree; length } -> `Ok { comparator; tree; length } + | `Duplicate_key _ as z -> z + ;; + + let of_list_with_key_or_error ~comparator list ~get_key = + Result.map (Tree0.of_list_with_key_or_error list ~get_key ~comparator) ~f:(fun tree -> + of_tree0 ~comparator tree) + ;; + + let of_list_with_key_exn ~comparator list ~get_key = + of_tree0 ~comparator (Tree0.of_list_with_key_exn list ~get_key ~comparator) + ;; + + let of_list_with_key_multi ~comparator list ~get_key = + Tree0.of_list_with_key_multi list ~get_key ~compare_key:comparator.Comparator.compare + |> of_tree0 ~comparator + ;; + + let of_list_with_key_fold ~comparator list ~get_key ~init ~f = + Tree0.of_list_with_key_fold + list + ~get_key + ~init + ~f + ~compare_key:comparator.Comparator.compare + |> of_tree0 ~comparator + ;; + + let of_list_with_key_reduce ~comparator list ~get_key ~f = + Tree0.of_list_with_key_reduce + list + ~get_key + ~f + ~compare_key:comparator.Comparator.compare + |> of_tree0 ~comparator + ;; + + let t_of_sexp_direct ~comparator k_of_sexp v_of_sexp sexp = + of_tree0 ~comparator (Tree0.t_of_sexp_direct k_of_sexp v_of_sexp sexp ~comparator) + ;; + + let map_keys ~comparator t ~f = + match Tree0.map_keys t.tree ~f ~comparator with + | `Ok pair -> `Ok (of_tree0 ~comparator pair) + | `Duplicate_key _ as dup -> dup + ;; + + let map_keys_exn ~comparator t ~f = + of_tree0 ~comparator (Tree0.map_keys_exn t.tree ~f ~comparator) + ;; + + let transpose_keys ~comparator:inner_comparator t = + let outer_comparator = t.comparator in + Tree0.transpose_keys ~outer_comparator ~inner_comparator (Tree0.map t.tree ~f:to_tree) + |> of_tree0 ~comparator:inner_comparator + |> map ~f:(fun x -> of_tree0 ~comparator:outer_comparator x) + ;; + + module Empty_without_value_restriction (K : Comparator.S1) = struct + let empty = { tree = Tree0.empty; comparator = K.comparator; length = 0 } + end + + module Tree = Tree +end + +include Accessors + +let comparator_s t = Comparator.to_module t.comparator +let to_comparator = Comparator.of_module +let of_tree m tree = of_tree ~comparator:(to_comparator m) tree +let empty m = Using_comparator.empty ~comparator:(to_comparator m) +let singleton m a = Using_comparator.singleton ~comparator:(to_comparator m) a +let of_alist m a = Using_comparator.of_alist ~comparator:(to_comparator m) a + +let of_alist_or_error m a = + Using_comparator.of_alist_or_error ~comparator:(to_comparator m) a +;; + +let of_alist_exn m a = Using_comparator.of_alist_exn ~comparator:(to_comparator m) a +let of_alist_multi m a = Using_comparator.of_alist_multi ~comparator:(to_comparator m) a + +let of_alist_fold m a ~init ~f = + Using_comparator.of_alist_fold ~comparator:(to_comparator m) a ~init ~f +;; + +let of_alist_reduce m a ~f = + Using_comparator.of_alist_reduce ~comparator:(to_comparator m) a ~f +;; + +let of_sorted_array_unchecked m a = + Using_comparator.of_sorted_array_unchecked ~comparator:(to_comparator m) a +;; + +let of_sorted_array m a = Using_comparator.of_sorted_array ~comparator:(to_comparator m) a +let of_iteri m ~iteri = Using_comparator.of_iteri ~iteri ~comparator:(to_comparator m) + +let of_iteri_exn m ~iteri = + Using_comparator.of_iteri_exn ~iteri ~comparator:(to_comparator m) +;; + +let of_increasing_iterator_unchecked m ~len ~f = + Using_comparator.of_increasing_iterator_unchecked ~len ~f ~comparator:(to_comparator m) +;; + +let of_increasing_sequence m seq = + Using_comparator.of_increasing_sequence ~comparator:(to_comparator m) seq +;; + +let of_sequence m s = Using_comparator.of_sequence ~comparator:(to_comparator m) s + +let of_sequence_or_error m s = + Using_comparator.of_sequence_or_error ~comparator:(to_comparator m) s +;; + +let of_sequence_exn m s = Using_comparator.of_sequence_exn ~comparator:(to_comparator m) s + +let of_sequence_multi m s = + Using_comparator.of_sequence_multi ~comparator:(to_comparator m) s +;; + +let of_sequence_fold m s ~init ~f = + Using_comparator.of_sequence_fold ~comparator:(to_comparator m) s ~init ~f +;; + +let of_sequence_reduce m s ~f = + Using_comparator.of_sequence_reduce ~comparator:(to_comparator m) s ~f +;; + +let of_list_with_key m l ~get_key = + Using_comparator.of_list_with_key ~comparator:(to_comparator m) l ~get_key +;; + +let of_list_with_key_or_error m l ~get_key = + Using_comparator.of_list_with_key_or_error ~comparator:(to_comparator m) l ~get_key +;; + +let of_list_with_key_exn m l ~get_key = + Using_comparator.of_list_with_key_exn ~comparator:(to_comparator m) l ~get_key +;; + +let of_list_with_key_multi m l ~get_key = + Using_comparator.of_list_with_key_multi ~comparator:(to_comparator m) l ~get_key +;; + +let of_list_with_key_fold m l ~get_key ~init ~f = + Using_comparator.of_list_with_key_fold ~comparator:(to_comparator m) l ~get_key ~init ~f +;; + +let of_list_with_key_reduce m l ~get_key ~f = + Using_comparator.of_list_with_key_reduce ~comparator:(to_comparator m) l ~get_key ~f +;; + +let map_keys m t ~f = Using_comparator.map_keys ~comparator:(to_comparator m) t ~f +let map_keys_exn m t ~f = Using_comparator.map_keys_exn ~comparator:(to_comparator m) t ~f +let transpose_keys m t = Using_comparator.transpose_keys ~comparator:(to_comparator m) t + +module M (K : sig + type t + type comparator_witness +end) = +struct + type nonrec 'v t = (K.t, 'v, K.comparator_witness) t +end + +module type Sexp_of_m = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end + +module type M_of_sexp = sig + type t [@@deriving_inline of_sexp] + + val t_of_sexp : Sexplib0.Sexp.t -> t + + [@@@end] + + include Comparator.S with type t := t +end + +module type M_sexp_grammar = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] +end + +module type Compare_m = sig end +module type Equal_m = sig end +module type Hash_fold_m = Hasher.S + +let sexp_of_m__t (type k) (module K : Sexp_of_m with type t = k) sexp_of_v t = + sexp_of_t K.sexp_of_t sexp_of_v (fun _ -> Sexp.Atom "_") t +;; + +let m__t_of_sexp + (type k cmp) + (module K : M_of_sexp with type t = k and type comparator_witness = cmp) + v_of_sexp + sexp + = + Using_comparator.t_of_sexp_direct ~comparator:K.comparator K.t_of_sexp v_of_sexp sexp +;; + +let m__t_sexp_grammar + (type k) + (module K : M_sexp_grammar with type t = k) + (v_grammar : _ Sexplib0.Sexp_grammar.t) + : _ Sexplib0.Sexp_grammar.t + = + { untyped = + Tagged + { key = Sexplib0.Sexp_grammar.assoc_tag + ; value = List [] + ; grammar = + List + (Many + (List + (Cons + ( Tagged + { key = Sexplib0.Sexp_grammar.assoc_key_tag + ; value = List [] + ; grammar = K.t_sexp_grammar.untyped + } + , Cons + ( Tagged + { key = Sexplib0.Sexp_grammar.assoc_value_tag + ; value = List [] + ; grammar = v_grammar.untyped + } + , Empty ) )))) + } + } +;; + +let compare_m__t (module _ : Compare_m) compare_v t1 t2 = compare_direct compare_v t1 t2 +let equal_m__t (module _ : Equal_m) equal_v t1 t2 = equal equal_v t1 t2 + +let hash_fold_m__t (type k) (module K : Hash_fold_m with type t = k) hash_fold_v state = + hash_fold_direct K.hash_fold_t hash_fold_v state +;; + +module Poly = struct + type nonrec ('k, 'v) t = ('k, 'v, Comparator.Poly.comparator_witness) t + type nonrec ('k, 'v) tree = ('k, 'v) Tree0.t + type comparator_witness = Comparator.Poly.comparator_witness + + include Accessors + + let comparator = Comparator.Poly.comparator + let of_tree tree = { tree; comparator; length = Tree0.length tree } + + include Using_comparator.Empty_without_value_restriction (Comparator.Poly) + + let singleton a = Using_comparator.singleton ~comparator a + let of_alist a = Using_comparator.of_alist ~comparator a + let of_alist_or_error a = Using_comparator.of_alist_or_error ~comparator a + let of_alist_exn a = Using_comparator.of_alist_exn ~comparator a + let of_alist_multi a = Using_comparator.of_alist_multi ~comparator a + let of_alist_fold a ~init ~f = Using_comparator.of_alist_fold ~comparator a ~init ~f + let of_alist_reduce a ~f = Using_comparator.of_alist_reduce ~comparator a ~f + + let of_sorted_array_unchecked a = + Using_comparator.of_sorted_array_unchecked ~comparator a + ;; + + let of_sorted_array a = Using_comparator.of_sorted_array ~comparator a + let of_iteri ~iteri = Using_comparator.of_iteri ~iteri ~comparator + let of_iteri_exn ~iteri = Using_comparator.of_iteri_exn ~iteri ~comparator + + let of_increasing_iterator_unchecked ~len ~f = + Using_comparator.of_increasing_iterator_unchecked ~len ~f ~comparator + ;; + + let of_increasing_sequence seq = Using_comparator.of_increasing_sequence ~comparator seq + let of_sequence s = Using_comparator.of_sequence ~comparator s + let of_sequence_or_error s = Using_comparator.of_sequence_or_error ~comparator s + let of_sequence_exn s = Using_comparator.of_sequence_exn ~comparator s + let of_sequence_multi s = Using_comparator.of_sequence_multi ~comparator s + + let of_sequence_fold s ~init ~f = + Using_comparator.of_sequence_fold ~comparator s ~init ~f + ;; + + let of_sequence_reduce s ~f = Using_comparator.of_sequence_reduce ~comparator s ~f + + let of_list_with_key l ~get_key = + Using_comparator.of_list_with_key ~comparator l ~get_key + ;; + + let of_list_with_key_or_error l ~get_key = + Using_comparator.of_list_with_key_or_error ~comparator l ~get_key + ;; + + let of_list_with_key_exn l ~get_key = + Using_comparator.of_list_with_key_exn ~comparator l ~get_key + ;; + + let of_list_with_key_multi l ~get_key = + Using_comparator.of_list_with_key_multi ~comparator l ~get_key + ;; + + let of_list_with_key_fold l ~get_key ~init ~f = + Using_comparator.of_list_with_key_fold ~comparator l ~get_key ~init ~f + ;; + + let of_list_with_key_reduce l ~get_key ~f = + Using_comparator.of_list_with_key_reduce ~comparator l ~get_key ~f + ;; + + let map_keys t ~f = Using_comparator.map_keys ~comparator t ~f + let map_keys_exn t ~f = Using_comparator.map_keys_exn ~comparator t ~f + let transpose_keys t = Using_comparator.transpose_keys ~comparator t +end diff --git a/unikernel/duniverse/base/src/map.mli b/unikernel/duniverse/base/src/map.mli new file mode 100644 index 00000000..2bee42d1 --- /dev/null +++ b/unikernel/duniverse/base/src/map.mli @@ -0,0 +1 @@ +include Map_intf.Map (** @inline *) diff --git a/unikernel/duniverse/base/src/map_intf.ml b/unikernel/duniverse/base/src/map_intf.ml new file mode 100644 index 00000000..761ae7a8 --- /dev/null +++ b/unikernel/duniverse/base/src/map_intf.ml @@ -0,0 +1,2033 @@ +open! Import +open! T + +module Or_duplicate = struct + type 'a t = + [ `Ok of 'a + | `Duplicate + ] + [@@deriving_inline compare, equal, sexp_of] + + let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = + fun _cmp__a a__001_ b__002_ -> + if Stdlib.( == ) a__001_ b__002_ + then 0 + else ( + match a__001_, b__002_ with + | `Ok _left__003_, `Ok _right__004_ -> _cmp__a _left__003_ _right__004_ + | `Duplicate, `Duplicate -> 0 + | x, y -> Stdlib.compare x y) + ;; + + let equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = + fun _cmp__a a__005_ b__006_ -> + if Stdlib.( == ) a__005_ b__006_ + then true + else ( + match a__005_, b__006_ with + | `Ok _left__007_, `Ok _right__008_ -> _cmp__a _left__007_ _right__008_ + | `Duplicate, `Duplicate -> true + | x, y -> Stdlib.( = ) x y) + ;; + + let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + fun _of_a__009_ -> function + | `Ok v__010_ -> Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; _of_a__009_ v__010_ ] + | `Duplicate -> Sexplib0.Sexp.Atom "Duplicate" + ;; + + [@@@end] +end + +module Without_comparator = struct + type ('key, 'cmp, 'z) t = 'z +end + +module With_comparator = struct + type ('key, 'cmp, 'z) t = comparator:('key, 'cmp) Comparator.t -> 'z +end + +module With_first_class_module = struct + type ('key, 'cmp, 'z) t = ('key, 'cmp) Comparator.Module.t -> 'z +end + +module Symmetric_diff_element = struct + type ('k, 'v) t = 'k * [ `Left of 'v | `Right of 'v | `Unequal of 'v * 'v ] + [@@deriving_inline compare, equal, sexp, sexp_grammar] + + let compare : + 'k 'v. ('k -> 'k -> int) -> ('v -> 'v -> int) -> ('k, 'v) t -> ('k, 'v) t -> int + = + fun _cmp__k _cmp__v a__011_ b__012_ -> + let t__013_, t__014_ = a__011_ in + let t__015_, t__016_ = b__012_ in + match _cmp__k t__013_ t__015_ with + | 0 -> + if Stdlib.( == ) t__014_ t__016_ + then 0 + else ( + match t__014_, t__016_ with + | `Left _left__017_, `Left _right__018_ -> _cmp__v _left__017_ _right__018_ + | `Right _left__019_, `Right _right__020_ -> _cmp__v _left__019_ _right__020_ + | `Unequal _left__021_, `Unequal _right__022_ -> + let t__023_, t__024_ = _left__021_ in + let t__025_, t__026_ = _right__022_ in + (match _cmp__v t__023_ t__025_ with + | 0 -> _cmp__v t__024_ t__026_ + | n -> n) + | x, y -> Stdlib.compare x y) + | n -> n + ;; + + let equal : + 'k 'v. + ('k -> 'k -> bool) -> ('v -> 'v -> bool) -> ('k, 'v) t -> ('k, 'v) t -> bool + = + fun _cmp__k _cmp__v a__027_ b__028_ -> + let t__029_, t__030_ = a__027_ in + let t__031_, t__032_ = b__028_ in + Stdlib.( && ) + (_cmp__k t__029_ t__031_) + (if Stdlib.( == ) t__030_ t__032_ + then true + else ( + match t__030_, t__032_ with + | `Left _left__033_, `Left _right__034_ -> _cmp__v _left__033_ _right__034_ + | `Right _left__035_, `Right _right__036_ -> _cmp__v _left__035_ _right__036_ + | `Unequal _left__037_, `Unequal _right__038_ -> + let t__039_, t__040_ = _left__037_ in + let t__041_, t__042_ = _right__038_ in + Stdlib.( && ) (_cmp__v t__039_ t__041_) (_cmp__v t__040_ t__042_) + | x, y -> Stdlib.( = ) x y)) + ;; + + let t_of_sexp : + 'k 'v. + (Sexplib0.Sexp.t -> 'k) + -> (Sexplib0.Sexp.t -> 'v) + -> Sexplib0.Sexp.t + -> ('k, 'v) t + = + let error_source__057_ = "map_intf.ml.Symmetric_diff_element.t" in + fun _of_k__043_ _of_v__044_ -> function + | Sexplib0.Sexp.List [ arg0__067_; arg1__068_ ] -> + let res0__069_ = _of_k__043_ arg0__067_ + and res1__070_ = + let sexp__066_ = arg1__068_ in + try + match sexp__066_ with + | Sexplib0.Sexp.Atom atom__047_ as _sexp__049_ -> + (match atom__047_ with + | "Left" -> + Sexplib0.Sexp_conv_error.ptag_takes_args error_source__057_ _sexp__049_ + | "Right" -> + Sexplib0.Sexp_conv_error.ptag_takes_args error_source__057_ _sexp__049_ + | "Unequal" -> + Sexplib0.Sexp_conv_error.ptag_takes_args error_source__057_ _sexp__049_ + | _ -> Sexplib0.Sexp_conv_error.no_variant_match ()) + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom atom__047_ :: sexp_args__050_) as + _sexp__049_ -> + (match atom__047_ with + | "Left" as _tag__063_ -> + (match sexp_args__050_ with + | [ arg0__064_ ] -> + let res0__065_ = _of_v__044_ arg0__064_ in + `Left res0__065_ + | _ -> + Sexplib0.Sexp_conv_error.ptag_incorrect_n_args + error_source__057_ + _tag__063_ + _sexp__049_) + | "Right" as _tag__060_ -> + (match sexp_args__050_ with + | [ arg0__061_ ] -> + let res0__062_ = _of_v__044_ arg0__061_ in + `Right res0__062_ + | _ -> + Sexplib0.Sexp_conv_error.ptag_incorrect_n_args + error_source__057_ + _tag__060_ + _sexp__049_) + | "Unequal" as _tag__051_ -> + (match sexp_args__050_ with + | [ arg0__058_ ] -> + let res0__059_ = + match arg0__058_ with + | Sexplib0.Sexp.List [ arg0__052_; arg1__053_ ] -> + let res0__054_ = _of_v__044_ arg0__052_ + and res1__055_ = _of_v__044_ arg1__053_ in + res0__054_, res1__055_ + | sexp__056_ -> + Sexplib0.Sexp_conv_error.tuple_of_size_n_expected + error_source__057_ + 2 + sexp__056_ + in + `Unequal res0__059_ + | _ -> + Sexplib0.Sexp_conv_error.ptag_incorrect_n_args + error_source__057_ + _tag__051_ + _sexp__049_) + | _ -> Sexplib0.Sexp_conv_error.no_variant_match ()) + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__048_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_poly_var + error_source__057_ + sexp__048_ + | Sexplib0.Sexp.List [] as sexp__048_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_poly_var + error_source__057_ + sexp__048_ + with + | Sexplib0.Sexp_conv_error.No_variant_match -> + Sexplib0.Sexp_conv_error.no_matching_variant_found + error_source__057_ + sexp__066_ + in + res0__069_, res1__070_ + | sexp__071_ -> + Sexplib0.Sexp_conv_error.tuple_of_size_n_expected error_source__057_ 2 sexp__071_ + ;; + + let sexp_of_t : + 'k 'v. + ('k -> Sexplib0.Sexp.t) + -> ('v -> Sexplib0.Sexp.t) + -> ('k, 'v) t + -> Sexplib0.Sexp.t + = + fun _of_k__072_ _of_v__073_ (arg0__081_, arg1__082_) -> + let res0__083_ = _of_k__072_ arg0__081_ + and res1__084_ = + match arg1__082_ with + | `Left v__074_ -> + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Left"; _of_v__073_ v__074_ ] + | `Right v__075_ -> + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Right"; _of_v__073_ v__075_ ] + | `Unequal v__076_ -> + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "Unequal" + ; (let arg0__077_, arg1__078_ = v__076_ in + let res0__079_ = _of_v__073_ arg0__077_ + and res1__080_ = _of_v__073_ arg1__078_ in + Sexplib0.Sexp.List [ res0__079_; res1__080_ ]) + ] + in + Sexplib0.Sexp.List [ res0__083_; res1__084_ ] + ;; + + let t_sexp_grammar : + 'k 'v. + 'k Sexplib0.Sexp_grammar.t + -> 'v Sexplib0.Sexp_grammar.t + -> ('k, 'v) t Sexplib0.Sexp_grammar.t + = + fun _'k_sexp_grammar _'v_sexp_grammar -> + { untyped = + List + (Cons + ( _'k_sexp_grammar.untyped + , Cons + ( Variant + { case_sensitivity = Case_sensitive + ; clauses = + [ No_tag + { name = "Left" + ; clause_kind = + List_clause + { args = Cons (_'v_sexp_grammar.untyped, Empty) } + } + ; No_tag + { name = "Right" + ; clause_kind = + List_clause + { args = Cons (_'v_sexp_grammar.untyped, Empty) } + } + ; No_tag + { name = "Unequal" + ; clause_kind = + List_clause + { args = + Cons + ( List + (Cons + ( _'v_sexp_grammar.untyped + , Cons (_'v_sexp_grammar.untyped, Empty) + )) + , Empty ) + } + } + ] + } + , Empty ) )) + } + ;; + + [@@@end] +end + +module Merge_element = struct + type ('left, 'right) t = + [ `Left of 'left + | `Right of 'right + | `Both of 'left * 'right + ] + [@@deriving_inline compare, equal, sexp_of] + + let compare : + 'left 'right. + ('left -> 'left -> int) + -> ('right -> 'right -> int) + -> ('left, 'right) t + -> ('left, 'right) t + -> int + = + fun _cmp__left _cmp__right a__085_ b__086_ -> + if Stdlib.( == ) a__085_ b__086_ + then 0 + else ( + match a__085_, b__086_ with + | `Left _left__087_, `Left _right__088_ -> _cmp__left _left__087_ _right__088_ + | `Right _left__089_, `Right _right__090_ -> _cmp__right _left__089_ _right__090_ + | `Both _left__091_, `Both _right__092_ -> + let t__093_, t__094_ = _left__091_ in + let t__095_, t__096_ = _right__092_ in + (match _cmp__left t__093_ t__095_ with + | 0 -> _cmp__right t__094_ t__096_ + | n -> n) + | x, y -> Stdlib.compare x y) + ;; + + let equal : + 'left 'right. + ('left -> 'left -> bool) + -> ('right -> 'right -> bool) + -> ('left, 'right) t + -> ('left, 'right) t + -> bool + = + fun _cmp__left _cmp__right a__097_ b__098_ -> + if Stdlib.( == ) a__097_ b__098_ + then true + else ( + match a__097_, b__098_ with + | `Left _left__099_, `Left _right__100_ -> _cmp__left _left__099_ _right__100_ + | `Right _left__101_, `Right _right__102_ -> _cmp__right _left__101_ _right__102_ + | `Both _left__103_, `Both _right__104_ -> + let t__105_, t__106_ = _left__103_ in + let t__107_, t__108_ = _right__104_ in + Stdlib.( && ) (_cmp__left t__105_ t__107_) (_cmp__right t__106_ t__108_) + | x, y -> Stdlib.( = ) x y) + ;; + + let sexp_of_t : + 'left 'right. + ('left -> Sexplib0.Sexp.t) + -> ('right -> Sexplib0.Sexp.t) + -> ('left, 'right) t + -> Sexplib0.Sexp.t + = + fun _of_left__109_ _of_right__110_ -> function + | `Left v__111_ -> + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Left"; _of_left__109_ v__111_ ] + | `Right v__112_ -> + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Right"; _of_right__110_ v__112_ ] + | `Both v__113_ -> + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "Both" + ; (let arg0__114_, arg1__115_ = v__113_ in + let res0__116_ = _of_left__109_ arg0__114_ + and res1__117_ = _of_right__110_ arg1__115_ in + Sexplib0.Sexp.List [ res0__116_; res1__117_ ]) + ] + ;; + + [@@@end] +end + +(** @canonical Base.Map.Continue_or_stop *) +module Continue_or_stop = struct + type t = + | Continue + | Stop + [@@deriving_inline compare, enumerate, equal, sexp_of] + + let compare = (Stdlib.compare : t -> t -> int) + let all = ([ Continue; Stop ] : t list) + let equal = (Stdlib.( = ) : t -> t -> bool) + + let sexp_of_t = + (function + | Continue -> Sexplib0.Sexp.Atom "Continue" + | Stop -> Sexplib0.Sexp.Atom "Stop" + : t -> Sexplib0.Sexp.t) + ;; + + [@@@end] +end + +(** @canonical Base.Map.Finished_or_unfinished *) +module Finished_or_unfinished = struct + type t = + | Finished + | Unfinished + [@@deriving_inline compare, enumerate, equal, sexp_of] + + let compare = (Stdlib.compare : t -> t -> int) + let all = ([ Finished; Unfinished ] : t list) + let equal = (Stdlib.( = ) : t -> t -> bool) + + let sexp_of_t = + (function + | Finished -> Sexplib0.Sexp.Atom "Finished" + | Unfinished -> Sexplib0.Sexp.Atom "Unfinished" + : t -> Sexplib0.Sexp.t) + ;; + + [@@@end] +end + +module type Accessors_generic = sig + type ('a, 'b, 'cmp) t + type ('a, 'b, 'cmp) tree + type 'a key + type 'cmp cmp + type ('a, 'cmp, 'z) access_options + + (** @inline *) + include + Dictionary_immutable.Accessors + with type 'key key := 'key key + and type ('key, 'data, 'cmp) t := ('key, 'data, 'cmp) t + and type ('fn, 'key, _, 'cmp) accessor := ('key, 'cmp, 'fn) access_options + + val invariants : ('k, 'cmp, ('k, 'v, 'cmp) t -> bool) access_options + val is_empty : (_, _, _) t -> bool + val length : (_, _, _) t -> int + + val add + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v, 'cmp) t Or_duplicate.t ) + access_options + + val add_exn + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v, 'cmp) t ) + access_options + + val set + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v, 'cmp) t ) + access_options + + val add_multi + : ( 'k + , 'cmp + , ('k, 'v list, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v list, 'cmp) t ) + access_options + + val remove_multi + : ('k, 'cmp, ('k, 'v list, 'cmp) t -> 'k key -> ('k, 'v list, 'cmp) t) access_options + + val find_multi : ('k, 'cmp, ('k, 'v list, 'cmp) t -> 'k key -> 'v list) access_options + + val change + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> 'k key -> f:('v option -> 'v option) -> ('k, 'v, 'cmp) t ) + access_options + + val update + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> 'k key -> f:('v option -> 'v) -> ('k, 'v, 'cmp) t ) + access_options + + val find : ('k, 'cmp, ('k, 'v, 'cmp) t -> 'k key -> 'v option) access_options + val find_exn : ('k, 'cmp, ('k, 'v, 'cmp) t -> 'k key -> 'v) access_options + val remove : ('k, 'cmp, ('k, 'v, 'cmp) t -> 'k key -> ('k, 'v, 'cmp) t) access_options + val mem : ('k, 'cmp, ('k, _, 'cmp) t -> 'k key -> bool) access_options + val iter_keys : ('k, _, _) t -> f:('k key -> unit) -> unit + val iter : (_, 'v, _) t -> f:('v -> unit) -> unit + val iteri : ('k, 'v, _) t -> f:(key:'k key -> data:'v -> unit) -> unit + + val iteri_until + : ('k, 'v, _) t + -> f:(key:'k key -> data:'v -> Continue_or_stop.t) + -> Finished_or_unfinished.t + + val iter2 + : ( 'k + , 'cmp + , ('k, 'v1, 'cmp) t + -> ('k, 'v2, 'cmp) t + -> f:(key:'k key -> data:('v1, 'v2) Merge_element.t -> unit) + -> unit ) + access_options + + val map : ('k, 'v1, 'cmp) t -> f:('v1 -> 'v2) -> ('k, 'v2, 'cmp) t + val mapi : ('k, 'v1, 'cmp) t -> f:(key:'k key -> data:'v1 -> 'v2) -> ('k, 'v2, 'cmp) t + + val fold + : ('k, 'v, _) t + -> init:'acc + -> f:(key:'k key -> data:'v -> 'acc -> 'acc) + -> 'acc + + val fold_until + : ('k, 'v, _) t + -> init:'acc + -> f:(key:'k key -> data:'v -> 'acc -> ('acc, 'final) Container.Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + val fold_right + : ('k, 'v, _) t + -> init:'acc + -> f:(key:'k key -> data:'v -> 'acc -> 'acc) + -> 'acc + + val fold2 + : ( 'k + , 'cmp + , ('k, 'v1, 'cmp) t + -> ('k, 'v2, 'cmp) t + -> init:'acc + -> f:(key:'k key -> data:('v1, 'v2) Merge_element.t -> 'acc -> 'acc) + -> 'acc ) + access_options + + val filter_keys : ('k, 'v, 'cmp) t -> f:('k key -> bool) -> ('k, 'v, 'cmp) t + val filter : ('k, 'v, 'cmp) t -> f:('v -> bool) -> ('k, 'v, 'cmp) t + val filteri : ('k, 'v, 'cmp) t -> f:(key:'k key -> data:'v -> bool) -> ('k, 'v, 'cmp) t + val filter_map : ('k, 'v1, 'cmp) t -> f:('v1 -> 'v2 option) -> ('k, 'v2, 'cmp) t + + val filter_mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k key -> data:'v1 -> 'v2 option) + -> ('k, 'v2, 'cmp) t + + val partition_mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k key -> data:'v1 -> ('v2, 'v3) Either.t) + -> ('k, 'v2, 'cmp) t * ('k, 'v3, 'cmp) t + + val partition_map + : ('k, 'v1, 'cmp) t + -> f:('v1 -> ('v2, 'v3) Either.t) + -> ('k, 'v2, 'cmp) t * ('k, 'v3, 'cmp) t + + val partitioni_tf + : ('k, 'v, 'cmp) t + -> f:(key:'k key -> data:'v -> bool) + -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t + + val partition_tf + : ('k, 'v, 'cmp) t + -> f:('v -> bool) + -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t + + val combine_errors + : ( 'k + , 'cmp + , ('k, 'v Or_error.t, 'cmp) t -> ('k, 'v, 'cmp) t Or_error.t ) + access_options + + val unzip : ('k, 'v1 * 'v2, 'cmp) t -> ('k, 'v1, 'cmp) t * ('k, 'v2, 'cmp) t + + val compare_direct + : ( 'k + , 'cmp + , ('v -> 'v -> int) -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> int ) + access_options + + val equal + : ( 'k + , 'cmp + , ('v -> 'v -> bool) -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> bool ) + access_options + + val keys : ('k, _, _) t -> 'k key list + val data : (_, 'v, _) t -> 'v list + + val to_alist + : ?key_order:[ `Increasing | `Decreasing ] + -> ('k, 'v, _) t + -> ('k key * 'v) list + + val merge + : ( 'k + , 'cmp + , ('k, 'v1, 'cmp) t + -> ('k, 'v2, 'cmp) t + -> f:(key:'k key -> ('v1, 'v2) Merge_element.t -> 'v3 option) + -> ('k, 'v3, 'cmp) t ) + access_options + + val merge_disjoint_exn + : ('k, 'cmp, ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t) access_options + + val merge_skewed + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> combine:(key:'k key -> 'v -> 'v -> 'v) + -> ('k, 'v, 'cmp) t ) + access_options + + val symmetric_diff + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> data_equal:('v -> 'v -> bool) + -> ('k key, 'v) Symmetric_diff_element.t Sequence.t ) + access_options + + val fold_symmetric_diff + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> data_equal:('v -> 'v -> bool) + -> init:'acc + -> f:('acc -> ('k key, 'v) Symmetric_diff_element.t -> 'acc) + -> 'acc ) + access_options + + val min_elt : ('k, 'v, _) t -> ('k key * 'v) option + val min_elt_exn : ('k, 'v, _) t -> 'k key * 'v + val max_elt : ('k, 'v, _) t -> ('k key * 'v) option + val max_elt_exn : ('k, 'v, _) t -> 'k key * 'v + val for_all : ('k, 'v, _) t -> f:('v -> bool) -> bool + val for_alli : ('k, 'v, _) t -> f:(key:'k key -> data:'v -> bool) -> bool + val exists : ('k, 'v, _) t -> f:('v -> bool) -> bool + val existsi : ('k, 'v, _) t -> f:(key:'k key -> data:'v -> bool) -> bool + val count : ('k, 'v, _) t -> f:('v -> bool) -> int + val counti : ('k, 'v, _) t -> f:(key:'k key -> data:'v -> bool) -> int + + val sum + : (module Container.Summable with type t = 'a) + -> ('k, 'v, _) t + -> f:('v -> 'a) + -> 'a + + val sumi + : (module Container.Summable with type t = 'a) + -> ('k, 'v, _) t + -> f:(key:'k key -> data:'v -> 'a) + -> 'a + + val split + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> 'k key + -> ('k, 'v, 'cmp) t * ('k key * 'v) option * ('k, 'v, 'cmp) t ) + access_options + + val split_le_gt + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> 'k key -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t ) + access_options + + val split_lt_ge + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> 'k key -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t ) + access_options + + val append + : ( 'k + , 'cmp + , lower_part:('k, 'v, 'cmp) t + -> upper_part:('k, 'v, 'cmp) t + -> [ `Ok of ('k, 'v, 'cmp) t | `Overlapping_key_ranges ] ) + access_options + + val subrange + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> lower_bound:'k key Maybe_bound.t + -> upper_bound:'k key Maybe_bound.t + -> ('k, 'v, 'cmp) t ) + access_options + + val fold_range_inclusive + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> min:'k key + -> max:'k key + -> init:'acc + -> f:(key:'k key -> data:'v -> 'acc -> 'acc) + -> 'acc ) + access_options + + val range_to_alist + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t -> min:'k key -> max:'k key -> ('k key * 'v) list ) + access_options + + val closest_key + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> [ `Greater_or_equal_to | `Greater_than | `Less_or_equal_to | `Less_than ] + -> 'k key + -> ('k key * 'v) option ) + access_options + + val nth : ('k, 'v, 'cmp) t -> int -> ('k key * 'v) option + val nth_exn : ('k, 'v, 'cmp) t -> int -> 'k key * 'v + val rank : ('k, 'cmp, ('k, _, 'cmp) t -> 'k key -> int option) access_options + val to_tree : ('k, 'v, 'cmp) t -> ('k key, 'v, 'cmp) tree + + val to_sequence + : ( 'k + , 'cmp + , ?order:[ `Increasing_key | `Decreasing_key ] + -> ?keys_greater_or_equal_to:'k key + -> ?keys_less_or_equal_to:'k key + -> ('k, 'v, 'cmp) t + -> ('k key * 'v) Sequence.t ) + access_options + + val binary_search + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> compare:(key:'k key -> data:'v -> 'key -> int) + -> Binary_searchable.Which_target_by_key.t + -> 'key + -> ('k key * 'v) option ) + access_options + + val binary_search_segmented + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> segment_of:(key:'k key -> data:'v -> [ `Left | `Right ]) + -> Binary_searchable.Which_target_by_segment.t + -> ('k key * 'v) option ) + access_options + + val binary_search_subrange + : ( 'k + , 'cmp + , ('k, 'v, 'cmp) t + -> compare:(key:'k key -> data:'v -> 'bound -> int) + -> lower_bound:'bound Maybe_bound.t + -> upper_bound:'bound Maybe_bound.t + -> ('k, 'v, 'cmp) t ) + access_options + + module Make_applicative_traversals (A : Applicative.Lazy_applicative) : sig + val mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k key -> data:'v1 -> 'v2 A.t) + -> ('k, 'v2, 'cmp) t A.t + + val filter_mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k key -> data:'v1 -> 'v2 option A.t) + -> ('k, 'v2, 'cmp) t A.t + end +end + +module type Creators_generic = sig + type ('k, 'v, 'cmp) t + type ('k, 'v, 'cmp) tree + type 'k key + type ('a, 'cmp, 'z) create_options + type ('a, 'cmp, 'z) access_options + type 'cmp cmp + + (** @inline *) + include + Dictionary_immutable.Creators + with type 'key key := 'key key + and type ('key, 'data, 'cmp) t := ('key, 'data, 'cmp) t + and type ('fn, 'key, _, 'cmp) creator := ('key, 'cmp, 'fn) create_options + + val empty : ('k, 'cmp, ('k, _, 'cmp) t) create_options + val singleton : ('k, 'cmp, 'k key -> 'v -> ('k, 'v, 'cmp) t) create_options + + val map_keys + : ( 'k2 + , 'cmp2 + , ('k1, 'v, 'cmp1) t + -> f:('k1 key -> 'k2 key) + -> [ `Ok of ('k2, 'v, 'cmp2) t | `Duplicate_key of 'k2 key ] ) + create_options + + val map_keys_exn + : ( 'k2 + , 'cmp2 + , ('k1, 'v, 'cmp1) t -> f:('k1 key -> 'k2 key) -> ('k2, 'v, 'cmp2) t ) + create_options + + val transpose_keys + : ( 'k1 + , 'cmp1 + , ( 'k2 + , 'cmp2 + , ('k1, ('k2, 'a, 'cmp2) t, 'cmp1) t -> ('k2, ('k1, 'a, 'cmp1) t, 'cmp2) t ) + create_options ) + access_options + + val of_sorted_array + : ('k, 'cmp, ('k key * 'v) array -> ('k, 'v, 'cmp) t Or_error.t) create_options + + val of_sorted_array_unchecked + : ('k, 'cmp, ('k key * 'v) array -> ('k, 'v, 'cmp) t) create_options + + val of_increasing_iterator_unchecked + : ('k, 'cmp, len:int -> f:(int -> 'k key * 'v) -> ('k, 'v, 'cmp) t) create_options + + val of_alist + : ( 'k + , 'cmp + , ('k key * 'v) list -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) + create_options + + val of_alist_or_error + : ('k, 'cmp, ('k key * 'v) list -> ('k, 'v, 'cmp) t Or_error.t) create_options + + val of_alist_exn : ('k, 'cmp, ('k key * 'v) list -> ('k, 'v, 'cmp) t) create_options + + val of_alist_multi + : ('k, 'cmp, ('k key * 'v) list -> ('k, 'v list, 'cmp) t) create_options + + val of_alist_fold + : ( 'k + , 'cmp + , ('k key * 'v1) list -> init:'v2 -> f:('v2 -> 'v1 -> 'v2) -> ('k, 'v2, 'cmp) t ) + create_options + + val of_alist_reduce + : ( 'k + , 'cmp + , ('k key * 'v) list -> f:('v -> 'v -> 'v) -> ('k, 'v, 'cmp) t ) + create_options + + val of_increasing_sequence + : ('k, 'cmp, ('k key * 'v) Sequence.t -> ('k, 'v, 'cmp) t Or_error.t) create_options + + val of_sequence + : ( 'k + , 'cmp + , ('k key * 'v) Sequence.t -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] + ) + create_options + + val of_sequence_or_error + : ('k, 'cmp, ('k key * 'v) Sequence.t -> ('k, 'v, 'cmp) t Or_error.t) create_options + + val of_sequence_exn + : ('k, 'cmp, ('k key * 'v) Sequence.t -> ('k, 'v, 'cmp) t) create_options + + val of_sequence_multi + : ('k, 'cmp, ('k key * 'v) Sequence.t -> ('k, 'v list, 'cmp) t) create_options + + val of_sequence_fold + : ( 'k + , 'cmp + , ('k key * 'v1) Sequence.t + -> init:'v2 + -> f:('v2 -> 'v1 -> 'v2) + -> ('k, 'v2, 'cmp) t ) + create_options + + val of_sequence_reduce + : ( 'k + , 'cmp + , ('k key * 'v) Sequence.t -> f:('v -> 'v -> 'v) -> ('k, 'v, 'cmp) t ) + create_options + + val of_list_with_key + : ( 'k + , 'cmp + , 'v list + -> get_key:('v -> 'k key) + -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) + create_options + + val of_list_with_key_or_error + : ( 'k + , 'cmp + , 'v list -> get_key:('v -> 'k key) -> ('k, 'v, 'cmp) t Or_error.t ) + create_options + + val of_list_with_key_exn + : ('k, 'cmp, 'v list -> get_key:('v -> 'k key) -> ('k, 'v, 'cmp) t) create_options + + val of_list_with_key_multi + : ( 'k + , 'cmp + , 'v list -> get_key:('v -> 'k key) -> ('k, 'v list, 'cmp) t ) + create_options + + val of_list_with_key_fold + : ( 'k + , 'cmp + , 'v list + -> get_key:('v -> 'k key) + -> init:'acc + -> f:('acc -> 'v -> 'acc) + -> ('k, 'acc, 'cmp) t ) + create_options + + val of_list_with_key_reduce + : ( 'k + , 'cmp + , 'v list -> get_key:('v -> 'k key) -> f:('v -> 'v -> 'v) -> ('k, 'v, 'cmp) t ) + create_options + + val of_iteri + : ( 'k + , 'cmp + , iteri:(f:(key:'k key -> data:'v -> unit) -> unit) + -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) + create_options + + val of_iteri_exn + : ( 'k + , 'cmp + , iteri:(f:(key:'k key -> data:'v -> unit) -> unit) -> ('k, 'v, 'cmp) t ) + create_options + + val of_tree : ('k, 'cmp, ('k key, 'v, 'cmp) tree -> ('k, 'v, 'cmp) t) create_options +end + +module type Creators_and_accessors_generic = sig + type ('a, 'b, 'c) t + type ('a, 'b, 'c) tree + type 'a key + type 'a cmp + type ('a, 'b, 'c) create_options + type ('a, 'b, 'c) access_options + + include + Creators_generic + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) tree + with type 'a key := 'a key + with type 'a cmp := 'a cmp + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) create_options + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) access_options + + include + Accessors_generic + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) tree + with type 'a key := 'a key + with type 'a cmp := 'a cmp + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) access_options +end + +module type S_poly = sig + type ('a, 'b) t + type ('a, 'b) tree + type comparator_witness + + include + Creators_and_accessors_generic + with type ('a, 'b, 'c) t := ('a, 'b) t + with type ('a, 'b, 'c) tree := ('a, 'b) tree + with type 'k key := 'k + with type 'c cmp := comparator_witness + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t +end + +module type For_deriving = sig + type ('a, 'b, 'c) t + + module type Sexp_of_m = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + end + + module type M_of_sexp = sig + type t [@@deriving_inline of_sexp] + + val t_of_sexp : Sexplib0.Sexp.t -> t + + [@@@end] + + include Comparator.S with type t := t + end + + module type M_sexp_grammar = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + end + + module type Compare_m = sig end + module type Equal_m = sig end + module type Hash_fold_m = Hasher.S + + val sexp_of_m__t + : (module Sexp_of_m with type t = 'k) + -> ('v -> Sexp.t) + -> ('k, 'v, 'cmp) t + -> Sexp.t + + val m__t_of_sexp + : (module M_of_sexp with type t = 'k and type comparator_witness = 'cmp) + -> (Sexp.t -> 'v) + -> Sexp.t + -> ('k, 'v, 'cmp) t + + val m__t_sexp_grammar + : (module M_sexp_grammar with type t = 'k) + -> 'v Sexplib0.Sexp_grammar.t + -> ('k, 'v, 'cmp) t Sexplib0.Sexp_grammar.t + + val compare_m__t + : (module Compare_m) + -> ('v -> 'v -> int) + -> ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> int + + val equal_m__t + : (module Equal_m) + -> ('v -> 'v -> bool) + -> ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> bool + + val hash_fold_m__t + : (module Hash_fold_m with type t = 'k) + -> (Hash.state -> 'v -> Hash.state) + -> Hash.state + -> ('k, 'v, _) t + -> Hash.state +end + +module type Map = sig + (** [Map] is a functional data structure (balanced binary tree) implementing finite maps + over a totally-ordered domain, called a "key". *) + + type (!'key, +!'value, !'cmp) t + + module Or_duplicate = Or_duplicate + module Continue_or_stop = Continue_or_stop + + module Finished_or_unfinished : sig + type t = Finished_or_unfinished.t = + | Finished + | Unfinished + [@@deriving_inline compare, enumerate, equal, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_enumerate_lib.Enumerable.S with type t := t + include Ppx_compare_lib.Equal.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + (** Maps [Continue] to [Finished] and [Stop] to [Unfinished]. *) + val of_continue_or_stop : Continue_or_stop.t -> t + + (** Maps [Finished] to [Continue] and [Unfinished] to [Stop]. *) + val to_continue_or_stop : t -> Continue_or_stop.t + end + + module Merge_element : sig + type ('left, 'right) t = + [ `Left of 'left + | `Right of 'right + | `Both of 'left * 'right + ] + [@@deriving_inline compare, equal, sexp_of] + + val compare + : ('left -> 'left -> int) + -> ('right -> 'right -> int) + -> ('left, 'right) t + -> ('left, 'right) t + -> int + + val equal + : ('left -> 'left -> bool) + -> ('right -> 'right -> bool) + -> ('left, 'right) t + -> ('left, 'right) t + -> bool + + val sexp_of_t + : ('left -> Sexplib0.Sexp.t) + -> ('right -> Sexplib0.Sexp.t) + -> ('left, 'right) t + -> Sexplib0.Sexp.t + + [@@@end] + + val left : ('left, _) t -> 'left option + val right : (_, 'right) t -> 'right option + val left_value : ('left, _) t -> default:'left -> 'left + val right_value : (_, 'right) t -> default:'right -> 'right + + val values + : ('left, 'right) t + -> left_default:'left + -> right_default:'right + -> 'left * 'right + end + + (** Test if the invariants of the internal AVL search tree hold. *) + val invariants : (_, _, _) t -> bool + + (** Returns a first-class module that can be used to build other map/set/etc. + with the same notion of comparison. *) + val comparator_s : ('a, _, 'cmp) t -> ('a, 'cmp) Comparator.Module.t + + val comparator : ('a, _, 'cmp) t -> ('a, 'cmp) Comparator.t + + (** The empty map. *) + val empty : ('a, 'cmp) Comparator.Module.t -> ('a, 'b, 'cmp) t + + (** A map with one (key, data) pair. *) + val singleton : ('a, 'cmp) Comparator.Module.t -> 'a -> 'b -> ('a, 'b, 'cmp) t + + (** Creates a map from an association list with unique keys. *) + val of_alist + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) list + -> [ `Ok of ('a, 'b, 'cmp) t | `Duplicate_key of 'a ] + + (** Creates a map from an association list with unique keys, returning an error if + duplicate ['a] keys are found. *) + val of_alist_or_error + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) list + -> ('a, 'b, 'cmp) t Or_error.t + + (** Creates a map from an association list with unique keys, raising an exception if + duplicate ['a] keys are found. *) + val of_alist_exn : ('a, 'cmp) Comparator.Module.t -> ('a * 'b) list -> ('a, 'b, 'cmp) t + + (** Creates a map from an association list with possibly repeated keys. The values in + the map for a given key appear in the same order as they did in the association + list. *) + val of_alist_multi + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) list + -> ('a, 'b list, 'cmp) t + + (** Combines an association list into a map, folding together bound values with common + keys. The accumulator is per-key. + + Example: + + {[ + # (let map = + String.Map.of_alist_fold + [ "a", 1; "a", 10; "b", 2; "b", 20; "b", 200 ] + ~init:Int.Set.empty + ~f:Set.add + in + print_s [%sexp (map : Int.Set.t String.Map.t)]);; + ((a (1 10)) (b (2 20 200))) + - : unit = () + ]} + *) + val of_alist_fold + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) list + -> init:'c + -> f:('c -> 'b -> 'c) + -> ('a, 'c, 'cmp) t + + (** Combines an association list into a map, reducing together bound values with common + keys. *) + val of_alist_reduce + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) list + -> f:('b -> 'b -> 'b) + -> ('a, 'b, 'cmp) t + + (** [of_iteri ~iteri] behaves like [of_alist], except that instead of taking a concrete + data structure, it takes an iteration function. For instance, to convert a string table + into a map: [of_iteri (module String) ~f:(Hashtbl.iteri table)]. It is faster than + adding the elements one by one. *) + val of_iteri + : ('a, 'cmp) Comparator.Module.t + -> iteri:(f:(key:'a -> data:'b -> unit) -> unit) + -> [ `Ok of ('a, 'b, 'cmp) t | `Duplicate_key of 'a ] + + (** Like [of_iteri] except that it raises an exception if duplicate ['a] keys are found. *) + val of_iteri_exn + : ('a, 'cmp) Comparator.Module.t + -> iteri:(f:(key:'a -> data:'b -> unit) -> unit) + -> ('a, 'b, 'cmp) t + + (** Creates a map from a sorted array of key-data pairs. The input array must be sorted + (either in ascending or descending order), as given by the relevant comparator, and + must not contain duplicate keys. If either of these conditions does not hold, + an error is returned. *) + val of_sorted_array + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) array + -> ('a, 'b, 'cmp) t Or_error.t + + (** Like [of_sorted_array] except that it returns a map with broken invariants when an + [Error] would have been returned. *) + val of_sorted_array_unchecked + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) array + -> ('a, 'b, 'cmp) t + + (** [of_increasing_iterator_unchecked c ~len ~f] behaves like [of_sorted_array_unchecked c + (Array.init len ~f)], with the additional restriction that a decreasing order is not + supported. The advantage is not requiring you to allocate an intermediate array. [f] + will be called with 0, 1, ... [len - 1], in order. *) + val of_increasing_iterator_unchecked + : ('a, 'cmp) Comparator.Module.t + -> len:int + -> f:(int -> 'a * 'b) + -> ('a, 'b, 'cmp) t + + (** [of_increasing_sequence c seq] behaves like [of_sorted_array c (Sequence.to_array + seq)], but does not allocate the intermediate array. + + The sequence will be folded over once, and the additional time complexity is {e O(n)}. + *) + val of_increasing_sequence + : ('k, 'cmp) Comparator.Module.t + -> ('k * 'v) Sequence.t + -> ('k, 'v, 'cmp) t Or_error.t + + (** Creates a map from an association sequence with unique keys. + + [of_sequence c seq] behaves like [of_alist c (Sequence.to_list seq)] but + does not allocate the intermediate list. + + If your sequence is increasing, use [of_increasing_sequence]. + *) + val of_sequence + : ('k, 'cmp) Comparator.Module.t + -> ('k * 'v) Sequence.t + -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k ] + + (** Creates a map from an association sequence with unique keys, returning an error if + duplicate ['a] keys are found. + + [of_sequence_or_error c seq] behaves like [of_alist_or_error c (Sequence.to_list seq)] + but does not allocate the intermediate list. + *) + val of_sequence_or_error + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) Sequence.t + -> ('a, 'b, 'cmp) t Or_error.t + + (** Creates a map from an association sequence with unique keys, raising an exception if + duplicate ['a] keys are found. + + [of_sequence_exn c seq] behaves like [of_alist_exn c (Sequence.to_list seq)] but + does not allocate the intermediate list. + *) + val of_sequence_exn + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) Sequence.t + -> ('a, 'b, 'cmp) t + + (** Creates a map from an association sequence with possibly repeated keys. The values in + the map for a given key appear in the same order as they did in the association + list. + + [of_sequence_multi c seq] behaves like [of_alist_exn c (Sequence.to_list seq)] but + does not allocate the intermediate list. + *) + val of_sequence_multi + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) Sequence.t + -> ('a, 'b list, 'cmp) t + + (** Combines an association sequence into a map, folding together bound values with common + keys. + + [of_sequence_fold c seq ~init ~f] behaves like [of_alist_fold c (Sequence.to_list seq) ~init ~f] + but does not allocate the intermediate list. + *) + val of_sequence_fold + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) Sequence.t + -> init:'c + -> f:('c -> 'b -> 'c) + -> ('a, 'c, 'cmp) t + + (** Combines an association sequence into a map, reducing together bound values with common + keys. + + [of_sequence_reduce c seq ~f] behaves like [of_alist_reduce c (Sequence.to_list seq) ~f] + but does not allocate the intermediate list. *) + val of_sequence_reduce + : ('a, 'cmp) Comparator.Module.t + -> ('a * 'b) Sequence.t + -> f:('b -> 'b -> 'b) + -> ('a, 'b, 'cmp) t + + (** Constructs a map from a list of values, where [get_key] extracts a key from a value. + *) + val of_list_with_key + : ('k, 'cmp) Comparator.Module.t + -> 'v list + -> get_key:('v -> 'k) + -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k ] + + (** Like [of_list_with_key]; returns [Error] on duplicate key. *) + val of_list_with_key_or_error + : ('k, 'cmp) Comparator.Module.t + -> 'v list + -> get_key:('v -> 'k) + -> ('k, 'v, 'cmp) t Or_error.t + + (** Like [of_list_with_key]; raises on duplicate key. *) + val of_list_with_key_exn + : ('k, 'cmp) Comparator.Module.t + -> 'v list + -> get_key:('v -> 'k) + -> ('k, 'v, 'cmp) t + + (** Like [of_list_with_key]; produces lists of all values associated with each key. *) + val of_list_with_key_multi + : ('k, 'cmp) Comparator.Module.t + -> 'v list + -> get_key:('v -> 'k) + -> ('k, 'v list, 'cmp) t + + (** Like [of_list_with_key]; resolves duplicate keys the same way [of_alist_fold] does. *) + val of_list_with_key_fold + : ('k, 'cmp) Comparator.Module.t + -> 'v list + -> get_key:('v -> 'k) + -> init:'acc + -> f:('acc -> 'v -> 'acc) + -> ('k, 'acc, 'cmp) t + + (** Like [of_list_with_key]; resolves duplicate keys the same way [of_alist_reduce] does. *) + val of_list_with_key_reduce + : ('k, 'cmp) Comparator.Module.t + -> 'v list + -> get_key:('v -> 'k) + -> f:('v -> 'v -> 'v) + -> ('k, 'v, 'cmp) t + + (** Tests whether a map is empty. *) + val is_empty : (_, _, _) t -> bool + + (** [length map] returns the number of elements in [map]. O(1), but [Tree.length] is + O(n). *) + val length : (_, _, _) t -> int + + (** Returns a new map with the specified new binding; if the key was already bound, its + previous binding disappears. *) + val set : ('k, 'v, 'cmp) t -> key:'k -> data:'v -> ('k, 'v, 'cmp) t + + (** [add t ~key ~data] adds a new entry to [t] mapping [key] to [data] and returns [`Ok] + with the new map, or if [key] is already present in [t], returns [`Duplicate]. *) + val add : ('k, 'v, 'cmp) t -> key:'k -> data:'v -> ('k, 'v, 'cmp) t Or_duplicate.t + + val add_exn : ('k, 'v, 'cmp) t -> key:'k -> data:'v -> ('k, 'v, 'cmp) t + + (** If [key] is not present then add a singleton list, otherwise, cons data onto the + head of the existing list. *) + val add_multi : ('k, 'v list, 'cmp) t -> key:'k -> data:'v -> ('k, 'v list, 'cmp) t + + (** If the key is present, then remove its head element; if the result is empty, remove + the key. *) + val remove_multi : ('k, 'v list, 'cmp) t -> 'k -> ('k, 'v list, 'cmp) t + + (** Returns the value bound to the given key, or the empty list if there is none. *) + val find_multi : ('k, 'v list, 'cmp) t -> 'k -> 'v list + + (** [change t key ~f] returns a new map [m] that is the same as [t] on all keys except + for [key], and whose value for [key] is defined by [f], i.e., [find m key = f (find + t key)]. *) + val change : ('k, 'v, 'cmp) t -> 'k -> f:('v option -> 'v option) -> ('k, 'v, 'cmp) t + + (** [update t key ~f] is [change t key ~f:(fun o -> Some (f o))]. *) + val update : ('k, 'v, 'cmp) t -> 'k -> f:('v option -> 'v) -> ('k, 'v, 'cmp) t + + (** Returns [Some value] bound to the given key, or [None] if none exists. *) + val find : ('k, 'v, 'cmp) t -> 'k -> 'v option + + (** Returns the value bound to the given key, raising [Stdlib.Not_found] or [Not_found_s] + if none exists. *) + val find_exn : ('k, 'v, 'cmp) t -> 'k -> 'v + + (** Returns a new map with any binding for the key in question removed. *) + val remove : ('k, 'v, 'cmp) t -> 'k -> ('k, 'v, 'cmp) t + + (** [mem map key] tests whether [map] contains a binding for [key]. *) + val mem : ('k, _, 'cmp) t -> 'k -> bool + + val iter_keys : ('k, _, _) t -> f:('k -> unit) -> unit + val iter : (_, 'v, _) t -> f:('v -> unit) -> unit + val iteri : ('k, 'v, _) t -> f:(key:'k -> data:'v -> unit) -> unit + + (** Iterates until the first time [f] returns [Stop]. If [f] returns [Stop], the final + result is [Unfinished]. Otherwise, the final result is [Finished]. *) + val iteri_until + : ('k, 'v, _) t + -> f:(key:'k -> data:'v -> Continue_or_stop.t) + -> Finished_or_unfinished.t + + (** Iterates two maps side by side. The complexity of this function is O(M + N). If two + inputs are [[(0, a); (1, a)]] and [[(1, b); (2, b)]], [f] will be called with [[(0, + `Left a); (1, `Both (a, b)); (2, `Right b)]]. *) + val iter2 + : ('k, 'v1, 'cmp) t + -> ('k, 'v2, 'cmp) t + -> f:(key:'k -> data:('v1, 'v2) Merge_element.t -> unit) + -> unit + + (** Returns a new map with bound values replaced by [f] applied to the bound values.*) + val map : ('k, 'v1, 'cmp) t -> f:('v1 -> 'v2) -> ('k, 'v2, 'cmp) t + + (** Like [map], but the passed function takes both [key] and [data] as arguments. *) + val mapi : ('k, 'v1, 'cmp) t -> f:(key:'k -> data:'v1 -> 'v2) -> ('k, 'v2, 'cmp) t + + (** Convert map with keys of type ['k2] to a map with keys of type ['k2] using [f]. *) + val map_keys + : ('k2, 'cmp2) Comparator.Module.t + -> ('k1, 'v, 'cmp1) t + -> f:('k1 -> 'k2) + -> [ `Ok of ('k2, 'v, 'cmp2) t | `Duplicate_key of 'k2 ] + + (** Like [map_keys], but raises on duplicate key. *) + val map_keys_exn + : ('k2, 'cmp2) Comparator.Module.t + -> ('k1, 'v, 'cmp1) t + -> f:('k1 -> 'k2) + -> ('k2, 'v, 'cmp2) t + + (** Folds over keys and data in the map in increasing order of [key]. *) + val fold : ('k, 'v, _) t -> init:'acc -> f:(key:'k -> data:'v -> 'acc -> 'acc) -> 'acc + + (** Folds over keys and data in the map in increasing order of [key], until the first + time that [f] returns [Stop _]. If [f] returns [Stop final], this function returns + immediately with the value [final]. If [f] never returns [Stop _], and the final + call to [f] returns [Continue last], this function returns [finish last]. *) + val fold_until + : ('k, 'v, _) t + -> init:'acc + -> f:(key:'k -> data:'v -> 'acc -> ('acc, 'final) Container.Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + (** Folds over keys and data in the map in decreasing order of [key]. *) + val fold_right + : ('k, 'v, _) t + -> init:'acc + -> f:(key:'k -> data:'v -> 'acc -> 'acc) + -> 'acc + + (** Folds over two maps side by side, like [iter2]. *) + val fold2 + : ('k, 'v1, 'cmp) t + -> ('k, 'v2, 'cmp) t + -> init:'acc + -> f:(key:'k -> data:('v1, 'v2) Merge_element.t -> 'acc -> 'acc) + -> 'acc + + (** [filter], [filteri], [filter_keys], [filter_map], and [filter_mapi] run in O(n) + time. + + [filter], [filteri], [filter_keys], [partition_tf] and [partitioni_tf] keep a lot + of sharing between their result and the original map. Dropping or keeping a run of + [k] consecutive elements costs [O(log(k))] extra memory. Keeping the entire map + costs no extra memory at all: [filter ~f:(fun _ -> true)] returns the original map. + *) + val filter_keys : ('k, 'v, 'cmp) t -> f:('k -> bool) -> ('k, 'v, 'cmp) t + + val filter : ('k, 'v, 'cmp) t -> f:('v -> bool) -> ('k, 'v, 'cmp) t + val filteri : ('k, 'v, 'cmp) t -> f:(key:'k -> data:'v -> bool) -> ('k, 'v, 'cmp) t + + (** Returns a new map with bound values filtered by [f] applied to the bound values. *) + val filter_map : ('k, 'v1, 'cmp) t -> f:('v1 -> 'v2 option) -> ('k, 'v2, 'cmp) t + + (** Like [filter_map], but the passed function takes both [key] and [data] as + arguments. *) + val filter_mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k -> data:'v1 -> 'v2 option) + -> ('k, 'v2, 'cmp) t + + (** [partition_mapi t ~f] returns two new [t]s, with each key in [t] appearing in + exactly one of the resulting maps depending on its mapping in [f]. *) + val partition_mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k -> data:'v1 -> ('v2, 'v3) Either.t) + -> ('k, 'v2, 'cmp) t * ('k, 'v3, 'cmp) t + + (** [partition_map t ~f = partition_mapi t ~f:(fun ~key:_ ~data -> f data)] *) + val partition_map + : ('k, 'v1, 'cmp) t + -> f:('v1 -> ('v2, 'v3) Either.t) + -> ('k, 'v2, 'cmp) t * ('k, 'v3, 'cmp) t + + (** + {[ + partitioni_tf t ~f + = + partition_mapi t ~f:(fun ~key ~data -> + if f ~key ~data + then First data + else Second data) + ]} *) + val partitioni_tf + : ('k, 'v, 'cmp) t + -> f:(key:'k -> data:'v -> bool) + -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t + + (** [partition_tf t ~f = partitioni_tf t ~f:(fun ~key:_ ~data -> f data)] *) + val partition_tf + : ('k, 'v, 'cmp) t + -> f:('v -> bool) + -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t + + (** Produces [Ok] of a map including all keys if all data is [Ok], or an [Error] + including all errors otherwise. *) + val combine_errors : ('k, 'v Or_error.t, 'cmp) t -> ('k, 'v, 'cmp) t Or_error.t + + (** Given a map of tuples, produces a tuple of maps. Equivalent to: + [map t ~f:fst, map t ~f:snd] *) + val unzip : ('k, 'v1 * 'v2, 'cmp) t -> ('k, 'v1, 'cmp) t * ('k, 'v2, 'cmp) t + + (** Returns a total ordering between maps. The first argument is a total ordering used + to compare data associated with equal keys in the two maps. *) + val compare_direct : ('v -> 'v -> int) -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> int + + (** Hash function: a building block to use when hashing data structures containing maps in + them. [hash_fold_direct hash_fold_key] is compatible with [compare_direct] iff + [hash_fold_key] is compatible with [(comparator m).compare] of the map [m] being + hashed. *) + val hash_fold_direct : 'k Hash.folder -> 'v Hash.folder -> ('k, 'v, 'cmp) t Hash.folder + + (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain + the same keys and associate each key with the same value. [cmp] is the equality + predicate used to compare the values associated with the keys. *) + val equal : ('v -> 'v -> bool) -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> bool + + (** Returns a list of the keys in the given map. *) + val keys : ('k, _, _) t -> 'k list + + (** Returns a list of the data in the given map. *) + val data : (_, 'v, _) t -> 'v list + + (** Creates an association list from the given map. *) + val to_alist + : ?key_order:[ `Increasing | `Decreasing ] (** default is [`Increasing] *) + -> ('k, 'v, _) t + -> ('k * 'v) list + + (** {2 Additional operations on maps} *) + + (** Merges two maps. The runtime is O(length(t1) + length(t2)). You shouldn't use this + function to merge a list of maps; consider using [merge_disjoin_exn] or + [merge_skewed] instead. *) + val merge + : ('k, 'v1, 'cmp) t + -> ('k, 'v2, 'cmp) t + -> f:(key:'k -> ('v1, 'v2) Merge_element.t -> 'v3 option) + -> ('k, 'v3, 'cmp) t + + (** Merges two dictionaries with the same type of data and disjoint sets of keys. + Raises if any keys overlap. *) + val merge_disjoint_exn : ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t + + (** A special case of [merge], [merge_skewed t1 t2] is a map containing all the + bindings of [t1] and [t2]. Bindings that appear in both [t1] and [t2] are + combined into a single value using the [combine] function. In a call + [combine ~key v1 v2], the value [v1] comes from [t1] and [v2] from [t2]. + + The runtime of [merge_skewed] is [O(min(l1, l2) * log(max(l1, l2)))], where [l1] is + the length of [t1] and [l2] the length of [t2]. This is likely to be faster than + [merge] when one of the maps is a lot smaller, or when you merge a list of maps. *) + val merge_skewed + : ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> combine:(key:'k -> 'v -> 'v -> 'v) + -> ('k, 'v, 'cmp) t + + module Symmetric_diff_element : sig + type ('k, 'v) t = 'k * [ `Left of 'v | `Right of 'v | `Unequal of 'v * 'v ] + [@@deriving_inline compare, equal, sexp, sexp_grammar] + + include Ppx_compare_lib.Comparable.S2 with type ('k, 'v) t := ('k, 'v) t + include Ppx_compare_lib.Equal.S2 with type ('k, 'v) t := ('k, 'v) t + include Sexplib0.Sexpable.S2 with type ('k, 'v) t := ('k, 'v) t + + val t_sexp_grammar + : 'k Sexplib0.Sexp_grammar.t + -> 'v Sexplib0.Sexp_grammar.t + -> ('k, 'v) t Sexplib0.Sexp_grammar.t + + [@@@end] + end + + (** [symmetric_diff t1 t2 ~data_equal] returns a list of changes between [t1] and [t2]. + It is intended to be efficient in the case where [t1] and [t2] share a large amount + of structure. The keys in the output sequence will be in sorted order. + + It is assumed that [data_equal] is at least as equating as physical equality: that + [phys_equal x y] implies [data_equal x y]. Otherwise, [symmetric_diff] may behave in + unexpected ways. For example, with [~data_equal:(fun _ _ -> false)] it is NOT + necessarily the case the resulting change sequence will contain an element + [(k, `Unequal _)] for every key [k] shared by both maps. + + Warning: Float equality violates this property! [phys_equal Float.nan Float.nan] is + true, but [Float.(=) Float.nan Float.nan] is false. *) + val symmetric_diff + : ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> data_equal:('v -> 'v -> bool) + -> ('k, 'v) Symmetric_diff_element.t Sequence.t + + (** [fold_symmetric_diff t1 t2 ~data_equal] folds across an implicit sequence of changes + between [t1] and [t2], in sorted order by keys. Equivalent to + [Sequence.fold (symmetric_diff t1 t2 ~data_equal)], and more efficient. *) + val fold_symmetric_diff + : ('k, 'v, 'cmp) t + -> ('k, 'v, 'cmp) t + -> data_equal:('v -> 'v -> bool) + -> init:'acc + -> f:('acc -> ('k, 'v) Symmetric_diff_element.t -> 'acc) + -> 'acc + + (** [min_elt map] returns [Some (key, data)] pair corresponding to the minimum key in + [map], or [None] if empty. *) + val min_elt : ('k, 'v, _) t -> ('k * 'v) option + + val min_elt_exn : ('k, 'v, _) t -> 'k * 'v + + (** [max_elt map] returns [Some (key, data)] pair corresponding to the maximum key in + [map], or [None] if [map] is empty. *) + val max_elt : ('k, 'v, _) t -> ('k * 'v) option + + val max_elt_exn : ('k, 'v, _) t -> 'k * 'v + + (** Swap the inner and outer keys of nested maps. If [transpose_keys m a = b], then + [find_exn (find_exn a i) j = find_exn (find_exn b j) i]. *) + val transpose_keys + : ('k2, 'cmp2) Comparator.Module.t + -> ('k1, ('k2, 'v, 'cmp2) t, 'cmp1) t + -> ('k2, ('k1, 'v, 'cmp1) t, 'cmp2) t + + (** These functions have the same semantics as similar functions in [List]. *) + + val for_all : ('k, 'v, _) t -> f:('v -> bool) -> bool + val for_alli : ('k, 'v, _) t -> f:(key:'k -> data:'v -> bool) -> bool + val exists : ('k, 'v, _) t -> f:('v -> bool) -> bool + val existsi : ('k, 'v, _) t -> f:(key:'k -> data:'v -> bool) -> bool + val count : ('k, 'v, _) t -> f:('v -> bool) -> int + val counti : ('k, 'v, _) t -> f:(key:'k -> data:'v -> bool) -> int + + val sum + : (module Container.Summable with type t = 'a) + -> ('k, 'v, _) t + -> f:('v -> 'a) + -> 'a + + val sumi + : (module Container.Summable with type t = 'a) + -> ('k, 'v, _) t + -> f:(key:'k -> data:'v -> 'a) + -> 'a + + (** [split t key] returns a map of keys strictly less than [key], the mapping of [key] if + any, and a map of keys strictly greater than [key]. + + Runtime is O(m + log n), where n is the size of the input map and m is the size of + the smaller of the two output maps. The O(m) term is due to the need to calculate + the length of the output maps. *) + val split + : ('k, 'v, 'cmp) t + -> 'k + -> ('k, 'v, 'cmp) t * ('k * 'v) option * ('k, 'v, 'cmp) t + + (** [split_le_gt t key] returns a map of keys that are less or equal to [key] and a + map of keys strictly greater than [key]. + + Runtime is O(m + log n), where n is the size of the input map and m is the size of + the smaller of the two output maps. The O(m) term is due to the need to calculate + the length of the output maps. *) + val split_le_gt : ('k, 'v, 'cmp) t -> 'k -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t + + (** [split_lt_ge t key] returns a map of keys strictly less than [key] and a map of + keys that are greater or equal to [key]. + + Runtime is O(m + log n), where n is the size of the input map and m is the size of + the smaller of the two output maps. The O(m) term is due to the need to calculate + the length of the output maps. *) + val split_lt_ge : ('k, 'v, 'cmp) t -> 'k -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t + + (** [append ~lower_part ~upper_part] returns [`Ok map] where [map] contains all the + [(key, value)] pairs from the two input maps if all the keys from [lower_part] are + less than all the keys from [upper_part]. Otherwise it returns + [`Overlapping_key_ranges]. + + Runtime is O(log n) where n is the size of the larger input map. This can be + significantly faster than [Map.merge] or repeated [Map.add]. + + {[ + assert (match Map.append ~lower_part ~upper_part with + | `Ok whole_map -> + Map.to_alist whole_map + = List.append (to_alist lower_part) (to_alist upper_part) + | `Overlapping_key_ranges -> true); + ]} *) + val append + : lower_part:('k, 'v, 'cmp) t + -> upper_part:('k, 'v, 'cmp) t + -> [ `Ok of ('k, 'v, 'cmp) t | `Overlapping_key_ranges ] + + (** [subrange t ~lower_bound ~upper_bound] returns a map containing all the entries from + [t] whose keys lie inside the interval indicated by [~lower_bound] and + [~upper_bound]. If this interval is empty, an empty map is returned. + + Runtime is O(m + log n), where n is the size of the input map and m is the size of + the output map. The O(m) term is due to the need to calculate the length of the + output map. *) + val subrange + : ('k, 'v, 'cmp) t + -> lower_bound:'k Maybe_bound.t + -> upper_bound:'k Maybe_bound.t + -> ('k, 'v, 'cmp) t + + (** [fold_range_inclusive t ~min ~max ~init ~f] folds [f] (with initial value [~init]) + over all keys (and their associated values) that are in the range [[min, max]] + (inclusive). *) + val fold_range_inclusive + : ('k, 'v, 'cmp) t + -> min:'k + -> max:'k + -> init:'acc + -> f:(key:'k -> data:'v -> 'acc -> 'acc) + -> 'acc + + (** [range_to_alist t ~min ~max] returns an associative list of the elements whose keys + lie in [[min, max]] (inclusive), with the smallest key being at the head of the + list. *) + val range_to_alist : ('k, 'v, 'cmp) t -> min:'k -> max:'k -> ('k * 'v) list + + (** [closest_key t dir k] returns the [(key, value)] pair in [t] with [key] closest to + [k] that satisfies the given inequality bound. + + For example, [closest_key t `Less_than k] would be the pair with the closest key to + [k] where [key < k]. + + [to_sequence] can be used to get the same results as [closest_key]. It is less + efficient for individual lookups but more efficient for finding many elements starting + at some value. *) + val closest_key + : ('k, 'v, 'cmp) t + -> [ `Greater_or_equal_to | `Greater_than | `Less_or_equal_to | `Less_than ] + -> 'k + -> ('k * 'v) option + + (** [nth t n] finds the (key, value) pair of rank n (i.e., such that there are exactly n + keys strictly less than the found key), if one exists. O(log(length t) + n) time. *) + val nth : ('k, 'v, _) t -> int -> ('k * 'v) option + + val nth_exn : ('k, 'v, _) t -> int -> 'k * 'v + + (** [rank t k] If [k] is in [t], returns the number of keys strictly less than [k] in + [t], and [None] otherwise. *) + val rank : ('k, 'v, 'cmp) t -> 'k -> int option + + (** [to_sequence ?order ?keys_greater_or_equal_to ?keys_less_or_equal_to t] + gives a sequence of key-value pairs between [keys_less_or_equal_to] and + [keys_greater_or_equal_to] inclusive, presented in [order]. If + [keys_greater_or_equal_to > keys_less_or_equal_to], the sequence is + empty. + + When neither [keys_greater_or_equal_to] nor [keys_less_or_equal_to] are + provided, the cost is O(log n) up front and amortized O(1) to produce + each element. If either is provided (and is used by the order parameter + provided), then the the cost is O(n) up front, and amortized O(1) to + produce each element. *) + val to_sequence + : ?order:[ `Increasing_key (** default *) | `Decreasing_key ] + -> ?keys_greater_or_equal_to:'k + -> ?keys_less_or_equal_to:'k + -> ('k, 'v, 'cmp) t + -> ('k * 'v) Sequence.t + + (** [binary_search t ~compare which elt] returns the [(key, value)] pair in [t] + specified by [compare] and [which], if one exists. + + [t] must be sorted in increasing order according to [compare], where [compare] and + [elt] divide [t] into three (possibly empty) segments: + + {v + | < elt | = elt | > elt | + v} + + [binary_search] returns an element on the boundary of segments as specified by + [which]. See the diagram below next to the [which] variants. + + [binary_search] does not check that [compare] orders [t], and behavior is + unspecified if [compare] doesn't order [t]. Behavior is also unspecified if + [compare] mutates [t]. *) + val binary_search + : ('k, 'v, 'cmp) t + -> compare:(key:'k -> data:'v -> 'key -> int) + -> [ `Last_strictly_less_than (** {v | < elt X | v} *) + | `Last_less_than_or_equal_to (** {v | <= elt X | v} *) + | `Last_equal_to (** {v | = elt X | v} *) + | `First_equal_to (** {v | X = elt | v} *) + | `First_greater_than_or_equal_to (** {v | X >= elt | v} *) + | `First_strictly_greater_than (** {v | X > elt | v} *) + ] + -> 'key + -> ('k * 'v) option + + (** [binary_search_segmented t ~segment_of which] takes a [segment_of] function that + divides [t] into two (possibly empty) segments: + + {v + | segment_of elt = `Left | segment_of elt = `Right | + v} + + [binary_search_segmented] returns the [(key, value)] pair on the boundary of the + segments as specified by [which]: [`Last_on_left] yields the last element of the + left segment, while [`First_on_right] yields the first element of the right segment. + It returns [None] if the segment is empty. + + [binary_search_segmented] does not check that [segment_of] segments [t] as in the + diagram, and behavior is unspecified if [segment_of] doesn't segment [t]. Behavior + is also unspecified if [segment_of] mutates [t]. *) + val binary_search_segmented + : ('k, 'v, 'cmp) t + -> segment_of:(key:'k -> data:'v -> [ `Left | `Right ]) + -> [ `Last_on_left | `First_on_right ] + -> ('k * 'v) option + + (** [binary_search_subrange] takes a [compare] function that divides [t] into three + (possibly empty) segments with respect to [lower_bound] and [upper_bound]: + + {v + | Below_lower_bound | In_range | Above_upper_bound | + v} + + and returns a map of the [In_range] segment. + + Runtime is O(log m + n) where [m] is the length of the input map and [n] is the + length of the output. The linear term in [n] is to compute the length of the output. + + Behavior is undefined if [compare] does not segment [t] as shown above, or if + [compare] mutates its inputs. *) + val binary_search_subrange + : ('k, 'v, 'cmp) t + -> compare:(key:'k -> data:'v -> 'bound -> int) + -> lower_bound:'bound Maybe_bound.t + -> upper_bound:'bound Maybe_bound.t + -> ('k, 'v, 'cmp) t + + (** Creates traversals to reconstruct a map within an applicative. Uses + [Lazy_applicative] so that the map can be traversed within the applicative, rather + than needing to be traversed all at once, outside the applicative. *) + module Make_applicative_traversals (A : Applicative.Lazy_applicative) : sig + val mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k -> data:'v1 -> 'v2 A.t) + -> ('k, 'v2, 'cmp) t A.t + + val filter_mapi + : ('k, 'v1, 'cmp) t + -> f:(key:'k -> data:'v1 -> 'v2 option A.t) + -> ('k, 'v2, 'cmp) t A.t + end + + (** [M] is meant to be used in combination with OCaml applicative functor types: + + {[ + type string_to_int_map = int Map.M(String).t + ]} + + which stands for: + + {[ + type string_to_int_map = (String.t, int, String.comparator_witness) Map.t + ]} + + The point is that [int Map.M(String).t] supports deriving, whereas the second syntax + doesn't (because there is no such thing as, say, [String.sexp_of_comparator_witness] + -- instead you would want to pass the comparator directly). + + In addition, when using [@@deriving], the requirements on the key module are only + those needed to satisfy what you are trying to derive on the map itself. Say you + write: + + {[ + type t = int Map.M(X).t [@@deriving hash] + ]} + + then this will be well typed exactly if [X] contains at least: + - a type [t] with no parameters + - a comparator witness + - a [hash_fold_t] function with the right type *) + module M (K : sig + type t + type comparator_witness + end) : sig + type nonrec 'v t = (K.t, 'v, K.comparator_witness) t + end + + include For_deriving with type ('key, 'value, 'cmp) t := ('key, 'value, 'cmp) t + + (** [Using_comparator] is a similar interface as the toplevel of [Map], except the + functions take a [~comparator:('k, 'cmp) Comparator.t], whereas the functions at the + toplevel of [Map] take a [('k, 'cmp) comparator]. *) + module Using_comparator : sig + type nonrec ('k, +'v, 'cmp) t = ('k, 'v, 'cmp) t [@@deriving_inline sexp_of] + + val sexp_of_t + : ('k -> Sexplib0.Sexp.t) + -> ('v -> Sexplib0.Sexp.t) + -> ('cmp -> Sexplib0.Sexp.t) + -> ('k, 'v, 'cmp) t + -> Sexplib0.Sexp.t + + [@@@end] + + val t_of_sexp_direct + : comparator:('k, 'cmp) Comparator.t + -> (Sexp.t -> 'k) + -> (Sexp.t -> 'v) + -> Sexp.t + -> ('k, 'v, 'cmp) t + + module Tree : sig + type (+'k, +'v, 'cmp) t [@@deriving_inline sexp_of] + + val sexp_of_t + : ('k -> Sexplib0.Sexp.t) + -> ('v -> Sexplib0.Sexp.t) + -> ('cmp -> Sexplib0.Sexp.t) + -> ('k, 'v, 'cmp) t + -> Sexplib0.Sexp.t + + [@@@end] + + val t_of_sexp_direct + : comparator:('k, 'cmp) Comparator.t + -> (Sexp.t -> 'k) + -> (Sexp.t -> 'v) + -> Sexp.t + -> ('k, 'v, 'cmp) t + + include + Creators_and_accessors_generic + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) t + with type 'k key := 'k + with type 'c cmp := 'c + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t + + val empty_without_value_restriction : (_, _, _) t + + (** [Build_increasing] can be used to construct a map incrementally from a + sequence that is known to be increasing. + + The total time complexity of constructing a map this way is O(n), which is more + efficient than using [Map.add] by a logarithmic factor. + + This interface can be thought of as a dual of [to_sequence], but we don't have + an equally neat idiom for the duals of sequences ([of_sequence] is much less + general because it does not allow the sequence to be produced asynchronously). *) + module Build_increasing : sig + type ('a, 'b, 'c) tree := ('a, 'b, 'c) t + type ('k, 'v, 'w) t + + val empty : ('k, 'v, 'w) t + + (** Time complexity of [add_exn] is amortized constant-time (if [t] is used + linearly), with a worst-case O(log(n)) time. *) + val add_exn + : ('k, 'v, 'w) t + -> comparator:('k, 'w) Comparator.t + -> key:'k + -> data:'v + -> ('k, 'v, 'w) t + + (** Time complexity is O(log(n)). *) + val to_tree : ('k, 'v, 'w) t -> ('k, 'v, 'w) tree + end + end + + include + Creators_and_accessors_generic + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Tree.t + with type 'k key := 'k + with type 'c cmp := 'c + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + + val comparator : ('a, _, 'cmp) t -> ('a, 'cmp) Comparator.t + + val hash_fold_direct + : 'k Hash.folder + -> 'v Hash.folder + -> ('k, 'v, 'cmp) t Hash.folder + + (** To get around the value restriction, apply the functor and include it. You + can see an example of this in the [Poly] submodule below. *) + module Empty_without_value_restriction (K : Comparator.S1) : sig + val empty : ('a K.t, 'v, K.comparator_witness) t + end + end + + (** A polymorphic Map. *) + module Poly : + S_poly + with type ('key, +'value) t = ('key, 'value, Comparator.Poly.comparator_witness) t + and type ('key, +'value) tree = + ('key, 'value, Comparator.Poly.comparator_witness) Using_comparator.Tree.t + and type comparator_witness = Comparator.Poly.comparator_witness + + (** Create a map from a tree using the given comparator. *) + val of_tree + : ('k, 'cmp) Comparator.Module.t + -> ('k, 'v, 'cmp) Using_comparator.Tree.t + -> ('k, 'v, 'cmp) t + + (** Extract a tree from a map. *) + val to_tree : ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) Using_comparator.Tree.t + + (** {2 Modules and module types for extending [Map]} + + For use in extensions of Base, like [Core]. *) + + module With_comparator = With_comparator + module With_first_class_module = With_first_class_module + module Without_comparator = Without_comparator + + module type For_deriving = For_deriving + module type S_poly = S_poly + module type Accessors_generic = Accessors_generic + module type Creators_and_accessors_generic = Creators_and_accessors_generic + module type Creators_generic = Creators_generic +end diff --git a/unikernel/duniverse/base/src/maybe_bound.ml b/unikernel/duniverse/base/src/maybe_bound.ml new file mode 100644 index 00000000..53242cee --- /dev/null +++ b/unikernel/duniverse/base/src/maybe_bound.ml @@ -0,0 +1,245 @@ +open! Import + +type 'a t = + | Incl of 'a + | Excl of 'a + | Unbounded +[@@deriving_inline enumerate, sexp, sexp_grammar, globalize] + +let all : 'a. 'a list -> 'a t list = + fun _all_of_a -> + Ppx_enumerate_lib.List.append + (let rec map l acc = + match l with + | [] -> Ppx_enumerate_lib.List.rev acc + | enumerate__001_ :: l -> map l (Incl enumerate__001_ :: acc) + in + map _all_of_a []) + (Ppx_enumerate_lib.List.append + (let rec map l acc = + match l with + | [] -> Ppx_enumerate_lib.List.rev acc + | enumerate__002_ :: l -> map l (Excl enumerate__002_ :: acc) + in + map _all_of_a []) + [ Unbounded ]) +;; + +let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = + fun (type a__018_) : ((Sexplib0.Sexp.t -> a__018_) -> Sexplib0.Sexp.t -> a__018_ t) -> + let error_source__006_ = "maybe_bound.ml.t" in + fun _of_a__003_ -> function + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("incl" | "Incl") as _tag__009_) :: sexp_args__010_) as + _sexp__008_ -> + (match sexp_args__010_ with + | [ arg0__011_ ] -> + let res0__012_ = _of_a__003_ arg0__011_ in + Incl res0__012_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__006_ + _tag__009_ + _sexp__008_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("excl" | "Excl") as _tag__014_) :: sexp_args__015_) as + _sexp__013_ -> + (match sexp_args__015_ with + | [ arg0__016_ ] -> + let res0__017_ = _of_a__003_ arg0__016_ in + Excl res0__017_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__006_ + _tag__014_ + _sexp__013_) + | Sexplib0.Sexp.Atom ("unbounded" | "Unbounded") -> Unbounded + | Sexplib0.Sexp.Atom ("incl" | "Incl") as sexp__007_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__006_ sexp__007_ + | Sexplib0.Sexp.Atom ("excl" | "Excl") as sexp__007_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__006_ sexp__007_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("unbounded" | "Unbounded") :: _) as + sexp__007_ -> Sexplib0.Sexp_conv_error.stag_no_args error_source__006_ sexp__007_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__005_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__006_ sexp__005_ + | Sexplib0.Sexp.List [] as sexp__005_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__006_ sexp__005_ + | sexp__005_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__006_ sexp__005_ +;; + +let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + fun (type a__024_) : ((a__024_ -> Sexplib0.Sexp.t) -> a__024_ t -> Sexplib0.Sexp.t) -> + fun _of_a__019_ -> function + | Incl arg0__020_ -> + let res0__021_ = _of_a__019_ arg0__020_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Incl"; res0__021_ ] + | Excl arg0__022_ -> + let res0__023_ = _of_a__019_ arg0__022_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Excl"; res0__023_ ] + | Unbounded -> Sexplib0.Sexp.Atom "Unbounded" +;; + +let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag + { name = "Incl" + ; clause_kind = + List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) } + } + ; No_tag + { name = "Excl" + ; clause_kind = + List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) } + } + ; No_tag { name = "Unbounded"; clause_kind = Atom_clause } + ] + } + } +;; + +let globalize : 'a. ('a -> 'a) -> 'a t -> 'a t = + fun (type a__025_) : ((a__025_ -> a__025_) -> a__025_ t -> a__025_ t) -> + fun _globalize_a__026_ x__027_ -> + match x__027_ with + | Unbounded as x__028_ -> x__028_ + | Incl arg__029_ -> Incl (_globalize_a__026_ arg__029_) + | Excl arg__030_ -> Excl (_globalize_a__026_ arg__030_) +;; + +[@@@end] + +type interval_comparison = + | Below_lower_bound + | In_range + | Above_upper_bound +[@@deriving_inline sexp, sexp_grammar, compare ~localize, hash] + +let interval_comparison_of_sexp = + (let error_source__033_ = "maybe_bound.ml.interval_comparison" in + function + | Sexplib0.Sexp.Atom ("below_lower_bound" | "Below_lower_bound") -> Below_lower_bound + | Sexplib0.Sexp.Atom ("in_range" | "In_range") -> In_range + | Sexplib0.Sexp.Atom ("above_upper_bound" | "Above_upper_bound") -> Above_upper_bound + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom ("below_lower_bound" | "Below_lower_bound") :: _) as sexp__034_ + -> Sexplib0.Sexp_conv_error.stag_no_args error_source__033_ sexp__034_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("in_range" | "In_range") :: _) as sexp__034_ + -> Sexplib0.Sexp_conv_error.stag_no_args error_source__033_ sexp__034_ + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom ("above_upper_bound" | "Above_upper_bound") :: _) as sexp__034_ + -> Sexplib0.Sexp_conv_error.stag_no_args error_source__033_ sexp__034_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__032_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__033_ sexp__032_ + | Sexplib0.Sexp.List [] as sexp__032_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__033_ sexp__032_ + | sexp__032_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__033_ sexp__032_ + : Sexplib0.Sexp.t -> interval_comparison) +;; + +let sexp_of_interval_comparison = + (function + | Below_lower_bound -> Sexplib0.Sexp.Atom "Below_lower_bound" + | In_range -> Sexplib0.Sexp.Atom "In_range" + | Above_upper_bound -> Sexplib0.Sexp.Atom "Above_upper_bound" + : interval_comparison -> Sexplib0.Sexp.t) +;; + +let (interval_comparison_sexp_grammar : interval_comparison Sexplib0.Sexp_grammar.t) = + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag { name = "Below_lower_bound"; clause_kind = Atom_clause } + ; No_tag { name = "In_range"; clause_kind = Atom_clause } + ; No_tag { name = "Above_upper_bound"; clause_kind = Atom_clause } + ] + } + } +;; + +let compare_interval_comparison__local = + (Stdlib.compare : interval_comparison -> interval_comparison -> int) +;; + +let compare_interval_comparison = + (fun a b -> compare_interval_comparison__local a b + : interval_comparison -> interval_comparison -> int) +;; + +let (hash_fold_interval_comparison : + Ppx_hash_lib.Std.Hash.state -> interval_comparison -> Ppx_hash_lib.Std.Hash.state) + = + (fun hsv arg -> + Ppx_hash_lib.Std.Hash.fold_int + hsv + (match arg with + | Below_lower_bound -> 0 + | In_range -> 1 + | Above_upper_bound -> 2) + : Ppx_hash_lib.Std.Hash.state -> interval_comparison -> Ppx_hash_lib.Std.Hash.state) +;; + +let (hash_interval_comparison : interval_comparison -> Ppx_hash_lib.Std.Hash.hash_value) = + let func arg = + Ppx_hash_lib.Std.Hash.get_hash_value + (let hsv = Ppx_hash_lib.Std.Hash.create () in + hash_fold_interval_comparison hsv arg) + in + fun x -> func x +;; + +[@@@end] + +let map t ~f = + match t with + | Incl incl -> Incl (f incl) + | Excl excl -> Excl (f excl) + | Unbounded -> Unbounded +;; + +let is_lower_bound t ~of_:a ~compare = + match t with + | Incl incl -> compare incl a <= 0 + | Excl excl -> compare excl a < 0 + | Unbounded -> true +;; + +let is_upper_bound t ~of_:a ~compare = + match t with + | Incl incl -> compare a incl <= 0 + | Excl excl -> compare a excl < 0 + | Unbounded -> true +;; + +let bounds_crossed ~lower ~upper ~compare = + match lower with + | Unbounded -> false + | Incl lower | Excl lower -> + (match upper with + | Unbounded -> false + | Incl upper | Excl upper -> compare lower upper > 0) +;; + +let check_interval_exn ~lower ~upper ~compare = + if bounds_crossed ~lower ~upper ~compare + then failwith "Maybe_bound.compare_to_interval_exn: lower bound > upper bound" +;; + +let compare_to_interval_exn ~lower ~upper a ~compare = + check_interval_exn ~lower ~upper ~compare; + if not (is_lower_bound lower ~of_:a ~compare) + then Below_lower_bound + else if not (is_upper_bound upper ~of_:a ~compare) + then Above_upper_bound + else In_range +;; + +let interval_contains_exn ~lower ~upper a ~compare = + match compare_to_interval_exn ~lower ~upper a ~compare with + | In_range -> true + | Below_lower_bound | Above_upper_bound -> false +;; diff --git a/unikernel/duniverse/base/src/maybe_bound.mli b/unikernel/duniverse/base/src/maybe_bound.mli new file mode 100644 index 00000000..234ea4db --- /dev/null +++ b/unikernel/duniverse/base/src/maybe_bound.mli @@ -0,0 +1,66 @@ +(** Used for specifying a bound (either upper or lower) as inclusive, exclusive, or + unbounded. *) + +open! Import + +type 'a t = + | Incl of 'a + | Excl of 'a + | Unbounded +[@@deriving_inline enumerate, sexp, sexp_grammar, globalize] + +include Ppx_enumerate_lib.Enumerable.S1 with type 'a t := 'a t +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t +val globalize : ('a -> 'a) -> 'a t -> 'a t + +[@@@end] + +val map : 'a t -> f:('a -> 'b) -> 'b t +val is_lower_bound : 'a t -> of_:'a -> compare:('a -> 'a -> int) -> bool +val is_upper_bound : 'a t -> of_:'a -> compare:('a -> 'a -> int) -> bool + +(** [interval_contains_exn ~lower ~upper x ~compare] raises if [lower] and [upper] are + crossed. *) +val interval_contains_exn + : lower:'a t + -> upper:'a t + -> 'a + -> compare:('a -> 'a -> int) + -> bool + +(** [bounds_crossed ~lower ~upper ~compare] returns true if [lower > upper]. + + It ignores whether the bounds are [Incl] or [Excl]. *) +val bounds_crossed : lower:'a t -> upper:'a t -> compare:('a -> 'a -> int) -> bool + +type interval_comparison = + | Below_lower_bound + | In_range + | Above_upper_bound +[@@deriving_inline sexp, sexp_grammar, compare ~localize, hash] + +val sexp_of_interval_comparison : interval_comparison -> Sexplib0.Sexp.t +val interval_comparison_of_sexp : Sexplib0.Sexp.t -> interval_comparison +val interval_comparison_sexp_grammar : interval_comparison Sexplib0.Sexp_grammar.t +val compare_interval_comparison : interval_comparison -> interval_comparison -> int +val compare_interval_comparison__local : interval_comparison -> interval_comparison -> int + +val hash_fold_interval_comparison + : Ppx_hash_lib.Std.Hash.state + -> interval_comparison + -> Ppx_hash_lib.Std.Hash.state + +val hash_interval_comparison : interval_comparison -> Ppx_hash_lib.Std.Hash.hash_value + +[@@@end] + +(** [compare_to_interval_exn ~lower ~upper x ~compare] raises if [lower] and [upper] are + crossed. *) +val compare_to_interval_exn + : lower:'a t + -> upper:'a t + -> 'a + -> compare:('a -> 'a -> int) + -> interval_comparison diff --git a/unikernel/duniverse/base/src/monad.ml b/unikernel/duniverse/base/src/monad.ml new file mode 100644 index 00000000..d01f3b5d --- /dev/null +++ b/unikernel/duniverse/base/src/monad.ml @@ -0,0 +1,306 @@ +open! Import +module List = List0 +include Monad_intf + +module type Basic_general = sig + type ('a, 'i, 'j, 'd, 'e) t + + val bind + : ('a, 'i, 'j, 'd, 'e) t + -> f:('a -> ('b, 'j, 'k, 'd, 'e) t) + -> ('b, 'i, 'k, 'd, 'e) t + + val map + : [ `Define_using_bind + | `Custom of ('a, 'i, 'j, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'i, 'j, 'd, 'e) t + ] + + val return : 'a -> ('a, 'i, 'i, 'd, 'e) t +end + +module Make_general (M : Basic_general) = struct + let bind = M.bind + let return = M.return + let map_via_bind ma ~f = M.bind ma ~f:(fun a -> M.return (f a)) + + let map = + match M.map with + | `Define_using_bind -> map_via_bind + | `Custom x -> x + ;; + + module Monad_infix = struct + let ( >>= ) t f = bind t ~f + let ( >>| ) t f = map t ~f + end + + include Monad_infix + + module Let_syntax = struct + let return = return + + include Monad_infix + + module Let_syntax = struct + let return = return + let bind = bind + let map = map + let both a b = a >>= fun a -> b >>| fun b -> a, b + + module Open_on_rhs = struct end + end + end + + let join t = t >>= fun t' -> t' + let ignore_m t = map t ~f:(fun _ -> ()) + + let all = + let rec loop vs = function + | [] -> return (List.rev vs) + | t :: ts -> t >>= fun v -> loop (v :: vs) ts + in + fun ts -> loop [] ts + ;; + + let rec all_unit = function + | [] -> return () + | t :: ts -> t >>= fun () -> all_unit ts + ;; +end + +module Make_indexed (M : Basic_indexed) : + S_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) M.t = Make_general (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j) M.t +end) + +module Make3 (M : Basic3) : S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) M.t = +Make_general (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd, 'e) M.t +end) + +module Make2 (M : Basic2) : S2 with type ('a, 'd) t := ('a, 'd) M.t = Make_general (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd) M.t +end) + +module Make (M : Basic) : S with type 'a t := 'a M.t = Make_general (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = 'a M.t +end) + +module Make2_local (M : Basic2_local) = struct + let bind = M.bind + let return = M.return + + let map_via_bind ma ~f = + let res = M.bind ma ~f:(fun a -> M.return (f a)) in + res + ;; + + let map = + match M.map with + | `Define_using_bind -> map_via_bind + | `Custom x -> x + ;; + + module Monad_infix = struct + let ( >>= ) t f = bind t ~f + let ( >>| ) t f = map t ~f + end + + include Monad_infix + + module Let_syntax = struct + let return = return + + include Monad_infix + + module Let_syntax = struct + let return = return + let bind = bind + let map = map + + let both a b = + let res = + bind a ~f:(fun a -> + let res = map b ~f:(fun b -> a, b) in + res) + in + res + ;; + + module Open_on_rhs = struct end + end + end + + let join t = t >>= Fn.id + + let ignore_m t = + let res = map t ~f:(fun _ -> ()) in + res + ;; + + let all = + let rec loop vs = function + | [] -> return (List.rev vs) + | t :: ts -> t >>= fun v -> loop (v :: vs) ts + in + fun ts -> loop [] ts + ;; + + let rec all_unit = function + | [] -> return () + | t :: ts -> t >>= fun () -> all_unit ts + ;; +end + +module Make_local (M : Basic_local) : S_local with type 'a t := 'a M.t = +Make2_local (struct + include M + + type ('a, 'e) t = 'a M.t +end) + +module Of_monad_general (Monad : sig + type ('a, 'i, 'j, 'd, 'e) t + + val bind + : ('a, 'i, 'j, 'd, 'e) t + -> f:('a -> ('b, 'j, 'k, 'd, 'e) t) + -> ('b, 'i, 'k, 'd, 'e) t + + val map : ('a, 'i, 'j, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'i, 'j, 'd, 'e) t + val return : 'a -> ('a, 'i, 'i, 'd, 'e) t +end) (M : sig + type ('a, 'i, 'j, 'd, 'e) t + + val to_monad : ('a, 'i, 'j, 'd, 'e) t -> ('a, 'i, 'j, 'd, 'e) Monad.t + val of_monad : ('a, 'i, 'j, 'd, 'e) Monad.t -> ('a, 'i, 'j, 'd, 'e) t +end) = +Make_general (struct + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j, 'd, 'e) M.t + + let return a = M.of_monad (Monad.return a) + let bind t ~f = M.of_monad (Monad.bind (M.to_monad t) ~f:(fun a -> M.to_monad (f a))) + let map = `Custom (fun t ~f -> M.of_monad (Monad.map (M.to_monad t) ~f)) +end) + +module Of_monad_indexed + (Monad : S_indexed) (M : sig + type ('a, 'i, 'j) t + + val to_monad : ('a, 'i, 'j) t -> ('a, 'i, 'j) Monad.t + val of_monad : ('a, 'i, 'j) Monad.t -> ('a, 'i, 'j) t + end) = + Of_monad_general + (struct + include Monad + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j) Monad.t + end) + (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j) M.t + end) + +module Of_monad3 + (Monad : S3) (M : sig + type ('a, 'b, 'c) t + + val to_monad : ('a, 'b, 'c) t -> ('a, 'b, 'c) Monad.t + val of_monad : ('a, 'b, 'c) Monad.t -> ('a, 'b, 'c) t + end) = + Of_monad_general + (struct + include Monad + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd, 'e) Monad.t + end) + (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd, 'e) M.t + end) + +module Of_monad2 + (Monad : S2) (M : sig + type ('a, 'b) t + + val to_monad : ('a, 'b) t -> ('a, 'b) Monad.t + val of_monad : ('a, 'b) Monad.t -> ('a, 'b) t + end) = + Of_monad_general + (struct + include Monad + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd) Monad.t + end) + (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd) M.t + end) + +module Of_monad + (Monad : S) (M : sig + type 'a t + + val to_monad : 'a t -> 'a Monad.t + val of_monad : 'a Monad.t -> 'a t + end) = + Of_monad_general + (struct + include Monad + + type ('a, 'i, 'j, 'd, 'e) t = 'a Monad.t + end) + (struct + include M + + type ('a, 'i, 'j, 'd, 'e) t = 'a M.t + end) + +module Ident = struct + type 'a t = 'a + + let[@inline] bind a ~f = (f [@inlined hint]) a + let[@inline] map a ~f = (f [@inlined hint]) a + + external return : ('a[@local_opt]) -> ('a[@local_opt]) = "%identity" + + module Monad_infix = struct + let[@inline] ( >>| ) a f = map a ~f + let[@inline] ( >>= ) a f = bind a ~f + end + + include Monad_infix + + module Let_syntax = struct + let return = return + + include Monad_infix + + module Let_syntax = struct + let return = return + let bind = bind + let map = map + let[@inline] both a b = a, b + + module Open_on_rhs = struct end + end + + let return = return + end + + external join : ('a[@local_opt]) -> ('a[@local_opt]) = "%identity" + external ignore_m : (_[@local_opt]) -> unit = "%ignore" + external all_unit : (unit list[@local_opt]) -> unit = "%ignore" + external all : ('a list[@local_opt]) -> ('a list[@local_opt]) = "%identity" +end diff --git a/unikernel/duniverse/base/src/monad.mli b/unikernel/duniverse/base/src/monad.mli new file mode 100644 index 00000000..65be892d --- /dev/null +++ b/unikernel/duniverse/base/src/monad.mli @@ -0,0 +1 @@ +include Monad_intf.Monad (** @inline *) diff --git a/unikernel/duniverse/base/src/monad_intf.ml b/unikernel/duniverse/base/src/monad_intf.ml new file mode 100644 index 00000000..0361c848 --- /dev/null +++ b/unikernel/duniverse/base/src/monad_intf.ml @@ -0,0 +1,517 @@ +open! Import + +module type Basic_gen = sig + type 'a t + type ('a, 'b) f_labeled_fn + + val bind : 'a t -> ('a -> 'b t, 'b t) f_labeled_fn + val return : 'a -> 'a t + + (** The following identities ought to hold (for some value of =): + + - [return x >>= f = f x] + - [t >>= fun x -> return x = t] + - [(t >>= f) >>= g = t >>= fun x -> (f x >>= g)] + + Note: [>>=] is the infix notation for [bind]) *) + + (** The [map] argument to [Monad.Make] says how to implement the monad's [map] function. + [`Define_using_bind] means to define [map t ~f = bind t ~f:(fun a -> return (f a))]. + [`Custom] overrides the default implementation, presumably with something more + efficient. + + Some other functions returned by [Monad.Make] are defined in terms of [map], so + passing in a more efficient [map] will improve their efficiency as well. *) + val map : [ `Define_using_bind | `Custom of 'a t -> ('a -> 'b, 'b t) f_labeled_fn ] +end + +module type Basic = Basic_gen with type ('a, 'b) f_labeled_fn := f:'a -> 'b +module type Basic_local = Basic_gen with type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type Infix_gen = sig + type 'a t + type ('a, 'b) fn + + (** [t >>= f] returns a computation that sequences the computations represented by two + monad elements. The resulting computation first does [t] to yield a value [v], and + then runs the computation returned by [f v]. *) + val ( >>= ) : 'a t -> ('a -> 'b t, 'b t) fn + + (** [t >>| f] is [t >>= (fun a -> return (f a))]. *) + val ( >>| ) : 'a t -> ('a -> 'b, 'b t) fn +end + +module type Infix = Infix_gen with type ('a, 'b) fn := 'a -> 'b +module type Infix_local = Infix_gen with type ('a, 'b) fn := 'a -> 'b + +module type Syntax_gen = sig + (** Opening a module of this type allows one to use the [%bind] and [%map] syntax + extensions defined by ppx_let, and brings [return] into scope. *) + + type 'a t + type ('a, 'b) fn + type ('a, 'b) f_labeled_fn + + module Let_syntax : sig + (** These are convenient to have in scope when programming with a monad: *) + + val return : 'a -> 'a t + + include Infix_gen with type 'a t := 'a t and type ('a, 'b) fn := ('a, 'b) fn + + module Let_syntax : sig + val return : 'a -> 'a t + val bind : 'a t -> ('a -> 'b t, 'b t) f_labeled_fn + val map : 'a t -> ('a -> 'b, 'b t) f_labeled_fn + val both : 'a t -> 'b t -> ('a * 'b) t + + module Open_on_rhs : sig end + end + end +end + +module type Syntax = + Syntax_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type Syntax_local = + Syntax_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type S_without_syntax_gen = sig + type 'a t + type ('a, 'b) fn + type ('a, 'b) f_labeled_fn + + include Infix_gen with type 'a t := 'a t and type ('a, 'b) fn := ('a, 'b) fn + + module Monad_infix : + Infix_gen with type 'a t := 'a t and type ('a, 'b) fn := ('a, 'b) fn + + (** [bind t ~f] = [t >>= f] *) + val bind : 'a t -> ('a -> 'b t, 'b t) f_labeled_fn + + (** [return v] returns the (trivial) computation that returns v. *) + val return : 'a -> 'a t + + (** [map t ~f] is t >>| f. *) + val map : 'a t -> ('a -> 'b, 'b t) f_labeled_fn + + (** [join t] is [t >>= (fun t' -> t')]. *) + val join : 'a t t -> 'a t + + (** [ignore_m t] is [map t ~f:(fun _ -> ())]. [ignore_m] used to be called [ignore], + but we decided that was a bad name, because it shadowed the widely used + [Stdlib.ignore]. Some monads still do [let ignore = ignore_m] for historical + reasons. *) + val ignore_m : 'a t -> unit t + + val all : 'a t list -> 'a list t + + (** Like [all], but ensures that every monadic value in the list produces a unit value, + all of which are discarded rather than being collected into a list. *) + val all_unit : unit t list -> unit t +end + +module type S_without_syntax = + S_without_syntax_gen + with type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b) fn := 'a -> 'b + +module type S_without_syntax_local = + S_without_syntax_gen + with type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b) fn := 'a -> 'b + +module type S = sig + type 'a t + + include S_without_syntax with type 'a t := 'a t + include Syntax with type 'a t := 'a t +end + +module type S_local = sig + type 'a t + + include S_without_syntax_local with type 'a t := 'a t + include Syntax_local with type 'a t := 'a t +end + +module type Basic2_gen = sig + (** Multi parameter monad. The second parameter gets unified across all the computation. + This is used to encode monads working on a multi parameter data structure like + ([('a,'b) result]). *) + + type ('a, 'e) t + type ('a, 'b) f_labeled_fn + + val bind : ('a, 'e) t -> ('a -> ('b, 'e) t, ('b, 'e) t) f_labeled_fn + + val map + : [ `Define_using_bind + | `Custom of ('a, 'e) t -> ('a -> 'b, ('b, 'e) t) f_labeled_fn + ] + + val return : 'a -> ('a, _) t +end + +module type Basic2 = Basic2_gen with type ('a, 'b) f_labeled_fn := f:'a -> 'b +module type Basic2_local = Basic2_gen with type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type Infix2_gen = sig + (** Same as {!Infix}, except the monad type has two arguments. The second is always just + passed through. *) + + type ('a, 'e) t + type ('a, 'b) fn + + val ( >>= ) : ('a, 'e) t -> ('a -> ('b, 'e) t, ('b, 'e) t) fn + val ( >>| ) : ('a, 'e) t -> ('a -> 'b, ('b, 'e) t) fn +end + +module type Infix2 = Infix2_gen with type ('a, 'b) fn := 'a -> 'b +module type Infix2_local = Infix2_gen with type ('a, 'b) fn := 'a -> 'b + +module type Syntax2_gen = sig + type ('a, 'e) t + type ('a, 'b) fn + type ('a, 'b) f_labeled_fn + + module Let_syntax : sig + val return : 'a -> ('a, _) t + + include + Infix2_gen with type ('a, 'e) t := ('a, 'e) t and type ('a, 'b) fn := ('a, 'b) fn + + module Let_syntax : sig + val return : 'a -> ('a, _) t + val bind : ('a, 'e) t -> ('a -> ('b, 'e) t, ('b, 'e) t) f_labeled_fn + val map : ('a, 'e) t -> ('a -> 'b, ('b, 'e) t) f_labeled_fn + val both : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t + + module Open_on_rhs : sig end + end + end +end + +module type Syntax2 = + Syntax2_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type Syntax2_local = + Syntax2_gen + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type S2_gen = sig + (** The same as {!S} except the monad type has two arguments. The second is always just + passed through. *) + + type ('a, 'e) t + type ('a, 'b) fn + type ('a, 'b) f_labeled_fn + + include + Infix2_gen with type ('a, 'e) t := ('a, 'e) t and type ('a, 'b) fn := ('a, 'b) fn + + include + Syntax2_gen + with type ('a, 'e) t := ('a, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn + and type ('a, 'b) f_labeled_fn := ('a, 'b) f_labeled_fn + + module Monad_infix : + Infix2_gen with type ('a, 'e) t := ('a, 'e) t and type ('a, 'b) fn := ('a, 'b) fn + + val bind : ('a, 'e) t -> ('a -> ('b, 'e) t, ('b, 'e) t) f_labeled_fn + val return : 'a -> ('a, _) t + val map : ('a, 'e) t -> ('a -> 'b, ('b, 'e) t) f_labeled_fn + val join : (('a, 'e) t, 'e) t -> ('a, 'e) t + val ignore_m : (_, 'e) t -> (unit, 'e) t + val all : ('a, 'e) t list -> ('a list, 'e) t + val all_unit : (unit, 'e) t list -> (unit, 'e) t +end + +module type S2 = + S2_gen with type ('a, 'b) fn := 'a -> 'b and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type S2_local = + S2_gen with type ('a, 'b) fn := 'a -> 'b and type ('a, 'b) f_labeled_fn := f:'a -> 'b + +module type Basic3 = sig + (** Multi parameter monad. The second and third parameters get unified across all the + computation. *) + + type ('a, 'd, 'e) t + + val bind : ('a, 'd, 'e) t -> f:('a -> ('b, 'd, 'e) t) -> ('b, 'd, 'e) t + + val map + : [ `Define_using_bind | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t ] + + val return : 'a -> ('a, _, _) t +end + +module type Infix3 = sig + (** Same as Infix, except the monad type has three arguments. The second and third are + always just passed through. *) + + type ('a, 'd, 'e) t + + val ( >>= ) : ('a, 'd, 'e) t -> ('a -> ('b, 'd, 'e) t) -> ('b, 'd, 'e) t + val ( >>| ) : ('a, 'd, 'e) t -> ('a -> 'b) -> ('b, 'd, 'e) t +end + +module type Syntax3 = sig + type ('a, 'd, 'e) t + + module Let_syntax : sig + val return : 'a -> ('a, _, _) t + + include Infix3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + + module Let_syntax : sig + val return : 'a -> ('a, _, _) t + val bind : ('a, 'd, 'e) t -> f:('a -> ('b, 'd, 'e) t) -> ('b, 'd, 'e) t + val map : ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t + val both : ('a, 'd, 'e) t -> ('b, 'd, 'e) t -> ('a * 'b, 'd, 'e) t + + module Open_on_rhs : sig end + end + end +end + +module type S3 = sig + (** The same as {!S} except the monad type has three arguments. The second + and third are always just passed through. *) + + type ('a, 'd, 'e) t + + include Infix3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + include Syntax3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + module Monad_infix : Infix3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + + val bind : ('a, 'd, 'e) t -> f:('a -> ('b, 'd, 'e) t) -> ('b, 'd, 'e) t + val return : 'a -> ('a, _, _) t + val map : ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t + val join : (('a, 'd, 'e) t, 'd, 'e) t -> ('a, 'd, 'e) t + val ignore_m : (_, 'd, 'e) t -> (unit, 'd, 'e) t + val all : ('a, 'd, 'e) t list -> ('a list, 'd, 'e) t + val all_unit : (unit, 'd, 'e) t list -> (unit, 'd, 'e) t +end + +module type Basic_indexed = sig + (** Indexed monad, in the style of Atkey. The second and third parameters are composed + across all computation. To see this more clearly, you can look at the type of bind: + + {[ + val bind : ('a, 'i, 'j) t -> f:('a -> ('b, 'j, 'k) t) -> ('b, 'i, 'k) t + ]} + + and isolate some of the type variables to see their individual behaviors: + + {[ + val bind : 'a -> f:('a -> 'b ) -> 'b + val bind : 'i, 'j -> 'j, 'k -> 'i, 'k + ]} + + For more information on Atkey-style indexed monads, see: + + {v + Parameterised Notions of Computation + Robert Atkey + http://bentnib.org/paramnotions-jfp.pdf + v} *) + + type ('a, 'i, 'j) t + + val bind : ('a, 'i, 'j) t -> f:('a -> ('b, 'j, 'k) t) -> ('b, 'i, 'k) t + + val map + : [ `Define_using_bind | `Custom of ('a, 'i, 'j) t -> f:('a -> 'b) -> ('b, 'i, 'j) t ] + + val return : 'a -> ('a, 'i, 'i) t +end + +module type Infix_indexed = sig + (** Same as {!Infix}, except the monad type has three arguments. The second and + third are composed across all computation. *) + + type ('a, 'i, 'j) t + + val ( >>= ) : ('a, 'i, 'j) t -> ('a -> ('b, 'j, 'k) t) -> ('b, 'i, 'k) t + val ( >>| ) : ('a, 'i, 'j) t -> ('a -> 'b) -> ('b, 'i, 'j) t +end + +module type Syntax_indexed = sig + type ('a, 'i, 'j) t + + module Let_syntax : sig + val return : 'a -> ('a, 'i, 'i) t + + include Infix_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) t + + module Let_syntax : sig + val return : 'a -> ('a, 'i, 'i) t + val bind : ('a, 'i, 'j) t -> f:('a -> ('b, 'j, 'k) t) -> ('b, 'i, 'k) t + val map : ('a, 'i, 'j) t -> f:('a -> 'b) -> ('b, 'i, 'j) t + val both : ('a, 'i, 'j) t -> ('b, 'j, 'k) t -> ('a * 'b, 'i, 'k) t + + module Open_on_rhs : sig end + end + end +end + +module type S_indexed = sig + (** The same as {!S} except the monad type has three arguments. The second and + third are composed across all computation. *) + + type ('a, 'i, 'j) t + + include Infix_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) t + include Syntax_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) t + module Monad_infix : Infix_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) t + + val bind : ('a, 'i, 'j) t -> f:('a -> ('b, 'j, 'k) t) -> ('b, 'i, 'k) t + val return : 'a -> ('a, 'i, 'i) t + val map : ('a, 'i, 'j) t -> f:('a -> 'b) -> ('b, 'i, 'j) t + val join : (('a, 'j, 'k) t, 'i, 'j) t -> ('a, 'i, 'k) t + val ignore_m : (_, 'i, 'j) t -> (unit, 'i, 'j) t + val all : ('a, 'i, 'i) t list -> ('a list, 'i, 'i) t + val all_unit : (unit, 'i, 'i) t list -> (unit, 'i, 'i) t +end + +module S_to_S2 (X : S) : S2 with type ('a, 'e) t = 'a X.t = struct + include X + + type ('a, 'e) t = 'a X.t +end + +module S2_to_S3 (X : S2) : S3 with type ('a, 'd, 'e) t = ('a, 'd) X.t = struct + include X + + type ('a, 'd, 'e) t = ('a, 'd) X.t +end + +module S_to_S_indexed (X : S) : S_indexed with type ('a, 'i, 'j) t = 'a X.t = struct + include X + + type ('a, 'i, 'j) t = 'a X.t +end + +module S2_to_S (X : S2) : S with type 'a t = ('a, unit) X.t = struct + include X + + type 'a t = ('a, unit) X.t +end + +module S3_to_S2 (X : S3) : S2 with type ('a, 'e) t = ('a, 'e, unit) X.t = struct + include X + + type ('a, 'e) t = ('a, 'e, unit) X.t +end + +module S_indexed_to_S2 (X : S_indexed) : S2 with type ('a, 'e) t = ('a, 'e, 'e) X.t = +struct + include X + + type ('a, 'e) t = ('a, 'e, 'e) X.t +end + +module type Monad = sig + (** A monad is an abstraction of the concept of sequencing of computations. A value of + type ['a monad] represents a computation that returns a value of type ['a]. *) + + module type Basic = Basic + module type Basic2 = Basic2 + module type Basic3 = Basic3 + module type Basic_indexed = Basic_indexed + module type Basic_local = Basic_local + module type Basic2_local = Basic2_local + module type Infix = Infix + module type Infix2 = Infix2 + module type Infix3 = Infix3 + module type Infix_indexed = Infix_indexed + module type Infix_local = Infix_local + module type Infix2_local = Infix2_local + module type Syntax = Syntax + module type Syntax2 = Syntax2 + module type Syntax3 = Syntax3 + module type Syntax_indexed = Syntax_indexed + module type Syntax_local = Syntax_local + module type Syntax2_local = Syntax2_local + module type S_without_syntax = S_without_syntax + module type S_without_syntax_local = S_without_syntax_local + module type S = S + module type S2 = S2 + module type S3 = S3 + module type S_indexed = S_indexed + module type S_local = S_local + module type S2_local = S2_local + + module Make (X : Basic) : S with type 'a t := 'a X.t + module Make2 (X : Basic2) : S2 with type ('a, 'e) t := ('a, 'e) X.t + module Make3 (X : Basic3) : S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t + + module Make_indexed (X : Basic_indexed) : + S_indexed with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t + + module Make_local (X : Basic_local) : S_local with type 'a t := 'a X.t + module Make2_local (X : Basic2_local) : S2_local with type ('a, 'e) t := ('a, 'e) X.t + + (** Define a monad through an isomorphism with an existing monad. For example: + + {[ + type 'a t = { value : 'a } + + include Monad.Of_monad (Monad.Ident) (struct + type nonrec 'a t = 'a t + + let to_monad { value } = value + let of_monad value = { value } + end) + ]} *) + module Of_monad + (Monad : S) (M : sig + type 'a t + + val to_monad : 'a t -> 'a Monad.t + val of_monad : 'a Monad.t -> 'a t + end) : S with type 'a t := 'a M.t + + module Of_monad2 + (Monad : S2) (M : sig + type ('a, 'b) t + + val to_monad : ('a, 'b) t -> ('a, 'b) Monad.t + val of_monad : ('a, 'b) Monad.t -> ('a, 'b) t + end) : S2 with type ('a, 'b) t := ('a, 'b) M.t + + module Of_monad3 + (Monad : S3) (M : sig + type ('a, 'b, 'c) t + + val to_monad : ('a, 'b, 'c) t -> ('a, 'b, 'c) Monad.t + val of_monad : ('a, 'b, 'c) Monad.t -> ('a, 'b, 'c) t + end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t + + module Of_monad_indexed + (Monad : S_indexed) (M : sig + type ('a, 'i, 'j) t + + val to_monad : ('a, 'i, 'j) t -> ('a, 'i, 'j) Monad.t + val of_monad : ('a, 'i, 'j) Monad.t -> ('a, 'i, 'j) t + end) : S_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) M.t + + (** An eager identity monad with functions heavily annotated with + [@inlined] or [@inline hint]. + + The implementation is manually written, rather than being + constructed by [Monad.Make]. This gives better inlining + guarantees. + *) + module Ident : S_local with type 'a t = 'a +end diff --git a/unikernel/duniverse/base/src/nativeint.ml b/unikernel/duniverse/base/src/nativeint.ml new file mode 100644 index 00000000..f3a67e54 --- /dev/null +++ b/unikernel/duniverse/base/src/nativeint.ml @@ -0,0 +1,331 @@ +open! Import +open! Stdlib.Nativeint +include Nativeint_replace_polymorphic_compare + +module T = struct + type t = nativeint [@@deriving_inline globalize, hash, sexp, sexp_grammar] + + let (globalize : t -> t) = (globalize_nativeint : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_nativeint + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_nativeint in + fun x -> func x + ;; + + let t_of_sexp = (nativeint_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_nativeint : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = nativeint_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + let compare = Nativeint_replace_polymorphic_compare.compare + let to_string = to_string + let of_string = of_string + let of_string_opt = of_string_opt +end + +include T +include Comparator.Make (T) + +include Comparable.With_zero (struct + include T + + let zero = zero +end) + +module Conv = Int_conversions +include Int_string_conversions.Make (T) + +include Int_string_conversions.Make_hex (struct + open Nativeint_replace_polymorphic_compare + + type t = nativeint [@@deriving_inline compare ~localize, hash] + + let compare__local = (compare_nativeint__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_nativeint + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_nativeint in + fun x -> func x + ;; + + [@@@end] + + let zero = zero + let neg = neg + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%nx" i + let of_string s = Stdlib.Scanf.sscanf s "%nx" Fn.id + let module_name = "Base.Nativeint.Hex" +end) + +include Pretty_printer.Register (struct + type nonrec t = t + + let to_string = to_string + let module_name = "Base.Nativeint" +end) + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! Nativeint_replace_polymorphic_compare + +let invariant (_ : t) = () +let num_bits = Word_size.num_bits Word_size.word_size +let float_lower_bound = Float0.lower_bound_for_int num_bits +let float_upper_bound = Float0.upper_bound_for_int num_bits +let shift_right_logical = shift_right_logical +let shift_right = shift_right +let shift_left = shift_left +let bit_not = lognot +let bit_xor = logxor +let bit_or = logor +let bit_and = logand +let min_value = min_int +let max_value = max_int +let abs = abs +let pred = pred +let succ = succ +let rem = rem +let neg = neg +let minus_one = minus_one +let one = one +let zero = zero +let to_float = to_float +let of_float_unchecked = of_float + +let of_float f = + if Float_replace_polymorphic_compare.( >= ) f float_lower_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + then of_float f + else + Printf.invalid_argf + "Nativeint.of_float: argument (%f) is out of range or NaN" + (Float0.box f) + () +;; + +module Pow2 = struct + open! Import + open Nativeint_replace_polymorphic_compare + + let raise_s = Error.raise_s + + let non_positive_argument () = + Printf.invalid_argf "argument must be strictly positive" () + ;; + + let ( lor ) = Stdlib.Nativeint.logor + let ( lsr ) = Stdlib.Nativeint.shift_right_logical + let ( land ) = Stdlib.Nativeint.logand + + (** "ceiling power of 2" - Least power of 2 greater than or equal to x. *) + let ceil_pow2 (x : nativeint) = + if x <= 0n then non_positive_argument (); + let x = Stdlib.Nativeint.pred x in + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + (* The next line is superfluous on 32-bit architectures, but it's faster to do it + anyway than to branch *) + let x = x lor (x lsr 32) in + Stdlib.Nativeint.succ x + ;; + + (** "floor power of 2" - Largest power of 2 less than or equal to x. *) + let floor_pow2 x = + if x <= 0n then non_positive_argument (); + let x = x lor (x lsr 1) in + let x = x lor (x lsr 2) in + let x = x lor (x lsr 4) in + let x = x lor (x lsr 8) in + let x = x lor (x lsr 16) in + let x = x lor (x lsr 32) in + Stdlib.Nativeint.sub x (x lsr 1) + ;; + + let is_pow2 x = + if x <= 0n then non_positive_argument (); + x land Stdlib.Nativeint.pred x = 0n + ;; + + (* C stubs for nativeint clz and ctz to use the CLZ/BSR/CTZ/BSF instruction where possible *) + external clz + : (nativeint[@unboxed]) + -> (int[@untagged]) + = "Base_int_math_nativeint_clz" "Base_int_math_nativeint_clz_unboxed" + [@@noalloc] + + external ctz + : (nativeint[@unboxed]) + -> (int[@untagged]) + = "Base_int_math_nativeint_ctz" "Base_int_math_nativeint_ctz_unboxed" + [@@noalloc] + + (** Hacker's Delight Second Edition p106 *) + let floor_log2 i = + if Poly.( <= ) i Stdlib.Nativeint.zero + then + raise_s + (Sexp.message + "[Nativeint.floor_log2] got invalid input" + [ "", sexp_of_nativeint i ]); + num_bits - 1 - clz i + ;; + + (** Hacker's Delight Second Edition p106 *) + let ceil_log2 i = + if Poly.( <= ) i Stdlib.Nativeint.zero + then + raise_s + (Sexp.message + "[Nativeint.ceil_log2] got invalid input" + [ "", sexp_of_nativeint i ]); + if Stdlib.Nativeint.equal i Stdlib.Nativeint.one + then 0 + else num_bits - clz (Stdlib.Nativeint.pred i) + ;; +end + +include Pow2 + +let between t ~low ~high = low <= t && t <= high +let clamp_unchecked t ~min:min_ ~max:max_ = min t max_ |> max min_ + +let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max +;; + +let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) +;; + +let ( / ) = div +let ( * ) = mul +let ( - ) = sub +let ( + ) = add +let ( ~- ) = neg +let incr r = r := !r + one +let decr r = r := !r - one +let of_nativeint t = t +let of_nativeint_exn = of_nativeint +let to_nativeint t = t +let to_nativeint_exn = to_nativeint +let popcount = Popcount.nativeint_popcount +let of_int = Conv.int_to_nativeint +let of_int_exn = of_int +let to_int = Conv.nativeint_to_int +let to_int_exn = Conv.nativeint_to_int_exn +let to_int_trunc = Conv.nativeint_to_int_trunc +let of_int32 = Conv.int32_to_nativeint +let of_int32_exn = of_int32 +let to_int32 = Conv.nativeint_to_int32 +let to_int32_exn = Conv.nativeint_to_int32_exn + +external to_int32_trunc + : (nativeint[@local_opt]) + -> (int32[@local_opt]) + = "%nativeint_to_int32" + +let of_int64 = Conv.int64_to_nativeint +let of_int64_exn = Conv.int64_to_nativeint_exn +let of_int64_trunc = Conv.int64_to_nativeint_trunc +let to_int64 = Conv.nativeint_to_int64 +let pow b e = of_int_exn (Int_math.Private.int_pow (to_int_exn b) (to_int_exn e)) +let ( ** ) b e = pow b e + +include Int_string_conversions.Make_binary (struct + type t = nativeint [@@deriving_inline compare ~localize, equal ~localize, hash] + + let compare__local = (compare_nativeint__local : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) + let equal__local = (equal_nativeint__local : t -> t -> bool) + let equal = (fun a b -> equal__local a b : t -> t -> bool) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_nativeint + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_nativeint in + fun x -> func x + ;; + + [@@@end] + + let ( land ) = ( land ) + let ( lsr ) = ( lsr ) + let clz = clz + let num_bits = num_bits + let one = one + let to_int_exn = to_int_exn + let zero = zero +end) + +module Pre_O = struct + let ( + ) = ( + ) + let ( - ) = ( - ) + let ( * ) = ( * ) + let ( / ) = ( / ) + let ( ~- ) = ( ~- ) + let ( ** ) = ( ** ) + + include (Nativeint_replace_polymorphic_compare : Comparisons.Infix with type t := t) + + let abs = abs + let neg = neg + let zero = zero + let of_int_exn = of_int_exn +end + +module O = struct + include Pre_O + + include Int_math.Make (struct + type nonrec t = t + + include Pre_O + + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) + + let ( land ) = bit_and + let ( lor ) = bit_or + let ( lxor ) = bit_xor + let lnot = bit_not + let ( lsl ) = shift_left + let ( asr ) = shift_right + let ( lsr ) = shift_right_logical +end + +include O + +(* [Nativeint] and [Nativeint.O] agree value-wise *) + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Nativeint_replace_polymorphic_compare + +external bswap : (t[@local_opt]) -> (t[@local_opt]) = "%bswap_native" diff --git a/unikernel/duniverse/base/src/nativeint.mli b/unikernel/duniverse/base/src/nativeint.mli new file mode 100644 index 00000000..a86d1123 --- /dev/null +++ b/unikernel/duniverse/base/src/nativeint.mli @@ -0,0 +1,42 @@ +(** Processor-native integers. *) + +open! Import + +type t = nativeint [@@deriving_inline globalize] + +val globalize : t -> t + +[@@@end] + +include Int_intf.S with type t := t + +(** {2 Conversion functions} *) + +val of_int : int -> t +val to_int : t -> int option +val of_int32 : int32 -> t +val to_int32 : t -> int32 option +val of_nativeint : nativeint -> t +val to_nativeint : t -> nativeint +val of_int64 : int64 -> t option + +(** {3 Truncating conversions} + + These functions return the least-significant bits of the input. In cases where + optional conversions return [Some x], truncating conversions return [x]. *) + +val to_int_trunc : t -> int + +external to_int32_trunc + : (nativeint[@local_opt]) + -> (int32[@local_opt]) + = "%nativeint_to_int32" + +val of_int64_trunc : int64 -> t + +(** {2 Byte swap functions} + + See {{!modtype:Int.Int_without_module_types}[Int]'s byte swap section} for + a description of Base's approach to exposing byte swap primitives. *) + +val bswap : t -> t diff --git a/unikernel/duniverse/base/src/nothing.ml b/unikernel/duniverse/base/src/nothing.ml new file mode 100644 index 00000000..ec604043 --- /dev/null +++ b/unikernel/duniverse/base/src/nothing.ml @@ -0,0 +1,61 @@ +open! Import + +module T = struct + type t = | + + let unreachable_code_local = function + | (_ : t) -> . + ;; + + let unreachable_code x = unreachable_code_local x + let all = [] + let hash_fold_t _ t = unreachable_code t + let hash = unreachable_code + let compare a _ = unreachable_code a + let compare__local a _ = unreachable_code a + let equal__local a _ = unreachable_code a + let sexp_of_t = unreachable_code + let t_of_sexp sexp = Sexplib0.Sexp_conv_error.empty_type "Base.Nothing.t" sexp + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = { untyped = Union [] } + let to_string = unreachable_code + let of_string (_ : string) = failwith "Base.Nothing.of_string: not supported" + let globalize = unreachable_code +end + +include T + +include Identifiable.Make (struct + include T + + let module_name = "Base.Nothing" +end) + +let must_be_none : t option -> unit = function + | None -> () + | Some _ -> . +;; + +let must_be_empty : t list -> unit = function + | [] -> () + | _ :: _ -> . +;; + +let must_be_ok : ('ok, t) Result.t -> 'ok = function + | Ok ok -> ok + | Error _ -> . +;; + +let must_be_error : (t, 'err) Result.t -> 'err = function + | Ok _ -> . + | Error error -> error +;; + +let must_be_first : ('first, t) Either.t -> 'first = function + | First first -> first + | Second _ -> . +;; + +let must_be_second : (t, 'second) Either.t -> 'second = function + | First _ -> . + | Second second -> second +;; diff --git a/unikernel/duniverse/base/src/nothing.mli b/unikernel/duniverse/base/src/nothing.mli new file mode 100644 index 00000000..e964a85f --- /dev/null +++ b/unikernel/duniverse/base/src/nothing.mli @@ -0,0 +1,88 @@ +(** An uninhabited type. This is useful when interfaces require that a type be specified, + but the implementer knows this type will not be used in their implementation of the + interface. + + For instance, [Async.Rpc.Pipe_rpc.t] is parameterized by an error type, but a user + may want to define a Pipe RPC that can't fail. *) + +open! Import + +(** Having [[@@deriving enumerate]] may seem strange due to the fact that generated + [val all : t list] is the empty list, so it seems like it could be of no use. + + This may be true if you always expect your type to be [Nothing.t], but [[@@deriving + enumerate]] can be useful if you have a type which you expect to change over time. + For example, you may have a program which has to interact with multiple servers which + are possibly at different versions. It may be useful in this program to have a + variant type which enumerates the ways in which the servers may differ. When all the + servers are at the same version, you can change this type to [Nothing.t] and code + which uses an enumeration of the type will continue to work correctly. + + This is a similar issue to the identifiability of [Nothing.t]. As discussed below, + another case where [[@deriving enumerate]] could be useful is when this type is part + of some larger type. + + Similar arguments apply for other derivers, like [globalize] and [sexp_grammar]. *) +type t = | [@@deriving_inline enumerate, globalize, sexp_grammar] + +include Ppx_enumerate_lib.Enumerable.S with type t := t + +val globalize : t -> t +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +(** Because there are no values of type [Nothing.t], a piece of code that has a value of + type [Nothing.t] must be unreachable. In such an unreachable piece of code, one can + use [unreachable_code] to give the code whatever type one needs. For example: + + {[ + let f (r : (int, Nothing.t) Result.t) : int = + match r with + | Ok i -> i + | Error n -> Nothing.unreachable_code n + ;; + ]} + + Note that the compiler knows that [Nothing.t] is uninhabited, hence this will type + without warning: + + {[ + let f (Ok i : (int, Nothing.t) Result.t) = i + ]} +*) +val unreachable_code : t -> _ + +(** The same as [unreachable_code], but for local [t]s. *) +val unreachable_code_local : t -> _ + +(** It may seem weird that this is identifiable, but we're just trying to anticipate all + the contexts in which people may need this. It would be a crying shame if you had some + variant type involving [Nothing.t] that you wished to make identifiable, but were + prevented for lack of [Identifiable.S] here. + + Obviously, [of_string] and [t_of_sexp] will raise an exception. *) +include Identifiable.S with type t := t + +include Ppx_compare_lib.Equal.S_local with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t + +(** Ignores [None] and guarantees there is no [Some _]. A better replacement for + [ignore]. *) +val must_be_none : t option -> unit + +(** Ignores [ [] ] and guarantees there is no [_ :: _]. A better replacement for + [ignore]. *) +val must_be_empty : t list -> unit + +(** Returns [ok] from [Ok ok] and guarantees there is no [Error _]. *) +val must_be_ok : ('ok, t) Result.t -> 'ok + +(** Returns [err] from [Error err] and guarantees there is no [Ok _]. *) +val must_be_error : (t, 'err) Result.t -> 'err + +(** Returns [fst] from [First fst] and guarantees there is no [Second _]. *) +val must_be_first : ('fst, t) Either.t -> 'fst + +(** Returns [snd] from [Second snd] and guarantees there is no [First _]. *) +val must_be_second : (t, 'snd) Either.t -> 'snd diff --git a/unikernel/duniverse/base/src/obj_array.ml b/unikernel/duniverse/base/src/obj_array.ml new file mode 100644 index 00000000..e0f0b786 --- /dev/null +++ b/unikernel/duniverse/base/src/obj_array.ml @@ -0,0 +1,197 @@ +open! Import +module Int = Int0 +module String = String0 +module Array = Array0 + +(* We maintain the property that all values of type [t] do not have the tag + [double_array_tag]. Some functions below assume this in order to avoid testing the + tag, and will segfault if this property doesn't hold. *) +type t = Stdlib.Obj.t array + +let invariant t = + assert (Stdlib.Obj.tag (Stdlib.Obj.repr t) <> Stdlib.Obj.double_array_tag) +;; + +let length = Array.length (* would check for float arrays in 32 bit, but whatever *) + +let sexp_of_t t = + Sexp.Atom + (String.concat ~sep:"" [ "" ]) +;; + +let zero_obj = Stdlib.Obj.repr (0 : int) + +(* We call [Array.create] with a value that is not a float so that the array doesn't get + tagged with [Double_array_tag]. *) +let create_zero ~len = Array.create ~len zero_obj +let empty = [||] + +type not_a_float = + | Not_a_float_0 + | Not_a_float_1 of int + +let _not_a_float_0 = Not_a_float_0 +let _not_a_float_1 = Not_a_float_1 42 + +let get t i = + (* Make the compiler believe [t] is an array not containing floats so it does not check + if [t] is tagged with [Double_array_tag]. It is NOT ok to use [int array] since (if + this function is inlined and the array contains in-heap boxed values) wrong register + typing may result, leading to a failure to register necessary GC roots. *) + Stdlib.Obj.repr + (* [Sys.opaque_identity] is required on the array because this code breaks the usual + assumptions about array kinds that the Flambda 2 optimiser can see. *) + ((Sys.opaque_identity (Stdlib.Obj.magic (t : t) : not_a_float array)).(i) + : not_a_float) +;; + +let[@inline always] unsafe_get t i = + (* Make the compiler believe [t] is an array not containing floats so it does not check + if [t] is tagged with [Double_array_tag]. *) + Stdlib.Obj.repr + (Array.unsafe_get + (Sys.opaque_identity (Obj_local.magic (t : t) : not_a_float array)) + i + : not_a_float) +;; + +let[@inline always] unsafe_set_with_caml_modify t i obj = + (* Same comment as [unsafe_get]. Sys.opaque_identity prevents the compiler from + potentially wrongly guessing the type of the array based on the type of element, that + is prevent the implication: (Obj.tag obj = Obj.double_tag) => (Obj.tag t = + Obj.double_array_tag) which flambda has tried in the past (at least that's assuming + the compiler respects Sys.opaque_identity, which is not always the case). *) + Array.unsafe_set + (Sys.opaque_identity (Obj_local.magic (t : t) : not_a_float array)) + i + (Stdlib.Obj.obj (Sys.opaque_identity obj) : not_a_float) +;; + +let[@inline always] set_with_caml_modify t i obj = + (* same as unsafe_set_with_caml_modify but safe *) + (Sys.opaque_identity (Stdlib.Obj.magic (t : t) : not_a_float array)).(i) + <- (Stdlib.Obj.obj (Sys.opaque_identity obj) : not_a_float) +;; + +let[@inline always] unsafe_set_int_assuming_currently_int t i int = + (* This skips [caml_modify], which is OK if both the old and new values are integers. *) + Array.unsafe_set + (Sys.opaque_identity (Obj_local.magic (t : t) : int array)) + i + (Sys.opaque_identity int) +;; + +(* For [set] and [unsafe_set], if a pointer is involved, we first do a physical-equality + test to see if the pointer is changing. If not, we don't need to do the [set], which + saves a call to [caml_modify]. We think this physical-equality test is worth it + because it is very cheap (both values are already available from the [is_int] test) + and because [caml_modify] is expensive. *) + +let set t i obj = + (* We use [get] first but then we use [Array.unsafe_set] since we know that [i] is + valid. *) + let old_obj = get t i in + if Stdlib.Obj.is_int old_obj && Stdlib.Obj.is_int obj + then unsafe_set_int_assuming_currently_int t i (Stdlib.Obj.obj obj : int) + else if not (phys_equal old_obj obj) + then unsafe_set_with_caml_modify t i obj +;; + +let[@inline always] unsafe_set t i obj = + let old_obj = unsafe_get t i in + if Stdlib.Obj.is_int old_obj && Stdlib.Obj.is_int obj + then unsafe_set_int_assuming_currently_int t i (Stdlib.Obj.obj obj : int) + else if not (phys_equal old_obj obj) + then unsafe_set_with_caml_modify t i obj +;; + +let[@inline always] unsafe_set_omit_phys_equal_check t i obj = + let old_obj = unsafe_get t i in + if Stdlib.Obj.is_int old_obj && Stdlib.Obj.is_int obj + then unsafe_set_int_assuming_currently_int t i (Stdlib.Obj.obj obj : int) + else unsafe_set_with_caml_modify t i obj +;; + +let swap t i j = + let a = get t i in + let b = get t j in + unsafe_set t i b; + unsafe_set t j a +;; + +let create ~len x = + (* If we can, use [Array.create] directly. Even though [is_int] check is subsumed by + the tag check, checking it is much faster, since it avoids a C function call. *) + if Stdlib.Obj.is_int x || Stdlib.Obj.tag x <> Stdlib.Obj.double_tag + then Array.create ~len x + else ( + (* Otherwise use [create_zero] and set the contents *) + let t = create_zero ~len in + let x = Sys.opaque_identity x in + for i = 0 to len - 1 do + unsafe_set_with_caml_modify t i x + done; + t) +;; + +let singleton obj = create ~len:1 obj + +(* Pre-condition: t.(i) is an integer. *) +let unsafe_set_assuming_currently_int t i obj = + if Stdlib.Obj.is_int obj + then unsafe_set_int_assuming_currently_int t i (Stdlib.Obj.obj obj : int) + else + (* [t.(i)] is an integer and [obj] is not, so we do not need to check if they are + equal. *) + unsafe_set_with_caml_modify t i obj +;; + +let unsafe_set_int t i int = + let old_obj = unsafe_get t i in + if Stdlib.Obj.is_int old_obj + then unsafe_set_int_assuming_currently_int t i int + else unsafe_set_with_caml_modify t i (Stdlib.Obj.repr int) +;; + +let unsafe_clear_if_pointer t i = + let old_obj = unsafe_get t i in + if not (Stdlib.Obj.is_int old_obj) + then unsafe_set_with_caml_modify t i (Stdlib.Obj.repr 0) +;; + +(** [unsafe_blit] is like [Array.blit], except it uses our own for-loop to avoid + caml_modify when possible. Its performance is still not comparable to a memcpy. *) +let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len = + (* When [phys_equal src dst], we need to check whether [dst_pos < src_pos] and have the + for loop go in the right direction so that we don't overwrite data that we still need + to read. When [not (phys_equal src dst)], doing this is harmless. From a + memory-performance perspective, it doesn't matter whether one loops up or down. + Constant-stride access, forward or backward, should be indistinguishable (at least on + an intel i7). So, we don't do a check for [phys_equal src dst] and always loop up in + that case. *) + if dst_pos < src_pos + then + for i = 0 to len - 1 do + unsafe_set dst (dst_pos + i) (unsafe_get src (src_pos + i)) + done + else + for i = len - 1 downto 0 do + unsafe_set dst (dst_pos + i) (unsafe_get src (src_pos + i)) + done +;; + +include Blit.Make (struct + type nonrec t = t + + let create = create_zero + let length = length + let unsafe_blit = unsafe_blit +end) + +let copy src = + let dst = create_zero ~len:(length src) in + blito ~src ~dst (); + dst +;; + +let sub = Array.sub diff --git a/unikernel/duniverse/base/src/obj_array.mli b/unikernel/duniverse/base/src/obj_array.mli new file mode 100644 index 00000000..d33b2d7d --- /dev/null +++ b/unikernel/duniverse/base/src/obj_array.mli @@ -0,0 +1,76 @@ +(** This module is not exposed for external use, and is only here for the implementation + of [Uniform_array] internally. [Obj.t Uniform_array.t] should be used in place of + [Obj_array.t]. *) + +open! Import + +type t [@@deriving_inline sexp_of] + +val sexp_of_t : t -> Sexplib0.Sexp.t + +[@@@end] + +include Blit.S with type t := t +include Invariant.S with type t := t + +(** [create ~len x] returns an obj-array of length [len], all of whose indices have value + [x]. *) +val create : len:int -> Stdlib.Obj.t -> t + +(** [create_zero ~len] returns an obj-array of length [len], all of whose indices have + value [Stdlib.Obj.repr 0]. *) +val create_zero : len:int -> t + +(** [copy t] returns a new array with the same elements as [t]. *) +val copy : t -> t + +val singleton : Stdlib.Obj.t -> t +val empty : t +val length : t -> int + +(** [get t i] and [unsafe_get t i] return the object at index [i]. [set t i o] and + [unsafe_set t i o] set index [i] to [o]. In no case is the object copied. The + [unsafe_*] variants omit the bounds check of [i]. *) +val get : t -> int -> Stdlib.Obj.t + +val unsafe_get : t -> int -> Stdlib.Obj.t +val set : t -> int -> Stdlib.Obj.t -> unit +val unsafe_set : t -> int -> Stdlib.Obj.t -> unit +val swap : t -> int -> int -> unit + +(** [set_with_caml_modify] simply sets the value in the array with no bells and whistles, + unlike [set] which first reads the value to optimize immediate values and setting the + index to its current value. This can be used when these optimizations are not useful, + but the noise in generated code is annoying (and might have an impact on performance, + although this is pure speculation). *) +val set_with_caml_modify : t -> int -> Stdlib.Obj.t -> unit + +(** [unsafe_set_assuming_currently_int t i obj] sets index [i] of [t] to [obj], but only + works correctly if [Stdlib.Obj.is_int (get t i)]. This precondition saves a dynamic + check. + + [unsafe_set_int_assuming_currently_int] is similar, except the value being set is an + int. + + [unsafe_set_int] is similar but does not assume anything about the target. *) +val unsafe_set_assuming_currently_int : t -> int -> Stdlib.Obj.t -> unit + +val unsafe_set_int_assuming_currently_int : t -> int -> int -> unit +val unsafe_set_int : t -> int -> int -> unit + +(** [unsafe_set_omit_phys_equal_check] is like [unsafe_set], except it doesn't do a + [phys_equal] check to try to skip [caml_modify]. It is safe to call this even if the + values are [phys_equal]. *) +val unsafe_set_omit_phys_equal_check : t -> int -> Stdlib.Obj.t -> unit + +(** Same as [set_with_caml_modify], but without bounds checks. This is like + [unsafe_set_omit_phys_equal_check] except it doesn't check whether the old value and + the value being set are integers to try to skip [caml_modify]. *) +val unsafe_set_with_caml_modify : t -> int -> Stdlib.Obj.t -> unit + +(** [unsafe_clear_if_pointer t i] prevents [t.(i)] from pointing to anything to prevent + space leaks. It does this by setting [t.(i)] to [Stdlib.Obj.repr 0]. As a performance hack, + it only does this when [not (Stdlib.Obj.is_int t.(i))]. *) +val unsafe_clear_if_pointer : t -> int -> unit + +val sub : t -> pos:int -> len:int -> t diff --git a/unikernel/duniverse/base/src/obj_local.ml b/unikernel/duniverse/base/src/obj_local.ml new file mode 100644 index 00000000..779fa8de --- /dev/null +++ b/unikernel/duniverse/base/src/obj_local.ml @@ -0,0 +1,77 @@ +open! Import + +type t = Stdlib.Obj.t +type raw_data = Stdlib.Obj.raw_data + +external magic : (_[@local_opt]) -> (_[@local_opt]) = "%identity" +external repr : (_[@local_opt]) -> (t[@local_opt]) = "%identity" +external obj : (t[@local_opt]) -> (_[@local_opt]) = "%identity" +external size : (t[@local_opt]) -> int = "%obj_size" + +let[@inline always] size t = size (Sys.opaque_identity t) + +external is_int : (t[@local_opt]) -> bool = "%obj_is_int" + +(* The result doesn't need to be marked local because the data is copied into a fresh + nativeint block regardless. *) +external raw_field : (t[@local_opt]) -> int -> raw_data = "caml_obj_raw_field" + +external set_raw_field + : (t[@local_opt]) + -> int + -> raw_data + -> unit + = "caml_obj_set_raw_field" + +external tag : (t[@local_opt]) -> int = "caml_obj_tag" [@@noalloc] + +(* Checks if the given value is on the local stack. Returns [false] for immediates. *) +external is_stack : (t[@local_opt]) -> bool = "caml_dummy_obj_is_stack" + +type stack_or_heap = + | Immediate + | Stack + | Heap +[@@deriving_inline sexp, compare] + +let stack_or_heap_of_sexp = + (let error_source__003_ = "obj_local.ml.stack_or_heap" in + function + | Sexplib0.Sexp.Atom ("immediate" | "Immediate") -> Immediate + | Sexplib0.Sexp.Atom ("stack" | "Stack") -> Stack + | Sexplib0.Sexp.Atom ("heap" | "Heap") -> Heap + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("immediate" | "Immediate") :: _) as + sexp__004_ -> Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("stack" | "Stack") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("heap" | "Heap") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__002_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__003_ sexp__002_ + | Sexplib0.Sexp.List [] as sexp__002_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__003_ sexp__002_ + | sexp__002_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__003_ sexp__002_ + : Sexplib0.Sexp.t -> stack_or_heap) +;; + +let sexp_of_stack_or_heap = + (function + | Immediate -> Sexplib0.Sexp.Atom "Immediate" + | Stack -> Sexplib0.Sexp.Atom "Stack" + | Heap -> Sexplib0.Sexp.Atom "Heap" + : stack_or_heap -> Sexplib0.Sexp.t) +;; + +let compare_stack_or_heap = (Stdlib.compare : stack_or_heap -> stack_or_heap -> int) + +[@@@end] + +let stack_or_heap repr = + if is_int repr + then Immediate + else ( + match Sys.backend_type with + | Sys.Native -> if is_stack repr then Stack else Heap + | Sys.Bytecode -> Heap + | Sys.Other _ -> Heap) +;; diff --git a/unikernel/duniverse/base/src/obj_local.mli b/unikernel/duniverse/base/src/obj_local.mli new file mode 100644 index 00000000..1a516cf4 --- /dev/null +++ b/unikernel/duniverse/base/src/obj_local.mli @@ -0,0 +1,37 @@ +(** Versions of [Obj] functions that work with locals. *) + +open! Import + +type t = Stdlib.Obj.t +type raw_data = Stdlib.Obj.raw_data + +external magic : (_[@local_opt]) -> (_[@local_opt]) = "%identity" +external repr : (_[@local_opt]) -> (t[@local_opt]) = "%identity" +external obj : (t[@local_opt]) -> (_[@local_opt]) = "%identity" +external raw_field : (t[@local_opt]) -> int -> raw_data = "caml_obj_raw_field" +val size : t -> int +external is_int : (t[@local_opt]) -> bool = "%obj_is_int" + +external set_raw_field + : (t[@local_opt]) + -> int + -> raw_data + -> unit + = "caml_obj_set_raw_field" + +external tag : (t[@local_opt]) -> int = "caml_obj_tag" [@@noalloc] + +type stack_or_heap = + | Immediate + | Stack + | Heap +[@@deriving_inline sexp, compare] + +val sexp_of_stack_or_heap : stack_or_heap -> Sexplib0.Sexp.t +val stack_or_heap_of_sexp : Sexplib0.Sexp.t -> stack_or_heap +val compare_stack_or_heap : stack_or_heap -> stack_or_heap -> int + +[@@@end] + +(** Checks if a value is immediate, stack-allocated, or heap-allocated. *) +val stack_or_heap : t -> stack_or_heap diff --git a/unikernel/duniverse/base/src/obj_stubs.c b/unikernel/duniverse/base/src/obj_stubs.c new file mode 100644 index 00000000..ce0d60dc --- /dev/null +++ b/unikernel/duniverse/base/src/obj_stubs.c @@ -0,0 +1,8 @@ +#include +#include +// only used for public release; +// internally this is implemented by caml_dummy_obj_is_stack in compiler runtime +CAMLprim value caml_dummy_obj_is_stack(__attribute__((unused)) value blk) { + // Public compilers don't support stack allocation, so we always return 0 + return Val_int(0); +} diff --git a/unikernel/duniverse/base/src/option.ml b/unikernel/duniverse/base/src/option.ml new file mode 100644 index 00000000..bea5f676 --- /dev/null +++ b/unikernel/duniverse/base/src/option.ml @@ -0,0 +1,264 @@ +open! Import + +include ( + struct + type 'a t = 'a option + [@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] + + let compare__local : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = + compare_option__local + ;; + + let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_option + + let globalize : 'a. ('a -> 'a) -> 'a t -> 'a t = + fun (type a__009_) : ((a__009_ -> a__009_) -> a__009_ t -> a__009_ t) -> + globalize_option + ;; + + let hash_fold_t : + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a t + -> Ppx_hash_lib.Std.Hash.state + = + hash_fold_option + ;; + + let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = + option_of_sexp + ;; + + let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + sexp_of_option + ;; + + let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> option_sexp_grammar _'a_sexp_grammar + ;; + + [@@@end] + end : + sig + type 'a t = 'a option + [@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] + + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + + val globalize : ('a -> 'a) -> 'a t -> 'a t + + include Ppx_hash_lib.Hashable.S1 with type 'a t := 'a t + include Sexplib0.Sexpable.S1 with type 'a t := 'a t + + val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + + [@@@end] + end) + +type 'a t = 'a option = + | None + | Some of 'a + +let is_none = function + | None -> true + | _ -> false +;; + +let is_some = function + | Some _ -> true + | _ -> false +;; + +let value_map o ~default ~f = + match o with + | Some x -> f x + | None -> default +;; + +let iter o ~f = + match o with + | None -> () + | Some a -> f a +;; + +let invariant f t = iter t ~f + +let call x ~f = + match f with + | None -> () + | Some f -> f x +;; + +let value t ~default = + match t with + | None -> default + | Some x -> x +;; + +let value_exn ?here ?error ?message t = + match t with + | Some x -> x + | None -> + let error = + match here, error, message with + | None, None, None -> Error.of_string "Option.value_exn None" + | None, None, Some m -> Error.of_string m + | None, Some e, None -> e + | None, Some e, Some m -> Error.tag e ~tag:m + | Some p, None, None -> + Error.create "Option.value_exn" p Source_code_position0.sexp_of_t + | Some p, None, Some m -> Error.create m p Source_code_position0.sexp_of_t + | Some p, Some e, _ -> + Error.create + (value message ~default:"") + (e, p) + (sexp_of_pair Error.sexp_of_t Source_code_position0.sexp_of_t) + in + Error.raise error +;; + +let value_or_thunk o ~default = + match o with + | Some x -> x + | None -> default () +;; + +let to_array t = + match t with + | None -> [||] + | Some x -> [| x |] +;; + +let to_list t = + match t with + | None -> [] + | Some x -> [ x ] +;; + +let for_all t ~f = + match t with + | None -> true + | Some x -> f x +;; + +let exists t ~f = + match t with + | None -> false + | Some x -> f x +;; + +let mem t a ~equal = + match t with + | None -> false + | Some a' -> equal a a' +;; + +let length t = + match t with + | None -> 0 + | Some _ -> 1 +;; + +let fold t ~init ~f = + match t with + | None -> init + | Some x -> f init x +;; + +let find t ~f = + match t with + | None -> None + | Some x -> if f x then t else None +;; + +let find_map t ~f = + match t with + | None -> None + | Some a -> f a +;; + +let equal f t t' = + match t, t' with + | None, None -> true + | Some x, Some x' -> f x x' + | _ -> false +;; + +let equal__local f t t' = + match t, t' with + | None, None -> true + | Some x, Some x' -> f x x' + | _ -> false +;; + +let some x = Some x + +let first_some x y = + match x with + | Some _ -> x + | None -> y +;; + +let some_if cond x = if cond then Some x else None + +let merge a b ~f = + match a, b with + | None, x | x, None -> x + | Some a, Some b -> Some (f a b) +;; + +let filter t ~f = + match t with + | Some v as o when f v -> o + | _ -> None +;; + +let try_with f = + match f () with + | x -> Some x + | exception _ -> None +;; + +let try_with_join f = + match f () with + | x -> x + | exception _ -> None +;; + +let map t ~f = + match t with + | None -> None + | Some a -> Some (f a) +;; + +module Monad_arg = struct + type 'a t = 'a option + + let return x = Some x + let map = `Custom map + + let bind o ~f = + match o with + | None -> None + | Some x -> f x + ;; +end + +include Monad.Make_local (Monad_arg) + +module Applicative_arg = struct + type 'a t = 'a option + + let return x = Some x + let map = `Custom map + + let map2 x y ~f = + match x, y with + | None, _ | _, None -> None + | Some x, Some y -> Some (f x y) + ;; +end + +include Applicative.Make_using_map2_local (Applicative_arg) diff --git a/unikernel/duniverse/base/src/option.mli b/unikernel/duniverse/base/src/option.mli new file mode 100644 index 00000000..34090683 --- /dev/null +++ b/unikernel/duniverse/base/src/option.mli @@ -0,0 +1,154 @@ +(** The option type indicates whether a meaningful value is present. It is frequently used + to represent success or failure, using [None] for failure. To be more descriptive + about why a function failed, see the {!Or_error} module. + + Usage example from a utop session follows. Hash table lookups use the option type to + indicate success or failure when looking up a key. + + {v + # let h = Hashtbl.of_alist (module String) [ ("Bar", "Value") ];; + val h : (string, string) Hashtbl.t = ;; + - : (string, string) Hashtbl.t = + # Hashtbl.find h "Foo";; + - : string option = None + # Hashtbl.find h "Bar";; + - : string option = Some "Value" + v} *) + +open! Import + +(** {2 Type and Interfaces} *) + +type 'a t = 'a option = + | None + | Some of 'a +[@@deriving_inline compare ~localize, globalize, hash, sexp_grammar] + +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + +val globalize : ('a -> 'a) -> 'a t -> 'a t + +include Ppx_hash_lib.Hashable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Equal.S1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t +include Invariant.S1 with type 'a t := 'a t +include Sexpable.S1 with type 'a t := 'a t + +(** {3 Applicative interface} + + Options form an applicative, where: + + {ul + {- [return x = Some x] } + {- [None <*> x = None] } + {- [Some f <*> None = None] } + {- [Some f <*> Some x = Some (f x)] }} +*) + +include Applicative.S_local with type 'a t := 'a t + +(** {3 Monadic interface} + + Options form a monad, where: + + {ul + {- [return x = Some x]} + {- [(None >>= f) = None]} + {- [(Some x >>= f) = f x]}} +*) + +include Monad.S_local with type 'a t := 'a t + +(** {2 Extracting Underlying Values} *) + +(** Extracts the underlying value if present, otherwise returns [default]. *) +val value : 'a t -> default:'a -> 'a + +(** Extracts the underlying value, or raises if there is no value present. The + error raised can be augmented using the [~here], [~error], and [~message] + optional arguments. *) +val value_exn + : ?here:Source_code_position0.t + -> ?error:Error.t + -> ?message:string + -> 'a t + -> 'a + +(** Extracts the underlying value and applies [f] to it if present, otherwise returns + [default]. *) +val value_map : 'a t -> default:'b -> f:('a -> 'b) -> 'b + +(** Extracts the underlying value if present, otherwise executes and returns the result of + [default]. [default] is only executed if the underlying value is absent. *) +val value_or_thunk : 'a t -> default:(unit -> 'a) -> 'a + +(** On [None], returns [init]. On [Some x], returns [f init x]. *) +val fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc + +(** Checks whether the provided element is there, using [equal]. *) +val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool + +val length : 'a t -> int +val iter : 'a t -> f:('a -> unit) -> unit + +(** On [None], returns [false]. On [Some x], returns [f x]. *) +val exists : 'a t -> f:('a -> bool) -> bool + +(** On [None], returns [true]. On [Some x], returns [f x]. *) +val for_all : 'a t -> f:('a -> bool) -> bool + +(** [find t ~f] returns [t] if [t = Some x] and [f x = true]; otherwise, [find] returns + [None]. *) +val find : 'a t -> f:('a -> bool) -> 'a option + +(** On [None], returns [None]. On [Some x], returns [f x]. *) +val find_map : 'a t -> f:('a -> 'b option) -> 'b option + +val to_list : 'a t -> 'a list +val to_array : 'a t -> 'a array + +(** [call x f] runs an optional function [~f] on the argument. *) +val call : 'a -> f:('a -> unit) t -> unit + +(** [merge a b ~f] merges together the values from [a] and [b] using [f]. If both [a] and + [b] are [None], returns [None]. If only one is [Some], returns that one, and if both + are [Some], returns [Some] of the result of applying [f] to the contents of [a] and + [b]. *) +val merge : 'a t -> 'a t -> f:('a -> 'a -> 'a) -> 'a t + +val filter : 'a t -> f:('a -> bool) -> 'a t + +(** {2 Constructors} *) + +(** [try_with f] returns [Some x] if [f] returns [x] and [None] if [f] raises an + exception. See [Result.try_with] if you'd like to know which exception. *) +val try_with : (unit -> 'a) -> 'a t + +(** [try_with_join f] returns the optional value returned by [f] if it exits normally, and + [None] if [f] raises an exception. *) +val try_with_join : (unit -> 'a t) -> 'a t + +(** Wraps the [Some] constructor as a function. *) +val some : 'a -> 'a t + +(** [first_some t1 t2] returns [t1] if it has an underlying value, or [t2] + otherwise. *) +val first_some : 'a t -> 'a t -> 'a t + +(** [some_if b x] converts a value [x] to [Some x] if [b], and [None] + otherwise. *) +val some_if : bool -> 'a -> 'a t + +(** {2 Predicates} *) + +(** [is_none t] returns true iff [t = None]. *) +val is_none : 'a t -> bool + +(** [is_some t] returns true iff [t = Some x]. *) +val is_some : 'a t -> bool diff --git a/unikernel/duniverse/base/src/option_array.ml b/unikernel/duniverse/base/src/option_array.ml new file mode 100644 index 00000000..280d4f76 --- /dev/null +++ b/unikernel/duniverse/base/src/option_array.ml @@ -0,0 +1,228 @@ +open! Import + +(** ['a Cheap_option.t] is like ['a option], but it doesn't box [some _] values. + + There are several things that are unsafe about it: + + - [float t array] (or any array-backed container) is not memory-safe + because float array optimization is incompatible with unboxed option + optimization. You have to use [Uniform_array.t] instead of [array]. + + - Nested options (['a t t]) don't work. They are believed to be + memory-safe, but not parametric. + + - A record with [float t]s in it should be safe, but it's only [t] being + abstract that gives you safety. If the compiler was smart enough to peek + through the module signature then it could decide to construct a float + array instead. *) +module Cheap_option = struct + (* This is taken from core. Rather than expose it in the public interface of base, just + keep a copy around here. *) + let phys_same (type a b) (a : a) (b : b) = phys_equal a (Stdlib.Obj.magic b : a) + + module T0 : sig + type 'a t + + val none : _ t + val some : 'a -> 'a t + val is_none : _ t -> bool + val is_some : _ t -> bool + val value_exn : 'a t -> 'a + val value_unsafe : 'a t -> 'a + val iter_some : 'a t -> f:('a -> unit) -> unit + end = struct + type +'a t + + (* Being a pointer, no one outside this module can construct a value that is + [phys_same] as this one. + + It would be simpler to use this value as [none], but we use an immediate instead + because it lets us avoid caml_modify when setting to [none], making certain + benchmarks significantly faster (e.g. ../bench/array_queue.exe). + + this code is duplicated in Moption, and if we find yet another place where we want + it we should reconsider making it shared. *) + let none_substitute : _ t = + Stdlib.Obj.obj (Stdlib.Obj.new_block Stdlib.Obj.abstract_tag 1) + ;; + + let none : _ t = + (* The number was produced by + [< /dev/urandom tr -c -d '1234567890abcdef' | head -c 16]. + + The idea is that a random number will have lower probability to collide with + anything than any number we can choose ourselves. + + We are using a polymorphic variant instead of an integer constant because there + is a compiler bug where it wrongly assumes that the result of [if _ then c else + y] is not a pointer if [c] is an integer compile-time constant. This is being + fixed in https://github.com/ocaml/ocaml/pull/555. The "memory corruption" test + below demonstrates the issue. *) + Stdlib.Obj.magic `x6e8ee3478e1d7449 + ;; + + let is_none x = phys_equal x none + let is_some x = not (phys_equal x none) + + let some (type a) (x : a) : a t = + if phys_same x none then none_substitute else Stdlib.Obj.magic x + ;; + + let value_unsafe (type a) (x : a t) : a = + if phys_equal x none_substitute then Stdlib.Obj.magic none else Stdlib.Obj.magic x + ;; + + let value_exn x = + if is_some x + then value_unsafe x + else failwith "Option_array.get_some_exn: the element is [None]" + ;; + + let iter_some t ~f = if is_some t then f (value_unsafe t) + end + + module T1 = struct + include T0 + + let of_option = function + | None -> none + | Some x -> some x + ;; + + let[@inline] to_option x = if is_some x then Some (value_unsafe x) else None + let[@inline] to_option_local x = if is_some x then Some (value_unsafe x) else None + let to_sexpable = to_option + let of_sexpable = of_option + + let t_sexp_grammar (type a) (grammar : a Sexplib0.Sexp_grammar.t) + : a t Sexplib0.Sexp_grammar.t + = + Sexplib0.Sexp_grammar.coerce (Option.t_sexp_grammar grammar) + ;; + end + + include T1 + include Sexpable.Of_sexpable1 (Option) (T1) +end + +type 'a t = 'a Cheap_option.t Uniform_array.t [@@deriving_inline sexp, sexp_grammar] + +let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = + fun _of_a__001_ x__003_ -> + Uniform_array.t_of_sexp (Cheap_option.t_of_sexp _of_a__001_) x__003_ +;; + +let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + fun _of_a__004_ x__005_ -> + Uniform_array.sexp_of_t (Cheap_option.sexp_of_t _of_a__004_) x__005_ +;; + +let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> + Uniform_array.t_sexp_grammar (Cheap_option.t_sexp_grammar _'a_sexp_grammar) +;; + +[@@@end] + +let empty = Uniform_array.empty +let create ~len = Uniform_array.create ~len Cheap_option.none +let init n ~f = Uniform_array.init n ~f:(fun i -> Cheap_option.of_option (f i)) [@nontail] +let init_some n ~f = Uniform_array.init n ~f:(fun i -> Cheap_option.some (f i)) [@nontail] +let length = Uniform_array.length +let[@inline] get t i = Cheap_option.to_option (Uniform_array.get t i) +let[@inline] get_local t i = Cheap_option.to_option_local (Uniform_array.get t i) +let get_some_exn t i = Cheap_option.value_exn (Uniform_array.get t i) +let is_none t i = Cheap_option.is_none (Uniform_array.get t i) +let is_some t i = Cheap_option.is_some (Uniform_array.get t i) +let set t i x = Uniform_array.set t i (Cheap_option.of_option x) +let set_some t i x = Uniform_array.set t i (Cheap_option.some x) +let set_none t i = Uniform_array.set t i Cheap_option.none +let swap t i j = Uniform_array.swap t i j +let unsafe_get t i = Cheap_option.to_option (Uniform_array.unsafe_get t i) +let unsafe_get_some_exn t i = Cheap_option.value_exn (Uniform_array.unsafe_get t i) + +let unsafe_get_some_assuming_some t i = + Cheap_option.value_unsafe (Uniform_array.unsafe_get t i) +;; + +let unsafe_is_some t i = Cheap_option.is_some (Uniform_array.unsafe_get t i) +let unsafe_set t i x = Uniform_array.unsafe_set t i (Cheap_option.of_option x) +let unsafe_set_some t i x = Uniform_array.unsafe_set t i (Cheap_option.some x) +let unsafe_set_none t i = Uniform_array.unsafe_set t i Cheap_option.none + +let clear t = + for i = 0 to length t - 1 do + unsafe_set_none t i + done +;; + +let iteri input ~f = + for i = 0 to length input - 1 do + f i (unsafe_get input i) + done +;; + +let iter input ~f = iteri input ~f:(fun (_ : int) x -> f x) [@nontail] + +let foldi input ~init ~f = + let acc = ref init in + iteri input ~f:(fun i elem -> acc := f i !acc elem); + !acc +;; + +let fold input ~init ~f = foldi input ~init ~f:(fun (_ : int) acc x -> f acc x) [@nontail] + +include Indexed_container.Make_gen (struct + type nonrec ('a, _, _) t = 'a t + type 'a elt = 'a option + + let fold = fold + let foldi = `Custom foldi + let iter = `Custom iter + let iteri = `Custom iteri + let length = `Custom length +end) + +let length = Uniform_array.length + +let mapi input ~f = + let output = create ~len:(length input) in + iteri input ~f:(fun i elem -> unsafe_set output i (f i elem)); + output +;; + +let map input ~f = mapi input ~f:(fun (_ : int) elem -> f elem) [@nontail] + +let map_some input ~f = + let len = length input in + let output = create ~len in + let () = + for i = 0 to len - 1 do + let opt = Uniform_array.unsafe_get input i in + Cheap_option.iter_some opt ~f:(fun x -> unsafe_set_some output i (f x)) + done + in + output +;; + +let of_array array = init (Array.length array) ~f:(fun i -> Array.unsafe_get array i) + +let of_array_some array = + init_some (Array.length array) ~f:(fun i -> Array.unsafe_get array i) +;; + +let to_array t = Array.init (length t) ~f:(fun i -> unsafe_get t i) + +include Blit.Make1_generic (struct + type nonrec 'a t = 'a t + + let length = length + let create_like ~len _ = create ~len + let unsafe_blit = Uniform_array.unsafe_blit +end) + +let copy = Uniform_array.copy + +module For_testing = struct + module Unsafe_cheap_option = Cheap_option +end diff --git a/unikernel/duniverse/base/src/option_array.mli b/unikernel/duniverse/base/src/option_array.mli new file mode 100644 index 00000000..0229a29e --- /dev/null +++ b/unikernel/duniverse/base/src/option_array.mli @@ -0,0 +1,114 @@ +(** ['a Option_array.t] is a compact representation of ['a option array]: it avoids + allocating heap objects representing [Some x], usually representing them with [x] + instead. It uses a special representation for [None] that's guaranteed to never + collide with any representation of [Some x]. *) + +open! Import + +type 'a t [@@deriving_inline sexp, sexp_grammar] + +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +[@@@end] + +val empty : _ t + +(** Initially filled with all [None] *) +val create : len:int -> _ t + +include + Indexed_container.Generic with type ('a, _, _) t := 'a t and type 'a elt := 'a option + +val length : _ t -> int +val init_some : int -> f:(int -> 'a) -> 'a t +val init : int -> f:(int -> 'a option) -> 'a t +val of_array : 'a option array -> 'a t +val of_array_some : 'a array -> 'a t +val to_array : 'a t -> 'a option Array.t + +(** [get t i] returns the element number [i] of array [t], raising if [i] is outside the + range 0 to [length t - 1]. *) +val get : 'a t -> int -> 'a option + +(** Similar to [get], but allocates result in the caller's stack region instead + of heap. *) +val get_local : 'a t -> int -> 'a option + +(** Raises if the element number [i] is [None]. *) +val get_some_exn : 'a t -> int -> 'a + +(** [is_none t i = Option.is_none (get t i)] *) +val is_none : _ t -> int -> bool + +(** [is_some t i = Option.is_some (get t i)] *) +val is_some : _ t -> int -> bool + +(** These can cause arbitrary behavior when used for an out-of-bounds array access. *) + +val unsafe_get : 'a t -> int -> 'a option + +(** [unsafe_get_some_exn t i] is unsafe because it does not bounds check [i]. It does, + however check whether the value at index [i] is none or some, and raises if it + is none. *) +val unsafe_get_some_exn : 'a t -> int -> 'a + +(** [unsafe_get_some_assuming_some t i] is unsafe both because it does not bounds check + [i] and because it does not check whether the value at index [i] is none or some, + assuming that it is some. *) +val unsafe_get_some_assuming_some : 'a t -> int -> 'a + +val unsafe_is_some : _ t -> int -> bool + +(** [set t i x] modifies array [t] in place, replacing element number [i] with [x], + raising if [i] is outside the range 0 to [length t - 1]. *) +val set : 'a t -> int -> 'a option -> unit + +val set_some : 'a t -> int -> 'a -> unit +val set_none : _ t -> int -> unit +val swap : _ t -> int -> int -> unit + +(** Replaces all the elements of the array with [None]. *) +val clear : _ t -> unit + +(** [map f [|a1; ...; an|]] applies function [f] to [a1], [a2], ..., [an], in order, + and builds the option_array [[|f a1; ...; f an|]] with the results returned by [f]. *) +val map : 'a t -> f:('a option -> 'b option) -> 'b t + +(** [map_some t ~f] is like [map], but [None] elements always map to [None] and [Some] + always map to [Some]. *) +val map_some : 'a t -> f:('a -> 'b) -> 'b t + +(** Unsafe versions of [set*]. Can cause arbitrary behaviour when used for an + out-of-bounds array access. *) + +val unsafe_set : 'a t -> int -> 'a option -> unit +val unsafe_set_some : 'a t -> int -> 'a -> unit +val unsafe_set_none : _ t -> int -> unit + +include Blit.S1 with type 'a t := 'a t + +(** Makes a (shallow) copy of the array. *) +val copy : 'a t -> 'a t + +(**/**) + +module For_testing : sig + module Unsafe_cheap_option : sig + type 'a t [@@deriving_inline sexp] + + include Sexplib0.Sexpable.S1 with type 'a t := 'a t + + [@@@end] + + val none : _ t + val some : 'a -> 'a t + val is_none : _ t -> bool + val is_some : _ t -> bool + val value_exn : 'a t -> 'a + val value_unsafe : 'a t -> 'a + val to_option : 'a t -> 'a Option.t + val of_option : 'a Option.t -> 'a t + end +end diff --git a/unikernel/duniverse/base/src/or_error.ml b/unikernel/duniverse/base/src/or_error.ml new file mode 100644 index 00000000..93e58ae9 --- /dev/null +++ b/unikernel/duniverse/base/src/or_error.ml @@ -0,0 +1,208 @@ +open! Import + +type 'a t = ('a, Error.t) Result.t +[@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + +let compare__local : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = + fun _cmp__a a__007_ b__008_ -> + Result.compare__local _cmp__a Error.compare__local a__007_ b__008_ +;; + +let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = + fun _cmp__a a__001_ b__002_ -> Result.compare _cmp__a Error.compare a__001_ b__002_ +;; + +let equal__local : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = + fun _cmp__a a__019_ b__020_ -> + Result.equal__local _cmp__a Error.equal__local a__019_ b__020_ +;; + +let equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = + fun _cmp__a a__013_ b__014_ -> Result.equal _cmp__a Error.equal a__013_ b__014_ +;; + +let globalize : 'a. ('a -> 'a) -> 'a t -> 'a t = + fun (type a__025_) : ((a__025_ -> a__025_) -> a__025_ t -> a__025_ t) -> + fun _globalize_a__026_ x__027_ -> + Result.globalize _globalize_a__026_ Error.globalize x__027_ +;; + +let hash_fold_t : + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a t + -> Ppx_hash_lib.Std.Hash.state + = + fun _hash_fold_a hsv arg -> Result.hash_fold_t _hash_fold_a Error.hash_fold_t hsv arg +;; + +let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = + fun _of_a__030_ x__032_ -> Result.t_of_sexp _of_a__030_ Error.t_of_sexp x__032_ +;; + +let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + fun _of_a__033_ x__034_ -> Result.sexp_of_t _of_a__033_ Error.sexp_of_t x__034_ +;; + +let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> Result.t_sexp_grammar _'a_sexp_grammar Error.t_sexp_grammar +;; + +[@@@end] + +let ( >>= ) = Result.( >>= ) +let ( >>| ) = Result.( >>| ) +let bind = Result.bind +let ignore_m = Result.ignore_m +let join = Result.join +let map = Result.map +let return = Result.return + +module Monad_infix = Result.Monad_infix + +let invariant invariant_a t = + match t with + | Ok a -> invariant_a a + | Error error -> Error.invariant error +;; + +let map2 a b ~f = + match a, b with + | Ok x, Ok y -> Ok (f x y) + | Ok _, (Error _ as e) | (Error _ as e), Ok _ -> e + | Error e1, Error e2 -> Error (Error.of_list [ e1; e2 ]) +;; + +module For_applicative = Applicative.Make_using_map2_local (struct + type nonrec 'a t = 'a t + + let return = return + let map = `Custom map + let map2 = map2 +end) + +let ( *> ) = For_applicative.( *> ) +let ( <* ) = For_applicative.( <* ) +let ( <*> ) = For_applicative.( <*> ) +let apply = For_applicative.apply +let both = For_applicative.both +let map3 = For_applicative.map3 + +module Applicative_infix = For_applicative.Applicative_infix + +module Let_syntax = struct + let return = return + + include Monad_infix + + module Let_syntax = struct + let return = return + let map = map + let bind = bind + let both = both + + (* from Applicative.Make *) + module Open_on_rhs = struct end + end +end + +let ok = Result.ok +let is_ok = Result.is_ok +let is_error = Result.is_error + +let try_with ?(backtrace = false) f = + try Ok (f ()) with + | exn -> Error (Error.of_exn exn ?backtrace:(if backtrace then Some `Get else None)) +;; + +let try_with_join ?backtrace f = join (try_with ?backtrace f) + +let ok_exn = function + | Ok x -> x + | Error err -> Error.raise err +;; + +let of_exn ?backtrace exn = Error (Error.of_exn ?backtrace exn) + +let of_exn_result ?backtrace = function + | Ok _ as z -> z + | Error exn -> of_exn ?backtrace exn +;; + +let of_option = Result.of_option + +let error ?here ?strict message a sexp_of_a = + Error (Error.create ?here ?strict message a sexp_of_a) +;; + +let error_s sexp = Error (Error.create_s sexp) +let error_string message = Error (Error.of_string message) +let errorf format = Printf.ksprintf error_string format +let tag t ~tag = Result.map_error t ~f:(Error.tag ~tag) +let tag_s t ~tag = Result.map_error t ~f:(Error.tag_s ~tag) +let tag_s_lazy t ~tag = Result.map_error t ~f:(Error.tag_s_lazy ~tag) + +let tag_arg t message a sexp_of_a = + Result.map_error t ~f:(fun e -> Error.tag_arg e message a sexp_of_a) +;; + +let unimplemented s = error "unimplemented" s sexp_of_string + +let combine_internal list ~on_ok ~on_error = + match Result.combine_errors list with + | Ok x -> Ok (on_ok x) + | Error errs -> Error (on_error errs) +;; + +let ignore_unit_list (_ : unit list) = () + +let error_of_list_if_necessary = function + | [ e ] -> e + | list -> Error.of_list list +;; + +let all list = combine_internal list ~on_ok:Fn.id ~on_error:error_of_list_if_necessary + +let all_unit list = + combine_internal list ~on_ok:ignore_unit_list ~on_error:error_of_list_if_necessary +;; + +let combine_errors list = combine_internal list ~on_ok:Fn.id ~on_error:Error.of_list + +let combine_errors_unit list = + combine_internal list ~on_ok:ignore_unit_list ~on_error:Error.of_list +;; + +let filter_ok_at_least_one l = + let ok, errs = List.partition_map l ~f:Result.to_either in + match ok with + | [] -> Error (Error.of_list errs) + | _ -> Ok ok +;; + +let find_ok l = + match List.find_map l ~f:Result.ok with + | Some x -> Ok x + | None -> + Error + (Error.of_list + (List.map l ~f:(function + | Ok _ -> assert false + | Error err -> err))) +;; + +let find_map_ok l ~f = + With_return.with_return (fun { return } -> + Error + (Error.of_list + (List.map l ~f:(fun elt -> + match f elt with + | Ok _ as x -> return x + | Error err -> err)))) [@nontail] +;; + +let map = Result.map +let iter = Result.iter +let iter_error = Result.iter_error diff --git a/unikernel/duniverse/base/src/or_error.mli b/unikernel/duniverse/base/src/or_error.mli new file mode 100644 index 00000000..36a0d573 --- /dev/null +++ b/unikernel/duniverse/base/src/or_error.mli @@ -0,0 +1,143 @@ +(** Type for tracking errors in an [Error.t]. This is a specialization of the [Result] + type, where the [Error] constructor carries an [Error.t]. + + A common idiom is to wrap a function that is not implemented on all platforms, e.g., + + {[val do_something_linux_specific : (unit -> unit) Or_error.t]} +*) + +open! Import + +(** Serialization and comparison of an [Error] force the error's lazy message. *) +type 'a t = ('a, Error.t) Result.t +[@@deriving_inline + compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] + +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t + +val globalize : ('a -> 'a) -> 'a t -> 'a t + +include Ppx_hash_lib.Hashable.S1 with type 'a t := 'a t +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +[@@@end] + +(** [Applicative] functions don't have quite the same semantics as + [Applicative.Of_Monad(Or_error)] would give -- [apply (Error e1) (Error e2)] returns + the combination of [e1] and [e2], whereas it would only return [e1] if it were defined + using [bind]. *) +include Applicative.S_local with type 'a t := 'a t + +include Invariant.S1 with type 'a t := 'a t +include Monad.S_local with type 'a t := 'a t + +val is_ok : _ t -> bool +val is_error : _ t -> bool + +(** [try_with f] catches exceptions thrown by [f] and returns them in the [Result.t] as an + [Error.t]. [try_with_join] is like [try_with], except that [f] can throw exceptions + or return an [Error] directly, without ending up with a nested error; it is equivalent + to [Result.join (try_with f)]. *) +val try_with : ?backtrace:bool (** defaults to [false] *) -> (unit -> 'a) -> 'a t + +val try_with_join : ?backtrace:bool (** defaults to [false] *) -> (unit -> 'a t) -> 'a t + +(** [ok t] returns [None] if [t] is an [Error], and otherwise returns the contents of the + [Ok] constructor. *) +val ok : 'ok t -> 'ok option + +(** [ok_exn t] throws an exception if [t] is an [Error], and otherwise returns the + contents of the [Ok] constructor. *) +val ok_exn : 'a t -> 'a + +(** [of_exn ?backtrace exn] is [Error (Error.of_exn ?backtrace exn)]. *) +val of_exn : ?backtrace:[ `Get | `This of string ] -> exn -> _ t + +(** [of_exn_result ?backtrace (Ok a) = Ok a] + + [of_exn_result ?backtrace (Error exn) = of_exn ?backtrace exn] *) +val of_exn_result : ?backtrace:[ `Get | `This of string ] -> ('a, exn) Result.t -> 'a t + +(** [of_option t] returns [Ok 'a] if [t] is [Some 'a], and otherwise returns the supplied + [error] as [Error error] *) +val of_option : 'a option -> error:Error.t -> 'a t + +(** [error] is a wrapper around [Error.create]: + + {[ + error ?strict message a sexp_of_a + = Error (Error.create ?strict message a sexp_of_a) + ]} + + As with [Error.create], [sexp_of_a a] is lazily computed when the info is converted + to a sexp. So, if [a] is mutated in the time between the call to [create] and the + sexp conversion, those mutations will be reflected in the sexp. Use [~strict:()] to + force [sexp_of_a a] to be computed immediately. *) +val error + : ?here:Source_code_position0.t + -> ?strict:unit + -> string + -> 'a + -> ('a -> Sexp.t) + -> _ t + +val error_s : Sexp.t -> _ t + +(** [error_string message] is [Error (Error.of_string message)]. *) +val error_string : string -> _ t + +(** [errorf format arg1 arg2 ...] is [Error (sprintf format arg1 arg2 ...)]. Note that it + calculates the string eagerly, so when performance matters you may want to use [error] + instead. *) +val errorf : ('a, unit, string, _ t) format4 -> 'a + +(** [tag t ~tag] is [Result.map_error t ~f:(Error.tag ~tag)]. *) +val tag : 'a t -> tag:string -> 'a t + +(** [tag_s] is like [tag] with a sexp tag. *) +val tag_s : 'a t -> tag:Sexp.t -> 'a t + +(** [tag_s_lazy] is like [tag] with a lazy sexp tag. *) +val tag_s_lazy : 'a t -> tag:Sexp.t Lazy.t -> 'a t + +(** [tag_arg] is like [tag], with a tag that has a sexpable argument. *) +val tag_arg : 'a t -> string -> 'b -> ('b -> Sexp.t) -> 'a t + +(** For marking a given value as unimplemented. Typically combined with conditional + compilation, where on some platforms the function is defined normally, and on some + platforms it is defined as unimplemented. The supplied string should be the name of + the function that is unimplemented. *) +val unimplemented : string -> _ t + +val map : 'a t -> f:('a -> 'b) -> 'b t +val iter : 'a t -> f:('a -> unit) -> unit +val iter_error : _ t -> f:(Error.t -> unit) -> unit + +(** [combine_errors ts] returns [Ok] if every element in [ts] is [Ok], else it returns + [Error] with all the errors in [ts]. More precisely: + + - [combine_errors [Ok a1; ...; Ok an] = Ok [a1; ...; an]] + - {[ combine_errors [...; Error e1; ...; Error en; ...] + = Error (Error.of_list [e1; ...; en]) ]} *) +val combine_errors : 'a t list -> 'a list t + +(** [combine_errors_unit ts] returns [Ok] if every element in [ts] is [Ok ()], else it + returns [Error] with all the errors in [ts], like [combine_errors]. *) +val combine_errors_unit : unit t list -> unit t + +(** [filter_ok_at_least_one ts] returns all values in [ts] that are [Ok] if there is at + least one, otherwise it returns the same error as [combine_errors ts]. *) +val filter_ok_at_least_one : 'a t list -> 'a list t + +(** [find_ok ts] returns the first value in [ts] that is [Ok], otherwise it returns the + same error as [combine_errors ts]. *) +val find_ok : 'a t list -> 'a t + +(** [find_map_ok l ~f] returns the first value in [l] for which [f] returns [Ok], + otherwise it returns the same error as [combine_errors (List.map l ~f)]. *) +val find_map_ok : 'a list -> f:('a -> 'b t) -> 'b t diff --git a/unikernel/duniverse/base/src/ordered_collection_common.ml b/unikernel/duniverse/base/src/ordered_collection_common.ml new file mode 100644 index 00000000..108d7545 --- /dev/null +++ b/unikernel/duniverse/base/src/ordered_collection_common.ml @@ -0,0 +1,7 @@ +open! Import +include Ordered_collection_common0 + +let get_pos_len ?pos ?len () ~total_length = + try Result.Ok (get_pos_len_exn () ?pos ?len ~total_length) with + | Invalid_argument s -> Error (Error.of_string s) +;; diff --git a/unikernel/duniverse/base/src/ordered_collection_common.mli b/unikernel/duniverse/base/src/ordered_collection_common.mli new file mode 100644 index 00000000..7d7231ee --- /dev/null +++ b/unikernel/duniverse/base/src/ordered_collection_common.mli @@ -0,0 +1,13 @@ +(** Functions for ordered collections. *) + +open! Import + +include module type of Ordered_collection_common0 (** @inline *) + +(** Like [get_pos_len_exn]. Returns an [Or_error.t]. *) +val get_pos_len + : ?pos:int + -> ?len:int + -> unit + -> total_length:int + -> (int * int) Or_error.t diff --git a/unikernel/duniverse/base/src/ordered_collection_common0.ml b/unikernel/duniverse/base/src/ordered_collection_common0.ml new file mode 100644 index 00000000..4c92874d --- /dev/null +++ b/unikernel/duniverse/base/src/ordered_collection_common0.ml @@ -0,0 +1,47 @@ +(* Split off to avoid a cyclic dependency with [Or_error]. *) + +open! Import + +let invalid_argf = Printf.invalid_argf + +let slow_check_pos_len_exn ~pos ~len ~total_length = + if pos < 0 then invalid_argf "Negative position: %d" pos (); + if len < 0 then invalid_argf "Negative length: %d" len (); + (* We use [pos > total_length - len] rather than [pos + len > total_length] to avoid the + possibility of overflow. *) + if pos > total_length - len + then invalid_argf "pos + len past end: %d + %d > %d" pos len total_length () + [@@cold] [@@inline never] [@@local never] [@@specialise never] +;; + +let check_pos_len_exn ~pos ~len ~total_length = + (* This is better than [slow_check_pos_len_exn] for two reasons: + + - much less inlined code + - only one conditional jump + + The reason it works is that checking [< 0] is testing the highest order bit, so + [a < 0 || b < 0] is the same as [a lor b < 0]. + + [pos + len] can overflow, so [pos > total_length - len] is not equivalent to + [total_length - len - pos < 0], we need to test for [pos + len] overflow as + well. *) + let stop = pos + len in + if pos lor len lor stop lor (total_length - stop) < 0 + then slow_check_pos_len_exn ~pos ~len ~total_length + [@@inline always] +;; + +let get_pos_len_exn ?(pos = 0) ?len () ~total_length = + let len = + match len with + | Some i -> i + | None -> total_length - pos + in + check_pos_len_exn ~pos ~len ~total_length; + pos, len +;; + +module Private = struct + let slow_check_pos_len_exn = slow_check_pos_len_exn +end diff --git a/unikernel/duniverse/base/src/ordered_collection_common0.mli b/unikernel/duniverse/base/src/ordered_collection_common0.mli new file mode 100644 index 00000000..5bd6e70d --- /dev/null +++ b/unikernel/duniverse/base/src/ordered_collection_common0.mli @@ -0,0 +1,36 @@ +open! Import + +(** [get_pos_len_exn], and [check_pos_len_exn] are intended to be used + by functions that take a sequence (array, string, bigstring, ...) and an optional + [pos] and [len] specifying a subrange of the sequence. Such functions should call + [get_pos_len] with the length of the sequence and the optional [pos] and [len], and it + will return the [pos] and [len] specifying the range, where the default [pos] is zero + and the default [len] is to go to the end of the sequence. + + It should be the case that: + + {[ + pos >= 0 && len >= 0 && pos + len <= total_length + ]} + + Note that this allows [pos = total_length] and [len = 0], i.e., an empty subrange + at the end of the sequence. + + [get_pos_len_exn] returns [(pos', len')] specifying a subrange where: + + {v + pos' = match pos with None -> 0 | Some i -> i + len' = match len with None -> total_length - pos' | Some i -> i + v} *) +val get_pos_len_exn : ?pos:int -> ?len:int -> unit -> total_length:int -> int * int + +(** [check_pos_len_exn ~pos ~len ~total_length] raises unless [pos >= 0 && len >= 0 && + pos + len <= total_length]. *) +val check_pos_len_exn : pos:int -> len:int -> total_length:int -> unit + +(*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) +module Private : sig + val slow_check_pos_len_exn : pos:int -> len:int -> total_length:int -> unit +end diff --git a/unikernel/duniverse/base/src/ordering.ml b/unikernel/duniverse/base/src/ordering.ml new file mode 100644 index 00000000..e980fc20 --- /dev/null +++ b/unikernel/duniverse/base/src/ordering.ml @@ -0,0 +1,93 @@ +open! Import + +type t = + | Less + | Equal + | Greater +[@@deriving_inline compare ~localize, hash, enumerate, sexp, sexp_grammar] + +let compare__local = (Stdlib.compare : t -> t -> int) +let compare = (fun a b -> compare__local a b : t -> t -> int) + +let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + (fun hsv arg -> + Ppx_hash_lib.Std.Hash.fold_int + hsv + (match arg with + | Less -> 0 + | Equal -> 1 + | Greater -> 2) + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) +;; + +let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func arg = + Ppx_hash_lib.Std.Hash.get_hash_value + (let hsv = Ppx_hash_lib.Std.Hash.create () in + hash_fold_t hsv arg) + in + fun x -> func x +;; + +let all = ([ Less; Equal; Greater ] : t list) + +let t_of_sexp = + (let error_source__005_ = "ordering.ml.t" in + function + | Sexplib0.Sexp.Atom ("less" | "Less") -> Less + | Sexplib0.Sexp.Atom ("equal" | "Equal") -> Equal + | Sexplib0.Sexp.Atom ("greater" | "Greater") -> Greater + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("less" | "Less") :: _) as sexp__006_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__005_ sexp__006_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("equal" | "Equal") :: _) as sexp__006_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__005_ sexp__006_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("greater" | "Greater") :: _) as sexp__006_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__005_ sexp__006_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__005_ sexp__004_ + | Sexplib0.Sexp.List [] as sexp__004_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__005_ sexp__004_ + | sexp__004_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__005_ sexp__004_ + : Sexplib0.Sexp.t -> t) +;; + +let sexp_of_t = + (function + | Less -> Sexplib0.Sexp.Atom "Less" + | Equal -> Sexplib0.Sexp.Atom "Equal" + | Greater -> Sexplib0.Sexp.Atom "Greater" + : t -> Sexplib0.Sexp.t) +;; + +let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag { name = "Less"; clause_kind = Atom_clause } + ; No_tag { name = "Equal"; clause_kind = Atom_clause } + ; No_tag { name = "Greater"; clause_kind = Atom_clause } + ] + } + } +;; + +[@@@end] + +let equal a b = compare a b = 0 +let equal__local a b = compare__local a b = 0 + +module Export = struct + type _ordering = t = + | Less + | Equal + | Greater +end + +let of_int n = if n < 0 then Less else if n = 0 then Equal else Greater + +let to_int = function + | Less -> -1 + | Equal -> 0 + | Greater -> 1 +;; diff --git a/unikernel/duniverse/base/src/ordering.mli b/unikernel/duniverse/base/src/ordering.mli new file mode 100644 index 00000000..95fea1ee --- /dev/null +++ b/unikernel/duniverse/base/src/ordering.mli @@ -0,0 +1,76 @@ +(** [Ordering] is intended to make code that matches on the result of a comparison + more concise and easier to read. + + For example, instead of writing: + + {[ + let r = compare x y in + if r < 0 then + ... + else if r = 0 then + ... + else + ... + ]} + + you could simply write: + + {[ + match Ordering.of_int (compare x y) with + | Less -> ... + | Equal -> ... + | Greater -> ... + ]} + +*) + +open! Import + +type t = + | Less + | Equal + | Greater +[@@deriving_inline compare ~localize, hash, sexp, sexp_grammar] + +include Ppx_compare_lib.Comparable.S with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t +include Ppx_hash_lib.Hashable.S with type t := t +include Sexplib0.Sexpable.S with type t := t + +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +(*_ Avoid [@@deriving_inline enumerate] due to circular dependency *) +val all : t list + +include Equal.S with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t + +(** [of_int n] is: + + {v + Less if n < 0 + Equal if n = 0 + Greater if n > 0 + v} *) +val of_int : int -> t + +(** [to_int t] is: + + {v + Less -> -1 + Equal -> 0 + Greater -> 1 + v} + + It can be useful when writing a comparison function to allow one to return + [Ordering.t] values and transform them to [int]s later. *) +val to_int : t -> int + +module Export : sig + type _ordering = t = + | Less + | Equal + | Greater +end diff --git a/unikernel/duniverse/base/src/poly0.ml b/unikernel/duniverse/base/src/poly0.ml new file mode 100644 index 00000000..7248aecb --- /dev/null +++ b/unikernel/duniverse/base/src/poly0.ml @@ -0,0 +1,19 @@ +(** Primitives for polymorphic compare. *) + +(*_ Polymorphic compiler primitives can't be aliases as this doesn't play well with + inlining. (If aliased without a type annotation, the compiler would implement them + using the generic code doing a C call, and it's this code that would be inlined.) As a + result we have to copy the [external ...] declaration here. *) +external ( < ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%lessthan" +external ( <= ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%lessequal" +external ( <> ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%notequal" +external ( = ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%equal" +external ( > ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%greaterthan" +external ( >= ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%greaterequal" +external ascending : ('a[@local_opt]) -> ('a[@local_opt]) -> int = "%compare" +external compare : ('a[@local_opt]) -> ('a[@local_opt]) -> int = "%compare" +external equal : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%equal" + +let descending x y = compare y x +let max x y = Bool0.select (x >= y) x y +let min x y = Bool0.select (x <= y) x y diff --git a/unikernel/duniverse/base/src/poly0.mli b/unikernel/duniverse/base/src/poly0.mli new file mode 100644 index 00000000..7c654e6d --- /dev/null +++ b/unikernel/duniverse/base/src/poly0.mli @@ -0,0 +1,22 @@ +(** A module containing the ad-hoc polymorphic comparison functions. Useful when + you want to use polymorphic compare in some small scope of a file within which + polymorphic compare has been hidden *) + +external compare : ('a[@local_opt]) -> ('a[@local_opt]) -> int = "%compare" + +(** [ascending] is identical to [compare]. [descending x y = ascending y x]. These are + intended to be mnemonic when used like [List.sort ~compare:ascending] and [List.sort + ~compare:descending], since they cause the list to be sorted in ascending or + descending order, respectively. *) +val ascending : 'a -> 'a -> int + +val descending : 'a -> 'a -> int +external ( < ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%lessthan" +external ( <= ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%lessequal" +external ( <> ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%notequal" +external ( = ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%equal" +external ( > ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%greaterthan" +external ( >= ) : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%greaterequal" +external equal : ('a[@local_opt]) -> ('a[@local_opt]) -> bool = "%equal" +val min : 'a -> 'a -> 'a +val max : 'a -> 'a -> 'a diff --git a/unikernel/duniverse/base/src/popcount.ml b/unikernel/duniverse/base/src/popcount.ml new file mode 100644 index 00000000..77fd8dfb --- /dev/null +++ b/unikernel/duniverse/base/src/popcount.ml @@ -0,0 +1,46 @@ +open! Import + +(* C stub for int popcount to use the POPCNT instruction where possible *) +external int_popcount : int -> int = "Base_int_math_int_popcount" [@@noalloc] + +(* To maintain javascript compatibility and enable unboxing, we implement popcount in + OCaml rather than use C stubs. Implementation adapted from: + https://en.wikipedia.org/wiki/Hamming_weight#Efficient_implementation *) +let int64_popcount = + let open Stdlib.Int64 in + let ( + ) = add in + let ( - ) = sub in + let ( * ) = mul in + let ( lsr ) = shift_right_logical in + let ( land ) = logand in + let m1 = 0x5555555555555555L in + (* 0b01010101... *) + let m2 = 0x3333333333333333L in + (* 0b00110011... *) + let m4 = 0x0f0f0f0f0f0f0f0fL in + (* 0b00001111... *) + let h01 = 0x0101010101010101L in + (* 1 bit set per byte *) + fun [@inline] x -> + (* gather the bit count for every pair of bits *) + let x = x - ((x lsr 1) land m1) in + (* gather the bit count for every 4 bits *) + let x = (x land m2) + ((x lsr 2) land m2) in + (* gather the bit count for every byte *) + let x = (x + (x lsr 4)) land m4 in + (* sum the bit counts in the top byte and shift it down *) + to_int ((x * h01) lsr 56) +;; + +let int32_popcount = + (* On 64-bit systems, this is faster than implementing using [int32] arithmetic. *) + let mask = 0xffff_ffffL in + fun [@inline] x -> int64_popcount (Stdlib.Int64.logand (Stdlib.Int64.of_int32 x) mask) +;; + +let nativeint_popcount = + match Stdlib.Nativeint.size with + | 32 -> fun [@inline] x -> int32_popcount (Stdlib.Nativeint.to_int32 x) + | 64 -> fun [@inline] x -> int64_popcount (Stdlib.Int64.of_nativeint x) + | _ -> assert false +;; diff --git a/unikernel/duniverse/base/src/popcount.mli b/unikernel/duniverse/base/src/popcount.mli new file mode 100644 index 00000000..39e57467 --- /dev/null +++ b/unikernel/duniverse/base/src/popcount.mli @@ -0,0 +1,11 @@ +(** This module exposes popcount functions (which count the number of ones in a bitstring) + for the various integer types. + + Functions are exposed in their respective modules. *) + +open! Import + +val int_popcount : int -> int +val int32_popcount : int32 -> int +val int64_popcount : int64 -> int +val nativeint_popcount : nativeint -> int diff --git a/unikernel/duniverse/base/src/pow_overflow_bounds.ml b/unikernel/duniverse/base/src/pow_overflow_bounds.ml new file mode 100644 index 00000000..13cd8466 --- /dev/null +++ b/unikernel/duniverse/base/src/pow_overflow_bounds.ml @@ -0,0 +1,425 @@ +(* This file was autogenerated by ../generate/generate_pow_overflow_bounds.exe *) + +open! Import +module Array = Array0 + +(* We have to use Int64.to_int_exn instead of int constants to make + sure that file can be preprocessed on 32-bit machines. *) + +let overflow_bound_max_int32_value : int32 = 2147483647l + +let int32_positive_overflow_bounds : int32 array = + [| 2147483647l + ; 2147483647l + ; 46340l + ; 1290l + ; 215l + ; 73l + ; 35l + ; 21l + ; 14l + ; 10l + ; 8l + ; 7l + ; 5l + ; 5l + ; 4l + ; 4l + ; 3l + ; 3l + ; 3l + ; 3l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + |] +;; + +let overflow_bound_max_int_value : int = -1 lsr 1 + +let int_positive_overflow_bounds : int array = + match Int_conversions.num_bits_int with + | 32 -> Array.map int32_positive_overflow_bounds ~f:Stdlib.Int32.to_int + | 63 -> + [| Stdlib.Int64.to_int 4611686018427387903L + ; Stdlib.Int64.to_int 4611686018427387903L + ; Stdlib.Int64.to_int 2147483647L + ; 1664510 + ; 46340 + ; 5404 + ; 1290 + ; 463 + ; 215 + ; 118 + ; 73 + ; 49 + ; 35 + ; 27 + ; 21 + ; 17 + ; 14 + ; 12 + ; 10 + ; 9 + ; 8 + ; 7 + ; 7 + ; 6 + ; 5 + ; 5 + ; 5 + ; 4 + ; 4 + ; 4 + ; 4 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 1 + ; 1 + |] + | 31 -> + [| 1073741823 + ; 1073741823 + ; 32767 + ; 1023 + ; 181 + ; 63 + ; 31 + ; 19 + ; 13 + ; 10 + ; 7 + ; 6 + ; 5 + ; 4 + ; 4 + ; 3 + ; 3 + ; 3 + ; 3 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + |] + | _ -> assert false +;; + +let overflow_bound_max_int63_on_int64_value : int64 = 4611686018427387903L + +let int63_on_int64_positive_overflow_bounds : int64 array = + [| 4611686018427387903L + ; 4611686018427387903L + ; 2147483647L + ; 1664510L + ; 46340L + ; 5404L + ; 1290L + ; 463L + ; 215L + ; 118L + ; 73L + ; 49L + ; 35L + ; 27L + ; 21L + ; 17L + ; 14L + ; 12L + ; 10L + ; 9L + ; 8L + ; 7L + ; 7L + ; 6L + ; 5L + ; 5L + ; 5L + ; 4L + ; 4L + ; 4L + ; 4L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 1L + ; 1L + |] +;; + +let overflow_bound_max_int64_value : int64 = 9223372036854775807L + +let int64_positive_overflow_bounds : int64 array = + [| 9223372036854775807L + ; 9223372036854775807L + ; 3037000499L + ; 2097151L + ; 55108L + ; 6208L + ; 1448L + ; 511L + ; 234L + ; 127L + ; 78L + ; 52L + ; 38L + ; 28L + ; 22L + ; 18L + ; 15L + ; 13L + ; 11L + ; 9L + ; 8L + ; 7L + ; 7L + ; 6L + ; 6L + ; 5L + ; 5L + ; 5L + ; 4L + ; 4L + ; 4L + ; 4L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 1L + |] +;; + +let int64_negative_overflow_bounds : int64 array = + [| -9223372036854775807L + ; -9223372036854775807L + ; -3037000499L + ; -2097151L + ; -55108L + ; -6208L + ; -1448L + ; -511L + ; -234L + ; -127L + ; -78L + ; -52L + ; -38L + ; -28L + ; -22L + ; -18L + ; -15L + ; -13L + ; -11L + ; -9L + ; -8L + ; -7L + ; -7L + ; -6L + ; -6L + ; -5L + ; -5L + ; -5L + ; -4L + ; -4L + ; -4L + ; -4L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -1L + |] +;; diff --git a/unikernel/duniverse/base/src/pow_overflow_bounds.mli b/unikernel/duniverse/base/src/pow_overflow_bounds.mli new file mode 100644 index 00000000..8771a2b8 --- /dev/null +++ b/unikernel/duniverse/base/src/pow_overflow_bounds.mli @@ -0,0 +1,9 @@ +val overflow_bound_max_int32_value : int32 +val int32_positive_overflow_bounds : int32 array +val overflow_bound_max_int_value : int +val int_positive_overflow_bounds : int array +val overflow_bound_max_int63_on_int64_value : int64 +val int63_on_int64_positive_overflow_bounds : int64 array +val overflow_bound_max_int64_value : int64 +val int64_positive_overflow_bounds : int64 array +val int64_negative_overflow_bounds : int64 array diff --git a/unikernel/duniverse/base/src/ppx_compare_lib.ml b/unikernel/duniverse/base/src/ppx_compare_lib.ml new file mode 100644 index 00000000..64fc280e --- /dev/null +++ b/unikernel/duniverse/base/src/ppx_compare_lib.ml @@ -0,0 +1,289 @@ +open Import0 + +let compare_abstract ~type_name _ _ = + Printf.ksprintf + failwith + "Compare called on the type %s, which is abstract in an implementation." + type_name +;; + +let equal_abstract ~type_name _ _ = + Printf.ksprintf + failwith + "Equal called on the type %s, which is abstract in an implementation." + type_name +;; + +type 'a compare = 'a -> 'a -> int +type 'a compare__local = 'a -> 'a -> int +type 'a equal = 'a -> 'a -> bool +type 'a equal__local = 'a -> 'a -> bool + +module Comparable = struct + module type S = sig + type t + + val compare : t compare + end + + module type S1 = sig + type 'a t + + val compare : 'a compare -> 'a t compare + end + + module type S2 = sig + type ('a, 'b) t + + val compare : 'a compare -> 'b compare -> ('a, 'b) t compare + end + + module type S3 = sig + type ('a, 'b, 'c) t + + val compare : 'a compare -> 'b compare -> 'c compare -> ('a, 'b, 'c) t compare + end + + module type S_local = sig + type t + + val compare__local : t compare__local + end + + module type S_local1 = sig + type 'a t + + val compare__local : 'a compare__local -> 'a t compare__local + end + + module type S_local2 = sig + type ('a, 'b) t + + val compare__local + : 'a compare__local + -> 'b compare__local + -> ('a, 'b) t compare__local + end + + module type S_local3 = sig + type ('a, 'b, 'c) t + + val compare__local + : 'a compare__local + -> 'b compare__local + -> 'c compare__local + -> ('a, 'b, 'c) t compare__local + end +end + +module Equal = struct + module type S = sig + type t + + val equal : t equal + end + + module type S1 = sig + type 'a t + + val equal : 'a equal -> 'a t equal + end + + module type S2 = sig + type ('a, 'b) t + + val equal : 'a equal -> 'b equal -> ('a, 'b) t equal + end + + module type S3 = sig + type ('a, 'b, 'c) t + + val equal : 'a equal -> 'b equal -> 'c equal -> ('a, 'b, 'c) t equal + end + + module type S_local = sig + type t + + val equal__local : t equal__local + end + + module type S_local1 = sig + type 'a t + + val equal__local : 'a equal__local -> 'a t equal__local + end + + module type S_local2 = sig + type ('a, 'b) t + + val equal__local : 'a equal__local -> 'b equal__local -> ('a, 'b) t equal__local + end + + module type S_local3 = sig + type ('a, 'b, 'c) t + + val equal__local + : 'a equal__local + -> 'b equal__local + -> 'c equal__local + -> ('a, 'b, 'c) t equal__local + end +end + +module Builtin = struct + let compare_bool : bool compare = Poly.compare + let compare_bool__local : bool compare__local = Poly.compare + let compare_char : char compare = Poly.compare + let compare_char__local : char compare__local = Poly.compare + let compare_float : float compare = Poly.compare + let compare_float__local : float compare__local = Poly.compare + let compare_int : int compare = Poly.compare + let compare_int__local : int compare__local = Poly.compare + let compare_int32 : int32 compare = Poly.compare + let compare_int32__local : int32 compare__local = Poly.compare + let compare_int64 : int64 compare = Poly.compare + let compare_int64__local : int64 compare__local = Poly.compare + let compare_nativeint : nativeint compare = Poly.compare + let compare_nativeint__local : nativeint compare__local = Poly.compare + let compare_string : string compare = Poly.compare + let compare_string__local : string compare__local = Poly.compare + let compare_bytes : bytes compare = Poly.compare + let compare_bytes__local : bytes compare__local = Poly.compare + let compare_unit : unit compare = Poly.compare + let compare_unit__local : unit compare__local = Poly.compare + + let compare_array__local compare_elt a b = + if phys_equal a b + then 0 + else ( + let len_a = Array0.length a in + let len_b = Array0.length b in + let ret = compare len_a len_b in + if ret <> 0 + then ret + else ( + let rec loop i = + if i = len_a + then 0 + else ( + let l = Array0.unsafe_get a i + and r = Array0.unsafe_get b i in + let res = compare_elt l r in + if res <> 0 then res else loop (i + 1)) + in + loop 0 [@nontail])) + ;; + + let compare_array compare_elt a b = compare_array__local compare_elt a b + + let rec compare_list compare_elt a b = + match a, b with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | x :: xs, y :: ys -> + let res = compare_elt x y in + if res <> 0 then res else compare_list compare_elt xs ys + ;; + + let rec compare_list__local compare_elt__local a b = + match a, b with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | x :: xs, y :: ys -> + let res = compare_elt__local x y in + if res <> 0 then res else compare_list__local compare_elt__local xs ys + ;; + + let compare_option compare_elt a b = + match a, b with + | None, None -> 0 + | None, Some _ -> -1 + | Some _, None -> 1 + | Some a, Some b -> compare_elt a b + ;; + + let compare_option__local compare_elt__local a b = + match a, b with + | None, None -> 0 + | None, Some _ -> -1 + | Some _, None -> 1 + | Some a, Some b -> compare_elt__local a b + ;; + + let compare_ref compare_elt a b = compare_elt !a !b + let compare_ref__local compare_elt a b = compare_elt !a !b + let equal_bool : bool equal = Poly.equal + let equal_bool__local : bool equal__local = Poly.equal + let equal_char : char equal = Poly.equal + let equal_char__local : char equal__local = Poly.equal + let equal_int : int equal = Poly.equal + let equal_int__local : int equal__local = Poly.equal + let equal_int32 : int32 equal = Poly.equal + let equal_int32__local : int32 equal__local = Poly.equal + let equal_int64 : int64 equal = Poly.equal + let equal_int64__local : int64 equal__local = Poly.equal + let equal_nativeint : nativeint equal = Poly.equal + let equal_nativeint__local : nativeint equal__local = Poly.equal + let equal_string : string equal = Poly.equal + let equal_string__local : string equal__local = Poly.equal + let equal_bytes : bytes equal = Poly.equal + let equal_bytes__local : bytes equal__local = Poly.equal + let equal_unit : unit equal = Poly.equal + let equal_unit__local : unit equal__local = Poly.equal + + (* [Poly.equal] is IEEE compliant, which is not what we want here. *) + let equal_float x y = equal_int (compare_float x y) 0 + let equal_float__local x y = equal_int (compare_float__local x y) 0 + + let equal_array__local equal_elt a b = + phys_equal a b + || + let len_a = Array0.length a in + let len_b = Array0.length b in + equal len_a len_b + && + let rec loop i = + i = len_a + || + let l = Array0.unsafe_get a i + and r = Array0.unsafe_get b i in + equal_elt l r && loop (i + 1) + in + loop 0 [@nontail] + ;; + + let equal_array equal_elt a b = equal_array__local equal_elt a b + + let rec equal_list equal_elt a b = + match a, b with + | [], [] -> true + | [], _ | _, [] -> false + | x :: xs, y :: ys -> equal_elt x y && equal_list equal_elt xs ys + ;; + + let rec equal_list__local equal_elt__local a b = + match a, b with + | [], [] -> true + | [], _ | _, [] -> false + | x :: xs, y :: ys -> equal_elt__local x y && equal_list__local equal_elt__local xs ys + ;; + + let equal_option equal_elt a b = + match a, b with + | None, None -> true + | None, Some _ | Some _, None -> false + | Some a, Some b -> equal_elt a b + ;; + + let equal_option__local equal_elt__local a b = + match a, b with + | None, None -> true + | None, Some _ | Some _, None -> false + | Some a, Some b -> equal_elt__local a b + ;; + + let equal_ref equal_elt a b = equal_elt !a !b + let equal_ref__local equal_elt a b = equal_elt !a !b +end diff --git a/unikernel/duniverse/base/src/ppx_compare_lib.mli b/unikernel/duniverse/base/src/ppx_compare_lib.mli new file mode 100644 index 00000000..f3cb657b --- /dev/null +++ b/unikernel/duniverse/base/src/ppx_compare_lib.mli @@ -0,0 +1,182 @@ +(** Runtime support for auto-generated comparators. Users are not intended to use this + module directly. *) + +type 'a compare = 'a -> 'a -> int +type 'a compare__local = 'a -> 'a -> int +type 'a equal = 'a -> 'a -> bool +type 'a equal__local = 'a -> 'a -> bool + +(** Raise when fully applied *) +val compare_abstract : type_name:string -> _ compare__local + +val equal_abstract : type_name:string -> _ equal__local + +module Comparable : sig + module type S = sig + type t + + val compare : t compare + end + + module type S1 = sig + type 'a t + + val compare : 'a compare -> 'a t compare + end + + module type S2 = sig + type ('a, 'b) t + + val compare : 'a compare -> 'b compare -> ('a, 'b) t compare + end + + module type S3 = sig + type ('a, 'b, 'c) t + + val compare : 'a compare -> 'b compare -> 'c compare -> ('a, 'b, 'c) t compare + end + + module type S_local = sig + type t + + val compare__local : t compare__local + end + + module type S_local1 = sig + type 'a t + + val compare__local : 'a compare__local -> 'a t compare__local + end + + module type S_local2 = sig + type ('a, 'b) t + + val compare__local + : 'a compare__local + -> 'b compare__local + -> ('a, 'b) t compare__local + end + + module type S_local3 = sig + type ('a, 'b, 'c) t + + val compare__local + : 'a compare__local + -> 'b compare__local + -> 'c compare__local + -> ('a, 'b, 'c) t compare__local + end +end + +module Equal : sig + module type S = sig + type t + + val equal : t equal + end + + module type S1 = sig + type 'a t + + val equal : 'a equal -> 'a t equal + end + + module type S2 = sig + type ('a, 'b) t + + val equal : 'a equal -> 'b equal -> ('a, 'b) t equal + end + + module type S3 = sig + type ('a, 'b, 'c) t + + val equal : 'a equal -> 'b equal -> 'c equal -> ('a, 'b, 'c) t equal + end + + module type S_local = sig + type t + + val equal__local : t equal__local + end + + module type S_local1 = sig + type 'a t + + val equal__local : 'a equal__local -> 'a t equal__local + end + + module type S_local2 = sig + type ('a, 'b) t + + val equal__local : 'a equal__local -> 'b equal__local -> ('a, 'b) t equal__local + end + + module type S_local3 = sig + type ('a, 'b, 'c) t + + val equal__local + : 'a equal__local + -> 'b equal__local + -> 'c equal__local + -> ('a, 'b, 'c) t equal__local + end +end + +module Builtin : sig + val compare_bool : bool compare + val compare_char : char compare + val compare_float : float compare + val compare_int : int compare + val compare_int32 : int32 compare + val compare_int64 : int64 compare + val compare_nativeint : nativeint compare + val compare_string : string compare + val compare_bytes : bytes compare + val compare_unit : unit compare + val compare_array : 'a compare -> 'a array compare + val compare_list : 'a compare -> 'a list compare + val compare_option : 'a compare -> 'a option compare + val compare_ref : 'a compare -> 'a ref compare + val equal_bool : bool equal + val equal_char : char equal + val equal_float : float equal + val equal_int : int equal + val equal_int32 : int32 equal + val equal_int64 : int64 equal + val equal_nativeint : nativeint equal + val equal_string : string equal + val equal_bytes : bytes equal + val equal_unit : unit equal + val equal_array : 'a equal -> 'a array equal + val equal_list : 'a equal -> 'a list equal + val equal_option : 'a equal -> 'a option equal + val equal_ref : 'a equal -> 'a ref equal + val compare_bool__local : bool compare__local + val compare_char__local : char compare__local + val compare_float__local : float compare__local + val compare_int__local : int compare__local + val compare_int32__local : int32 compare__local + val compare_int64__local : int64 compare__local + val compare_nativeint__local : nativeint compare__local + val compare_string__local : string compare__local + val compare_bytes__local : bytes compare__local + val compare_unit__local : unit compare__local + val compare_array__local : 'a compare__local -> 'a array compare__local + val compare_list__local : 'a compare__local -> 'a list compare__local + val compare_option__local : 'a compare__local -> 'a option compare__local + val compare_ref__local : 'a compare__local -> 'a ref compare__local + val equal_bool__local : bool equal__local + val equal_char__local : char equal__local + val equal_float__local : float equal__local + val equal_int__local : int equal__local + val equal_int32__local : int32 equal__local + val equal_int64__local : int64 equal__local + val equal_nativeint__local : nativeint equal__local + val equal_string__local : string equal__local + val equal_bytes__local : bytes equal__local + val equal_unit__local : unit equal__local + val equal_array__local : 'a equal__local -> 'a array equal__local + val equal_list__local : 'a equal__local -> 'a list equal__local + val equal_option__local : 'a equal__local -> 'a option equal__local + val equal_ref__local : 'a equal__local -> 'a ref equal__local +end diff --git a/unikernel/duniverse/base/src/ppx_enumerate_lib.ml b/unikernel/duniverse/base/src/ppx_enumerate_lib.ml new file mode 100644 index 00000000..ccb725c3 --- /dev/null +++ b/unikernel/duniverse/base/src/ppx_enumerate_lib.ml @@ -0,0 +1,27 @@ +module List = List + +module Enumerable = struct + module type S = sig + type t + + val all : t list + end + + module type S1 = sig + type 'a t + + val all : 'a list -> 'a t list + end + + module type S2 = sig + type ('a, 'b) t + + val all : 'a list -> 'b list -> ('a, 'b) t list + end + + module type S3 = sig + type ('a, 'b, 'c) t + + val all : 'a list -> 'b list -> 'c list -> ('a, 'b, 'c) t list + end +end diff --git a/unikernel/duniverse/base/src/ppx_hash_lib.ml b/unikernel/duniverse/base/src/ppx_hash_lib.ml new file mode 100644 index 00000000..84ae88ab --- /dev/null +++ b/unikernel/duniverse/base/src/ppx_hash_lib.ml @@ -0,0 +1,37 @@ +(** This module is for use by ppx_hash, and is thus not in the interface of Base. *) +module Std = struct + module Hash = Hash (** @canonical Base.Hash *) +end + +type 'a hash_fold = Std.Hash.state -> 'a -> Std.Hash.state + +module Hashable = struct + module type S = sig + type t + + val hash_fold_t : t hash_fold + val hash : t -> Std.Hash.hash_value + end + + module type S1 = sig + type 'a t + + val hash_fold_t : 'a hash_fold -> 'a t hash_fold + end + + module type S2 = sig + type ('a, 'b) t + + val hash_fold_t : 'a hash_fold -> 'b hash_fold -> ('a, 'b) t hash_fold + end + + module type S3 = sig + type ('a, 'b, 'c) t + + val hash_fold_t + : 'a hash_fold + -> 'b hash_fold + -> 'c hash_fold + -> ('a, 'b, 'c) t hash_fold + end +end diff --git a/unikernel/duniverse/base/src/pretty_printer.ml b/unikernel/duniverse/base/src/pretty_printer.ml new file mode 100644 index 00000000..4007f788 --- /dev/null +++ b/unikernel/duniverse/base/src/pretty_printer.ml @@ -0,0 +1,34 @@ +open! Import + +let r = ref [ "Base.Sexp.pp_hum" ] +let all () = !r +let register p = r := p :: !r + +module type S = sig + type t + + val pp : Formatter.t -> t -> unit +end + +module Register_pp (M : sig + include S + + val module_name : string +end) = +struct + include M + + let () = register (M.module_name ^ ".pp") +end + +module Register (M : sig + type t + + val module_name : string + val to_string : t -> string +end) = +Register_pp (struct + include M + + let pp formatter t = Stdlib.Format.pp_print_string formatter (M.to_string t) +end) diff --git a/unikernel/duniverse/base/src/pretty_printer.mli b/unikernel/duniverse/base/src/pretty_printer.mli new file mode 100644 index 00000000..e8247a67 --- /dev/null +++ b/unikernel/duniverse/base/src/pretty_printer.mli @@ -0,0 +1,54 @@ +(** A list of pretty printers for various types, for use in toplevels. + + [Pretty_printer] has a [string list ref] with the names of [pp] functions matching the + interface: + + {[ + val pp : Format.formatter -> t -> unit + ]} + + The names are actually OCaml identifier names, e.g., "Base.Int.pp". Code for + building toplevels evaluates the strings to yield the + pretty printers and register them with the OCaml runtime. + + This module is only responsible for collecting the pretty-printers. Another mechanism + is needed to register this collection with the "toploop" library for pretty-printing + to actually happen. How to do that depends on how you build and deploy + the OCaml toplevel. One common way to do it in vanilla toplevel is to call + [#require "core.top"]. +*) + +open! Import + +(** [all ()] returns all pretty printers that have been [register]ed. *) +val all : unit -> string list + +(** Modules that provide a pretty printer will match [S]. *) +module type S = sig + type t + + val pp : Formatter.t -> t -> unit +end + +(** [Register] builds a [pp] function from a [to_string] function, and adds the + [module_name ^ ".pp"] to the list of pretty printers. The idea is to statically + guarantee that one has the desired [pp] function at the same point where the [name] is + added. *) +module Register (M : sig + type t + + val module_name : string + val to_string : t -> string +end) : S with type t := M.t + +(** [Register_pp] is like [Register], but allows a custom [pp] function rather than using + [to_string]. *) +module Register_pp (M : sig + include S + + val module_name : string +end) : S with type t := M.t + +(** [register name] adds [name] to the list of pretty printers. Use the [Register] + functor if possible. *) +val register : string -> unit diff --git a/unikernel/duniverse/base/src/printf.ml b/unikernel/duniverse/base/src/printf.ml new file mode 100644 index 00000000..2f33e667 --- /dev/null +++ b/unikernel/duniverse/base/src/printf.ml @@ -0,0 +1,12 @@ +open! Import0 +include Stdlib.Printf + +(** failwith, invalid_arg, and exit accepting printf's format. *) + +let[@inline never] [@zero_alloc assume never_returns_normally] failwithf fmt = + ksprintf (fun s () -> failwith s) fmt +;; + +let[@inline never] [@zero_alloc assume never_returns_normally] invalid_argf fmt = + ksprintf (fun s () -> invalid_arg s) fmt +;; diff --git a/unikernel/duniverse/base/src/printf.mli b/unikernel/duniverse/base/src/printf.mli new file mode 100644 index 00000000..81930303 --- /dev/null +++ b/unikernel/duniverse/base/src/printf.mli @@ -0,0 +1,139 @@ +(** Functions for formatted output. + + [fprintf] and related functions format their arguments according to the given format + string. The format string is a character string which contains two types of objects: + plain characters, which are simply copied to the output channel, and conversion + specifications, each of which causes conversion and printing of arguments. + + Conversion specifications have the following form: + + {[% [flags] [width] [.precision] type]} + + In short, a conversion specification consists in the [%] character, followed by + optional modifiers and a type which is made of one or two characters. + + The types and their meanings are: + + - [d], [i]: convert an integer argument to signed decimal. + - [u], [n], [l], [L], or [N]: convert an integer argument to unsigned + decimal. Warning: [n], [l], [L], and [N] are used for [scanf], and should not be used + for [printf]. + - [x]: convert an integer argument to unsigned hexadecimal, using lowercase letters. + - [X]: convert an integer argument to unsigned hexadecimal, using uppercase letters. + - [o]: convert an integer argument to unsigned octal. + - [s]: insert a string argument. + - [S]: convert a string argument to OCaml syntax (double quotes, escapes). + - [c]: insert a character argument. + - [C]: convert a character argument to OCaml syntax (single quotes, escapes). + - [f]: convert a floating-point argument to decimal notation, in the style [dddd.ddd]. + - [F]: convert a floating-point argument to OCaml syntax ([dddd.] or [dddd.ddd] or + [d.ddd e+-dd]). + - [e] or [E]: convert a floating-point argument to decimal notation, in the style + [d.ddd e+-dd] (mantissa and exponent). + - [g] or [G]: convert a floating-point argument to decimal notation, in style [f] or + [e], [E] (whichever is more compact). Moreover, any trailing zeros are removed from + the fractional part of the result and the decimal-point character is removed if there + is no fractional part remaining. + - [h] or [H]: convert a floating-point argument to hexadecimal notation, in the style + [0xh.hhhh e+-dd] (hexadecimal mantissa, exponent in decimal and denotes a power of 2). + - [B]: convert a boolean argument to the string true or false + - [b]: convert a boolean argument (deprecated; do not use in new programs). + - [ld], [li], [lu], [lx], [lX], [lo]: convert an int32 argument to the format + specified by the second letter (decimal, hexadecimal, etc). + - [nd], [ni], [nu], [nx], [nX], [no]: convert a nativeint argument to the format + specified by the second letter. + - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: convert an int64 argument to the format + specified by the second letter. + - [a]: user-defined printer. Take two arguments and apply the first one to outchan + (the current output channel) and to the second argument. The first argument must + therefore have type [out_channel -> 'b -> unit] and the second ['b]. The output + produced by the function is inserted in the output of [fprintf] at the current point. + - [t]: same as [%a], but take only one argument (with type [out_channel -> unit]) and + apply it to [outchan]. + - [{ fmt %}]: convert a format string argument to its type digest. The argument must + have the same type as the internal format string [fmt]. + - [( fmt %)]: format string substitution. Take a format string argument and substitute + it to the internal format string fmt to print following arguments. The argument must + have the same type as the internal format string fmt. + - [!]: take no argument and flush the output. + - [%]: take no argument and output one [%] character. + - [@]: take no argument and output one [@] character. + - [,]: take no argument and output nothing: a no-op delimiter for conversion + specifications. + + The optional [flags] are: + + - [-]: left-justify the output (default is right justification). + - [0]: for numerical conversions, pad with zeroes instead of spaces. + - [+]: for signed numerical conversions, prefix number with a [+] sign if positive. + - space: for signed numerical conversions, prefix number with a space if positive. + - [#]: request an alternate formatting style for the hexadecimal and octal integer + types ([x], [X], [o], [lx], [lX], [lo], [Lx], [LX], [Lo]). + + The optional [width] is an integer indicating the minimal width of the result. For + instance, [%6d] prints an integer, prefixing it with spaces to fill at least 6 + characters. + + The optional [precision] is a dot [.] followed by an integer indicating how many + digits follow the decimal point in the [%f], [%e], and [%E] conversions. For instance, + [%.4f] prints a [float] with 4 fractional digits. + + The integer in a [width] or [precision] can also be specified as [*], in which case an + extra integer argument is taken to specify the corresponding [width] or + [precision]. This integer argument precedes immediately the argument to print. For + instance, [%.*f] prints a float with as many fractional digits as the value of the + argument given before the float. +*) + +open! Import0 + +(** Same as [fprintf], but does not print anything. Useful for ignoring some material when + conditionally printing. *) +val ifprintf : 'a -> ('r, 'a, 'c, unit) format4 -> 'r + +(** Same as [fprintf], but instead of printing on an output channel, returns a string. *) +val sprintf : ('r, unit, string) format -> 'r + +(** Same as [fprintf], but instead of printing on an output channel, appends the formatted + arguments to the given extensible buffer. *) +val bprintf : Stdlib.Buffer.t -> ('r, Stdlib.Buffer.t, unit) format -> 'r + +(** Same as [sprintf], but instead of returning the string, passes it to the first + argument. *) +val ksprintf : (string -> 'a) -> ('r, unit, string, 'a) format4 -> 'r + +(** Same as [bprintf], but instead of returning immediately, passes the buffer, after + printing, to its first argument. *) +val kbprintf + : (Stdlib.Buffer.t -> 'a) + -> Stdlib.Buffer.t + -> ('r, Stdlib.Buffer.t, unit, 'a) format4 + -> 'r + +(** {6 Formatting error and exit functions} + + These functions have a polymorphic return type, since they do not return. Naively, + this doesn't mix well with variadic functions: if you define, say, + + {[ + let f fmt = ksprintf (fun s -> failwith s) fmt + ]} + + then you find that [f "%d" : int -> 'a], as you'd expect, and [f "%d" 7 : 'a]. The + problem with this is that ['a] unifies with (say) [int -> 'b], so [f "%d" 7 4] is not + a type error -- the [4] is simply ignored. + + To mitigate this problem, these functions all take a final unit parameter. These + rarely arise as formatting positional parameters (they can do with e.g. "%a", but not + in a useful way) so they serve as an effective signpost for + "end of formatting arguments". *) + +(** Raises [Failure]. + + *) +val failwithf : ('r, unit, string, unit -> _) format4 -> 'r + +(** Raises [Invalid_arg]. + + *) +val invalid_argf : ('r, unit, string, unit -> _) format4 -> 'r diff --git a/unikernel/duniverse/base/src/queue.ml b/unikernel/duniverse/base/src/queue.ml new file mode 100644 index 00000000..f26c639a --- /dev/null +++ b/unikernel/duniverse/base/src/queue.ml @@ -0,0 +1,558 @@ +open! Import + +(* [t] stores the [t.length] queue elements at consecutive increasing indices of [t.elts], + mod the capacity of [t], which is [Option_array.length t.elts]. The capacity is + required to be a power of two (user-requested capacities are rounded up to the nearest + power), so that mod can quickly be computed using [land t.mask], where [t.mask = + capacity t - 1]. So, queue element [i] is at [t.elts.( (t.front + i) land t.mask )]. + + [num_mutations] is used to detect modification during iteration. *) +type 'a t = + { mutable num_mutations : int + ; mutable front : int + ; mutable mask : int + ; mutable length : int + ; mutable elts : 'a Option_array.t + } +[@@deriving_inline sexp_of] + +let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + fun _of_a__001_ + { num_mutations = num_mutations__003_ + ; front = front__005_ + ; mask = mask__007_ + ; length = length__009_ + ; elts = elts__011_ + } -> + let bnds__002_ = ([] : _ Stdlib.List.t) in + let bnds__002_ = + let arg__012_ = Option_array.sexp_of_t _of_a__001_ elts__011_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "elts"; arg__012_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__010_ = sexp_of_int length__009_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "length"; arg__010_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__008_ = sexp_of_int mask__007_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "mask"; arg__008_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__006_ = sexp_of_int front__005_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "front"; arg__006_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__004_ = sexp_of_int num_mutations__003_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "num_mutations"; arg__004_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List bnds__002_ +;; + +[@@@end] + +let globalize _ t = + { num_mutations = t.num_mutations + ; front = t.front + ; mask = t.mask + ; length = t.length + ; elts = Option_array.copy t.elts + } +;; + +module type S = Queue_intf.S + +let inc_num_mutations t = t.num_mutations <- t.num_mutations + 1 +let capacity t = t.mask + 1 +let elts_index t i = (t.front + i) land t.mask +let unsafe_get t i = Option_array.unsafe_get_some_exn t.elts (elts_index t i) +let unsafe_is_set t i = Option_array.unsafe_is_some t.elts (elts_index t i) +let unsafe_set t i a = Option_array.unsafe_set_some t.elts (elts_index t i) a +let unsafe_unset t i = Option_array.unsafe_set_none t.elts (elts_index t i) + +let check_index_exn t i = + if i < 0 || i >= t.length + then + Error.raise_s + (Sexp.message + "Queue index out of bounds" + [ "index", i |> Int.sexp_of_t; "length", t.length |> Int.sexp_of_t ]) +;; + +let get t i = + check_index_exn t i; + unsafe_get t i +;; + +let set t i a = + check_index_exn t i; + inc_num_mutations t; + unsafe_set t i a +;; + +let is_empty t = t.length = 0 +let length { length; _ } = length + +let[@cold] [@inline never] raise_mutation_during_iteration t = + Error.raise_s + (Sexp.message + "mutation of queue during iteration" + [ "", t |> globalize () |> sexp_of_t (fun _ -> Sexp.Atom "_") ]) +;; + +let ensure_no_mutation t num_mutations = + if t.num_mutations <> num_mutations then raise_mutation_during_iteration t +;; + +let compare__local = + let rec unsafe_compare_from compare_elt pos ~t1 ~t2 ~len1 ~len2 ~mut1 ~mut2 = + match pos = len1, pos = len2 with + | true, true -> 0 + | true, false -> -1 + | false, true -> 1 + | false, false -> + let x = compare_elt (unsafe_get t1 pos) (unsafe_get t2 pos) in + ensure_no_mutation t1 mut1; + ensure_no_mutation t2 mut2; + (match x with + | 0 -> unsafe_compare_from compare_elt (pos + 1) ~t1 ~t2 ~len1 ~len2 ~mut1 ~mut2 + | n -> n) + in + fun compare_elt t1 t2 -> + if phys_equal t1 t2 + then 0 + else + unsafe_compare_from + compare_elt + 0 + ~t1 + ~t2 + ~len1:t1.length + ~len2:t2.length + ~mut1:t1.num_mutations + ~mut2:t2.num_mutations +;; + +let compare compare_elt t1 t2 = compare__local compare_elt t1 t2 + +let equal__local = + let rec unsafe_equal_from equal_elt pos ~t1 ~t2 ~mut1 ~mut2 ~len = + pos = len + || + let b = equal_elt (unsafe_get t1 pos) (unsafe_get t2 pos) in + ensure_no_mutation t1 mut1; + ensure_no_mutation t2 mut2; + b && unsafe_equal_from equal_elt (pos + 1) ~t1 ~t2 ~mut1 ~mut2 ~len + in + fun equal_elt t1 t2 -> + phys_equal t1 t2 + || + let len1 = t1.length in + let len2 = t2.length in + len1 = len2 + && unsafe_equal_from + equal_elt + 0 + ~t1 + ~t2 + ~len:len1 + ~mut1:t1.num_mutations + ~mut2:t2.num_mutations +;; + +let equal equal_elt t1 t2 = equal__local equal_elt t1 t2 + +let invariant invariant_a t = + let { num_mutations; mask = _; elts; front; length } = t in + assert (front >= 0); + assert (front < capacity t); + let capacity = capacity t in + assert (capacity = Option_array.length elts); + assert (capacity >= 1); + assert (Int.is_pow2 capacity); + assert (length >= 0); + assert (length <= capacity); + for i = 0 to capacity - 1 do + if i < t.length + then ( + invariant_a (unsafe_get t i); + ensure_no_mutation t num_mutations) + else assert (not (unsafe_is_set t i)) + done +;; + +let create (type a) ?capacity () : a t = + let capacity = + match capacity with + | None -> 2 + | Some capacity -> + if capacity < 0 + then + Error.raise_s + (Sexp.message + "cannot have queue with negative capacity" + [ "capacity", capacity |> Int.sexp_of_t ]) + else if capacity = 0 + then 1 + else Int.ceil_pow2 capacity + in + { num_mutations = 0 + ; front = 0 + ; mask = capacity - 1 + ; length = 0 + ; elts = Option_array.create ~len:capacity + } +;; + +let blit_to_array ~src dst = + assert (src.length <= Option_array.length dst); + let front_len = Int.min src.length (capacity src - src.front) in + let rest_len = src.length - front_len in + Option_array.blit ~len:front_len ~src:src.elts ~src_pos:src.front ~dst ~dst_pos:0; + Option_array.blit ~len:rest_len ~src:src.elts ~src_pos:0 ~dst ~dst_pos:front_len +;; + +let set_capacity_internal t new_capacity = + let dst = Option_array.create ~len:new_capacity in + blit_to_array ~src:t dst; + t.front <- 0; + t.mask <- new_capacity - 1; + t.elts <- dst +;; + +let set_capacity t desired_capacity = + (* We allow arguments less than 1 to [set_capacity], but translate them to 1 to simplify + the code that relies on the array length being a power of 2. *) + inc_num_mutations t; + let new_capacity = Int.ceil_pow2 (max 1 (max desired_capacity t.length)) in + if new_capacity <> capacity t then set_capacity_internal t new_capacity +;; + +let enqueue t a = + inc_num_mutations t; + if t.length = capacity t then set_capacity_internal t (2 * t.length); + unsafe_set t t.length a; + t.length <- t.length + 1 +;; + +let enqueue_front t a = + inc_num_mutations t; + if t.length = capacity t then set_capacity_internal t (2 * t.length); + let front = (t.front - 1) land t.mask in + t.front <- front; + t.length <- t.length + 1; + unsafe_set t 0 a +;; + +let dequeue_nonempty t = + inc_num_mutations t; + let elts = t.elts in + let front = t.front in + let res = Option_array.get_some_exn elts front in + Option_array.set_none elts front; + t.front <- elts_index t 1; + t.length <- t.length - 1; + res +;; + +let back_index t = elts_index t (t.length - 1) + +let dequeue_back_nonempty t = + inc_num_mutations t; + let elts = t.elts in + let back = back_index t in + let res = Option_array.get_some_exn elts back in + Option_array.set_none elts back; + t.length <- t.length - 1; + res +;; + +let dequeue_exn t = if is_empty t then raise Stdlib.Queue.Empty else dequeue_nonempty t +let dequeue t = if is_empty t then None else Some (dequeue_nonempty t) +let dequeue_and_ignore_exn (type elt) (t : elt t) = ignore (dequeue_exn t : elt) + +let dequeue_back_exn t = + if is_empty t then raise Stdlib.Queue.Empty else dequeue_back_nonempty t +;; + +let dequeue_back t = if is_empty t then None else Some (dequeue_back_nonempty t) +let front_nonempty t = Option_array.unsafe_get_some_exn t.elts t.front +let back_nonempty t = Option_array.unsafe_get_some_exn t.elts (back_index t) +let last_nonempty t = unsafe_get t (t.length - 1) +let peek t = if is_empty t then None else Some (front_nonempty t) +let peek_exn t = if is_empty t then raise Stdlib.Queue.Empty else front_nonempty t +let peek_back t = if is_empty t then None else Some (back_nonempty t) +let peek_back_exn t = if is_empty t then raise Stdlib.Queue.Empty else back_nonempty t +let last t = if is_empty t then None else Some (last_nonempty t) +let last_exn t = if is_empty t then raise Stdlib.Queue.Empty else last_nonempty t + +let drain t ~f ~while_ = + while (not (is_empty t)) && while_ (front_nonempty t) do + f (dequeue_nonempty t) + done +;; + +let clear t = + inc_num_mutations t; + if t.length > 0 + then ( + for i = 0 to t.length - 1 do + unsafe_unset t i + done; + t.length <- 0; + t.front <- 0) +;; + +let blit_transfer ~src ~dst ?len () = + inc_num_mutations src; + inc_num_mutations dst; + let len = + match len with + | None -> src.length + | Some len -> + if len < 0 + then + Error.raise_s + (Sexp.message + "Queue.blit_transfer: negative length" + [ "length", len |> Int.sexp_of_t ]); + min len src.length + in + if len > 0 + then ( + set_capacity dst (max (capacity dst) (dst.length + len)); + let dst_start = dst.front + dst.length in + for i = 0 to len - 1 do + (* This is significantly faster than simply [enqueue dst (dequeue_nonempty src)] *) + let src_i = (src.front + i) land src.mask in + let dst_i = (dst_start + i) land dst.mask in + Option_array.unsafe_set_some + dst.elts + dst_i + (Option_array.unsafe_get_some_exn src.elts src_i); + Option_array.unsafe_set_none src.elts src_i + done; + dst.length <- dst.length + len; + src.front <- (src.front + len) land src.mask; + src.length <- src.length - len) +;; + +let enqueue_all t l = + (* Traversing the list up front to compute its length is probably (but not definitely) + better than doubling the underlying array size several times for large queues. *) + set_capacity t (Int.max (capacity t) (t.length + List.length l)); + List.iter l ~f:(fun x -> enqueue t x) +;; + +let fold t ~init ~f = + if t.length = 0 + then init + else ( + let num_mutations = t.num_mutations in + let r = ref init in + for i = 0 to t.length - 1 do + r := f !r (unsafe_get t i); + ensure_no_mutation t num_mutations + done; + !r) +;; + +let foldi t ~init ~f = + let i = ref 0 in + fold t ~init ~f:(fun acc a -> + let acc = f !i acc a in + i := !i + 1; + acc) [@nontail] +;; + +(* [iter] is implemented directly because implementing it in terms of [fold] is + slower. *) +let iter t ~f = + let num_mutations = t.num_mutations in + for i = 0 to t.length - 1 do + f (unsafe_get t i); + ensure_no_mutation t num_mutations + done +;; + +let iteri t ~f = + let num_mutations = t.num_mutations in + for i = 0 to t.length - 1 do + f i (unsafe_get t i); + ensure_no_mutation t num_mutations + done +;; + +let to_list t = + let result = ref [] in + for i = t.length - 1 downto 0 do + result := unsafe_get t i :: !result + done; + !result +;; + +module C = Indexed_container.Make (struct + type nonrec 'a t = 'a t + + let fold = fold + let iter = `Custom iter + let length = `Custom length + let foldi = `Custom foldi + let iteri = `Custom iteri +end) + +let count = C.count +let exists = C.exists +let find = C.find +let find_map = C.find_map +let fold_result = C.fold_result +let fold_until = C.fold_until +let for_all = C.for_all +let max_elt = C.max_elt +let mem = C.mem +let min_elt = C.min_elt +let sum = C.sum +let counti = C.counti +let existsi = C.existsi +let find_mapi = C.find_mapi +let findi = C.findi +let for_alli = C.for_alli + +(* For [concat_map], [filter_map], and [filter], we don't create [t_result] with [t]'s + capacity because we have no idea how many elements [t_result] will ultimately hold. *) +let concat_map t ~f = + let t_result = create () in + iter t ~f:(fun a -> List.iter (f a) ~f:(fun b -> enqueue t_result b)); + t_result +;; + +let concat_mapi t ~f = + let t_result = create () in + iteri t ~f:(fun i a -> List.iter (f i a) ~f:(fun b -> enqueue t_result b)); + t_result +;; + +let filter_map t ~f = + let t_result = create () in + iter t ~f:(fun a -> + match f a with + | None -> () + | Some b -> enqueue t_result b); + t_result +;; + +let filter_mapi t ~f = + let t_result = create () in + iteri t ~f:(fun i a -> + match f i a with + | None -> () + | Some b -> enqueue t_result b); + t_result +;; + +let filter t ~f = + let t_result = create () in + iter t ~f:(fun a -> if f a then enqueue t_result a); + t_result +;; + +let filteri t ~f = + let t_result = create () in + iteri t ~f:(fun i a -> if f i a then enqueue t_result a); + t_result +;; + +let filter_inplace t ~f = + let t2 = filter t ~f in + clear t; + blit_transfer ~src:t2 ~dst:t () +;; + +let filteri_inplace t ~f = + let t2 = filteri t ~f in + clear t; + blit_transfer ~src:t2 ~dst:t () +;; + +let copy src = + let dst = create ~capacity:src.length () in + blit_to_array ~src dst.elts; + dst.length <- src.length; + dst +;; + +let of_list l = + (* Traversing the list up front to compute its length is probably (but not definitely) + better than doubling the underlying array size several times for large queues. *) + let t = create ~capacity:(List.length l) () in + List.iter l ~f:(fun x -> enqueue t x); + t +;; + +(* The queue [t] returned by [create] will have [t.length = 0], [t.front = 0], and + [capacity t = Int.ceil_pow2 len]. So, we only have to set [t.length] to [len] after + the blit to maintain all the invariants: [t.length] is equal to the number of elements + in the queue, [t.front] is the array index of the first element in the queue, and + [capacity t = Option_array.length t.elts]. *) +let init len ~f = + if len < 0 + then + Error.raise_s + (Sexp.message "Queue.init: negative length" [ "length", len |> Int.sexp_of_t ]); + let t = create ~capacity:len () in + assert (Option_array.length t.elts >= len); + for i = 0 to len - 1 do + Option_array.unsafe_set_some t.elts i (f i) + done; + t.length <- len; + t +;; + +let of_array a = init (Array.length a) ~f:(Array.unsafe_get a) +let to_array t = Array.init t.length ~f:(fun i -> unsafe_get t i) + +let map ta ~f = + let num_mutations = ta.num_mutations in + let tb = create ~capacity:ta.length () in + tb.length <- ta.length; + for i = 0 to ta.length - 1 do + let b = f (unsafe_get ta i) in + ensure_no_mutation ta num_mutations; + Option_array.unsafe_set_some tb.elts i b + done; + tb +;; + +let mapi t ~f = + let i = ref 0 in + map t ~f:(fun a -> + let result = f !i a in + i := !i + 1; + result) [@nontail] +;; + +let singleton x = + let t = create ~capacity:1 () in + enqueue t x; + t +;; + +let sexp_of_t sexp_of_a t = to_list t |> List.sexp_of_t sexp_of_a +let t_of_sexp a_of_sexp sexp = List.t_of_sexp a_of_sexp sexp |> of_list + +let t_sexp_grammar (type a) (grammar : a Sexplib0.Sexp_grammar.t) + : a t Sexplib0.Sexp_grammar.t + = + Sexplib0.Sexp_grammar.coerce (List.t_sexp_grammar grammar) +;; + +module Iteration = struct + type t = int + + let start q = q.num_mutations + let assert_no_mutation_since_start t q = ensure_no_mutation q t +end diff --git a/unikernel/duniverse/base/src/queue.mli b/unikernel/duniverse/base/src/queue.mli new file mode 100644 index 00000000..4e095d99 --- /dev/null +++ b/unikernel/duniverse/base/src/queue.mli @@ -0,0 +1 @@ +include Queue_intf.Queue (** @inline *) diff --git a/unikernel/duniverse/base/src/queue_intf.ml b/unikernel/duniverse/base/src/queue_intf.ml new file mode 100644 index 00000000..f4a627b8 --- /dev/null +++ b/unikernel/duniverse/base/src/queue_intf.ml @@ -0,0 +1,187 @@ +open! Import + +(** An interface for queues that follows Base's conventions, as opposed to OCaml's + standard [Queue] module. *) +module type S = sig + type 'a t [@@deriving_inline sexp, sexp_grammar] + + include Sexplib0.Sexpable.S1 with type 'a t := 'a t + + val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Indexed_container.S1 with type 'a t := 'a t + + (** [singleton a] returns a queue with one element. *) + val singleton : 'a -> 'a t + + (** [of_list list] returns a queue [t] with the elements of [list] in the same order as + the elements of [list] (i.e. the first element of [t] is the first element of the + list). *) + val of_list : 'a list -> 'a t + + val of_array : 'a array -> 'a t + + (** [init n ~f] is equivalent to [of_list (List.init n ~f)]. *) + val init : int -> f:(int -> 'a) -> 'a t + + (** [enqueue t a] adds [a] to the end of [t].*) + val enqueue : 'a t -> 'a -> unit + + (** [enqueue_all t list] adds all elements in [list] to [t] in order of [list]. *) + val enqueue_all : 'a t -> 'a list -> unit + + (** [dequeue t] removes and returns the front element of [t], if any. *) + val dequeue : 'a t -> 'a option + + val dequeue_exn : 'a t -> 'a + + (** [dequeue_and_ignore_exn t] removes the front element of [t], or raises if the queue + is empty. *) + val dequeue_and_ignore_exn : 'a t -> unit + + (** [drain t ~f ~while_] repeatedly calls [while_] on the head of [t], and if it returns + true then dequeues it and calls [f] on it. It stops when [t] is empty or [while_] + returns false. A common use case is tracking the sum of data in a recent time + interval: [t] contains timestamped data, [while_] checks for elements with an old + timestamp, and [f] subtracts data from the sum. *) + val drain : 'a t -> f:('a -> unit) -> while_:('a -> bool) -> unit + + (** [peek t] returns but does not remove the front element of [t], if any. *) + val peek : 'a t -> 'a option + + val peek_exn : 'a t -> 'a + + (** [clear t] discards all elements from [t]. *) + val clear : _ t -> unit + + (** [copy t] returns a copy of [t]. *) + val copy : 'a t -> 'a t + + val map : 'a t -> f:('a -> 'b) -> 'b t + val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t + + (** Creates a new queue with elements equal to [List.concat_map ~f (to_list t)]. *) + val concat_map : 'a t -> f:('a -> 'b list) -> 'b t + + val concat_mapi : 'a t -> f:(int -> 'a -> 'b list) -> 'b t + + (** [filter_map] creates a new queue with elements equal to [List.filter_map ~f (to_list + t)]. *) + val filter_map : 'a t -> f:('a -> 'b option) -> 'b t + + val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t + + (** [filter] is like [filter_map], except with [List.filter]. *) + val filter : 'a t -> f:('a -> bool) -> 'a t + + val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t + + (** [filter_inplace t ~f] removes all elements of [t] that don't satisfy [f]. If [f] + raises, [t] is unchanged. This is inplace in that it modifies [t]; however, it uses + space linear in the final length of [t]. *) + val filter_inplace : 'a t -> f:('a -> bool) -> unit + + val filteri_inplace : 'a t -> f:(int -> 'a -> bool) -> unit +end + +module type Queue = sig + (** A queue implemented with an array. + + The implementation will grow the array as necessary. The array will + never automatically be shrunk, but the size can be interrogated and set + with [capacity] and [set_capacity]. + + Iteration functions ([iter], [fold], [map], [concat_map], [filter], + [filter_map], [filter_inplace], and some functions from [Container.S1]) + will raise if the queue is modified during iteration. + + Also see {!Linked_queue}, which has different performance characteristics. *) + + module type S = S + + type 'a t [@@deriving_inline compare ~localize, globalize] + + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + + val globalize : ('a -> 'a) -> 'a t -> 'a t + + [@@@end] + + include S with type 'a t := 'a t + include Equal.S1 with type 'a t := 'a t + include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t + include Invariant.S1 with type 'a t := 'a t + + (** Create an empty queue. *) + val create : ?capacity:int (** default is [1]. *) -> unit -> _ t + + (** [last t] returns the most recently enqueued element in [t], if any. *) + val last : 'a t -> 'a option + + val last_exn : 'a t -> 'a + + (** Add an element to the front of the queue, as opposed to [enqueue] which adds to the + back of the queue. *) + val enqueue_front : 'a t -> 'a -> unit + + (** [dequeue_back t] removes and returns the back element of [t], if any. *) + val dequeue_back : 'a t -> 'a option + + val dequeue_back_exn : 'a t -> 'a + + (** [peek_back t] returns but does not remove the back element of [t], if any. *) + val peek_back : 'a t -> 'a option + + val peek_back_exn : 'a t -> 'a + + (** Transfers up to [len] elements from the front of [src] to the end of [dst], removing + them from [src]. It is an error if [len < 0]. + + Aside from a call to [set_capacity dst] if needed, runs in O([len]) time *) + val blit_transfer + : src:'a t + -> dst:'a t + -> ?len:int (** default is [length src] *) + -> unit + -> unit + + (** [get t i] returns the [i]'th element in [t], where the 0'th element is at the front of + [t] and the [length t - 1] element is at the back. *) + val get : 'a t -> int -> 'a + + val set : 'a t -> int -> 'a -> unit + + (** Returns the current length of the backing array. *) + val capacity : _ t -> int + + (** [set_capacity t c] sets the capacity of [t]'s backing array to at least [max c (length + t)]. If [t]'s capacity changes, then this involves allocating a new backing array and + copying the queue elements over. [set_capacity] may decrease the capacity of [t], if + [c < capacity t]. *) + val set_capacity : _ t -> int -> unit + + (** Use [Iteration] to implement iteration functions that guard against mutation. *) + module Iteration : sig + type 'a queue := 'a t + + (** A token representing state from the beginning of an iteration. *) + type t [@@immediate] + + (** Capture state at the start of iteration. *) + val start : _ queue -> t + + (** [assert_no_mutation_since_start t queue] raises if any mutation has happened to + [queue] since [t] was created by [start queue]. Results are unspecified if you + call [assert_no_mutation_since_start] with a different queue from the one passed + to [start]. + + Call [assert_no_mutation_since_start] after each step of an iteration loop, before + checking if the queue is empty or advancing to the next element. This ensures + these read operations are consistent with the queue's state at the start of + iteration. *) + val assert_no_mutation_since_start : t -> _ queue -> unit + end +end diff --git a/unikernel/duniverse/base/src/random.ml b/unikernel/duniverse/base/src/random.ml new file mode 100644 index 00000000..0aa4d355 --- /dev/null +++ b/unikernel/duniverse/base/src/random.ml @@ -0,0 +1,250 @@ +open! Import +module Int = Int0 +module Char = Char0 + +(* Unfortunately, because the standard library does not expose + [Stdlib.Random.State.default], we have to construct our own. We then build the + [Stdlib.Random.int], [Stdlib.Random.bool] functions and friends using that default state in + exactly the same way as the standard library. *) + +(* Regression tests ought to be deterministic because that way anyone who breaks the test + knows that it's their code that broke the test. If tests are nondeterministic, a test + failure may instead happen because the test runner got unlucky and uncovered an + existing bug in the code supposedly being "protected" by the test in question. *) +let forbid_nondeterminism_in_tests ~allow_in_tests = + if am_testing + then ( + match allow_in_tests with + | Some true -> () + | None | Some false -> + failwith + "initializing Random with a nondeterministic seed is forbidden in inline tests") +;; + +external random_seed : unit -> int array = "caml_sys_random_seed" + +let random_seed ?allow_in_tests () = + forbid_nondeterminism_in_tests ~allow_in_tests; + random_seed () +;; + +module Repr = Random_repr + +module State = struct + type t = Repr.t + + let bits t = Stdlib.Random.State.bits (Repr.get_state t) + let bits64 t = Stdlib.Random.State.bits64 (Repr.get_state t) + let bool t = Stdlib.Random.State.bool (Repr.get_state t) + let int t x = Stdlib.Random.State.int (Repr.get_state t) x + let int32 t x = Stdlib.Random.State.int32 (Repr.get_state t) x + let int64 t x = Stdlib.Random.State.int64 (Repr.get_state t) x + let nativeint t x = Stdlib.Random.State.nativeint (Repr.get_state t) x + let make seed = Repr.make (Stdlib.Random.State.make seed) + let copy t = Repr.make (Stdlib.Random.State.copy (Repr.get_state t)) + let char t = int t 256 |> Char.unsafe_of_int + let ascii t = int t 128 |> Char.unsafe_of_int + + let make_self_init ?allow_in_tests () = + forbid_nondeterminism_in_tests ~allow_in_tests; + Repr.make_lazy ~f:Stdlib.Random.State.make_self_init + ;; + + let assign = Repr.assign + let full_init t seed = assign t (Stdlib.Random.State.make seed) + + let default = + if am_testing + then ( + (* We define Base's default random state as a copy of OCaml's default random state. + This means that programs that use Base.Random will see the same sequence of + random bits as if they had used Stdlib.Random. However, because [get_state] returns + a copy, Base.Random and OCaml.Random are not using the same state. If a program + used both, each of them would go through the same sequence of random bits. To + avoid that, we reset OCaml's random state to a different seed, giving it a + different sequence. *) + let t = Stdlib.Random.get_state () in + Stdlib.Random.init 137; + Repr.make t) + else + (* Outside of tests, we initialize random state nondeterministically and lazily. + We force the random initialization to be lazy so that we do not pay any cost + for it in programs that do not use randomness. *) + make_self_init () + ;; + + let int_on_64bits t bound = + if bound <= 0x3FFFFFFF (* (1 lsl 30) - 1 *) + then int t bound + else Stdlib.Int64.to_int (int64 t (Stdlib.Int64.of_int bound)) + ;; + + let int_on_32bits t bound = + (* Not always true with the JavaScript backend. *) + if bound <= 0x3FFFFFFF (* (1 lsl 30) - 1 *) + then int t bound + else Stdlib.Int32.to_int (int32 t (Stdlib.Int32.of_int bound)) + ;; + + let int = + match Word_size.word_size with + | W64 -> int_on_64bits + | W32 -> int_on_32bits + ;; + + let full_range_int64 = + let open Stdlib.Int64 in + let bits state = of_int (bits state) in + fun state -> + logxor + (bits state) + (logxor (shift_left (bits state) 30) (shift_left (bits state) 60)) + ;; + + let full_range_int32 = + let open Stdlib.Int32 in + let bits state = of_int (bits state) in + fun state -> logxor (bits state) (shift_left (bits state) 30) + ;; + + let full_range_int_on_64bits state = Stdlib.Int64.to_int (full_range_int64 state) + let full_range_int_on_32bits state = Stdlib.Int32.to_int (full_range_int32 state) + + let full_range_int = + match Word_size.word_size with + | W64 -> full_range_int_on_64bits + | W32 -> full_range_int_on_32bits + ;; + + let full_range_nativeint_on_64bits state = + Stdlib.Int64.to_nativeint (full_range_int64 state) + ;; + + let full_range_nativeint_on_32bits state = + Stdlib.Nativeint.of_int32 (full_range_int32 state) + ;; + + let full_range_nativeint = + match Word_size.word_size with + | W64 -> full_range_nativeint_on_64bits + | W32 -> full_range_nativeint_on_32bits + ;; + + let raise_crossed_bounds name lower_bound upper_bound string_of_bound = + Printf.failwithf + "Random.%s: crossed bounds [%s > %s]" + name + (string_of_bound lower_bound) + (string_of_bound upper_bound) + () + [@@cold] [@@inline never] [@@local never] [@@specialise never] + ;; + + let int_incl = + let rec in_range state lo hi = + let int = full_range_int state in + if int >= lo && int <= hi then int else in_range state lo hi + in + fun state lo hi -> + if lo > hi then raise_crossed_bounds "int" lo hi Int.to_string; + let diff = hi - lo in + if diff = Int.max_value + then lo + (full_range_int state land Int.max_value) + else if diff >= 0 + then lo + int state (Int.succ diff) + else in_range state lo hi + ;; + + let int32_incl = + let open Int32_replace_polymorphic_compare in + let rec in_range state lo hi = + let int = full_range_int32 state in + if int >= lo && int <= hi then int else in_range state lo hi + in + let open Stdlib.Int32 in + fun state lo hi -> + if lo > hi then raise_crossed_bounds "int32" lo hi to_string; + let diff = sub hi lo in + if diff = max_int + then add lo (logand (full_range_int32 state) max_int) + else if diff >= 0l + then add lo (int32 state (succ diff)) + else in_range state lo hi + ;; + + let nativeint_incl = + let open Nativeint_replace_polymorphic_compare in + let rec in_range state lo hi = + let int = full_range_nativeint state in + if int >= lo && int <= hi then int else in_range state lo hi + in + let open Stdlib.Nativeint in + fun state lo hi -> + if lo > hi then raise_crossed_bounds "nativeint" lo hi to_string; + let diff = sub hi lo in + if diff = max_int + then add lo (logand (full_range_nativeint state) max_int) + else if diff >= 0n + then add lo (nativeint state (succ diff)) + else in_range state lo hi + ;; + + let int64_incl = + let open Int64_replace_polymorphic_compare in + let rec in_range state lo hi = + let int = full_range_int64 state in + if int >= lo && int <= hi then int else in_range state lo hi + in + let open Stdlib.Int64 in + fun state lo hi -> + if lo > hi then raise_crossed_bounds "int64" lo hi to_string; + let diff = sub hi lo in + if diff = max_int + then add lo (logand (full_range_int64 state) max_int) + else if diff >= 0L + then add lo (int64 state (succ diff)) + else in_range state lo hi + ;; + + (* Return a uniformly random float in [0, 1). *) + let rec rawfloat state = + let open Float_replace_polymorphic_compare in + let scale = 0x1p-30 in + (* 2^-30 *) + let r1 = Stdlib.float_of_int (bits state) in + let r2 = Stdlib.float_of_int (bits state) in + let result = ((r1 *. scale) +. r2) *. scale in + (* With very small probability, result can round up to 1.0, so in that case, we just + try again. *) + if result < 1.0 then result else rawfloat state + ;; + + let float state hi = rawfloat state *. hi + + let float_range state lo hi = + let open Float_replace_polymorphic_compare in + if lo > hi then raise_crossed_bounds "float" lo hi Stdlib.string_of_float; + lo +. float state (hi -. lo) + ;; +end + +let default = State.default +let bits () = State.bits default +let bits64 () = State.bits64 default +let int x = State.int default x +let int32 x = State.int32 default x +let nativeint x = State.nativeint default x +let int64 x = State.int64 default x +let float x = State.float default x +let int_incl x y = State.int_incl default x y +let int32_incl x y = State.int32_incl default x y +let nativeint_incl x y = State.nativeint_incl default x y +let int64_incl x y = State.int64_incl default x y +let float_range x y = State.float_range default x y +let bool () = State.bool default +let char () = State.char default +let ascii () = State.ascii default +let full_init seed = State.full_init default seed +let init seed = full_init [| seed |] +let self_init ?allow_in_tests () = full_init (random_seed ?allow_in_tests ()) +let set_state s = State.assign default (Repr.get_state s) diff --git a/unikernel/duniverse/base/src/random.mli b/unikernel/duniverse/base/src/random.mli new file mode 100644 index 00000000..9f1f9431 --- /dev/null +++ b/unikernel/duniverse/base/src/random.mli @@ -0,0 +1,140 @@ +(** Pseudo-random number generation. + + This is a wrapper of the standard library's [Random] library, though it does not share + state with that library. +*) + +(*_ + (***********************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* Damien Doligez, projet Para, INRIA Rocquencourt *) + (* *) + (* Copyright 1996 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed *) + (* under the terms of the Apache 2.0 license. See ../THIRD-PARTY.txt *) + (* for details. *) + (* *) + (***********************************************************************) *) + +open! Import + +(** {6 Basic functions} *) + +(** Note that all of these "basic" functions mutate a global random state. *) + +(** Initialize the generator, using the argument as a seed. The same seed will always + yield the same sequence of numbers. *) +val init : int -> unit + +(** Same as {!Random.init} but takes more data as seed. *) +val full_init : int array -> unit + +(** Initialize the generator with a more-or-less random seed chosen in a system-dependent + way. By default, [self_init] is disallowed in inline tests, as it's often used for no + good reason and it just creates nondeterministic failures for everyone. Passing + [~allow_in_tests:true] removes this restriction in case you legitimately want + nondeterministic values, like in [Filename.temp_dir]. *) +val self_init : ?allow_in_tests:bool -> unit -> unit + +(** Return 30 random bits in a nonnegative integer. @before 3.12.0 used a different + algorithm (affects all the following functions) *) +val bits : unit -> int + +(** [Random.bits64 ()] returns 64 random bits as an integer between + {!Int64.min_int} and {!Int64.max_int}. + @since 4.14 *) +val bits64 : unit -> int64 + +(** [Random.int bound] returns a random integer between 0 (inclusive) and [bound] + (exclusive). [bound] must be greater than 0. *) +val int : int -> int + +(** [Random.int32 bound] returns a random integer between 0 (inclusive) and [bound] + (exclusive). [bound] must be greater than 0. *) +val int32 : int32 -> int32 + +(** [Random.nativeint bound] returns a random integer between 0 (inclusive) and [bound] + (exclusive). [bound] must be greater than 0. *) +val nativeint : nativeint -> nativeint + +(** [Random.int64 bound] returns a random integer between 0 (inclusive) and [bound] + (exclusive). [bound] must be greater than 0. *) +val int64 : int64 -> int64 + +(** [Random.float bound] returns a random floating-point number between 0 (inclusive) and + [bound] (exclusive). If [bound] is negative, the result is negative or zero. If + [bound] is 0, the result is 0. *) +val float : float -> float + +(** Produces a random value between the given inclusive bounds. Raises if bounds are + given in decreasing order. *) +val int_incl : int -> int -> int + +val int32_incl : int32 -> int32 -> int32 +val nativeint_incl : nativeint -> nativeint -> nativeint +val int64_incl : int64 -> int64 -> int64 + +(** Produces a value between the given bounds (inclusive and exclusive, respectively). + Raises if bounds are given in decreasing order. *) +val float_range : float -> float -> float + +(** [Random.bool ()] returns [true] or [false] with probability 0.5 each. *) +val bool : unit -> bool + +(** Return a uniformly-chosen {!char}. *) +val char : unit -> char + +(** Return a uniformly-chosen {!char} in the ASCII range. *) +val ascii : unit -> char + +(** {6 Advanced functions} *) + +(** The functions from module [State] manipulate the current state of the random generator + explicitly. This allows using one or several deterministic PRNGs, even in a + multi-threaded program, without interference from other parts of the program. + + Note that [Random.get_state] from the standard library is not exposed, because it + misleadingly makes a copy of random state, which is not typically the desired outcome + for accessing the shared state. + + Obtaining multiple generators with good independence properties is nontrivial; see + the [Splittable_random] library for that. *) +module State : sig + type t + + (** This gives access to the default random state, allowing user code to share (and + thereby mutate) the random state used by the main functions in [Random]. *) + val default : t + + (** Creates a new state and initializes it with the given seed. *) + val make : int array -> t + + (** Creates a new state and initializes it with a system-dependent low-entropy seed. *) + val make_self_init : ?allow_in_tests:bool -> unit -> t + + val copy : t -> t + + (** These functions are the same as the basic functions, except that they use (and + update) the given PRNG state instead of the default one. *) + + val bits : t -> int + val bits64 : t -> int64 + val int : t -> int -> int + val int32 : t -> int32 -> int32 + val nativeint : t -> nativeint -> nativeint + val int64 : t -> int64 -> int64 + val float : t -> float -> float + val int_incl : t -> int -> int -> int + val int32_incl : t -> int32 -> int32 -> int32 + val nativeint_incl : t -> nativeint -> nativeint -> nativeint + val int64_incl : t -> int64 -> int64 -> int64 + val float_range : t -> float -> float -> float + val bool : t -> bool + val char : t -> char + val ascii : t -> char +end + +(** Sets the state of the generator used by the basic functions. *) +val set_state : State.t -> unit diff --git a/unikernel/duniverse/base/src/ref.ml b/unikernel/duniverse/base/src/ref.ml new file mode 100644 index 00000000..6c83ccfc --- /dev/null +++ b/unikernel/duniverse/base/src/ref.ml @@ -0,0 +1,83 @@ +open! Import + +include ( + struct + type 'a t = 'a ref + [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + + let compare__local : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_ref__local + let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_ref + let equal__local : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = equal_ref__local + let equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = equal_ref + + let globalize : 'a. ('a -> 'a) -> 'a t -> 'a t = + fun (type a__017_) : ((a__017_ -> a__017_) -> a__017_ t -> a__017_ t) -> + globalize_ref + ;; + + let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = ref_of_sexp + let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = sexp_of_ref + + let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> ref_sexp_grammar _'a_sexp_grammar + ;; + + [@@@end] + end : + sig + type 'a t = 'a ref + [@@deriving_inline + compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t + include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t + + val globalize : ('a -> 'a) -> 'a t -> 'a t + + include Sexplib0.Sexpable.S1 with type 'a t := 'a t + + val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + + [@@@end] + end) + +(* In the definition of [t], we do not have [[@@deriving compare, sexp]] because + in general, syntax extensions tend to use the implementation when available rather than + using the alias. Here that would lead to use the record representation [ { mutable + contents : 'a } ] which would result in different (and unwanted) behavior. *) +type 'a t = 'a ref = { mutable contents : 'a } + +external create : 'a -> ('a t[@local_opt]) = "%makemutable" +external ( ! ) : ('a t[@local_opt]) -> 'a = "%field0" +external ( := ) : ('a t[@local_opt]) -> 'a -> unit = "%setfield0" + +let swap t1 t2 = + let tmp = !t1 in + t1 := !t2; + t2 := tmp +;; + +let replace t f = t := f !t + +let set_temporarily t a ~f = + let restore_to = !t in + t := a; + Exn.protect ~f ~finally:(fun () -> t := restore_to) +;; + +module And_value = struct + type t = T : 'a ref * 'a -> t [@@deriving sexp_of] + + let set (T (r, a)) = r := a + let sets ts = List.iter ts ~f:set + let snapshot (T (r, _)) = T (r, !r) + let snapshots ts = List.map ts ~f:snapshot +end + +let sets_temporarily and_values ~f = + let restore_to = And_value.snapshots and_values in + And_value.sets and_values; + Exn.protect ~f ~finally:(fun () -> And_value.sets restore_to) +;; diff --git a/unikernel/duniverse/base/src/ref.mli b/unikernel/duniverse/base/src/ref.mli new file mode 100644 index 00000000..e4843817 --- /dev/null +++ b/unikernel/duniverse/base/src/ref.mli @@ -0,0 +1,54 @@ +(** Module for the type [ref], mutable indirection cells [r] containing a value of type + ['a], accessed with [!r] and set by [r := a]. *) + +open! Import + +type 'a t = 'a Stdlib.ref = { mutable contents : 'a } +[@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t + +val globalize : ('a -> 'a) -> 'a t -> 'a t + +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +[@@@end] + +(*_ defined as externals to avoid breaking the inliner *) + +external create : 'a -> ('a t[@local_opt]) = "%makemutable" +external ( ! ) : ('a t[@local_opt]) -> 'a = "%field0" +external ( := ) : ('a t[@local_opt]) -> 'a -> unit = "%setfield0" + +(** [swap t1 t2] swaps the values in [t1] and [t2]. *) +val swap : 'a t -> 'a t -> unit + +(** [replace t f] is [t := f !t] *) +val replace : 'a t -> ('a -> 'a) -> unit + +(** [set_temporarily t a ~f] sets [t] to [a], calls [f ()], and then restores [t] to its + value prior to [set_temporarily] being called, whether [f] returns or raises. *) +val set_temporarily : 'a t -> 'a -> f:(unit -> 'b) -> 'b + +module And_value : sig + type t = T : 'a ref * 'a -> t [@@deriving sexp_of] + + (** [set (T (r, x))] is equivalent to [r := x]. *) + val set : t -> unit + + (** [sets ts = List.iter ts ~f:set] *) + val sets : t list -> unit + + (** [snapshot (T (r, _))] returns [T (r, !r)]. *) + val snapshot : t -> t +end + +(** [sets_temporarily [ ...; T (ti, ai); ... ] ~f] sets each [ti] to [ai], calls [f ()], + and then restores all [ti] to their value prior to [sets_temporarily] being called, + whether [f] returns or raises. *) +val sets_temporarily : And_value.t list -> f:(unit -> 'a) -> 'a diff --git a/unikernel/duniverse/base/src/result.ml b/unikernel/duniverse/base/src/result.ml new file mode 100644 index 00000000..d095d774 --- /dev/null +++ b/unikernel/duniverse/base/src/result.ml @@ -0,0 +1,310 @@ +open! Import +module Either = Either0 + +type ('a, 'b) t = ('a, 'b) Stdlib.result = + | Ok of 'a + | Error of 'b +[@@deriving_inline sexp, sexp_grammar, compare ~localize, equal ~localize, hash] + +let t_of_sexp : + 'a 'b. + (Sexplib0.Sexp.t -> 'a) -> (Sexplib0.Sexp.t -> 'b) -> Sexplib0.Sexp.t -> ('a, 'b) t + = + fun (type a__017_ b__018_) + : ((Sexplib0.Sexp.t -> a__017_) -> (Sexplib0.Sexp.t -> b__018_) -> Sexplib0.Sexp.t + -> (a__017_, b__018_) t) -> + let error_source__005_ = "result.ml.t" in + fun _of_a__001_ _of_b__002_ -> function + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("ok" | "Ok") as _tag__008_) :: sexp_args__009_) as + _sexp__007_ -> + (match sexp_args__009_ with + | [ arg0__010_ ] -> + let res0__011_ = _of_a__001_ arg0__010_ in + Ok res0__011_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__005_ + _tag__008_ + _sexp__007_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("error" | "Error") as _tag__013_) :: sexp_args__014_) as + _sexp__012_ -> + (match sexp_args__014_ with + | [ arg0__015_ ] -> + let res0__016_ = _of_b__002_ arg0__015_ in + Error res0__016_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__005_ + _tag__013_ + _sexp__012_) + | Sexplib0.Sexp.Atom ("ok" | "Ok") as sexp__006_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__005_ sexp__006_ + | Sexplib0.Sexp.Atom ("error" | "Error") as sexp__006_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__005_ sexp__006_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__005_ sexp__004_ + | Sexplib0.Sexp.List [] as sexp__004_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__005_ sexp__004_ + | sexp__004_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__005_ sexp__004_ +;; + +let sexp_of_t : + 'a 'b. + ('a -> Sexplib0.Sexp.t) -> ('b -> Sexplib0.Sexp.t) -> ('a, 'b) t -> Sexplib0.Sexp.t + = + fun (type a__025_ b__026_) + : ((a__025_ -> Sexplib0.Sexp.t) -> (b__026_ -> Sexplib0.Sexp.t) + -> (a__025_, b__026_) t -> Sexplib0.Sexp.t) -> + fun _of_a__019_ _of_b__020_ -> function + | Ok arg0__021_ -> + let res0__022_ = _of_a__019_ arg0__021_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; res0__022_ ] + | Error arg0__023_ -> + let res0__024_ = _of_b__020_ arg0__023_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Error"; res0__024_ ] +;; + +let t_sexp_grammar : + 'a 'b. + 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t + = + fun _'a_sexp_grammar _'b_sexp_grammar -> + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag + { name = "Ok" + ; clause_kind = + List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) } + } + ; No_tag + { name = "Error" + ; clause_kind = + List_clause { args = Cons (_'b_sexp_grammar.untyped, Empty) } + } + ] + } + } +;; + +let compare__local : + 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + = + fun _cmp__a _cmp__b a__033_ b__034_ -> + if Stdlib.( == ) a__033_ b__034_ + then 0 + else ( + match a__033_, b__034_ with + | Ok _a__035_, Ok _b__036_ -> _cmp__a _a__035_ _b__036_ + | Ok _, _ -> -1 + | _, Ok _ -> 1 + | Error _a__037_, Error _b__038_ -> _cmp__b _a__037_ _b__038_) +;; + +let compare : + 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + = + fun _cmp__a _cmp__b a__027_ b__028_ -> + if Stdlib.( == ) a__027_ b__028_ + then 0 + else ( + match a__027_, b__028_ with + | Ok _a__029_, Ok _b__030_ -> _cmp__a _a__029_ _b__030_ + | Ok _, _ -> -1 + | _, Ok _ -> 1 + | Error _a__031_, Error _b__032_ -> _cmp__b _a__031_ _b__032_) +;; + +let equal__local : + 'a 'b. ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + = + fun _cmp__a _cmp__b a__045_ b__046_ -> + if Stdlib.( == ) a__045_ b__046_ + then true + else ( + match a__045_, b__046_ with + | Ok _a__047_, Ok _b__048_ -> _cmp__a _a__047_ _b__048_ + | Ok _, _ -> false + | _, Ok _ -> false + | Error _a__049_, Error _b__050_ -> _cmp__b _a__049_ _b__050_) +;; + +let equal : + 'a 'b. ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + = + fun _cmp__a _cmp__b a__039_ b__040_ -> + if Stdlib.( == ) a__039_ b__040_ + then true + else ( + match a__039_, b__040_ with + | Ok _a__041_, Ok _b__042_ -> _cmp__a _a__041_ _b__042_ + | Ok _, _ -> false + | _, Ok _ -> false + | Error _a__043_, Error _b__044_ -> _cmp__b _a__043_ _b__044_) +;; + +let hash_fold_t + : type a b. + (Ppx_hash_lib.Std.Hash.state -> a -> Ppx_hash_lib.Std.Hash.state) + -> (Ppx_hash_lib.Std.Hash.state -> b -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> (a, b) t + -> Ppx_hash_lib.Std.Hash.state + = + fun _hash_fold_a _hash_fold_b hsv arg -> + match arg with + | Ok _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 0 in + let hsv = hsv in + _hash_fold_a hsv _a0 + | Error _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 1 in + let hsv = hsv in + _hash_fold_b hsv _a0 +;; + +[@@@end] + +let globalize = globalize_result + +include Monad.Make2_local (struct + type nonrec ('a, 'b) t = ('a, 'b) t + + let bind x ~f = + match x with + | Error _ as x -> x + | Ok x -> f x + ;; + + let map x ~f = + match x with + | Error _ as x -> x + | Ok x -> Ok (f x) + ;; + + let map = `Custom map + let return x = Ok x +end) + +let invariant check_ok check_error t = + match t with + | Ok ok -> check_ok ok + | Error error -> check_error error +;; + +let fail x = Error x +let failf format = Printf.ksprintf fail format + +let map_error t ~f = + match t with + | Ok _ as x -> x + | Error x -> Error (f x) +;; + +module Error = Monad.Make2_local (struct + type nonrec ('a, 'b) t = ('b, 'a) t + + let bind x ~f = + match x with + | Ok _ as ok -> ok + | Error e -> f e + ;; + + let map = `Custom map_error + let return e = Error e +end) + +let is_ok = function + | Ok _ -> true + | Error _ -> false +;; + +let is_error = function + | Ok _ -> false + | Error _ -> true +;; + +let ok = function + | Ok x -> Some x + | Error _ -> None +;; + +let error = function + | Ok _ -> None + | Error x -> Some x +;; + +let of_option opt ~error = + match opt with + | Some x -> Ok x + | None -> Error error +;; + +let iter v ~f = + match v with + | Ok x -> f x + | Error _ -> () +;; + +let iter_error v ~f = + match v with + | Ok _ -> () + | Error x -> f x +;; + +let to_either : _ t -> _ Either.t = function + | Ok x -> First x + | Error x -> Second x +;; + +let of_either : _ Either.t -> _ t = function + | First x -> Ok x + | Second x -> Error x +;; + +let ok_if_true bool ~error = if bool then Ok () else Error error + +let try_with f = + try Ok (f ()) with + | exn -> Error exn +;; + +let ok_exn = function + | Ok x -> x + | Error exn -> raise exn +;; + +let ok_or_failwith = function + | Ok x -> x + | Error str -> failwith str +;; + +module Export = struct + type ('ok, 'err) _result = ('ok, 'err) t = + | Ok of 'ok + | Error of 'err + + let is_error = is_error + let is_ok = is_ok +end + +let combine t1 t2 ~ok ~err = + match t1, t2 with + | Ok _, Error e | Error e, Ok _ -> Error e + | Ok ok1, Ok ok2 -> Ok (ok ok1 ok2) + | Error err1, Error err2 -> Error (err err1 err2) +;; + +let combine_errors l = + let ok, errs = List1.partition_map l ~f:to_either in + match errs with + | [] -> Ok ok + | _ :: _ -> Error errs +;; + +let combine_errors_unit l = map (combine_errors l) ~f:(fun (_ : unit list) -> ()) diff --git a/unikernel/duniverse/base/src/result.mli b/unikernel/duniverse/base/src/result.mli new file mode 100644 index 00000000..618aa33e --- /dev/null +++ b/unikernel/duniverse/base/src/result.mli @@ -0,0 +1,103 @@ +(** [Result] is often used to handle error messages. *) + +open! Import + +(** ['ok] is the return type, and ['err] is often an error message string. + + {[ + type nat = Zero | Succ of nat + + let pred = function + | Succ n -> Ok n + | Zero -> Error "Zero does not have a predecessor" + ]} + + The return type of [pred] could be [nat option], but [(nat, string) + Result.t] gives more control over the error message. *) +type ('ok, 'err) t = ('ok, 'err) Stdlib.result = + | Ok of 'ok + | Error of 'err +[@@deriving_inline + sexp, sexp_grammar, compare ~localize, equal ~localize, hash, globalize] + +include Sexplib0.Sexpable.S2 with type ('ok, 'err) t := ('ok, 'err) t + +val t_sexp_grammar + : 'ok Sexplib0.Sexp_grammar.t + -> 'err Sexplib0.Sexp_grammar.t + -> ('ok, 'err) t Sexplib0.Sexp_grammar.t + +include Ppx_compare_lib.Comparable.S2 with type ('ok, 'err) t := ('ok, 'err) t +include Ppx_compare_lib.Comparable.S_local2 with type ('ok, 'err) t := ('ok, 'err) t +include Ppx_compare_lib.Equal.S2 with type ('ok, 'err) t := ('ok, 'err) t +include Ppx_compare_lib.Equal.S_local2 with type ('ok, 'err) t := ('ok, 'err) t +include Ppx_hash_lib.Hashable.S2 with type ('ok, 'err) t := ('ok, 'err) t + +val globalize : ('ok -> 'ok) -> ('err -> 'err) -> ('ok, 'err) t -> ('ok, 'err) t + +[@@@end] + +include Monad.S2_local with type ('a, 'err) t := ('a, 'err) t +module Error : Monad.S2_local with type ('err, 'a) t := ('a, 'err) t +include Invariant_intf.S2 with type ('ok, 'err) t := ('ok, 'err) t + +val fail : 'err -> (_, 'err) t + +(** e.g., [failf "Couldn't find bloogle %s" (Bloogle.to_string b)]. *) +val failf : ('a, unit, string, (_, string) t) format4 -> 'a + +val is_ok : (_, _) t -> bool +val is_error : (_, _) t -> bool +val ok : ('ok, _) t -> 'ok option +val ok_exn : ('ok, exn) t -> 'ok +val ok_or_failwith : ('ok, string) t -> 'ok +val error : (_, 'err) t -> 'err option +val of_option : 'ok option -> error:'err -> ('ok, 'err) t +val iter : ('ok, _) t -> f:('ok -> unit) -> unit +val iter_error : (_, 'err) t -> f:('err -> unit) -> unit +val map : ('ok, 'err) t -> f:('ok -> 'c) -> ('c, 'err) t +val map_error : ('ok, 'err) t -> f:('err -> 'c) -> ('ok, 'c) t + +(** Returns [Ok] if both are [Ok] and [Error] otherwise. *) +val combine + : ('ok1, 'err) t + -> ('ok2, 'err) t + -> ok:('ok1 -> 'ok2 -> 'ok3) + -> err:('err -> 'err -> 'err) + -> ('ok3, 'err) t + +(** [combine_errors ts] returns [Ok] if every element in [ts] is [Ok], else it returns + [Error] with all the errors in [ts]. + + This is similar to [all] from [Monad.S2], with the difference that [all] only returns + the first error. *) +val combine_errors : ('ok, 'err) t list -> ('ok list, 'err list) t + +(** [combine_errors_unit] returns [Ok] if every element in [ts] is [Ok ()], else it + returns [Error] with all the errors in [ts], like [combine_errors]. *) +val combine_errors_unit : (unit, 'err) t list -> (unit, 'err list) t + +(** [to_either] is useful with [List.partition_map]. For example: + + {[ + let ints, exns = + List.partition_map ["1"; "two"; "three"; "4"] ~f:(fun string -> + Result.to_either (Result.try_with (fun () -> Int.of_string string))) + ]} *) +val to_either : ('ok, 'err) t -> ('ok, 'err) Either0.t + +val of_either : ('ok, 'err) Either0.t -> ('ok, 'err) t + +(** [ok_if_true] returns [Ok ()] if [bool] is true, and [Error error] if it is false. *) +val ok_if_true : bool -> error:'err -> (unit, 'err) t + +val try_with : (unit -> 'a) -> ('a, exn) t + +module Export : sig + type ('ok, 'err) _result = ('ok, 'err) t = + | Ok of 'ok + | Error of 'err + + val is_ok : (_, _) t -> bool + val is_error : (_, _) t -> bool +end diff --git a/unikernel/duniverse/base/src/runtime.js b/unikernel/duniverse/base/src/runtime.js new file mode 100644 index 00000000..01341b4f --- /dev/null +++ b/unikernel/duniverse/base/src/runtime.js @@ -0,0 +1,171 @@ +//Provides: Base_int_math_int_popcount const +function Base_int_math_int_popcount(v) { + v = v - ((v >>> 1) & 0x55555555); + v = (v & 0x33333333) + ((v >>> 2) & 0x33333333); + return ((v + (v >>> 4) & 0xF0F0F0F) * 0x1010101) >>> 24; +} + +//Provides: Base_clear_caml_backtrace_pos const +function Base_clear_caml_backtrace_pos(x) { + return 0; +} + +//Provides: Base_caml_exn_is_most_recent_exn const +function Base_caml_exn_is_most_recent_exn(x) { + return 1; +} + +//Provides: Base_int_math_int32_clz const +function Base_int_math_int32_clz(x) { + var n = 32; + var y; + y = x >> 16; if (y != 0) { n = n - 16; x = y; } + y = x >> 8; if (y != 0) { n = n - 8; x = y; } + y = x >> 4; if (y != 0) { n = n - 4; x = y; } + y = x >> 2; if (y != 0) { n = n - 2; x = y; } + y = x >> 1; if (y != 0) return n - 2; + return n - x; +} + +//Provides: Base_int_math_int_clz const +//Requires: Base_int_math_int32_clz +function Base_int_math_int_clz(x) { return Base_int_math_int32_clz(x); } + +//Provides: Base_int_math_nativeint_clz const +//Requires: Base_int_math_int32_clz +function Base_int_math_nativeint_clz(x) { return Base_int_math_int32_clz(x); } + +//Provides: Base_int_math_int64_clz const +//Requires: caml_int64_shift_right_unsigned, caml_int64_is_zero, caml_int64_to_int32 +function Base_int_math_int64_clz(x) { + var n = 64; + var y; + y = caml_int64_shift_right_unsigned(x, 32); + if (!caml_int64_is_zero(y)) { n = n - 32; x = y; } + y = caml_int64_shift_right_unsigned(x, 16); + if (!caml_int64_is_zero(y)) { n = n - 16; x = y; } + y = caml_int64_shift_right_unsigned(x, 8); + if (!caml_int64_is_zero(y)) { n = n - 8; x = y; } + y = caml_int64_shift_right_unsigned(x, 4); + if (!caml_int64_is_zero(y)) { n = n - 4; x = y; } + y = caml_int64_shift_right_unsigned(x, 2); + if (!caml_int64_is_zero(y)) { n = n - 2; x = y; } + y = caml_int64_shift_right_unsigned(x, 1); + if (!caml_int64_is_zero(y)) return n - 2; + return n - caml_int64_to_int32(x); +} + +//Provides: Base_int_math_int32_ctz const +function Base_int_math_int32_ctz(x) { + if (x === 0) { return 32; } + var n = 1; + if ((x & 0x0000FFFF) === 0) { n = n + 16; x = x >> 16; } + if ((x & 0x000000FF) === 0) { n = n + 8; x = x >> 8; } + if ((x & 0x0000000F) === 0) { n = n + 4; x = x >> 4; } + if ((x & 0x00000003) === 0) { n = n + 2; x = x >> 2; } + return n - (x & 1); +} + +//Provides: Base_int_math_int_ctz const +//Requires: Base_int_math_int32_ctz +function Base_int_math_int_ctz(x) { return Base_int_math_int32_ctz(x); } + +//Provides: Base_int_math_nativeint_ctz const +//Requires: Base_int_math_int32_ctz +function Base_int_math_nativeint_ctz(x) { return Base_int_math_int32_ctz(x); } + +//Provides: Base_int_math_int64_ctz const +//Requires: caml_int64_shift_right_unsigned, caml_int64_is_zero, caml_int64_to_int32 +//Requires: caml_int64_and, caml_int64_of_int32, caml_int64_create_lo_mi_hi +function Base_int_math_int64_ctz(x) { + if (caml_int64_is_zero(x)) { return 64; } + var n = 1; + function is_zero(x) { return caml_int64_is_zero(x); } + function land(x, y) { return caml_int64_and(x, y); } + function small_int64(x) { return caml_int64_create_lo_mi_hi(x, 0, 0); } + if (is_zero(land(x, caml_int64_create_lo_mi_hi(0xFFFFFF, 0x0000FF, 0x0000)))) { + n = n + 32; x = caml_int64_shift_right_unsigned(x, 32); + } + if (is_zero(land(x, small_int64(0x00FFFF)))) { + n = n + 16; x = caml_int64_shift_right_unsigned(x, 16); + } + if (is_zero(land(x, small_int64(0x0000FF)))) { + n = n + 8; x = caml_int64_shift_right_unsigned(x, 8); + } + if (is_zero(land(x, small_int64(0x00000F)))) { + n = n + 4; x = caml_int64_shift_right_unsigned(x, 4); + } + if (is_zero(land(x, small_int64(0x000003)))) { + n = n + 2; x = caml_int64_shift_right_unsigned(x, 2); + } + return n - (caml_int64_to_int32(caml_int64_and(x, small_int64(0x000001)))); +} + +//Provides: Base_int_math_int_pow_stub const +function Base_int_math_int_pow_stub(base, exponent) { + var one = 1; + var mul = [one, base, one, one]; + var res = one; + while (!exponent == 0) { + mul[1] = (mul[1] * mul[3]) | 0; + mul[2] = (mul[1] * mul[1]) | 0; + mul[3] = (mul[2] * mul[1]) | 0; + res = (res * mul[exponent & 3]) | 0; + exponent = exponent >> 2; + } + return res; +} + +//Provides: Base_int_math_int64_pow_stub const +//Requires: caml_int64_mul, caml_int64_is_zero, caml_int64_shift_right_unsigned +//Requires: caml_int64_create_lo_hi, caml_int64_lo32 +function Base_int_math_int64_pow_stub(base, exponent) { + var one = caml_int64_create_lo_hi(1, 0); + var mul = [one, base, one, one]; + var res = one; + while (!caml_int64_is_zero(exponent)) { + mul[1] = caml_int64_mul(mul[1], mul[3]); + mul[2] = caml_int64_mul(mul[1], mul[1]); + mul[3] = caml_int64_mul(mul[2], mul[1]); + res = caml_int64_mul(res, mul[caml_int64_lo32(exponent) & 3]); + exponent = caml_int64_shift_right_unsigned(exponent, 2); + } + return res; +} + +//Provides: Base_hash_string mutable +//Requires: caml_hash +function Base_hash_string(s) { + return caml_hash(1, 1, 0, s) +} +//Provides: Base_hash_double const +//Requires: caml_hash +function Base_hash_double(d) { + return caml_hash(1, 1, 0, d); +} + +//Provides: Base_am_testing const +//Weakdef +function Base_am_testing(x) { + return 0; +} + +//Provides: Base_unsafe_create_local_bytes +//Requires: caml_create_bytes +function Base_unsafe_create_local_bytes(v_len) { + // This does a redundant bounds check and (since this is + // javascript) doesn't allocate locally, but that's fine. + return caml_create_bytes(v_len); +} + +//Provides: caml_make_local_vect +//Requires: caml_make_vect +function caml_make_local_vect(v_len, v_elt) { + // In javascript there's no local allocation. + return caml_make_vect(v_len, v_elt); +} + +//Provides: caml_dummy_obj_is_stack +function caml_dummy_obj_is_stack(x) { + throw new Error(`BUG: this function should be unreachable; please report to compiler or base devs.`); +} diff --git a/unikernel/duniverse/base/src/select-random-repr/dune b/unikernel/duniverse/base/src/select-random-repr/dune new file mode 100644 index 00000000..e69de29b diff --git a/unikernel/duniverse/base/src/select-random-repr/select.ml b/unikernel/duniverse/base/src/select-random-repr/select.ml new file mode 100644 index 00000000..62ce822f --- /dev/null +++ b/unikernel/duniverse/base/src/select-random-repr/select.ml @@ -0,0 +1,74 @@ +let () = + let ver, output = + match Sys.argv with + | [| _; "-ocaml-version"; v; "-o"; fn |] -> + Scanf.sscanf v "%d.%d" (fun major minor -> major, minor), fn + | _ -> failwith "bad command line arguments" + in + let oc = open_out output in + if ver >= (5, 0) + then + Printf.fprintf + oc + {| +type t = Stdlib.Random.State.t Stdlib.Domain.DLS.key + +module Repr = struct + open Stdlib.Bigarray + + type t = (int64, int64_elt, c_layout) Array1.t + + let of_state : Stdlib.Random.State.t -> t = Stdlib.Obj.magic +end + +let assign t state = + let dst = Repr.of_state (Stdlib.Domain.DLS.get t) in + let src = Repr.of_state state in + Stdlib.Bigarray.Array1.blit src dst +;; + +let make state = + let split_from_parent v = Stdlib.Random.State.split v in + let t = Stdlib.Domain.DLS.new_key ~split_from_parent (fun () -> state) in + Stdlib.Domain.DLS.get t |> ignore; + t +;; + +let make_lazy ~f = + let split_from_parent v = Stdlib.Random.State.split v in + Stdlib.Domain.DLS.new_key ~split_from_parent f +;; + +let[@inline always] get_state t = Stdlib.Domain.DLS.get t +|} + else + Printf.fprintf + oc + {| +module Array = Array0 + +type t = Stdlib.Random.State.t Lazy.t + +module Repr = struct + type t = + { st : int array + ; mutable idx : int + } + + let of_state : Stdlib.Random.State.t -> t = Stdlib.Obj.magic +end + +let assign t state = + let t1 = Repr.of_state (Lazy.force t) in + let t2 = Repr.of_state state in + Array.blit ~src:t2.st ~src_pos:0 ~dst:t1.st ~dst_pos:0 ~len:(Array.length t1.st); + t1.idx <- t2.idx + +let make state = Lazy.from_val state + +let make_lazy ~f = Lazy.from_fun f + +let[@inline always] get_state t = Lazy.force t +|}; + close_out oc +;; diff --git a/unikernel/duniverse/base/src/select-random-repr/select.mli b/unikernel/duniverse/base/src/select-random-repr/select.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/src/select-random-repr/select.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/src/sequence.ml b/unikernel/duniverse/base/src/sequence.ml new file mode 100644 index 00000000..ecbba2a3 --- /dev/null +++ b/unikernel/duniverse/base/src/sequence.ml @@ -0,0 +1,1437 @@ +open! Import +open Container_intf.Export +module Array = Array0 +module List = List1 + +module Step = struct + (* 'a is an item in the sequence, 's is the state that will produce the remainder of + the sequence *) + type ('a, 's) t = + | Done + | Skip of { state : 's } + | Yield of + { value : 'a + ; state : 's + } + [@@deriving_inline sexp_of] + + let sexp_of_t : + 'a 's. + ('a -> Sexplib0.Sexp.t) + -> ('s -> Sexplib0.Sexp.t) + -> ('a, 's) t + -> Sexplib0.Sexp.t + = + fun (type a__011_ s__012_) + : ((a__011_ -> Sexplib0.Sexp.t) -> (s__012_ -> Sexplib0.Sexp.t) + -> (a__011_, s__012_) t -> Sexplib0.Sexp.t) -> + fun _of_a__001_ _of_s__002_ -> function + | Done -> Sexplib0.Sexp.Atom "Done" + | Skip { state = state__004_ } -> + let bnds__003_ = ([] : _ Stdlib.List.t) in + let bnds__003_ = + let arg__005_ = _of_s__002_ state__004_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "state"; arg__005_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List (Sexplib0.Sexp.Atom "Skip" :: bnds__003_) + | Yield { value = value__007_; state = state__009_ } -> + let bnds__006_ = ([] : _ Stdlib.List.t) in + let bnds__006_ = + let arg__010_ = _of_s__002_ state__009_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "state"; arg__010_ ] :: bnds__006_ + : _ Stdlib.List.t) + in + let bnds__006_ = + let arg__008_ = _of_a__001_ value__007_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "value"; arg__008_ ] :: bnds__006_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List (Sexplib0.Sexp.Atom "Yield" :: bnds__006_) + ;; + + [@@@end] +end + +open Step + +module T = struct + (* 'a is an item in the sequence, 's is the state that will produce the remainder of the + sequence *) + type +_ t = + | Sequence : + { state : 's + ; next : 's -> ('a, 's) Step.t + } + -> 'a t +end + +include T + +let globalize _ (Sequence { state; next }) = Sequence { state; next } + +module Expert = struct + module View = T + + let view t = t + + let next_step (Sequence { state = s; next = f }) = + match f s with + | Done -> Done + | Skip { state = s } -> Skip { state = Sequence { state = s; next = f } } + | Yield { value = a; state = s } -> + Yield { value = a; state = Sequence { state = s; next = f } } + ;; + + let delayed_fold_step s ~init ~f ~finish = + let rec loop s next finish f acc = + match next s with + | Done -> finish acc + | Skip { state = s } -> f acc None ~k:(loop s next finish f) + | Yield { value = a; state = s } -> f acc (Some a) ~k:(loop s next finish f) + in + match s with + | Sequence { state = s; next } -> loop s next finish f init + ;; +end + +let unfold_step ~init ~f = Sequence { state = init; next = f } + +let unfold ~init ~f = + unfold_step ~init ~f:(fun s -> + match f s with + | None -> Step.Done + | Some (a, s) -> Step.Yield { value = a; state = s }) +;; + +let unfold_with s ~init ~f = + match s with + | Sequence { state = s; next } -> + Sequence + { state = init, s + ; next = + (fun (seed, s) -> + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = seed, s } + | Yield { value = a; state = s } -> + (match f seed a with + | Done -> Done + | Skip { state = seed } -> Skip { state = seed, s } + | Yield { value = a; state = seed } -> Yield { value = a; state = seed, s })) + } +;; + +let unfold_with_and_finish s ~init ~running_step ~inner_finished ~finishing_step = + match s with + | Sequence { state = s; next } -> + Sequence + { state = `Inner_running (init, s) + ; next = + (fun state -> + match state with + | `Inner_running (state, inner_state) -> + (match next inner_state with + | Done -> Skip { state = `Inner_finished (inner_finished state) } + | Skip { state = inner_state } -> + Skip { state = `Inner_running (state, inner_state) } + | Yield { value = x; state = inner_state } -> + (match running_step state x with + | Done -> Done + | Skip { state } -> Skip { state = `Inner_running (state, inner_state) } + | Yield { value = y; state } -> + Yield { value = y; state = `Inner_running (state, inner_state) })) + | `Inner_finished state -> + (match finishing_step state with + | Done -> Done + | Skip { state } -> Skip { state = `Inner_finished state } + | Yield { value = y; state } -> + Yield { value = y; state = `Inner_finished state })) + } +;; + +let of_list l = + unfold_step ~init:l ~f:(function + | [] -> Done + | x :: l -> Yield { value = x; state = l }) +;; + +let fold t ~init ~f = + let rec loop seed v next f = + match next seed with + | Done -> v + | Skip { state = s } -> loop s v next f + | Yield { value = a; state = s } -> loop s (f v a) next f + in + match t with + | Sequence { state = seed; next } -> loop seed init next f +;; + +let to_list_rev t = fold t ~init:[] ~f:(fun l x -> x :: l) + +let to_list (Sequence { state = s; next }) = + let[@tail_mod_cons] rec to_list s next = + match next s with + | Done -> [] + | Skip { state = s } -> (to_list [@tailcall]) s next + | Yield { value = a; state = s } -> a :: (to_list [@tailcall]) s next + in + to_list s next +;; + +let sexp_of_t sexp_of_a t = sexp_of_list sexp_of_a (to_list t) + +let range ?(stride = 1) ?(start = `inclusive) ?(stop = `exclusive) start_v stop_v = + let step = + match stop with + | `inclusive when stride >= 0 -> + fun i -> if i > stop_v then Done else Yield { value = i; state = i + stride } + | `inclusive -> + fun i -> if i < stop_v then Done else Yield { value = i; state = i + stride } + | `exclusive when stride >= 0 -> + fun i -> if i >= stop_v then Done else Yield { value = i; state = i + stride } + | `exclusive -> + fun i -> if i <= stop_v then Done else Yield { value = i; state = i + stride } + in + let init = + match start with + | `inclusive -> start_v + | `exclusive -> start_v + stride + in + unfold_step ~init ~f:step +;; + +let of_lazy t_lazy = + unfold_step ~init:t_lazy ~f:(fun t_lazy -> + let (Sequence { state = s; next }) = Lazy.force t_lazy in + match next s with + | Done -> Done + | Skip { state = s } -> + Skip + { state = + (let v = Sequence { state = s; next } in + lazy v) + } + | Yield { value = x; state = s } -> + Yield + { value = x + ; state = + (let v = Sequence { state = s; next } in + lazy v) + }) +;; + +let map t ~f = + match t with + | Sequence { state = seed; next } -> + Sequence + { state = seed + ; next = + (fun seed -> + match next seed with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = a; state = s } -> Yield { value = f a; state = s }) + } +;; + +let mapi t ~f = + match t with + | Sequence { state = s; next } -> + Sequence + { state = 0, s + ; next = + (fun (i, s) -> + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } -> Yield { value = f i a; state = i + 1, s }) + } +;; + +let folding_map t ~init ~f = + unfold_with t ~init ~f:(fun acc x -> + let acc, x = f acc x in + Yield { value = x; state = acc }) +;; + +let folding_mapi t ~init ~f = + unfold_with t ~init:(0, init) ~f:(fun (i, acc) x -> + let acc, x = f i acc x in + Yield { value = x; state = i + 1, acc }) +;; + +let filter t ~f = + match t with + | Sequence { state = seed; next } -> + Sequence + { state = seed + ; next = + (fun seed -> + match next seed with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = a; state = s } when f a -> Yield { value = a; state = s } + | Yield { value = _; state = s } -> Skip { state = s }) + } +;; + +let filteri t ~f = + map ~f:snd (filter (mapi t ~f:(fun i s -> i, s)) ~f:(fun (i, s) -> f i s)) +;; + +let length t = + let rec loop i s next = + match next s with + | Done -> i + | Skip { state = s } -> loop i s next + | Yield { value = _; state = s } -> loop (i + 1) s next + in + match t with + | Sequence { state = seed; next } -> loop 0 seed next +;; + +let to_list_rev_with_length t = fold t ~init:([], 0) ~f:(fun (l, i) x -> x :: l, i + 1) + +let to_array t = + let l, len = to_list_rev_with_length t in + match l with + | [] -> [||] + | x :: l -> + let a = Array.create ~len x in + let rec loop i l = + match l with + | [] -> assert (i = -1) + | x :: l -> + a.(i) <- x; + loop (i - 1) l + in + loop (len - 2) l; + a +;; + +let find t ~f = + let rec loop s next f = + match next s with + | Done -> None + | Yield { value = a; state = _ } when f a -> Some a + | Yield { value = _; state = s } | Skip { state = s } -> loop s next f + in + match t with + | Sequence { state = seed; next } -> loop seed next f +;; + +let find_map t ~f = + let rec loop s next f = + match next s with + | Done -> None + | Yield { value = a; state = s } -> + (match f a with + | None -> loop s next f + | some_b -> some_b) + | Skip { state = s } -> loop s next f + in + match t with + | Sequence { state = seed; next } -> loop seed next f +;; + +let find_mapi t ~f = + let rec loop s next f i = + match next s with + | Done -> None + | Yield { value = a; state = s } -> + (match f i a with + | None -> loop s next f (i + 1) + | some_b -> some_b) + | Skip { state = s } -> loop s next f i + in + match t with + | Sequence { state = seed; next } -> loop seed next f 0 +;; + +let for_all t ~f = + let rec loop s next f = + match next s with + | Done -> true + | Yield { value = a; state = _ } when not (f a) -> false + | Yield { value = _; state = s } | Skip { state = s } -> loop s next f + in + match t with + | Sequence { state = seed; next } -> loop seed next f +;; + +let for_alli t ~f = + let rec loop s next f i = + match next s with + | Done -> true + | Yield { value = a; state = _ } when not (f i a) -> false + | Yield { value = _; state = s } -> loop s next f (i + 1) + | Skip { state = s } -> loop s next f i + in + match t with + | Sequence { state = seed; next } -> loop seed next f 0 +;; + +let exists t ~f = + let rec loop s next f = + match next s with + | Done -> false + | Yield { value = a; state = _ } when f a -> true + | Yield { value = _; state = s } | Skip { state = s } -> loop s next f + in + match t with + | Sequence { state = seed; next } -> loop seed next f +;; + +let existsi t ~f = + let rec loop s next f i = + match next s with + | Done -> false + | Yield { value = a; state = _ } when f i a -> true + | Yield { value = _; state = s } -> loop s next f (i + 1) + | Skip { state = s } -> loop s next f i + in + match t with + | Sequence { state = seed; next } -> loop seed next f 0 +;; + +let iter t ~f = + let rec loop seed next f = + match next seed with + | Done -> () + | Skip { state = s } -> loop s next f + | Yield { value = a; state = s } -> + f a; + loop s next f + in + match t with + | Sequence { state = seed; next } -> loop seed next f +;; + +let is_empty t = + let rec loop s next = + match next s with + | Done -> true + | Skip { state = s } -> loop s next + | Yield _ -> false + in + match t with + | Sequence { state = seed; next } -> loop seed next +;; + +let mem t a ~equal = + let rec loop s next a = + match next s with + | Done -> false + | Yield { value = b; state = _ } when equal a b -> true + | Yield { value = _; state = s } | Skip { state = s } -> loop s next a + in + match t with + | Sequence { state = seed; next } -> loop seed next a [@nontail] +;; + +let empty = Sequence { state = (); next = (fun () -> Done) } + +let bind t ~f = + unfold_step + ~f:(function + | Sequence { state = seed; next }, rest -> + (match next seed with + | Done -> + (match rest with + | Sequence { state = seed; next } -> + (match next seed with + | Done -> Done + | Skip { state = s } -> + Skip { state = empty, Sequence { state = s; next } } + | Yield { value = a; state = s } -> + Skip { state = f a, Sequence { state = s; next } })) + | Skip { state = s } -> Skip { state = Sequence { state = s; next }, rest } + | Yield { value = a; state = s } -> + Yield { value = a; state = Sequence { state = s; next }, rest })) + ~init:(empty, t) +;; + +let return x = + unfold_step ~init:(Some x) ~f:(function + | None -> Done + | Some x -> Yield { value = x; state = None }) +;; + +include Monad.Make (struct + type nonrec 'a t = 'a t + + let map = `Custom map + let bind = bind + let return = return +end) + +let nth s n = + if n < 0 + then None + else ( + let rec loop i s next = + match next s with + | Done -> None + | Skip { state = s } -> loop i s next + | Yield { value = a; state = s } -> + if phys_equal i 0 then Some a else loop (i - 1) s next + in + match s with + | Sequence { state = s; next } -> loop n s next) +;; + +let nth_exn s n = + if n < 0 + then invalid_arg "Sequence.nth" + else ( + match nth s n with + | None -> failwith "Sequence.nth" + | Some x -> x) +;; + +module Merge_with_duplicates_element = struct + type ('a, 'b) t = + | Left of 'a + | Right of 'b + | Both of 'a * 'b + [@@deriving_inline compare ~localize, equal ~localize, hash, sexp, sexp_grammar] + + let compare__local : + 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + = + fun _cmp__a _cmp__b a__023_ b__024_ -> + if Stdlib.( == ) a__023_ b__024_ + then 0 + else ( + match a__023_, b__024_ with + | Left _a__025_, Left _b__026_ -> _cmp__a _a__025_ _b__026_ + | Left _, _ -> -1 + | _, Left _ -> 1 + | Right _a__027_, Right _b__028_ -> _cmp__b _a__027_ _b__028_ + | Right _, _ -> -1 + | _, Right _ -> 1 + | Both (_a__029_, _a__031_), Both (_b__030_, _b__032_) -> + (match _cmp__a _a__029_ _b__030_ with + | 0 -> _cmp__b _a__031_ _b__032_ + | n -> n)) + ;; + + let compare : + 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + = + fun _cmp__a _cmp__b a__013_ b__014_ -> + if Stdlib.( == ) a__013_ b__014_ + then 0 + else ( + match a__013_, b__014_ with + | Left _a__015_, Left _b__016_ -> _cmp__a _a__015_ _b__016_ + | Left _, _ -> -1 + | _, Left _ -> 1 + | Right _a__017_, Right _b__018_ -> _cmp__b _a__017_ _b__018_ + | Right _, _ -> -1 + | _, Right _ -> 1 + | Both (_a__019_, _a__021_), Both (_b__020_, _b__022_) -> + (match _cmp__a _a__019_ _b__020_ with + | 0 -> _cmp__b _a__021_ _b__022_ + | n -> n)) + ;; + + let equal__local : + 'a 'b. + ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + = + fun _cmp__a _cmp__b a__043_ b__044_ -> + if Stdlib.( == ) a__043_ b__044_ + then true + else ( + match a__043_, b__044_ with + | Left _a__045_, Left _b__046_ -> _cmp__a _a__045_ _b__046_ + | Left _, _ -> false + | _, Left _ -> false + | Right _a__047_, Right _b__048_ -> _cmp__b _a__047_ _b__048_ + | Right _, _ -> false + | _, Right _ -> false + | Both (_a__049_, _a__051_), Both (_b__050_, _b__052_) -> + Stdlib.( && ) (_cmp__a _a__049_ _b__050_) (_cmp__b _a__051_ _b__052_)) + ;; + + let equal : + 'a 'b. + ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + = + fun _cmp__a _cmp__b a__033_ b__034_ -> + if Stdlib.( == ) a__033_ b__034_ + then true + else ( + match a__033_, b__034_ with + | Left _a__035_, Left _b__036_ -> _cmp__a _a__035_ _b__036_ + | Left _, _ -> false + | _, Left _ -> false + | Right _a__037_, Right _b__038_ -> _cmp__b _a__037_ _b__038_ + | Right _, _ -> false + | _, Right _ -> false + | Both (_a__039_, _a__041_), Both (_b__040_, _b__042_) -> + Stdlib.( && ) (_cmp__a _a__039_ _b__040_) (_cmp__b _a__041_ _b__042_)) + ;; + + let hash_fold_t + : type a b. + (Ppx_hash_lib.Std.Hash.state -> a -> Ppx_hash_lib.Std.Hash.state) + -> (Ppx_hash_lib.Std.Hash.state -> b -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> (a, b) t + -> Ppx_hash_lib.Std.Hash.state + = + fun _hash_fold_a _hash_fold_b hsv arg -> + match arg with + | Left _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 0 in + let hsv = hsv in + _hash_fold_a hsv _a0 + | Right _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 1 in + let hsv = hsv in + _hash_fold_b hsv _a0 + | Both (_a0, _a1) -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 2 in + let hsv = + let hsv = hsv in + _hash_fold_a hsv _a0 + in + _hash_fold_b hsv _a1 + ;; + + let t_of_sexp : + 'a 'b. + (Sexplib0.Sexp.t -> 'a) + -> (Sexplib0.Sexp.t -> 'b) + -> Sexplib0.Sexp.t + -> ('a, 'b) t + = + fun (type a__076_ b__077_) + : ((Sexplib0.Sexp.t -> a__076_) -> (Sexplib0.Sexp.t -> b__077_) -> Sexplib0.Sexp.t + -> (a__076_, b__077_) t) -> + let error_source__057_ = "sequence.ml.Merge_with_duplicates_element.t" in + fun _of_a__053_ _of_b__054_ -> function + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("left" | "Left") as _tag__060_) :: sexp_args__061_) as + _sexp__059_ -> + (match sexp_args__061_ with + | arg0__062_ :: [] -> + let res0__063_ = _of_a__053_ arg0__062_ in + Left res0__063_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__057_ + _tag__060_ + _sexp__059_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("right" | "Right") as _tag__065_) :: sexp_args__066_) as + _sexp__064_ -> + (match sexp_args__066_ with + | arg0__067_ :: [] -> + let res0__068_ = _of_b__054_ arg0__067_ in + Right res0__068_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__057_ + _tag__065_ + _sexp__064_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("both" | "Both") as _tag__070_) :: sexp_args__071_) as + _sexp__069_ -> + (match sexp_args__071_ with + | [ arg0__072_; arg1__073_ ] -> + let res0__074_ = _of_a__053_ arg0__072_ + and res1__075_ = _of_b__054_ arg1__073_ in + Both (res0__074_, res1__075_) + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__057_ + _tag__070_ + _sexp__069_) + | Sexplib0.Sexp.Atom ("left" | "Left") as sexp__058_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__057_ sexp__058_ + | Sexplib0.Sexp.Atom ("right" | "Right") as sexp__058_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__057_ sexp__058_ + | Sexplib0.Sexp.Atom ("both" | "Both") as sexp__058_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__057_ sexp__058_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__056_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__057_ sexp__056_ + | Sexplib0.Sexp.List [] as sexp__056_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__057_ sexp__056_ + | sexp__056_ -> + Sexplib0.Sexp_conv_error.unexpected_stag error_source__057_ sexp__056_ + ;; + + let sexp_of_t : + 'a 'b. + ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t + = + fun (type a__088_ b__089_) + : ((a__088_ -> Sexplib0.Sexp.t) -> (b__089_ -> Sexplib0.Sexp.t) + -> (a__088_, b__089_) t -> Sexplib0.Sexp.t) -> + fun _of_a__078_ _of_b__079_ -> function + | Left arg0__080_ -> + let res0__081_ = _of_a__078_ arg0__080_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Left"; res0__081_ ] + | Right arg0__082_ -> + let res0__083_ = _of_b__079_ arg0__082_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Right"; res0__083_ ] + | Both (arg0__084_, arg1__085_) -> + let res0__086_ = _of_a__078_ arg0__084_ + and res1__087_ = _of_b__079_ arg1__085_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Both"; res0__086_; res1__087_ ] + ;; + + let t_sexp_grammar : + 'a 'b. + 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t + = + fun _'a_sexp_grammar _'b_sexp_grammar -> + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag + { name = "Left" + ; clause_kind = + List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) } + } + ; No_tag + { name = "Right" + ; clause_kind = + List_clause { args = Cons (_'b_sexp_grammar.untyped, Empty) } + } + ; No_tag + { name = "Both" + ; clause_kind = + List_clause + { args = + Cons + ( _'a_sexp_grammar.untyped + , Cons (_'b_sexp_grammar.untyped, Empty) ) + } + } + ] + } + } + ;; + + [@@@end] +end + +let merge_with_duplicates + (Sequence { state = s1; next = next1 }) + (Sequence { state = s2; next = next2 }) + ~compare + = + let unshadowed_compare = compare in + let open Merge_with_duplicates_element in + let next = function + | Skip { state = s1 }, s2 -> Skip { state = next1 s1, s2 } + | s1, Skip { state = s2 } -> Skip { state = s1, next2 s2 } + | (Yield { value = a; state = s1' } as s1), (Yield { value = b; state = s2' } as s2) + -> + let comparison = unshadowed_compare a b in + if comparison < 0 + then Yield { value = Left a; state = Skip { state = s1' }, s2 } + else if comparison = 0 + then + Yield { value = Both (a, b); state = Skip { state = s1' }, Skip { state = s2' } } + else Yield { value = Right b; state = s1, Skip { state = s2' } } + | Done, Done -> Done + | Yield { value = a; state = s1 }, Done -> + Yield { value = Left a; state = Skip { state = s1 }, Done } + | Done, Yield { value = b; state = s2 } -> + Yield { value = Right b; state = Done, Skip { state = s2 } } + in + Sequence { state = Skip { state = s1 }, Skip { state = s2 }; next } +;; + +let merge_deduped_and_sorted s1 s2 ~compare = + map (merge_with_duplicates s1 s2 ~compare) ~f:(function + | Left x | Right x | Both (x, _) -> x) +;; + +let merge_sorted + (Sequence { state = s1; next = next1 }) + (Sequence { state = s2; next = next2 }) + ~compare + = + let next = function + | Skip { state = s1 }, s2 -> Skip { state = next1 s1, s2 } + | s1, Skip { state = s2 } -> Skip { state = s1, next2 s2 } + | (Yield { value = a; state = s1' } as s1), (Yield { value = b; state = s2' } as s2) + -> + let comparison = compare a b in + if comparison <= 0 + then Yield { value = a; state = Skip { state = s1' }, s2 } + else Yield { value = b; state = s1, Skip { state = s2' } } + | Done, Done -> Done + | Yield { value = a; state = s1 }, Done -> + Yield { value = a; state = Skip { state = s1 }, Done } + | Done, Yield { value = b; state = s2 } -> + Yield { value = b; state = Done, Skip { state = s2 } } + in + Sequence { state = Skip { state = s1 }, Skip { state = s2 }; next } +;; + +let hd s = + let rec loop s next = + match next s with + | Done -> None + | Skip { state = s } -> loop s next + | Yield { value = a; state = _ } -> Some a + in + match s with + | Sequence { state = s; next } -> loop s next +;; + +let hd_exn s = + match hd s with + | None -> failwith "hd_exn" + | Some a -> a +;; + +let tl s = + let rec loop s next = + match next s with + | Done -> None + | Skip { state = s } -> loop s next + | Yield { value = _; state = a } -> Some a + in + match s with + | Sequence { state = s; next } -> + (match loop s next with + | None -> None + | Some s -> Some (Sequence { state = s; next })) +;; + +let tl_eagerly_exn s = + match tl s with + | None -> failwith "Sequence.tl_exn" + | Some s -> s +;; + +let lift_identity next s = + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = `Identity s } + | Yield { value = a; state = s } -> Yield { value = a; state = `Identity s } +;; + +let next s = + let rec loop s next = + match next s with + | Done -> None + | Skip { state = s } -> loop s next + | Yield { value = a; state = s } -> Some (a, Sequence { state = s; next }) + in + match s with + | Sequence { state = s; next } -> loop s next +;; + +let filter_opt s = + match s with + | Sequence { state = s; next } -> + Sequence + { state = s + ; next = + (fun s -> + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = None; state = s } -> Skip { state = s } + | Yield { value = Some a; state = s } -> Yield { value = a; state = s }) + } +;; + +let filter_map s ~f = filter_opt (map s ~f) +let filter_mapi s ~f = filter_map (mapi s ~f:(fun i s -> i, s)) ~f:(fun (i, s) -> f i s) + +let split_n s n = + let rec loop s i accum next = + if i <= 0 + then List.rev accum, Sequence { state = s; next } + else ( + match next s with + | Done -> List.rev accum, empty + | Skip { state = s } -> loop s i accum next + | Yield { value = a; state = s } -> loop s (i - 1) (a :: accum) next) + in + match s with + | Sequence { state = s; next } -> loop s n [] next +;; + +let chunks_exn t n = + if n <= 0 + then invalid_arg "Sequence.chunks_exn" + else + unfold_step ~init:t ~f:(fun t -> + match split_n t n with + | [], _empty -> Done + | (_ :: _ as xs), t -> Yield { value = xs; state = t }) +;; + +let findi t ~f = + let rec loop s next i f = + match next s with + | Done -> None + | Yield { value = a; state = _ } when f i a -> Some (i, a) + | Yield { value = _; state = s } -> loop s next (i + 1) f + | Skip { state = s } -> loop s next i f + in + match t with + | Sequence { state = seed; next } -> loop seed next 0 f +;; + +let find_exn s ~f = + match find s ~f with + | None -> failwith "Sequence.find_exn" + | Some x -> x +;; + +let append s1 s2 = + match s1, s2 with + | Sequence { state = s1; next = next1 }, Sequence { state = s2; next = next2 } -> + Sequence + { state = `First_list s1 + ; next = + (function + | `First_list s1 -> + (match next1 s1 with + | Done -> Skip { state = `Second_list s2 } + | Skip { state = s1 } -> Skip { state = `First_list s1 } + | Yield { value = a; state = s1 } -> + Yield { value = a; state = `First_list s1 }) + | `Second_list s2 -> + (match next2 s2 with + | Done -> Done + | Skip { state = s2 } -> Skip { state = `Second_list s2 } + | Yield { value = a; state = s2 } -> + Yield { value = a; state = `Second_list s2 })) + } +;; + +let concat_map s ~f = bind s ~f +let concat s = concat_map s ~f:Fn.id +let concat_mapi s ~f = concat_map (mapi s ~f:(fun i s -> i, s)) ~f:(fun (i, s) -> f i s) + +let zip (Sequence { state = s1; next = next1 }) (Sequence { state = s2; next = next2 }) = + let next = function + | Yield { value = a; state = s1 }, Yield { value = b; state = s2 } -> + Yield { value = a, b; state = Skip { state = s1 }, Skip { state = s2 } } + | Done, _ | _, Done -> Done + | Skip { state = s1 }, s2 -> Skip { state = next1 s1, s2 } + | s1, Skip { state = s2 } -> Skip { state = s1, next2 s2 } + in + Sequence { state = Skip { state = s1 }, Skip { state = s2 }; next } +;; + +let zip_full + (Sequence { state = s1; next = next1 }) + (Sequence { state = s2; next = next2 }) + = + let next = function + | Yield { value = a; state = s1 }, Yield { value = b; state = s2 } -> + Yield { value = `Both (a, b); state = Skip { state = s1 }, Skip { state = s2 } } + | Done, Done -> Done + | Skip { state = s1 }, s2 -> Skip { state = next1 s1, s2 } + | s1, Skip { state = s2 } -> Skip { state = s1, next2 s2 } + | Done, Yield { value = b; state = s2 } -> + Yield { value = `Right b; state = Done, next2 s2 } + | Yield { value = a; state = s1 }, Done -> + Yield { value = `Left a; state = next1 s1, Done } + in + Sequence { state = Skip { state = s1 }, Skip { state = s2 }; next } +;; + +let bounded_length (Sequence { state = seed; next }) ~at_most = + let rec loop i seed next = + if i > at_most + then `Greater + else ( + match next seed with + | Done -> `Is i + | Skip { state = seed } -> loop i seed next + | Yield { value = _; state = seed } -> loop (i + 1) seed next) + in + loop 0 seed next +;; + +let length_is_bounded_by ?(min = -1) ?max t = + let length_is_at_least (Sequence { state = s; next }) = + let rec loop s acc = + if acc >= min + then true + else ( + match next s with + | Done -> false + | Skip { state = s } -> loop s acc + | Yield { value = _; state = s } -> loop s (acc + 1)) + in + loop s 0 + in + match max with + | None -> length_is_at_least t + | Some max -> + (match bounded_length t ~at_most:max with + | `Is len when len >= min -> true + | _ -> false) +;; + +let iteri s ~f = iter (mapi s ~f:(fun i s -> i, s)) ~f:(fun (i, s) -> f i s) [@nontail] + +let foldi s ~init ~f = + fold ~init (mapi s ~f:(fun i s -> i, s)) ~f:(fun acc (i, s) -> f i acc s) [@nontail] +;; + +let reduce s ~f = + match next s with + | None -> None + | Some (a, s) -> Some (fold s ~init:a ~f) +;; + +let reduce_exn s ~f = + match reduce s ~f with + | None -> failwith "Sequence.reduce_exn" + | Some res -> res +;; + +let group (Sequence { state = s; next }) ~break = + unfold_step + ~init:(Some ([], s)) + ~f:(function + | None -> Done + | Some (acc, s) -> + (match acc, next s with + | _, Skip { state = s } -> Skip { state = Some (acc, s) } + | [], Done -> Done + | acc, Done -> Yield { value = List.rev acc; state = None } + | [], Yield { value = cur; state = s } -> Skip { state = Some ([ cur ], s) } + | (prev :: _ as acc), Yield { value = cur; state = s } -> + if break prev cur + then Yield { value = List.rev acc; state = Some ([ cur ], s) } + else Skip { state = Some (cur :: acc, s) })) +;; + +let find_consecutive_duplicate (Sequence { state = s; next }) ~equal = + let rec loop last_elt s = + match next s with + | Done -> None + | Skip { state = s } -> loop last_elt s + | Yield { value = a; state = s } -> + (match last_elt with + | Some b when equal a b -> Some (b, a) + | None | Some _ -> loop (Some a) s) + in + loop None s [@nontail] +;; + +let remove_consecutive_duplicates s ~equal = + unfold_with s ~init:None ~f:(fun prev a -> + match prev with + | Some b when equal a b -> Skip { state = Some a } + | None | Some _ -> Yield { value = a; state = Some a }) +;; + +let count s ~f = fold s ~init:0 ~f:(fun acc elt -> acc + Bool.to_int (f elt)) [@nontail] + +let counti t ~f = + foldi t ~init:0 ~f:(fun i acc elt -> acc + Bool.to_int (f i elt)) [@nontail] +;; + +let sum m t ~f = Container.sum ~fold m t ~f +let min_elt t ~compare = Container.min_elt ~fold t ~compare +let max_elt t ~compare = Container.max_elt ~fold t ~compare + +let init n ~f = + unfold_step ~init:0 ~f:(fun i -> + if i >= n then Done else Yield { value = f i; state = i + 1 }) +;; + +let sub s ~pos ~len = + if pos < 0 || len < 0 then failwith "Sequence.sub"; + match s with + | Sequence { state = s; next } -> + Sequence + { state = 0, s + ; next = + (fun (i, s) -> + if i - pos >= len + then Done + else ( + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } when i >= pos -> + Yield { value = a; state = i + 1, s } + | Yield { value = _; state = s } -> Skip { state = i + 1, s })) + } +;; + +let take s len = + if len < 0 then failwith "Sequence.take"; + match s with + | Sequence { state = s; next } -> + Sequence + { state = 0, s + ; next = + (fun (i, s) -> + if i >= len + then Done + else ( + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } -> Yield { value = a; state = i + 1, s })) + } +;; + +let drop s len = + if len < 0 then failwith "Sequence.drop"; + match s with + | Sequence { state = s; next } -> + Sequence + { state = 0, s + ; next = + (fun (i, s) -> + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } when i >= len -> + Yield { value = a; state = i + 1, s } + | Yield { value = _; state = s } -> Skip { state = i + 1, s }) + } +;; + +let take_while s ~f = + match s with + | Sequence { state = s; next } -> + Sequence + { state = s + ; next = + (fun s -> + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = a; state = s } when f a -> Yield { value = a; state = s } + | Yield { value = _; state = _ } -> Done) + } +;; + +let drop_while s ~f = + match s with + | Sequence { state = s; next } -> + Sequence + { state = `Dropping s + ; next = + (function + | `Dropping s -> + (match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = `Dropping s } + | Yield { value = a; state = s } when f a -> Skip { state = `Dropping s } + | Yield { value = a; state = s } -> Yield { value = a; state = `Identity s }) + | `Identity s -> lift_identity next s) + } +;; + +let shift_right s x = + match s with + | Sequence { state = seed; next } -> + Sequence + { state = `Consing (seed, x) + ; next = + (function + | `Consing (seed, x) -> Yield { value = x; state = `Identity seed } + | `Identity s -> lift_identity next s) + } +;; + +let shift_right_with_list s l = append (of_list l) s +let shift_left = drop + +module Infix = struct + let ( @ ) = append +end + +let intersperse s ~sep = + match s with + | Sequence { state = s; next } -> + Sequence + { state = `Init s + ; next = + (function + | `Init s -> + (match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = `Init s } + | Yield { value = a; state = s } -> Yield { value = a; state = `Running s }) + | `Running s -> + (match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = `Running s } + | Yield { value = a; state = s } -> + Yield { value = sep; state = `Putting (a, s) }) + | `Putting (a, s) -> Yield { value = a; state = `Running s }) + } +;; + +let repeat x = unfold_step ~init:x ~f:(fun x -> Yield { value = x; state = x }) + +let cycle_list_exn xs = + if List.is_empty xs then invalid_arg "Sequence.cycle_list_exn"; + let s = of_list xs in + concat_map ~f:(fun () -> s) (repeat ()) +;; + +let cartesian_product sa sb = concat_map sa ~f:(fun a -> zip (repeat a) sb) +let singleton x = return x + +let delayed_fold s ~init ~f ~finish = + Expert.delayed_fold_step s ~init ~finish ~f:(fun acc option ~k -> + match option with + | None -> k acc + | Some a -> f acc a ~k) +;; + +let fold_m ~bind ~return t ~init ~f = + Expert.delayed_fold_step + t + ~init + ~f:(fun acc option ~k -> + match option with + | None -> bind (return acc) ~f:k + | Some a -> bind (f acc a) ~f:k) + ~finish:return +;; + +let iter_m ~bind ~return t ~f = + Expert.delayed_fold_step + t + ~init:() + ~f:(fun () option ~k -> + match option with + | None -> bind (return ()) ~f:k + | Some a -> bind (f a) ~f:k) + ~finish:return +;; + +let fold_until s ~init ~f ~finish = + let rec loop s next f acc = + match next s with + | Done -> finish acc + | Skip { state = s } -> loop s next f acc + | Yield { value = a; state = s } -> + (match (f acc a : ('a, 'b) Continue_or_stop.t) with + | Stop x -> x + | Continue acc -> loop s next f acc) + in + match s with + | Sequence { state = s; next } -> loop s next f init [@nontail] +;; + +let fold_result s ~init ~f = + let rec loop s next f acc = + match next s with + | Done -> Result.return acc + | Skip { state = s } -> loop s next f acc + | Yield { value = a; state = s } -> + (match (f acc a : (_, _) Result.t) with + | Error _ as e -> e + | Ok acc -> loop s next f acc) + in + match s with + | Sequence { state = s; next } -> loop s next f init +;; + +let force_eagerly t = of_list (to_list t) + +let memoize (type a) (Sequence { state = s; next }) = + let module M = struct + type t = T of (a, t) Step.t Lazy.t + end + in + let rec memoize s = M.T (lazy (find_step s)) + and find_step s = + match next s with + | Done -> Done + | Skip { state = s } -> find_step s + | Yield { value = a; state = s } -> Yield { value = a; state = memoize s } + in + Sequence { state = memoize s; next = (fun (M.T l) -> Lazy.force l) } +;; + +let drop_eagerly s len = + let rec loop i ~len s next = + if i >= len + then Sequence { state = s; next } + else ( + match next s with + | Done -> empty + | Skip { state = s } -> loop i ~len s next + | Yield { value = _; state = s } -> loop (i + 1) ~len s next) + in + match s with + | Sequence { state = s; next } -> loop 0 ~len s next +;; + +let drop_while_option (Sequence { state = s; next }) ~f = + let rec loop s = + match next s with + | Done -> None + | Skip { state = s } -> loop s + | Yield { value = x; state = s } -> + if f x then loop s else Some (x, Sequence { state = s; next }) + in + loop s [@nontail] +;; + +let rec skip_loop s next = + match next s with + | Skip { state } -> skip_loop state next + | (Done | Yield _) as next -> next +;; + +let compare compare_a (Sequence l) (Sequence r) = + let rec loop compare_a s_l next_l s_r next_r = + match skip_loop s_l next_l, skip_loop s_r next_r with + | Done, Done -> 0 + | Done, Yield _ -> -1 + | Yield _, Done -> 1 + | Yield l, Yield r -> + let c = compare_a l.value r.value in + if c <> 0 then c else loop compare_a l.state next_l r.state next_r + | Skip _, _ | _, Skip _ -> failwith "Bug: This branch should be unreachable" + in + loop compare_a l.state l.next r.state r.next +;; + +let compare__local compare_a__local t1 t2 = + compare (fun x y -> compare_a__local x y) (globalize () t1) (globalize () t2) +;; + +let equal equal_a t1 t2 = + for_all (zip_full t1 t2) ~f:(function + | `Both (a1, a2) -> equal_a a1 a2 + | `Left _ | `Right _ -> false) +;; + +let equal__local equal_a__local t1 t2 = + equal (fun x y -> equal_a__local x y) (globalize () t1) (globalize () t2) +;; + +let round_robin list = + let next (todo_stack, done_stack) = + match todo_stack with + | Sequence { state = s; next = f } :: todo_stack -> + (match f s with + | Yield { value = x; state = s } -> + Yield + { value = x + ; state = todo_stack, Sequence { state = s; next = f } :: done_stack + } + | Skip { state = s } -> + Skip { state = Sequence { state = s; next = f } :: todo_stack, done_stack } + | Done -> Skip { state = todo_stack, done_stack }) + | [] -> + if List.is_empty done_stack then Done else Skip { state = List.rev done_stack, [] } + in + let state = list, [] in + Sequence { state; next } +;; + +let interleave (Sequence { state = s1; next = f1 }) = + let next (todo_stack, done_stack, s1) = + match todo_stack with + | Sequence { state = s2; next = f2 } :: todo_stack -> + (match f2 s2 with + | Yield { value = x; state = s2 } -> + Yield + { value = x + ; state = todo_stack, Sequence { state = s2; next = f2 } :: done_stack, s1 + } + | Skip { state = s2 } -> + Skip { state = todo_stack, Sequence { state = s2; next = f2 } :: done_stack, s1 } + | Done -> Skip { state = todo_stack, done_stack, s1 }) + | [] -> + (match f1 s1, done_stack with + | Yield { value = t; state = s1 }, _ -> + Skip { state = List.rev (t :: done_stack), [], s1 } + | Skip { state = s1 }, _ -> Skip { state = List.rev done_stack, [], s1 } + | Done, _ :: _ -> Skip { state = List.rev done_stack, [], s1 } + | Done, [] -> Done) + in + let state = [], [], s1 in + Sequence { state; next } +;; + +let interleaved_cartesian_product s1 s2 = + map s1 ~f:(fun x1 -> map s2 ~f:(fun x2 -> x1, x2)) |> interleave +;; + +let of_seq (seq : _ Stdlib.Seq.t) = + unfold_step ~init:seq ~f:(fun seq -> + match seq () with + | Nil -> Done + | Cons (hd, tl) -> Yield { value = hd; state = tl }) +;; + +let to_seq (Sequence { state; next }) = + let rec loop state = + match next state with + | Done -> Stdlib.Seq.Nil + | Skip { state } -> loop state + | Yield { value = hd; state } -> Stdlib.Seq.Cons (hd, fun () -> loop state) + in + fun () -> loop state +;; + +module Generator = struct + type 'elt steps = Wrap of ('elt, unit -> 'elt steps) Step.t + + let unwrap (Wrap step) = step + + module T = struct + type ('a, 'elt) t = ('a -> 'elt steps) -> 'elt steps + + let return x k = k x + + let bind m ~f k = + m (fun a -> + let m' = f a in + m' k) + ;; + + let map m ~f k = m (fun a -> k (f a)) + let map = `Custom map + end + + include T + include Monad.Make2 (T) + + let yield e k = Wrap (Yield { value = e; state = k }) + let to_steps t = t (fun () -> Wrap Done) + + let of_sequence sequence = + delayed_fold + sequence + ~init:() + ~f:(fun () x ~k f -> Wrap (Yield { value = x; state = (fun () -> k () f) })) + ~finish:return + ;; + + let run t = + let init () = to_steps t in + let f thunk = unwrap (thunk ()) in + unfold_step ~init ~f + ;; +end diff --git a/unikernel/duniverse/base/src/sequence.mli b/unikernel/duniverse/base/src/sequence.mli new file mode 100644 index 00000000..38e43e0b --- /dev/null +++ b/unikernel/duniverse/base/src/sequence.mli @@ -0,0 +1,515 @@ +(** A sequence of elements that can be produced one at a time, on demand, normally with no + sharing. + + The elements are computed on demand, possibly repeating work if they are demanded + multiple times. A sequence can be built by unfolding from some initial state, which + will in practice often be other containers. + + Most functions constructing a sequence will not immediately compute any elements of + the sequence. These functions will always return in O(1), but traversing the + resulting sequence may be more expensive. The most they will do immediately is + generate a new internal state and a new step function. + + Functions that transform existing sequences sometimes have to reconstruct some suffix + of the input sequence, even if it is unmodified. For example, calling [drop 1] will + return a sequence with a slightly larger state and whose elements all cost slightly + more to traverse. Because this is sometimes undesirable (for example, applying [drop + 1] n times will cost O(n) per element traversed in the result), there are also more + eager versions of many functions (whose names are suffixed with [_eagerly]) that do + more work up front. A function has the [_eagerly] suffix iff it matches both of these + conditions: + + - It might consume an element from an input [t] before returning. + + - It only returns a [t] (not paired with something else, not wrapped in an [option], + etc.). If it returns anything other than a [t] and it has at least one [t] input, + it's probably demanding elements from the input [t] anyway. + + Only [*_exn] functions can raise exceptions, except if the function underlying the + sequence (the [f] passed to [unfold]) raises, in which case the exception will + cascade. *) + +open! Import + +type +'a t [@@deriving_inline globalize, sexp_of] + +val globalize : ('a -> 'a) -> 'a t -> 'a t +val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + +[@@@end] + +type 'a sequence := 'a t + +include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t +include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t +include Indexed_container.S1 with type 'a t := 'a t +include Monad.S with type 'a t := 'a t + +(** [empty] is a sequence with no elements. *) +val empty : _ t + +(** [next] returns the next element of a sequence and the next tail if the sequence is not + finished. *) +val next : 'a t -> ('a * 'a t) option + +(** A [Step] describes the next step of the sequence construction. [Done] indicates the + sequence is finished. [Skip] indicates the sequence continues with another state + without producing the next element yet. [Yield] outputs an element and introduces a + new state. + + Modifying ['s] doesn't violate any {e internal} invariants, but it may violate some + undocumented expectations. For example, one might expect that producing an element + from the same point in the sequence would always give the same value, but if the state + can mutate, that is not so. *) +module Step : sig + type ('a, 's) t = + | Done + | Skip of { state : 's } + | Yield of + { value : 'a + ; state : 's + } + [@@deriving_inline sexp_of] + + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('s -> Sexplib0.Sexp.t) + -> ('a, 's) t + -> Sexplib0.Sexp.t + + [@@@end] +end + +(** [unfold_step ~init ~f] constructs a sequence by giving an initial state [init] and a + function [f] explaining how to continue the next step from a given state. *) +val unfold_step : init:'s -> f:('s -> ('a, 's) Step.t) -> 'a t + +(** [unfold ~init f] is a simplified version of [unfold_step] that does not allow + [Skip]. *) +val unfold : init:'s -> f:('s -> ('a * 's) option) -> 'a t + +(** [unfold_with t ~init ~f] folds a state through the sequence [t] to create a new + sequence *) +val unfold_with : 'a t -> init:'s -> f:('s -> 'a -> ('b, 's) Step.t) -> 'b t + +(** [unfold_with_and_finish t ~init ~running_step ~inner_finished ~finishing_step] folds a + state through [t] to create a new sequence (like [unfold_with t ~init + ~f:running_step]), and then continues the new sequence by unfolding the final state + (like [unfold_step ~init:(inner_finished final_state) ~f:finishing_step]). *) +val unfold_with_and_finish + : 'a t + -> init:'s_a + -> running_step:('s_a -> 'a -> ('b, 's_a) Step.t) + -> inner_finished:('s_a -> 's_b) + -> finishing_step:('s_b -> ('b, 's_b) Step.t) + -> 'b t + +(** Returns the nth element. *) +val nth : 'a t -> int -> 'a option + +val nth_exn : 'a t -> int -> 'a + +(** [folding_map] is a version of [map] that threads an accumulator through calls to + [f]. *) +val folding_map : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc * 'b) -> 'b t + +val folding_mapi : 'a t -> init:'acc -> f:(int -> 'acc -> 'a -> 'acc * 'b) -> 'b t +val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t +val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t +val filter : 'a t -> f:('a -> bool) -> 'a t + +(** If [t1] and [t2] are each sorted without duplicates, [merge_deduped_and_sorted t1 t2 + ~compare] merges [t1] and [t2] into a sorted sequence without duplicates. Whenever + identical elements are found in both [t1] and [t2], the one from [t1] is used and the + one from [t2] is discarded. The behavior is undefined if the inputs aren't sorted or + contain duplicates. *) +val merge_deduped_and_sorted : 'a t -> 'a t -> compare:('a -> 'a -> int) -> 'a t + +(** If [t1] and [t2] are each sorted, [merge_sorted t1 t2 ~compare] merges [t1] and [t2] + into a sorted sequence. Whenever identical elements are found in both [t1] and [t2], + the one from [t1] is used first. The behavior is undefined if the inputs aren't + sorted. *) +val merge_sorted : 'a t -> 'a t -> compare:('a -> 'a -> int) -> 'a t + +module Merge_with_duplicates_element : sig + type ('a, 'b) t = + | Left of 'a + | Right of 'b + | Both of 'a * 'b + [@@deriving_inline compare ~localize, equal ~localize, hash, sexp, sexp_grammar] + + include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t + include Ppx_compare_lib.Comparable.S_local2 with type ('a, 'b) t := ('a, 'b) t + include Ppx_compare_lib.Equal.S2 with type ('a, 'b) t := ('a, 'b) t + include Ppx_compare_lib.Equal.S_local2 with type ('a, 'b) t := ('a, 'b) t + include Ppx_hash_lib.Hashable.S2 with type ('a, 'b) t := ('a, 'b) t + include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t + + val t_sexp_grammar + : 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t + + [@@@end] +end + +(** [merge_with_duplicates_element t1 t2 ~compare] is like [merge], except that for each + element it indicates which input(s) the element comes from, using + [Merge_with_duplicates_element]. *) +val merge_with_duplicates + : 'a t + -> 'b t + -> compare:('a -> 'b -> int) + -> ('a, 'b) Merge_with_duplicates_element.t t + +val hd : 'a t -> 'a option +val hd_exn : 'a t -> 'a + +(** [tl t] and [tl_eagerly_exn t] immediately evaluates the first element of [t] and + returns the unevaluated tail. *) +val tl : 'a t -> 'a t option + +val tl_eagerly_exn : 'a t -> 'a t + +(** [find_exn t ~f] returns the first element of [t] that satisfies [f]. It raises if + there is no such element. *) +val find_exn : 'a t -> f:('a -> bool) -> 'a + +(** Like [for_all], but passes the index as an argument. *) +val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool + +(** [append t1 t2] first produces the elements of [t1], then produces the elements of + [t2]. *) +val append : 'a t -> 'a t -> 'a t + +(** [concat tt] produces the elements of each inner sequence sequentially. If any inner + sequences are infinite, elements of subsequent inner sequences will not be reached. *) +val concat : 'a t t -> 'a t + +(** [concat_map t ~f] is [concat (map t ~f)].*) +val concat_map : 'a t -> f:('a -> 'b t) -> 'b t + +(** [concat_mapi t ~f] is like concat_map, but passes the index as an argument. *) +val concat_mapi : 'a t -> f:(int -> 'a -> 'b t) -> 'b t + +(** [interleave tt] produces each element of the inner sequences of [tt] eventually, even + if any or all of the inner sequences are infinite. The elements of each inner + sequence are produced in order with respect to that inner sequence. The manner of + interleaving among the separate inner sequences is deterministic but unspecified. *) +val interleave : 'a t t -> 'a t + +(** [round_robin list] is like [interleave (of_list list)], except that the manner of + interleaving among the inner sequences is guaranteed to be round-robin. The input + sequences may be of different lengths; an empty sequence is dropped from subsequent + rounds of interleaving. *) +val round_robin : 'a t list -> 'a t + +(** Transforms a pair of sequences into a sequence of pairs. The length of the returned + sequence is the length of the shorter input. The remaining elements of the longer + input are discarded. + + WARNING: Unlike [List.zip], this will not error out if the two input sequences are of + different lengths, because [zip] may have already returned some elements by the time + this becomes apparent. *) +val zip : 'a t -> 'b t -> ('a * 'b) t + +(** [zip_full] is like [zip], but if one sequence ends before the other, then it keeps + producing elements from the other sequence until it has ended as well. *) +val zip_full : 'a t -> 'b t -> [ `Left of 'a | `Both of 'a * 'b | `Right of 'b ] t + +(** [reduce_exn f [a1; ...; an]] is [f (... (f (f a1 a2) a3) ...) an]. It fails on the + empty sequence. *) +val reduce_exn : 'a t -> f:('a -> 'a -> 'a) -> 'a + +val reduce : 'a t -> f:('a -> 'a -> 'a) -> 'a option + +(** [group l ~break] returns a sequence of lists (i.e., groups) whose concatenation is + equal to the original sequence. Each group is broken where [break] returns true on a + pair of successive elements. + + Example: + + {[ + group ~break:(<>) (of_list ['M';'i';'s';'s';'i';'s';'s';'i';'p';'p';'i']) -> + + of_list [['M'];['i'];['s';'s'];['i'];['s';'s'];['i'];['p';'p'];['i']] ]} *) +val group : 'a t -> break:('a -> 'a -> bool) -> 'a list t + +(** [find_consecutive_duplicate t ~equal] returns the first pair of consecutive elements + [(a1, a2)] in [t] such that [equal a1 a2]. They are returned in the same order as + they appear in [t]. *) +val find_consecutive_duplicate : 'a t -> equal:('a -> 'a -> bool) -> ('a * 'a) option + +(** The same sequence with consecutive duplicates removed. The relative order of the + other elements is unaffected. *) +val remove_consecutive_duplicates : 'a t -> equal:('a -> 'a -> bool) -> 'a t + +(** [range ?stride ?start ?stop start_i stop_i] is the sequence of integers from [start_i] + to [stop_i], stepping by [stride]. If [stride] < 0 then we need [start_i] > [stop_i] + for the result to be nonempty (or [start_i] >= [stop_i] in the case where both bounds + are inclusive). *) +val range + : ?stride:int (** default is [1] *) + -> ?start:[ `inclusive | `exclusive ] (** default is [`inclusive] *) + -> ?stop:[ `inclusive | `exclusive ] (** default is [`exclusive] *) + -> int + -> int + -> int t + +(** [init n ~f] is [[(f 0); (f 1); ...; (f (n-1))]]. It is an error if [n < 0]. *) +val init : int -> f:(int -> 'a) -> 'a t + +(** [filter_map t ~f] produce mapped elements of [t] which are not [None]. *) +val filter_map : 'a t -> f:('a -> 'b option) -> 'b t + +(** [filter_mapi] is just like [filter_map], but it also passes in the index of each + element to [f]. *) +val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t + +(** [filter_opt t] produces the elements of [t] which are not [None]. [filter_opt t] = + [filter_map t ~f:Fn.id]. *) +val filter_opt : 'a option t -> 'a t + +(** [sub t ~pos ~len] is the [len]-element subsequence of [t], starting at [pos]. If the + sequence is shorter than [pos + len], it returns [ t[pos] ... t[l-1] ], where [l] is + the length of the sequence. *) +val sub : 'a t -> pos:int -> len:int -> 'a t + +(** [take t n] produces the first [n] elements of [t]. *) +val take : 'a t -> int -> 'a t + +(** [drop t n] produces all elements of [t] except the first [n] elements. If there are + fewer than [n] elements in [t], there is no error; the resulting sequence simply + produces no elements. Usually you will probably want to use [drop_eagerly] because it + can be significantly cheaper. *) +val drop : 'a t -> int -> 'a t + +(** [drop_eagerly t n] immediately consumes the first [n] elements of [t] and returns the + unevaluated tail of [t]. *) +val drop_eagerly : 'a t -> int -> 'a t + +(** [take_while t ~f] produces the longest prefix of [t] for which [f] applied to each + element is [true]. *) +val take_while : 'a t -> f:('a -> bool) -> 'a t + +(** [drop_while t ~f] produces the suffix of [t] beginning with the first element of [t] + for which [f] is [false]. Usually you will probably want to use [drop_while_option] + because it can be significantly cheaper. *) +val drop_while : 'a t -> f:('a -> bool) -> 'a t + +(** [drop_while_option t ~f] immediately consumes the elements from [t] until the + predicate [f] fails and returns the first element that failed along with the + unevaluated tail of [t]. The first element is returned separately because the + alternatives would mean forcing the consumer to evaluate the first element again (if + the previous state of the sequence is returned) or take on extra cost for each element + (if the element is added to the final state of the sequence using [shift_right]). *) +val drop_while_option : 'a t -> f:('a -> bool) -> ('a * 'a t) option + +(** [split_n t n] immediately consumes the first [n] elements of [t] and returns the + consumed prefix, as a list, along with the unevaluated tail of [t]. *) +val split_n : 'a t -> int -> 'a list * 'a t + +(** [chunks_exn t n] produces lists of elements of [t], up to [n] elements at a time. The + last list may contain fewer than [n] elements. No list contains zero elements. If [n] + is not positive, it raises. *) +val chunks_exn : 'a t -> int -> 'a list t + +(** [shift_right t a] produces [a] and then produces each element of [t]. *) +val shift_right : 'a t -> 'a -> 'a t + +(** [shift_right_with_list t l] produces the elements of [l], then produces the elements + of [t]. It is better to call [shift_right_with_list] with a list of size n than + [shift_right] n times; the former will require O(1) work per element produced and the + latter O(n) work per element produced. *) +val shift_right_with_list : 'a t -> 'a list -> 'a t + +(** [shift_left t n] is a synonym for [drop t n].*) +val shift_left : 'a t -> int -> 'a t + +module Infix : sig + val ( @ ) : 'a t -> 'a t -> 'a t +end + +(** Returns a sequence with all possible pairs. The stepper function of the second + sequence passed as argument may be applied to the same state multiple times, so be + careful using [cartesian_product] with expensive or side-effecting functions. If the + second sequence is infinite, some values in the first sequence may not be reached. *) +val cartesian_product : 'a t -> 'b t -> ('a * 'b) t + +(** Returns a sequence that eventually reaches every possible pair of elements of the + inputs, even if either or both are infinite. The step function of both inputs may be + applied to the same state repeatedly, so be careful using + [interleaved_cartesian_product] with expensive or side-effecting functions. *) +val interleaved_cartesian_product : 'a t -> 'b t -> ('a * 'b) t + +(** [intersperse xs ~sep] produces [sep] between adjacent elements of [xs], e.g., + [intersperse [1;2;3] ~sep:0 = [1;0;2;0;3]]. *) +val intersperse : 'a t -> sep:'a -> 'a t + +(** [cycle_list_exn xs] repeats the elements of [xs] forever. If [xs] is empty, it + raises. *) +val cycle_list_exn : 'a list -> 'a t + +(** [repeat a] repeats [a] forever. *) +val repeat : 'a -> 'a t + +(** [singleton a] produces [a] exactly once. *) +val singleton : 'a -> 'a t + +(** [delayed_fold] allows to do an on-demand fold, while maintaining a state. + + It is possible to exit early by not calling [k] in [f]. It is also possible to call + [k] multiple times. This results in the rest of the sequence being folded over + multiple times, independently. + + Note that [delayed_fold], when targeting JavaScript, can result in stack overflow as + JavaScript doesn't generally have tail call optimization. *) +val delayed_fold + : 'a t + -> init:'s + -> f:('s -> 'a -> k:('s -> 'r) -> 'r) (** [k] stands for "continuation" *) + -> finish:('s -> 'r) + -> 'r + +(** [fold_m] is a monad-friendly version of [fold]. Supply it with the monad's [return] + and [bind], and it will chain them through the computation. *) +val fold_m + : bind:('acc_m -> f:('acc -> 'acc_m) -> 'acc_m) + -> return:('acc -> 'acc_m) + -> 'elt t + -> init:'acc + -> f:('acc -> 'elt -> 'acc_m) + -> 'acc_m + +(** [iter_m] is a monad-friendly version of [iter]. Supply it with the monad's [return] + and [bind], and it will chain them through the computation. *) +val iter_m + : bind:('unit_m -> f:(unit -> 'unit_m) -> 'unit_m) + -> return:(unit -> 'unit_m) + -> 'elt t + -> f:('elt -> 'unit_m) + -> 'unit_m + +(** [to_list_rev t] returns a list of the elements of [t], in reverse order. It is faster + than [to_list]. *) +val to_list_rev : 'a t -> 'a list + +val of_list : 'a list -> 'a t + +(** [of_lazy t_lazy] produces a sequence that forces [t_lazy] the first time it needs to + compute an element. *) +val of_lazy : 'a t Lazy.t -> 'a t + +(** [memoize t] produces each element of [t], but also memoizes them so that if you + consume the same element multiple times it is only computed once. It's a non-eager + version of [force_eagerly]. *) +val memoize : 'a t -> 'a t + +(** [force_eagerly t] precomputes the sequence. It is behaviorally equivalent to [of_list + (to_list t)], but may at some point have a more efficient implementation. It's an + eager version of [memoize]. *) +val force_eagerly : 'a t -> 'a t + +(** [bounded_length ~at_most t] returns [`Is len] if [len = length t <= at_most], and + otherwise returns [`Greater]. Walks through only as much of the sequence as + necessary. Always returns [`Greater] if [at_most < 0]. *) +val bounded_length : _ t -> at_most:int -> [ `Is of int | `Greater ] + +(** [length_is_bounded_by ~min ~max t] returns true if [min <= length t] and [length t <= + max] When [min] or [max] are not provided, the check for that bound is omitted. Walks + through only as much of the sequence as necessary. *) +val length_is_bounded_by : ?min:int -> ?max:int -> _ t -> bool + +val of_seq : 'a Stdlib.Seq.t -> 'a t +val to_seq : 'a t -> 'a Stdlib.Seq.t + +(** [Generator] is a monadic interface to generate sequences in a direct style, similar to + Python's generators. + + Here are some examples: + + {[ + open Generator + + let rec traverse_list = function + | [] -> return () + | x :: xs -> yield x >>= fun () -> traverse_list xs + + let traverse_option = function + | None -> return () + | Some x -> yield x + + let traverse_array arr = + let n = Array.length arr in + let rec loop i = + if i >= n then return () else yield arr.(i) >>= fun () -> loop (i + 1) + in + loop 0 + + let rec traverse_bst = function + | Node.Empty -> return () + | Node.Branch (left, value, right) -> + traverse_bst left >>= fun () -> + yield value >>= fun () -> + traverse_bst right + + let sequence_of_list x = Generator.run (traverse_list x) + let sequence_of_option x = Generator.run (traverse_option x) + let sequence_of_array x = Generator.run (traverse_array x) + let sequence_of_bst x = Generator.run (traverse_bst x) + ]} *) + +module Generator : sig + include Monad.S2 + + val yield : 'elt -> (unit, 'elt) t + val of_sequence : 'elt sequence -> (unit, 'elt) t + val run : (unit, 'elt) t -> 'elt sequence +end + +(** The functions in [Expert] expose internal structure which is normally meant to be + hidden. For example, at least when [f] is purely functional, it is not intended for + client code to distinguish between + + {[ + List.filter xs ~f + |> Sequence.of_list + ]} + + and + + {[ + Sequence.of_list xs + |> Sequence.filter ~f + ]} + + But sometimes for operational reasons it still makes sense to distinguish them. For + example, being able to handle [Skip]s explicitly allows breaking up some + computationally expensive sequences into smaller chunks of work. *) +module Expert : sig + (** [next_step] returns the next step in a sequence's construction. It is like [next], + but it also allows observing [Skip] steps. *) + val next_step : 'a t -> ('a, 'a t) Step.t + + (** [delayed_fold_step] is liked [delayed_fold], but [f] takes an option where [None] + represents a [Skip] step. *) + val delayed_fold_step + : 'a t + -> init:'s + -> f:('s -> 'a option -> k:('s -> 'r) -> 'r) (** [k] stands for "continuation" *) + -> finish:('s -> 'r) + -> 'r + + module View : sig + type +_ t = private + | Sequence : + { state : 's + ; next : 's -> ('a, 's) Step.t + } + -> 'a t + end + + val view : 'a t -> 'a View.t +end diff --git a/unikernel/duniverse/base/src/set.ml b/unikernel/duniverse/base/src/set.ml new file mode 100644 index 00000000..66641ca7 --- /dev/null +++ b/unikernel/duniverse/base/src/set.ml @@ -0,0 +1,1616 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Apache 2.0 license. See ../THIRD-PARTY.txt *) +(* for details. *) +(* *) +(***********************************************************************) + +(* Sets over ordered types *) + +open! Import +include Set_intf + +let with_return = With_return.with_return + +module Tree0 = struct + type 'a t = + | Empty + (* Leaf is the same as Node with empty children but uses less space. *) + | Leaf of { elt : 'a } + | Node of + { left : 'a t + ; elt : 'a + ; right : 'a t + ; height : int + ; size : int + } + + type 'a tree = 'a t + + (* Sets are represented by balanced binary trees (the heights of the children differ by + at most 2. *) + let[@inline always] height = function + | Empty -> 0 + | Leaf { elt = _ } -> 1 + | Node { left = _; elt = _; right = _; height = h; size = _ } -> h + ;; + + let[@inline always] length = function + | Empty -> 0 + | Leaf { elt = _ } -> 1 + | Node { left = _; elt = _; right = _; height = _; size = s } -> s + ;; + + let invariants = + let in_range lower upper compare_elt v = + (match lower with + | None -> true + | Some lower -> compare_elt lower v < 0) + && + match upper with + | None -> true + | Some upper -> compare_elt v upper < 0 + in + let rec loop lower upper compare_elt t = + match t with + | Empty -> true + | Leaf { elt = v } -> in_range lower upper compare_elt v + | Node { left = l; elt = v; right = r; height = h; size = n } -> + let hl = height l + and hr = height r in + abs (hl - hr) <= 2 + && h = max hl hr + 1 + && n = length l + length r + 1 + && in_range lower upper compare_elt v + && loop lower (Some v) compare_elt l + && loop (Some v) upper compare_elt r + in + fun t ~compare_elt -> loop None None compare_elt t + ;; + + let is_empty = function + | Empty -> true + | Leaf { elt = _ } | Node _ -> false + ;; + + (* Creates a new node with left son l, value v and right son r. + We must have all elements of l < v < all elements of r. + l and r must be balanced and | height l - height r | <= 2. *) + + let[@inline always] create l v r = + let hl = (height [@inlined]) l in + let hr = (height [@inlined]) r in + let h = if hl >= hr then hl + 1 else hr + 1 in + if h = 1 + then Leaf { elt = v } + else ( + let sl = (length [@inlined]) l in + let sr = (length [@inlined]) r in + Node { left = l; elt = v; right = r; height = h; size = sl + sr + 1 }) + ;; + + (* We must call [f] with increasing indexes, because the bin_prot reader in + Core.Set needs it. *) + let of_increasing_iterator_unchecked ~len ~f = + let rec loop n ~f i = + match n with + | 0 -> Empty + | 1 -> + let k = f i in + Leaf { elt = k } + | 2 -> + let kl = f i in + let k = f (i + 1) in + create (Leaf { elt = kl }) k Empty + | 3 -> + let kl = f i in + let k = f (i + 1) in + let kr = f (i + 2) in + create (Leaf { elt = kl }) k (Leaf { elt = kr }) + | n -> + let left_length = n lsr 1 in + let right_length = n - left_length - 1 in + let left = loop left_length ~f i in + let k = f (i + left_length) in + let right = loop right_length ~f (i + left_length + 1) in + create left k right + in + loop len ~f 0 + ;; + + let of_sorted_array_unchecked array ~compare_elt = + let array_length = Array.length array in + let next = + (* We don't check if the array is sorted or keys are duplicated, because that + checking is slower than the whole [of_sorted_array] function *) + if array_length < 2 || compare_elt array.(0) array.(1) < 0 + then fun i -> array.(i) + else fun i -> array.(array_length - 1 - i) + in + of_increasing_iterator_unchecked ~len:array_length ~f:next + ;; + + let of_sorted_array array ~compare_elt = + match array with + | [||] | [| _ |] -> Result.Ok (of_sorted_array_unchecked array ~compare_elt) + | _ -> + with_return (fun r -> + let increasing = + match compare_elt array.(0) array.(1) with + | 0 -> r.return (Or_error.error_string "of_sorted_array: duplicated elements") + | i -> i < 0 + in + for i = 1 to Array.length array - 2 do + match compare_elt array.(i) array.(i + 1) with + | 0 -> r.return (Or_error.error_string "of_sorted_array: duplicated elements") + | i -> + if Poly.( <> ) (i < 0) increasing + then + r.return (Or_error.error_string "of_sorted_array: elements are not ordered") + done; + Result.Ok (of_sorted_array_unchecked array ~compare_elt)) + ;; + + (* Same as create, but performs one step of rebalancing if necessary. + Assumes l and r balanced and | height l - height r | <= 3. *) + + let bal l v r = + let hl = (height [@inlined]) l in + let hr = (height [@inlined]) r in + if hl > hr + 2 + then ( + match l with + | Empty -> assert false + | Leaf { elt = _ } -> assert false (* because h(l)>h(r)+2 and h(leaf)=1 *) + | Node { left = ll; elt = lv; right = lr; height = _; size = _ } -> + if height ll >= height lr + then create ll lv (create lr v r) + else ( + match lr with + | Empty -> assert false + | Leaf { elt = lrv } -> + assert (is_empty ll); + create (create ll lv Empty) lrv (create Empty v r) + | Node { left = lrl; elt = lrv; right = lrr; height = _; size = _ } -> + create (create ll lv lrl) lrv (create lrr v r))) + else if hr > hl + 2 + then ( + match r with + | Empty -> assert false + | Leaf { elt = _ } -> assert false (* because h(r)>h(l)+2 and h(leaf)=1 *) + | Node { left = rl; elt = rv; right = rr; height = _; size = _ } -> + if height rr >= height rl + then create (create l v rl) rv rr + else ( + match rl with + | Empty -> assert false + | Leaf { elt = rlv } -> + assert (is_empty rr); + create (create l v Empty) rlv (create Empty rv rr) + | Node { left = rll; elt = rlv; right = rlr; height = _; size = _ } -> + create (create l v rll) rlv (create rlr rv rr))) + else (create [@inlined]) l v r + ;; + + (* Insertion of one element *) + + exception Same + + let add t x ~compare_elt = + let rec aux = function + | Empty -> Leaf { elt = x } + | Leaf { elt = v } -> + let c = compare_elt x v in + if c = 0 + then Exn.raise_without_backtrace Same + else if c < 0 + then create (Leaf { elt = x }) v Empty + else create Empty v (Leaf { elt = x }) + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + let c = compare_elt x v in + if c = 0 + then Exn.raise_without_backtrace Same + else if c < 0 + then bal (aux l) v r + else bal l v (aux r) + in + try aux t with + | Same -> t + ;; + + (* specialization of [add] that assumes that [x] is less than all existing elements *) + let rec add_min x t = + match t with + | Empty -> Leaf { elt = x } + | Leaf { elt = _ } -> Node { left = Empty; elt = x; right = t; height = 2; size = 2 } + | Node { left = l; elt = v; right = r; height = _; size = _ } -> bal (add_min x l) v r + ;; + + (* specialization of [add] that assumes that [x] is greater than all existing elements *) + let rec add_max t x = + match t with + | Empty -> Leaf { elt = x } + | Leaf { elt = _ } -> Node { left = t; elt = x; right = Empty; height = 2; size = 2 } + | Node { left = l; elt = v; right = r; height = _; size = _ } -> bal l v (add_max r x) + ;; + + (* Same as create and bal, but no assumptions are made on the relative heights of l and + r. *) + let rec join l v r = + match l, r with + | Empty, _ -> add_min v r + | _, Empty -> add_max l v + | Leaf { elt = lv }, _ -> add_min lv (add_min v r) + | _, Leaf { elt = rv } -> add_max (add_max l v) rv + | ( Node { left = ll; elt = lv; right = lr; height = lh; size = _ } + , Node { left = rl; elt = rv; right = rr; height = rh; size = _ } ) -> + if lh > rh + 2 + then bal ll lv (join lr v r) + else if rh > lh + 2 + then bal (join l v rl) rv rr + else create l v r + ;; + + (* Smallest and greatest element of a set *) + let rec min_elt = function + | Empty -> None + | Leaf { elt = v } | Node { left = Empty; elt = v; right = _; height = _; size = _ } + -> Some v + | Node { left = l; elt = _; right = _; height = _; size = _ } -> min_elt l + ;; + + exception Set_min_elt_exn_of_empty_set [@@deriving_inline sexp] + + let () = + Sexplib0.Sexp_conv.Exn_converter.add + [%extension_constructor Set_min_elt_exn_of_empty_set] + (function + | Set_min_elt_exn_of_empty_set -> + Sexplib0.Sexp.Atom "set.ml.Tree0.Set_min_elt_exn_of_empty_set" + | _ -> assert false) + ;; + + [@@@end] + + exception Set_max_elt_exn_of_empty_set [@@deriving_inline sexp] + + let () = + Sexplib0.Sexp_conv.Exn_converter.add + [%extension_constructor Set_max_elt_exn_of_empty_set] + (function + | Set_max_elt_exn_of_empty_set -> + Sexplib0.Sexp.Atom "set.ml.Tree0.Set_max_elt_exn_of_empty_set" + | _ -> assert false) + ;; + + [@@@end] + + let min_elt_exn t = + match min_elt t with + | None -> raise Set_min_elt_exn_of_empty_set + | Some v -> v + ;; + + let fold_until t ~init ~f ~finish = + let rec fold_until_helper ~f t acc = + match t with + | Empty -> Container.Continue_or_stop.Continue acc + | Leaf { elt = value } -> f acc value [@nontail] + | Node { left; elt = value; right; height = _; size = _ } -> + (match fold_until_helper ~f left acc with + | Stop _a as x -> x + | Continue acc -> + (match f acc value with + | Stop _a as x -> x + | Continue a -> fold_until_helper ~f right a)) + in + match fold_until_helper ~f t init with + | Continue x -> finish x [@nontail] + | Stop x -> x + ;; + + let rec max_elt = function + | Empty -> None + | Leaf { elt = v } | Node { left = _; elt = v; right = Empty; height = _; size = _ } + -> Some v + | Node { left = _; elt = _; right = r; height = _; size = _ } -> max_elt r + ;; + + let max_elt_exn t = + match max_elt t with + | None -> raise Set_max_elt_exn_of_empty_set + | Some v -> v + ;; + + (* Remove the smallest element of the given set *) + + let rec remove_min_elt = function + | Empty -> invalid_arg "Set.remove_min_elt" + | Leaf { elt = _ } -> Empty + | Node { left = Empty; elt = _; right = r; height = _; size = _ } -> r + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + bal (remove_min_elt l) v r + ;; + + (* Merge two trees l and r into one. All elements of l must precede the elements of r. + Assume | height l - height r | <= 2. *) + let merge t1 t2 = + match t1, t2 with + | Empty, t -> t + | t, Empty -> t + | _, _ -> bal t1 (min_elt_exn t2) (remove_min_elt t2) + ;; + + (* Merge two trees l and r into one. All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + let concat t1 t2 = + match t1, t2 with + | Empty, t | t, Empty -> t + | _, _ -> join t1 (min_elt_exn t2) (remove_min_elt t2) + ;; + + let split t x ~compare_elt = + let rec split t = + match t with + | Empty -> Empty, None, Empty + | Leaf { elt = v } -> + let c = compare_elt x v in + if c = 0 + then Empty, Some v, Empty + else if c < 0 + then Empty, None, Leaf { elt = v } + else Leaf { elt = v }, None, Empty + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + let c = compare_elt x v in + if c = 0 + then l, Some v, r + else if c < 0 + then ( + let ll, maybe_elt, rl = split l in + ll, maybe_elt, join rl v r) + else ( + let lr, maybe_elt, rr = split r in + join l v lr, maybe_elt, rr) + in + split t + ;; + + let rec split_le_gt t x ~compare_elt = + match t with + | Empty -> Empty, Empty + | Leaf { elt = v } -> + if compare_elt x v >= 0 then Leaf { elt = v }, Empty else Empty, Leaf { elt = v } + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + let c = compare_elt x v in + if c = 0 + then add_max l v, r + else if c < 0 + then ( + let ll, rl = split_le_gt l x ~compare_elt in + ll, join rl v r) + else ( + let lr, rr = split_le_gt r x ~compare_elt in + join l v lr, rr) + ;; + + let rec split_lt_ge t x ~compare_elt = + match t with + | Empty -> Empty, Empty + | Leaf { elt = v } -> + if compare_elt x v > 0 then Leaf { elt = v }, Empty else Empty, Leaf { elt = v } + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + let c = compare_elt x v in + if c = 0 + then l, add_min v r + else if c < 0 + then ( + let ll, rl = split_lt_ge l x ~compare_elt in + ll, join rl v r) + else ( + let lr, rr = split_lt_ge r x ~compare_elt in + join l v lr, rr) + ;; + + (* Implementation of the set operations *) + + let empty = Empty + + let rec mem t x ~compare_elt = + match t with + | Empty -> false + | Leaf { elt = v } -> + let c = compare_elt x v in + c = 0 + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + let c = compare_elt x v in + c = 0 || mem (if c < 0 then l else r) x ~compare_elt + ;; + + let singleton x = Leaf { elt = x } + + let remove t x ~compare_elt = + let rec aux t = + match t with + | Empty -> Exn.raise_without_backtrace Same + | Leaf { elt = v } -> + if compare_elt x v = 0 then Empty else Exn.raise_without_backtrace Same + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + let c = compare_elt x v in + if c = 0 then merge l r else if c < 0 then bal (aux l) v r else bal l v (aux r) + in + try aux t with + | Same -> t + ;; + + let remove_index t i ~compare_elt:_ = + let rec aux t i = + match t with + | Empty -> Exn.raise_without_backtrace Same + | Leaf { elt = _ } -> if i = 0 then Empty else Exn.raise_without_backtrace Same + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + let l_size = length l in + let c = Poly.compare i l_size in + if c = 0 + then merge l r + else if c < 0 + then bal (aux l i) v r + else bal l v (aux r (i - l_size - 1)) + in + try aux t i with + | Same -> t + ;; + + let union s1 s2 ~compare_elt = + let rec union s1 s2 = + if phys_equal s1 s2 + then s1 + else ( + match s1, s2 with + | Empty, t | t, Empty -> t + | Leaf { elt = v1 }, _ -> + union (Node { left = Empty; elt = v1; right = Empty; height = 1; size = 1 }) s2 + | _, Leaf { elt = v2 } -> + union s1 (Node { left = Empty; elt = v2; right = Empty; height = 1; size = 1 }) + | ( Node { left = l1; elt = v1; right = r1; height = h1; size = _ } + , Node { left = l2; elt = v2; right = r2; height = h2; size = _ } ) -> + if h1 >= h2 + then + if h2 = 1 + then add s1 v2 ~compare_elt + else ( + let l2, _, r2 = split s2 v1 ~compare_elt in + join (union l1 l2) v1 (union r1 r2)) + else if h1 = 1 + then add s2 v1 ~compare_elt + else ( + let l1, _, r1 = split s1 v2 ~compare_elt in + join (union l1 l2) v2 (union r1 r2))) + in + union s1 s2 + ;; + + let union_list ~comparator ~to_tree xs = + let compare_elt = comparator.Comparator.compare in + List.fold xs ~init:empty ~f:(fun ac x -> union ac (to_tree x) ~compare_elt) + ;; + + let inter s1 s2 ~compare_elt = + let rec inter s1 s2 = + if phys_equal s1 s2 + then s1 + else ( + match s1, s2 with + | Empty, _ | _, Empty -> Empty + | (Leaf { elt } as singleton), other_set | other_set, (Leaf { elt } as singleton) + -> if mem other_set elt ~compare_elt then singleton else Empty + | Node { left = l1; elt = v1; right = r1; height = _; size = _ }, t2 -> + (match split t2 v1 ~compare_elt with + | l2, None, r2 -> concat (inter l1 l2) (inter r1 r2) + | l2, Some v1, r2 -> join (inter l1 l2) v1 (inter r1 r2))) + in + inter s1 s2 + ;; + + let diff s1 s2 ~compare_elt = + let rec diff s1 s2 = + if phys_equal s1 s2 + then Empty + else ( + match s1, s2 with + | Empty, _ -> Empty + | t1, Empty -> t1 + | Leaf { elt = v1 }, t2 -> + diff (Node { left = Empty; elt = v1; right = Empty; height = 1; size = 1 }) t2 + | Node { left = l1; elt = v1; right = r1; height = _; size = _ }, t2 -> + (match split t2 v1 ~compare_elt with + | l2, None, r2 -> join (diff l1 l2) v1 (diff r1 r2) + | l2, Some _, r2 -> concat (diff l1 l2) (diff r1 r2))) + in + diff s1 s2 + ;; + + module Enum = struct + type increasing + type decreasing + + type ('a, 'direction) t = + | End + | More of 'a * 'a tree * ('a, 'direction) t + + let rec cons s (e : (_, increasing) t) : (_, increasing) t = + match s with + | Empty -> e + | Leaf { elt = v } -> More (v, Empty, e) + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + cons l (More (v, r, e)) + ;; + + let rec cons_right s (e : (_, decreasing) t) : (_, decreasing) t = + match s with + | Empty -> e + | Leaf { elt = v } -> More (v, Empty, e) + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + cons_right r (More (v, l, e)) + ;; + + let of_set s : (_, increasing) t = cons s End + let of_set_right s : (_, decreasing) t = cons_right s End + + let starting_at_increasing t key compare : (_, increasing) t = + let rec loop t e = + match t with + | Empty -> e + | Leaf { elt = v } -> + loop (Node { left = Empty; elt = v; right = Empty; height = 1; size = 1 }) e + | Node { left = _; elt = v; right = r; height = _; size = _ } + when compare v key < 0 -> loop r e + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + loop l (More (v, r, e)) + in + loop t End + ;; + + let starting_at_decreasing t key compare : (_, decreasing) t = + let rec loop t e = + match t with + | Empty -> e + | Leaf { elt = v } -> + loop (Node { left = Empty; elt = v; right = Empty; height = 1; size = 1 }) e + | Node { left = l; elt = v; right = _; height = _; size = _ } + when compare v key > 0 -> loop l e + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + loop r (More (v, l, e)) + in + loop t End + ;; + + let compare compare_elt e1 e2 = + let rec loop e1 e2 = + match e1, e2 with + | End, End -> 0 + | End, _ -> -1 + | _, End -> 1 + | More (v1, r1, e1), More (v2, r2, e2) -> + let c = compare_elt v1 v2 in + if c <> 0 + then c + else if phys_equal r1 r2 + then loop e1 e2 + else loop (cons r1 e1) (cons r2 e2) + in + loop e1 e2 + ;; + + let rec iter ~f = function + | End -> () + | More (a, tree, enum) -> + f a; + iter (cons tree enum) ~f + ;; + + let iter2 compare_elt t1 t2 ~f = + let rec loop t1 t2 = + match t1, t2 with + | End, End -> () + | End, _ -> iter t2 ~f:(fun a -> f (`Right a)) [@nontail] + | _, End -> iter t1 ~f:(fun a -> f (`Left a)) [@nontail] + | More (a1, tree1, enum1), More (a2, tree2, enum2) -> + let compare_result = compare_elt a1 a2 in + if compare_result = 0 + then ( + f (`Both (a1, a2)); + loop (cons tree1 enum1) (cons tree2 enum2)) + else if compare_result < 0 + then ( + f (`Left a1); + loop (cons tree1 enum1) t2) + else ( + f (`Right a2); + loop t1 (cons tree2 enum2)) + in + loop t1 t2 [@nontail] + ;; + + let symmetric_diff t1 t2 ~compare_elt = + let step state : ((_, _) Either.t, _) Sequence.Step.t = + match state with + | End, End -> Done + | End, More (elt, tree, enum) -> + Yield { value = Second elt; state = End, cons tree enum } + | More (elt, tree, enum), End -> + Yield { value = First elt; state = cons tree enum, End } + | (More (a1, tree1, enum1) as left), (More (a2, tree2, enum2) as right) -> + let compare_result = compare_elt a1 a2 in + if compare_result = 0 + then ( + let next_state = + if phys_equal tree1 tree2 + then enum1, enum2 + else cons tree1 enum1, cons tree2 enum2 + in + Skip { state = next_state }) + else if compare_result < 0 + then Yield { value = First a1; state = cons tree1 enum1, right } + else Yield { value = Second a2; state = left, cons tree2 enum2 } + in + Sequence.unfold_step ~init:(of_set t1, of_set t2) ~f:step + ;; + end + + let to_sequence_increasing comparator ~from_elt t = + let next enum = + match enum with + | Enum.End -> Sequence.Step.Done + | Enum.More (k, t, e) -> Sequence.Step.Yield { value = k; state = Enum.cons t e } + in + let init = + match from_elt with + | None -> Enum.of_set t + | Some key -> Enum.starting_at_increasing t key comparator.Comparator.compare + in + Sequence.unfold_step ~init ~f:next + ;; + + let to_sequence_decreasing comparator ~from_elt t = + let next enum = + match enum with + | Enum.End -> Sequence.Step.Done + | Enum.More (k, t, e) -> + Sequence.Step.Yield { value = k; state = Enum.cons_right t e } + in + let init = + match from_elt with + | None -> Enum.of_set_right t + | Some key -> Enum.starting_at_decreasing t key comparator.Comparator.compare + in + Sequence.unfold_step ~init ~f:next + ;; + + let to_sequence + comparator + ?(order = `Increasing) + ?greater_or_equal_to + ?less_or_equal_to + t + = + let inclusive_bound side t bound = + let compare_elt = comparator.Comparator.compare in + let l, maybe, r = split t bound ~compare_elt in + let t = side (l, r) in + match maybe with + | None -> t + | Some elt -> add t elt ~compare_elt + in + match order with + | `Increasing -> + let t = Option.fold less_or_equal_to ~init:t ~f:(inclusive_bound fst) in + to_sequence_increasing comparator ~from_elt:greater_or_equal_to t + | `Decreasing -> + let t = Option.fold greater_or_equal_to ~init:t ~f:(inclusive_bound snd) in + to_sequence_decreasing comparator ~from_elt:less_or_equal_to t + ;; + + let rec find_first_satisfying t ~f = + match t with + | Empty -> None + | Leaf { elt = v } -> if f v then Some v else None + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + if f v + then ( + match find_first_satisfying l ~f with + | None -> Some v + | Some _ as x -> x) + else find_first_satisfying r ~f + ;; + + let rec find_last_satisfying t ~f = + match t with + | Empty -> None + | Leaf { elt = v } -> if f v then Some v else None + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + if f v + then ( + match find_last_satisfying r ~f with + | None -> Some v + | Some _ as x -> x) + else find_last_satisfying l ~f + ;; + + let binary_search t ~compare how v = + match how with + | `Last_strictly_less_than -> + find_last_satisfying t ~f:(fun x -> compare x v < 0) [@nontail] + | `Last_less_than_or_equal_to -> + find_last_satisfying t ~f:(fun x -> compare x v <= 0) [@nontail] + | `First_equal_to -> + (match find_first_satisfying t ~f:(fun x -> compare x v >= 0) with + | Some x as elt when compare x v = 0 -> elt + | None | Some _ -> None) + | `Last_equal_to -> + (match find_last_satisfying t ~f:(fun x -> compare x v <= 0) with + | Some x as elt when compare x v = 0 -> elt + | None | Some _ -> None) + | `First_greater_than_or_equal_to -> + find_first_satisfying t ~f:(fun x -> compare x v >= 0) [@nontail] + | `First_strictly_greater_than -> + find_first_satisfying t ~f:(fun x -> compare x v > 0) [@nontail] + ;; + + let binary_search_segmented t ~segment_of how = + let is_left x = + match segment_of x with + | `Left -> true + | `Right -> false + in + let is_right x = not (is_left x) in + match how with + | `Last_on_left -> find_last_satisfying t ~f:is_left [@nontail] + | `First_on_right -> find_first_satisfying t ~f:is_right [@nontail] + ;; + + let merge_to_sequence + comparator + ?(order = `Increasing) + ?greater_or_equal_to + ?less_or_equal_to + t + t' + = + Sequence.merge_with_duplicates + (to_sequence comparator ~order ?greater_or_equal_to ?less_or_equal_to t) + (to_sequence comparator ~order ?greater_or_equal_to ?less_or_equal_to t') + ~compare: + (match order with + | `Increasing -> comparator.compare + | `Decreasing -> Fn.flip comparator.compare) + ;; + + let compare compare_elt s1 s2 = + Enum.compare compare_elt (Enum.of_set s1) (Enum.of_set s2) + ;; + + let iter2 s1 s2 ~compare_elt ~f = + Enum.iter2 compare_elt (Enum.of_set s1) (Enum.of_set s2) ~f + ;; + + let equal s1 s2 ~compare_elt = compare compare_elt s1 s2 = 0 + + let is_subset s1 ~of_:s2 ~compare_elt = + let rec is_subset s1 ~of_:s2 = + match s1, s2 with + | Empty, _ -> true + | _, Empty -> false + | Leaf { elt = v1 }, t2 -> mem t2 v1 ~compare_elt + | Node { left = l1; elt = v1; right = r1; height = _; size = _ }, Leaf { elt = v2 } + -> + (match l1, r1 with + | Empty, Empty -> + (* This case shouldn't occur in practice because we should have constructed + a Leaf {elt=rather} than a Node with two Empty subtrees *) + compare_elt v1 v2 = 0 + | _, _ -> false) + | ( Node { left = l1; elt = v1; right = r1; height = _; size = _ } + , (Node { left = l2; elt = v2; right = r2; height = _; size = _ } as t2) ) -> + let c = compare_elt v1 v2 in + if c = 0 + then + phys_equal s1 s2 || (is_subset l1 ~of_:l2 && is_subset r1 ~of_:r2) + (* Note that height and size don't matter here. *) + else if c < 0 + then + is_subset + (Node { left = l1; elt = v1; right = Empty; height = 0; size = 0 }) + ~of_:l2 + && is_subset r1 ~of_:t2 + else + is_subset + (Node { left = Empty; elt = v1; right = r1; height = 0; size = 0 }) + ~of_:r2 + && is_subset l1 ~of_:t2 + in + is_subset s1 ~of_:s2 + ;; + + let rec are_disjoint s1 s2 ~compare_elt = + match s1, s2 with + | Empty, _ | _, Empty -> true + | Leaf { elt }, other_set | other_set, Leaf { elt } -> + not (mem other_set elt ~compare_elt) + | Node { left = l1; elt = v1; right = r1; height = _; size = _ }, t2 -> + if phys_equal s1 s2 + then false + else ( + match split t2 v1 ~compare_elt with + | l2, None, r2 -> + are_disjoint l1 l2 ~compare_elt && are_disjoint r1 r2 ~compare_elt + | _, Some _, _ -> false) + ;; + + let iter t ~f = + let rec iter = function + | Empty -> () + | Leaf { elt = v } -> f v + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + iter l; + f v; + iter r + in + iter t [@nontail] + ;; + + let symmetric_diff = Enum.symmetric_diff + + let rec fold s ~init:accu ~f = + match s with + | Empty -> accu + | Leaf { elt = v } -> f accu v + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + fold ~f r ~init:(f (fold ~f l ~init:accu) v) + ;; + + let hash_fold_t_ignoring_structure hash_fold_elem state t = + fold t ~init:(hash_fold_int state (length t)) ~f:hash_fold_elem + ;; + + let count t ~f = Container.count ~fold t ~f + let sum m t ~f = Container.sum ~fold m t ~f + + let rec fold_right s ~init:accu ~f = + match s with + | Empty -> accu + | Leaf { elt = v } -> f v accu + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + fold_right ~f l ~init:(f v (fold_right ~f r ~init:accu)) + ;; + + let rec for_all t ~f:p = + match t with + | Empty -> true + | Leaf { elt = v } -> p v + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + p v && for_all ~f:p l && for_all ~f:p r + ;; + + let rec exists t ~f:p = + match t with + | Empty -> false + | Leaf { elt = v } -> p v + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + p v || exists ~f:p l || exists ~f:p r + ;; + + let filter s ~f:p = + let rec filt = function + | Empty -> Empty + | Leaf { elt = v } as t -> if p v then t else Empty + | Node { left = l; elt = v; right = r; height = _; size = _ } as t -> + let l' = filt l in + let keep_v = p v in + let r' = filt r in + if keep_v && phys_equal l l' && phys_equal r r' + then t + else if keep_v + then join l' v r' + else concat l' r' + in + filt s [@nontail] + ;; + + let filter_map s ~f:p ~compare_elt = + let rec filt accu = function + | Empty -> accu + | Leaf { elt = v } -> + (match p v with + | None -> accu + | Some v -> add accu v ~compare_elt) + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + filt + (filt + (match p v with + | None -> accu + | Some v -> add accu v ~compare_elt) + l) + r + in + filt Empty s [@nontail] + ;; + + let partition_tf s ~f:p = + let rec loop = function + | Empty -> Empty, Empty + | Leaf { elt = v } as t -> if p v then t, Empty else Empty, t + | Node { left = l; elt = v; right = r; height = _; size = _ } as t -> + let l't, l'f = loop l in + let keep_v_t = p v in + let r't, r'f = loop r in + let mk keep_v l' r' = + if keep_v && phys_equal l l' && phys_equal r r' + then t + else if keep_v + then join l' v r' + else concat l' r' + in + mk keep_v_t l't r't, mk (not keep_v_t) l'f r'f + in + loop s [@nontail] + ;; + + let rec elements_aux accu = function + | Empty -> accu + | Leaf { elt = v } -> v :: accu + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + elements_aux (v :: elements_aux accu r) l + ;; + + let elements s = elements_aux [] s + + let choose t = + match t with + | Empty -> None + | Leaf { elt = v } -> Some v + | Node { left = _; elt = v; right = _; height = _; size = _ } -> Some v + ;; + + let choose_exn = + let not_found = Not_found_s (Atom "Set.choose_exn: empty set") in + let choose_exn t = + match choose t with + | None -> raise not_found + | Some v -> v + in + (* named to preserve symbol in compiled binary *) + choose_exn + ;; + + let of_list lst ~compare_elt = + List.fold lst ~init:empty ~f:(fun t x -> add t x ~compare_elt) + ;; + + let of_sequence sequence ~compare_elt = + Sequence.fold sequence ~init:empty ~f:(fun t x -> add t x ~compare_elt) + ;; + + let to_list s = elements s + + let of_array a ~compare_elt = + Array.fold a ~init:empty ~f:(fun t x -> add t x ~compare_elt) + ;; + + (* faster but equivalent to [Array.of_list (to_list t)] *) + let to_array = function + | Empty -> [||] + | Leaf { elt = v } -> [| v |] + | Node { left = l; elt = v; right = r; height = _; size = s } -> + let res = Array.create ~len:s v in + let pos_ref = ref 0 in + let rec loop = function + (* Invariant: on entry and on exit to [loop], !pos_ref is the next + available cell in the array. *) + | Empty -> () + | Leaf { elt = v } -> + res.(!pos_ref) <- v; + incr pos_ref + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + loop l; + res.(!pos_ref) <- v; + incr pos_ref; + loop r + in + loop l; + (* res.(!pos_ref) is already initialized (by Array.create ~len:above). *) + incr pos_ref; + loop r; + res + ;; + + let map t ~f ~compare_elt = + fold t ~init:empty ~f:(fun t x -> add t (f x) ~compare_elt) [@nontail] + ;; + + let group_by set ~equiv = + let rec loop set equiv_classes = + if is_empty set + then equiv_classes + else ( + let x = choose_exn set in + let equiv_x, not_equiv_x = + partition_tf set ~f:(fun elt -> phys_equal x elt || equiv x elt) + in + loop not_equiv_x (equiv_x :: equiv_classes)) + in + loop set [] [@nontail] + ;; + + let rec find t ~f = + match t with + | Empty -> None + | Leaf { elt = v } -> if f v then Some v else None + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + if f v + then Some v + else ( + match find l ~f with + | None -> find r ~f + | Some _ as r -> r) + ;; + + let rec find_map t ~f = + match t with + | Empty -> None + | Leaf { elt = v } -> f v + | Node { left = l; elt = v; right = r; height = _; size = _ } -> + (match f v with + | Some _ as r -> r + | None -> + (match find_map l ~f with + | None -> find_map r ~f + | Some _ as r -> r)) + ;; + + let find_exn t ~f = + match find t ~f with + | None -> failwith "Set.find_exn failed to find a matching element" + | Some e -> e + ;; + + let rec nth t i = + match t with + | Empty -> None + | Leaf { elt = v } -> if i = 0 then Some v else None + | Node { left = l; elt = v; right = r; height = _; size = s } -> + if i >= s + then None + else ( + let l_size = length l in + let c = Poly.compare i l_size in + if c < 0 then nth l i else if c = 0 then Some v else nth r (i - l_size - 1)) + ;; + + let stable_dedup_list xs ~compare_elt = + let rec loop xs leftovers already_seen = + match xs with + | [] -> List.rev leftovers + | hd :: tl -> + if mem already_seen hd ~compare_elt + then loop tl leftovers already_seen + else loop tl (hd :: leftovers) (add already_seen hd ~compare_elt) + in + loop xs [] empty + ;; + + let t_of_sexp_direct a_of_sexp sexp ~compare_elt = + match sexp with + | Sexp.List lst -> + let elt_lst = List.map lst ~f:a_of_sexp in + let set = of_list elt_lst ~compare_elt in + if length set = List.length lst + then set + else ( + let set = ref empty in + List.iter2_exn lst elt_lst ~f:(fun el_sexp el -> + if mem !set el ~compare_elt + then of_sexp_error "Set.t_of_sexp: duplicate element in set" el_sexp + else set := add !set el ~compare_elt); + assert false) + | sexp -> of_sexp_error "Set.t_of_sexp: list needed" sexp + ;; + + let sexp_of_t sexp_of_a t = + Sexp.List (fold_right t ~init:[] ~f:(fun el acc -> sexp_of_a el :: acc)) + ;; + + module Named = struct + let is_subset + (subset : _ Named.t) + ~of_:(superset : _ Named.t) + ~sexp_of_elt + ~compare_elt + = + let invalid_elements = diff subset.set superset.set ~compare_elt in + if is_empty invalid_elements + then Ok () + else ( + let invalid_elements_sexp = sexp_of_t sexp_of_elt invalid_elements in + Or_error.error_s + (Sexp.message + (subset.name ^ " is not a subset of " ^ superset.name) + [ "invalid_elements", invalid_elements_sexp ])) + ;; + + let equal s1 s2 ~sexp_of_elt ~compare_elt = + Or_error.combine_errors_unit + [ is_subset s1 ~of_:s2 ~sexp_of_elt ~compare_elt + ; is_subset s2 ~of_:s1 ~sexp_of_elt ~compare_elt + ] + ;; + end +end + +type ('a, 'comparator) t = + { (* [comparator] is the first field so that polymorphic equality fails on a map due + to the functional value in the comparator. + Note that this does not affect polymorphic [compare]: that still produces + nonsense. *) + comparator : ('a, 'comparator) Comparator.t + ; tree : 'a Tree0.t + } + +type ('a, 'comparator) tree = 'a Tree0.t + +let like { tree = _; comparator } tree = { tree; comparator } + +let like_maybe_no_op ({ tree = old_tree; comparator } as old_t) tree = + if phys_equal old_tree tree then old_t else { tree; comparator } +;; + +let compare_elt t = t.comparator.Comparator.compare + +module Accessors = struct + let comparator t = t.comparator + let comparator_s t = Comparator.to_module t.comparator + let invariants t = Tree0.invariants t.tree ~compare_elt:(compare_elt t) + let length t = Tree0.length t.tree + let is_empty t = Tree0.is_empty t.tree + let elements t = Tree0.elements t.tree + let min_elt t = Tree0.min_elt t.tree + let min_elt_exn t = Tree0.min_elt_exn t.tree + let max_elt t = Tree0.max_elt t.tree + let max_elt_exn t = Tree0.max_elt_exn t.tree + let choose t = Tree0.choose t.tree + let choose_exn t = Tree0.choose_exn t.tree + let to_list t = Tree0.to_list t.tree + let to_array t = Tree0.to_array t.tree + let fold t ~init ~f = Tree0.fold t.tree ~init ~f + let fold_until t ~init ~f ~finish = Tree0.fold_until t.tree ~init ~f ~finish + let fold_right t ~init ~f = Tree0.fold_right t.tree ~init ~f + let fold_result t ~init ~f = Container.fold_result ~fold ~init ~f t + let iter t ~f = Tree0.iter t.tree ~f + let iter2 a b ~f = Tree0.iter2 a.tree b.tree ~f ~compare_elt:(compare_elt a) + let exists t ~f = Tree0.exists t.tree ~f + let for_all t ~f = Tree0.for_all t.tree ~f + let count t ~f = Tree0.count t.tree ~f + let sum m t ~f = Tree0.sum m t.tree ~f + let find t ~f = Tree0.find t.tree ~f + let find_exn t ~f = Tree0.find_exn t.tree ~f + let find_map t ~f = Tree0.find_map t.tree ~f + let mem t a = Tree0.mem t.tree a ~compare_elt:(compare_elt t) + let filter t ~f = like_maybe_no_op t (Tree0.filter t.tree ~f) + let add t a = like t (Tree0.add t.tree a ~compare_elt:(compare_elt t)) + let remove t a = like t (Tree0.remove t.tree a ~compare_elt:(compare_elt t)) + let union t1 t2 = like t1 (Tree0.union t1.tree t2.tree ~compare_elt:(compare_elt t1)) + let inter t1 t2 = like t1 (Tree0.inter t1.tree t2.tree ~compare_elt:(compare_elt t1)) + let diff t1 t2 = like t1 (Tree0.diff t1.tree t2.tree ~compare_elt:(compare_elt t1)) + + let symmetric_diff t1 t2 = + Tree0.symmetric_diff t1.tree t2.tree ~compare_elt:(compare_elt t1) + ;; + + let compare_direct t1 t2 = Tree0.compare (compare_elt t1) t1.tree t2.tree + let equal t1 t2 = Tree0.equal t1.tree t2.tree ~compare_elt:(compare_elt t1) + let is_subset t ~of_ = Tree0.is_subset t.tree ~of_:of_.tree ~compare_elt:(compare_elt t) + + let are_disjoint t1 t2 = + Tree0.are_disjoint t1.tree t2.tree ~compare_elt:(compare_elt t1) + ;; + + module Named = struct + let to_named_tree (named : (_, _) t Named.t) = { named with set = named.set.tree } + + let is_subset subset ~of_:superset = + Tree0.Named.is_subset + (to_named_tree subset) + ~of_:(to_named_tree superset) + ~compare_elt:(compare_elt subset.set) + ~sexp_of_elt:subset.set.comparator.sexp_of_t + ;; + + let equal t1 t2 = + Or_error.combine_errors_unit [ is_subset t1 ~of_:t2; is_subset t2 ~of_:t1 ] + ;; + + include Named + end + + let partition_tf t ~f = + let tree_t, tree_f = Tree0.partition_tf t.tree ~f in + like_maybe_no_op t tree_t, like_maybe_no_op t tree_f + ;; + + let split t a = + let tree1, b, tree2 = Tree0.split t.tree a ~compare_elt:(compare_elt t) in + like t tree1, b, like t tree2 + ;; + + let split_le_gt t a = + let tree1, tree2 = Tree0.split_le_gt t.tree a ~compare_elt:(compare_elt t) in + like t tree1, like t tree2 + ;; + + let split_lt_ge t a = + let tree1, tree2 = Tree0.split_lt_ge t.tree a ~compare_elt:(compare_elt t) in + like t tree1, like t tree2 + ;; + + let group_by t ~equiv = List.map (Tree0.group_by t.tree ~equiv) ~f:(like t) + let nth t i = Tree0.nth t.tree i + let remove_index t i = like t (Tree0.remove_index t.tree i ~compare_elt:(compare_elt t)) + let sexp_of_t sexp_of_a _ t = Tree0.sexp_of_t sexp_of_a t.tree + + let to_sequence ?order ?greater_or_equal_to ?less_or_equal_to t = + Tree0.to_sequence t.comparator ?order ?greater_or_equal_to ?less_or_equal_to t.tree + ;; + + let binary_search t ~compare how v = Tree0.binary_search t.tree ~compare how v + + let binary_search_segmented t ~segment_of how = + Tree0.binary_search_segmented t.tree ~segment_of how + ;; + + let merge_to_sequence ?order ?greater_or_equal_to ?less_or_equal_to t t' = + Tree0.merge_to_sequence + t.comparator + ?order + ?greater_or_equal_to + ?less_or_equal_to + t.tree + t'.tree + ;; + + let hash_fold_direct hash_fold_key state t = + Tree0.hash_fold_t_ignoring_structure hash_fold_key state t.tree + ;; +end + +include Accessors + +let compare _ _ t1 t2 = compare_direct t1 t2 + +module Tree = struct + type ('a, 'comparator) t = ('a, 'comparator) tree + + let ce comparator = comparator.Comparator.compare + + let t_of_sexp_direct ~comparator a_of_sexp sexp = + Tree0.t_of_sexp_direct ~compare_elt:(ce comparator) a_of_sexp sexp + ;; + + let empty_without_value_restriction = Tree0.empty + let empty ~comparator:_ = empty_without_value_restriction + let singleton ~comparator:_ e = Tree0.singleton e + let length t = Tree0.length t + let invariants ~comparator t = Tree0.invariants t ~compare_elt:(ce comparator) + let is_empty t = Tree0.is_empty t + let elements t = Tree0.elements t + let min_elt t = Tree0.min_elt t + let min_elt_exn t = Tree0.min_elt_exn t + let max_elt t = Tree0.max_elt t + let max_elt_exn t = Tree0.max_elt_exn t + let choose t = Tree0.choose t + let choose_exn t = Tree0.choose_exn t + let to_list t = Tree0.to_list t + let to_array t = Tree0.to_array t + let iter t ~f = Tree0.iter t ~f + let exists t ~f = Tree0.exists t ~f + let for_all t ~f = Tree0.for_all t ~f + let count t ~f = Tree0.count t ~f + let sum m t ~f = Tree0.sum m t ~f + let find t ~f = Tree0.find t ~f + let find_exn t ~f = Tree0.find_exn t ~f + let find_map t ~f = Tree0.find_map t ~f + let fold t ~init ~f = Tree0.fold t ~init ~f + let fold_until t ~init ~f ~finish = Tree0.fold_until t ~init ~f ~finish + let fold_right t ~init ~f = Tree0.fold_right t ~init ~f + let map ~comparator t ~f = Tree0.map t ~f ~compare_elt:(ce comparator) + let filter t ~f = Tree0.filter t ~f + let filter_map ~comparator t ~f = Tree0.filter_map t ~f ~compare_elt:(ce comparator) + let partition_tf t ~f = Tree0.partition_tf t ~f + let iter2 ~comparator a b ~f = Tree0.iter2 a b ~f ~compare_elt:(ce comparator) + let mem ~comparator t a = Tree0.mem t a ~compare_elt:(ce comparator) + let add ~comparator t a = Tree0.add t a ~compare_elt:(ce comparator) + let remove ~comparator t a = Tree0.remove t a ~compare_elt:(ce comparator) + let union ~comparator t1 t2 = Tree0.union t1 t2 ~compare_elt:(ce comparator) + let inter ~comparator t1 t2 = Tree0.inter t1 t2 ~compare_elt:(ce comparator) + let diff ~comparator t1 t2 = Tree0.diff t1 t2 ~compare_elt:(ce comparator) + + let symmetric_diff ~comparator t1 t2 = + Tree0.symmetric_diff t1 t2 ~compare_elt:(ce comparator) + ;; + + let compare_direct ~comparator t1 t2 = Tree0.compare (ce comparator) t1 t2 + let equal ~comparator t1 t2 = Tree0.equal t1 t2 ~compare_elt:(ce comparator) + let is_subset ~comparator t ~of_ = Tree0.is_subset t ~of_ ~compare_elt:(ce comparator) + + let are_disjoint ~comparator t1 t2 = + Tree0.are_disjoint t1 t2 ~compare_elt:(ce comparator) + ;; + + let of_list ~comparator l = Tree0.of_list l ~compare_elt:(ce comparator) + let of_sequence ~comparator s = Tree0.of_sequence s ~compare_elt:(ce comparator) + let of_array ~comparator a = Tree0.of_array a ~compare_elt:(ce comparator) + + let of_sorted_array_unchecked ~comparator a = + Tree0.of_sorted_array_unchecked a ~compare_elt:(ce comparator) + ;; + + let of_increasing_iterator_unchecked ~comparator:_ ~len ~f = + Tree0.of_increasing_iterator_unchecked ~len ~f + ;; + + let of_sorted_array ~comparator a = Tree0.of_sorted_array a ~compare_elt:(ce comparator) + let union_list ~comparator l = Tree0.union_list l ~to_tree:Fn.id ~comparator + + let stable_dedup_list ~comparator xs = + Tree0.stable_dedup_list xs ~compare_elt:(ce comparator) + ;; + + let group_by t ~equiv = Tree0.group_by t ~equiv + let split ~comparator t a = Tree0.split t a ~compare_elt:(ce comparator) + let split_le_gt ~comparator t a = Tree0.split_le_gt t a ~compare_elt:(ce comparator) + let split_lt_ge ~comparator t a = Tree0.split_lt_ge t a ~compare_elt:(ce comparator) + let nth t i = Tree0.nth t i + let remove_index ~comparator t i = Tree0.remove_index t i ~compare_elt:(ce comparator) + let sexp_of_t sexp_of_a _ t = Tree0.sexp_of_t sexp_of_a t + let to_tree t = t + let of_tree ~comparator:_ t = t + + let to_sequence ~comparator ?order ?greater_or_equal_to ?less_or_equal_to t = + Tree0.to_sequence comparator ?order ?greater_or_equal_to ?less_or_equal_to t + ;; + + let binary_search ~comparator:_ t ~compare how v = Tree0.binary_search t ~compare how v + + let binary_search_segmented ~comparator:_ t ~segment_of how = + Tree0.binary_search_segmented t ~segment_of how + ;; + + let merge_to_sequence ~comparator ?order ?greater_or_equal_to ?less_or_equal_to t t' = + Tree0.merge_to_sequence comparator ?order ?greater_or_equal_to ?less_or_equal_to t t' + ;; + + let fold_result t ~init ~f = Container.fold_result ~fold ~init ~f t + + module Named = struct + include Tree0.Named + + let is_subset ~comparator t1 ~of_:t2 = + Tree0.Named.is_subset + t1 + ~of_:t2 + ~compare_elt:(ce comparator) + ~sexp_of_elt:comparator.Comparator.sexp_of_t + ;; + + let equal ~comparator t1 t2 = + Tree0.Named.equal + t1 + t2 + ~compare_elt:(ce comparator) + ~sexp_of_elt:comparator.Comparator.sexp_of_t + ;; + end +end + +module Using_comparator = struct + type nonrec ('elt, 'cmp) t = ('elt, 'cmp) t + + include Accessors + + let to_tree t = t.tree + let of_tree ~comparator tree = { comparator; tree } + + let t_of_sexp_direct ~comparator a_of_sexp sexp = + of_tree + ~comparator + (Tree0.t_of_sexp_direct ~compare_elt:comparator.compare a_of_sexp sexp) + ;; + + let empty ~comparator = { comparator; tree = Tree0.empty } + + module Empty_without_value_restriction (Elt : Comparator.S1) = struct + let empty = { comparator = Elt.comparator; tree = Tree0.empty } + end + + let singleton ~comparator e = { comparator; tree = Tree0.singleton e } + + let union_list ~comparator l = + of_tree ~comparator (Tree0.union_list ~comparator ~to_tree l) + ;; + + let of_sorted_array_unchecked ~comparator array = + let tree = + Tree0.of_sorted_array_unchecked array ~compare_elt:comparator.Comparator.compare + in + { comparator; tree } + ;; + + let of_increasing_iterator_unchecked ~comparator ~len ~f = + of_tree ~comparator (Tree0.of_increasing_iterator_unchecked ~len ~f) + ;; + + let of_sorted_array ~comparator array = + Or_error.Monad_infix.( + Tree0.of_sorted_array array ~compare_elt:comparator.Comparator.compare + >>| fun tree -> { comparator; tree }) + ;; + + let of_list ~comparator l = + { comparator; tree = Tree0.of_list l ~compare_elt:comparator.Comparator.compare } + ;; + + let of_sequence ~comparator s = + { comparator; tree = Tree0.of_sequence s ~compare_elt:comparator.Comparator.compare } + ;; + + let of_array ~comparator a = + { comparator; tree = Tree0.of_array a ~compare_elt:comparator.Comparator.compare } + ;; + + let stable_dedup_list ~comparator xs = + Tree0.stable_dedup_list xs ~compare_elt:comparator.Comparator.compare + ;; + + let map ~comparator t ~f = + { comparator; tree = Tree0.map t.tree ~f ~compare_elt:comparator.Comparator.compare } + ;; + + let filter_map ~comparator t ~f = + { comparator + ; tree = Tree0.filter_map t.tree ~f ~compare_elt:comparator.Comparator.compare + } + ;; + + module Tree = Tree +end + +let to_comparator = Comparator.of_module +let empty m = Using_comparator.empty ~comparator:(to_comparator m) +let singleton m a = Using_comparator.singleton ~comparator:(to_comparator m) a +let union_list m a = Using_comparator.union_list ~comparator:(to_comparator m) a + +let of_sorted_array_unchecked m a = + Using_comparator.of_sorted_array_unchecked ~comparator:(to_comparator m) a +;; + +let of_increasing_iterator_unchecked m ~len ~f = + Using_comparator.of_increasing_iterator_unchecked ~comparator:(to_comparator m) ~len ~f +;; + +let of_sorted_array m a = Using_comparator.of_sorted_array ~comparator:(to_comparator m) a +let of_list m a = Using_comparator.of_list ~comparator:(to_comparator m) a +let of_sequence m a = Using_comparator.of_sequence ~comparator:(to_comparator m) a +let of_array m a = Using_comparator.of_array ~comparator:(to_comparator m) a + +let stable_dedup_list m a = + Using_comparator.stable_dedup_list ~comparator:(to_comparator m) a +;; + +let map m a ~f = Using_comparator.map ~comparator:(to_comparator m) a ~f +let filter_map m a ~f = Using_comparator.filter_map ~comparator:(to_comparator m) a ~f +let to_tree = Using_comparator.to_tree +let of_tree m t = Using_comparator.of_tree ~comparator:(to_comparator m) t + +module M (Elt : sig + type t + type comparator_witness +end) = +struct + type nonrec t = (Elt.t, Elt.comparator_witness) t +end + +module type Sexp_of_m = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end + +module type M_of_sexp = sig + type t [@@deriving_inline of_sexp] + + val t_of_sexp : Sexplib0.Sexp.t -> t + + [@@@end] + + include Comparator.S with type t := t +end + +module type M_sexp_grammar = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] +end + +module type Compare_m = sig end +module type Equal_m = sig end +module type Hash_fold_m = Hasher.S + +let sexp_of_m__t (type elt) (module Elt : Sexp_of_m with type t = elt) t = + sexp_of_t Elt.sexp_of_t (fun _ -> Sexp.Atom "_") t +;; + +let m__t_of_sexp + (type elt cmp) + (module Elt : M_of_sexp with type t = elt and type comparator_witness = cmp) + sexp + = + Using_comparator.t_of_sexp_direct ~comparator:Elt.comparator Elt.t_of_sexp sexp +;; + +let m__t_sexp_grammar (type elt) (module Elt : M_sexp_grammar with type t = elt) + : (elt, _) t Sexplib0.Sexp_grammar.t + = + Sexplib0.Sexp_grammar.coerce (list_sexp_grammar Elt.t_sexp_grammar) +;; + +let compare_m__t (module _ : Compare_m) t1 t2 = compare_direct t1 t2 +let equal_m__t (module _ : Equal_m) t1 t2 = equal t1 t2 + +let hash_fold_m__t (type elt) (module Elt : Hash_fold_m with type t = elt) state = + hash_fold_direct Elt.hash_fold_t state +;; + +let hash_m__t folder t = + let state = hash_fold_m__t folder (Hash.create ()) t in + Hash.get_hash_value state +;; + +module Poly = struct + type comparator_witness = Comparator.Poly.comparator_witness + type nonrec 'elt t = ('elt, comparator_witness) t + + include Accessors + + let comparator = Comparator.Poly.comparator + + include Using_comparator.Empty_without_value_restriction (Comparator.Poly) + + let singleton a = Using_comparator.singleton ~comparator a + let union_list a = Using_comparator.union_list ~comparator a + + let of_sorted_array_unchecked a = + Using_comparator.of_sorted_array_unchecked ~comparator a + ;; + + let of_increasing_iterator_unchecked ~len ~f = + Using_comparator.of_increasing_iterator_unchecked ~comparator ~len ~f + ;; + + let of_sorted_array a = Using_comparator.of_sorted_array ~comparator a + let of_list a = Using_comparator.of_list ~comparator a + let of_sequence a = Using_comparator.of_sequence ~comparator a + let of_array a = Using_comparator.of_array ~comparator a + let stable_dedup_list a = Using_comparator.stable_dedup_list ~comparator a + let map a ~f = Using_comparator.map ~comparator a ~f + let filter_map a ~f = Using_comparator.filter_map ~comparator a ~f + let of_tree tree = { comparator; tree } + let to_tree t = t.tree +end diff --git a/unikernel/duniverse/base/src/set.mli b/unikernel/duniverse/base/src/set.mli new file mode 100644 index 00000000..5b64bbd7 --- /dev/null +++ b/unikernel/duniverse/base/src/set.mli @@ -0,0 +1 @@ +include Set_intf.Set (** @inline *) diff --git a/unikernel/duniverse/base/src/set_intf.ml b/unikernel/duniverse/base/src/set_intf.ml new file mode 100644 index 00000000..14805549 --- /dev/null +++ b/unikernel/duniverse/base/src/set_intf.ml @@ -0,0 +1,840 @@ +open! Import +open! T + +module type Elt_plain = sig + type t [@@deriving_inline compare, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] +end + +module Without_comparator = Map_intf.Without_comparator +module With_comparator = Map_intf.With_comparator +module With_first_class_module = Map_intf.With_first_class_module +module Merge_to_sequence_element = Sequence.Merge_with_duplicates_element + +module Named = struct + type 'a t = + { set : 'a + ; name : string + } +end + +module type Accessors_generic = sig + type ('a, 'cmp) t + + include Container.Generic with type ('a, 'cmp, _) t := ('a, 'cmp) t + + type ('a, 'cmp) tree + + (** The [access_options] type is used to make [Accessors_generic] flexible as to whether + a comparator is required to be passed to certain functions. *) + type ('a, 'cmp, 'z) access_options + + type 'cmp cmp + + val invariants : ('a, 'cmp, ('a, 'cmp) t -> bool) access_options + + (** override [Container]'s [mem] *) + val mem : ('a, 'cmp, ('a, 'cmp) t -> 'a elt -> bool) access_options + + val add : ('a, 'cmp, ('a, 'cmp) t -> 'a elt -> ('a, 'cmp) t) access_options + val remove : ('a, 'cmp, ('a, 'cmp) t -> 'a elt -> ('a, 'cmp) t) access_options + val union : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> ('a, 'cmp) t) access_options + val inter : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> ('a, 'cmp) t) access_options + val diff : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> ('a, 'cmp) t) access_options + + val symmetric_diff + : ( 'a + , 'cmp + , ('a, 'cmp) t -> ('a, 'cmp) t -> ('a elt, 'a elt) Either.t Sequence.t ) + access_options + + val compare_direct : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> int) access_options + val equal : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> bool) access_options + val is_subset : ('a, 'cmp, ('a, 'cmp) t -> of_:('a, 'cmp) t -> bool) access_options + val are_disjoint : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> bool) access_options + + module Named : sig + val is_subset + : ( 'a + , 'cmp + , ('a, 'cmp) t Named.t -> of_:('a, 'cmp) t Named.t -> unit Or_error.t ) + access_options + + val equal + : ( 'a + , 'cmp + , ('a, 'cmp) t Named.t -> ('a, 'cmp) t Named.t -> unit Or_error.t ) + access_options + end + + val fold_until + : ('a, _) t + -> init:'acc + -> f:('acc -> 'a elt -> ('acc, 'final) Container.Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + val fold_right : ('a, _) t -> init:'acc -> f:('a elt -> 'acc -> 'acc) -> 'acc + + val iter2 + : ( 'a + , 'cmp + , ('a, 'cmp) t + -> ('a, 'cmp) t + -> f:([ `Left of 'a elt | `Right of 'a elt | `Both of 'a elt * 'a elt ] -> unit) + -> unit ) + access_options + + val filter : ('a, 'cmp) t -> f:('a elt -> bool) -> ('a, 'cmp) t + val partition_tf : ('a, 'cmp) t -> f:('a elt -> bool) -> ('a, 'cmp) t * ('a, 'cmp) t + val elements : ('a, _) t -> 'a elt list + val min_elt : ('a, _) t -> 'a elt option + val min_elt_exn : ('a, _) t -> 'a elt + val max_elt : ('a, _) t -> 'a elt option + val max_elt_exn : ('a, _) t -> 'a elt + val choose : ('a, _) t -> 'a elt option + val choose_exn : ('a, _) t -> 'a elt + + val split + : ( 'a + , 'cmp + , ('a, 'cmp) t -> 'a elt -> ('a, 'cmp) t * 'a elt option * ('a, 'cmp) t ) + access_options + + val split_le_gt + : ('a, 'cmp, ('a, 'cmp) t -> 'a elt -> ('a, 'cmp) t * ('a, 'cmp) t) access_options + + val split_lt_ge + : ('a, 'cmp, ('a, 'cmp) t -> 'a elt -> ('a, 'cmp) t * ('a, 'cmp) t) access_options + + val group_by : ('a, 'cmp) t -> equiv:('a elt -> 'a elt -> bool) -> ('a, 'cmp) t list + val find_exn : ('a, _) t -> f:('a elt -> bool) -> 'a elt + val nth : ('a, _) t -> int -> 'a elt option + val remove_index : ('a, 'cmp, ('a, 'cmp) t -> int -> ('a, 'cmp) t) access_options + val to_tree : ('a, 'cmp) t -> ('a, 'cmp) tree + + val to_sequence + : ( 'a + , 'cmp + , ?order:[ `Increasing | `Decreasing ] + -> ?greater_or_equal_to:'a elt + -> ?less_or_equal_to:'a elt + -> ('a, 'cmp) t + -> 'a elt Sequence.t ) + access_options + + val binary_search + : ( 'a + , 'cmp + , ('a, 'cmp) t + -> compare:('a elt -> 'key -> int) + -> Binary_searchable.Which_target_by_key.t + -> 'key + -> 'a elt option ) + access_options + + val binary_search_segmented + : ( 'a + , 'cmp + , ('a, 'cmp) t + -> segment_of:('a elt -> [ `Left | `Right ]) + -> Binary_searchable.Which_target_by_segment.t + -> 'a elt option ) + access_options + + val merge_to_sequence + : ( 'a + , 'cmp + , ?order:[ `Increasing | `Decreasing ] + -> ?greater_or_equal_to:'a elt + -> ?less_or_equal_to:'a elt + -> ('a, 'cmp) t + -> ('a, 'cmp) t + -> ('a elt, 'a elt) Merge_to_sequence_element.t Sequence.t ) + access_options +end + +module type Creators_generic = sig + type ('a, 'cmp) t + type ('a, 'cmp) set + type ('a, 'cmp) tree + type 'a elt + type ('a, 'cmp, 'z) create_options + type 'cmp cmp + + val empty : ('a, 'cmp, ('a, 'cmp) t) create_options + val singleton : ('a, 'cmp, 'a elt -> ('a, 'cmp) t) create_options + val union_list : ('a, 'cmp, ('a, 'cmp) t list -> ('a, 'cmp) t) create_options + val of_list : ('a, 'cmp, 'a elt list -> ('a, 'cmp) t) create_options + val of_sequence : ('a, 'cmp, 'a elt Sequence.t -> ('a, 'cmp) t) create_options + val of_array : ('a, 'cmp, 'a elt array -> ('a, 'cmp) t) create_options + val of_sorted_array : ('a, 'cmp, 'a elt array -> ('a, 'cmp) t Or_error.t) create_options + val of_sorted_array_unchecked : ('a, 'cmp, 'a elt array -> ('a, 'cmp) t) create_options + + val of_increasing_iterator_unchecked + : ('a, 'cmp, len:int -> f:(int -> 'a elt) -> ('a, 'cmp) t) create_options + + val stable_dedup_list : ('a, _, 'a elt list -> 'a elt list) create_options + [@@deprecated "[since 2023-04] Use [List.stable_dedup] instead."] + + (** The types of [map] and [filter_map] are subtle. The input set, [('a, _) set], + reflects the fact that these functions take a set of *any* type, with any + comparator, while the output set, [('b, 'cmp) t], reflects that the output set has + the particular ['cmp] of the creation function. The comparator can come in one of + three ways, depending on which set module is used + + - [Set.map] -- comparator comes as an argument + - [Set.Poly.map] -- comparator is polymorphic comparison + - [Foo.Set.map] -- comparator is [Foo.comparator] *) + val map : ('b, 'cmp, ('a, _) set -> f:('a -> 'b elt) -> ('b, 'cmp) t) create_options + + val filter_map + : ('b, 'cmp, ('a, _) set -> f:('a -> 'b elt option) -> ('b, 'cmp) t) create_options + + val of_tree : ('a, 'cmp, ('a, 'cmp) tree -> ('a, 'cmp) t) create_options +end + +module type Creators_and_accessors_generic = sig + type ('elt, 'cmp) set + type ('elt, 'cmp) t + type ('elt, 'cmp) tree + type 'elt elt + type 'cmp cmp + + include + Accessors_generic + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) tree + with type 'a elt := 'a elt + with type 'cmp cmp := 'cmp cmp + + include + Creators_generic + with type ('a, 'b) set := ('a, 'b) set + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) tree + with type 'a elt := 'a elt + with type 'cmp cmp := 'cmp cmp +end + +module type S_poly = sig + type ('elt, 'cmp) set + type 'elt t + type 'elt tree + type comparator_witness + + include + Creators_and_accessors_generic + with type ('elt, 'cmp) set := ('elt, 'cmp) set + with type ('elt, 'cmp) t := 'elt t + with type ('elt, 'cmp) tree := 'elt tree + with type 'a elt := 'a + with type 'c cmp := comparator_witness + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t +end + +module type For_deriving = sig + type ('a, 'b) t + + module type Sexp_of_m = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + end + + module type M_of_sexp = sig + type t [@@deriving_inline of_sexp] + + val t_of_sexp : Sexplib0.Sexp.t -> t + + [@@@end] + + include Comparator.S with type t := t + end + + module type M_sexp_grammar = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + end + + module type Compare_m = sig end + module type Equal_m = sig end + module type Hash_fold_m = Hasher.S + + val sexp_of_m__t : (module Sexp_of_m with type t = 'elt) -> ('elt, 'cmp) t -> Sexp.t + + val m__t_of_sexp + : (module M_of_sexp with type t = 'elt and type comparator_witness = 'cmp) + -> Sexp.t + -> ('elt, 'cmp) t + + val m__t_sexp_grammar + : (module M_sexp_grammar with type t = 'elt) + -> ('elt, 'cmp) t Sexplib0.Sexp_grammar.t + + val compare_m__t : (module Compare_m) -> ('elt, 'cmp) t -> ('elt, 'cmp) t -> int + val equal_m__t : (module Equal_m) -> ('elt, 'cmp) t -> ('elt, 'cmp) t -> bool + + val hash_fold_m__t + : (module Hash_fold_m with type t = 'elt) + -> Hash.state + -> ('elt, _) t + -> Hash.state + + val hash_m__t : (module Hash_fold_m with type t = 'elt) -> ('elt, _) t -> int +end + +module type Set = sig + (** Sets based on {!Comparator.S}. + + Creators require a comparator argument to be passed in, whereas accessors use the + comparator provided by the input set. *) + + (** The type of a set. The first type parameter identifies the type of the element, and + the second identifies the comparator, which determines the comparison function that + is used for ordering elements in this set. Many operations (e.g., {!union}), + require that they be passed sets with the same element type and the same comparator + type. *) + type (!'elt, !'cmp) t [@@deriving_inline compare] + + include Ppx_compare_lib.Comparable.S2 with type (!'elt, !'cmp) t := ('elt, 'cmp) t + + [@@@end] + + (** Tests internal invariants of the set data structure. Returns true on success. *) + val invariants : (_, _) t -> bool + + (** Returns a first-class module that can be used to build other map/set/etc + with the same notion of comparison. *) + val comparator_s : ('a, 'cmp) t -> ('a, 'cmp) Comparator.Module.t + + val comparator : ('a, 'cmp) t -> ('a, 'cmp) Comparator.t + + (** Creates an empty set based on the provided comparator. *) + val empty : ('a, 'cmp) Comparator.Module.t -> ('a, 'cmp) t + + (** Creates a set based on the provided comparator that contains only the provided + element. *) + val singleton : ('a, 'cmp) Comparator.Module.t -> 'a -> ('a, 'cmp) t + + (** Returns the cardinality of the set. [O(1)]. *) + val length : (_, _) t -> int + + (** [is_empty t] is [true] iff [t] is empty. [O(1)]. *) + val is_empty : (_, _) t -> bool + + (** [mem t a] returns [true] iff [a] is in [t]. [O(log n)]. *) + val mem : ('a, _) t -> 'a -> bool + + (** [add t a] returns a new set with [a] added to [t], or returns [t] if [mem t a]. + [O(log n)]. *) + val add : ('a, 'cmp) t -> 'a -> ('a, 'cmp) t + + (** [remove t a] returns a new set with [a] removed from [t] if [mem t a], or returns [t] + otherwise. [O(log n)]. *) + val remove : ('a, 'cmp) t -> 'a -> ('a, 'cmp) t + + (** [union t1 t2] returns the union of the two sets. [O(length t1 + length t2)]. *) + val union : ('a, 'cmp) t -> ('a, 'cmp) t -> ('a, 'cmp) t + + (** [union_list c list] returns the union of all the sets in [list]. The + [comparator] argument is required for the case where [list] is empty. + [O(max(List.length list, n log n))], where [n] is the sum of sizes of the input sets. *) + val union_list : ('a, 'cmp) Comparator.Module.t -> ('a, 'cmp) t list -> ('a, 'cmp) t + + (** [inter t1 t2] computes the intersection of sets [t1] and [t2]. [O(length t1 + + length t2)]. *) + val inter : ('a, 'cmp) t -> ('a, 'cmp) t -> ('a, 'cmp) t + + (** [diff t1 t2] computes the set difference [t1 - t2], i.e., the set containing all + elements in [t1] that are not in [t2]. [O(length t1 + length t2)]. *) + val diff : ('a, 'cmp) t -> ('a, 'cmp) t -> ('a, 'cmp) t + + (** [symmetric_diff t1 t2] returns a sequence of changes between [t1] and [t2]. It is + intended to be efficient in the case where [t1] and [t2] share a large amount of + structure. *) + val symmetric_diff : ('a, 'cmp) t -> ('a, 'cmp) t -> ('a, 'a) Either.t Sequence.t + + (** [compare_direct t1 t2] compares the sets [t1] and [t2]. It returns the same result + as [compare], but unlike compare, doesn't require arguments to be passed in for the + type parameters of the set. [O(length t1 + length t2)]. *) + val compare_direct : ('a, 'cmp) t -> ('a, 'cmp) t -> int + + (** Hash function: a building block to use when hashing data structures containing sets in + them. [hash_fold_direct hash_fold_key] is compatible with [compare_direct] iff + [hash_fold_key] is compatible with [(comparator s).compare] of the set [s] being + hashed. *) + val hash_fold_direct : 'a Hash.folder -> ('a, 'cmp) t Hash.folder + + (** [equal t1 t2] returns [true] iff the two sets have the same elements. [O(length t1 + + length t2)] *) + val equal : ('a, 'cmp) t -> ('a, 'cmp) t -> bool + + (** [exists t ~f] returns [true] iff there exists an [a] in [t] for which [f a]. [O(n)], + but returns as soon as it finds an [a] for which [f a]. *) + val exists : ('a, _) t -> f:('a -> bool) -> bool + + (** [for_all t ~f] returns [true] iff for all [a] in [t], [f a]. [O(n)], but returns as + soon as it finds an [a] for which [not (f a)]. *) + val for_all : ('a, _) t -> f:('a -> bool) -> bool + + (** [count t] returns the number of elements of [t] for which [f] returns [true]. + [O(n)]. *) + val count : ('a, _) t -> f:('a -> bool) -> int + + (** [sum t] returns the sum of [f t] for each [t] in the set. + [O(n)]. *) + val sum + : (module Container.Summable with type t = 'sum) + -> ('a, _) t + -> f:('a -> 'sum) + -> 'sum + + (** [find t f] returns an element of [t] for which [f] returns true, with no guarantee as + to which element is returned. [O(n)], but returns as soon as a suitable element is + found. *) + val find : ('a, _) t -> f:('a -> bool) -> 'a option + + (** [find_map t f] returns [b] for some [a] in [t] for which [f a = Some b]. If no such + [a] exists, then [find] returns [None]. [O(n)], but returns as soon as a suitable + element is found. *) + val find_map : ('a, _) t -> f:('a -> 'b option) -> 'b option + + (** Like [find], but throws an exception on failure. *) + val find_exn : ('a, _) t -> f:('a -> bool) -> 'a + + (** [nth t i] returns the [i]th smallest element of [t], in [O(log n)] time. The + smallest element has [i = 0]. Returns [None] if [i < 0] or [i >= length t]. *) + val nth : ('a, _) t -> int -> 'a option + + (** [remove_index t i] returns a version of [t] with the [i]th smallest element removed, + in [O(log n)] time. The smallest element has [i = 0]. Returns [t] if [i < 0] or + [i >= length t]. *) + val remove_index : ('a, 'cmp) t -> int -> ('a, 'cmp) t + + (** [is_subset t1 ~of_:t2] returns true iff [t1] is a subset of [t2]. *) + val is_subset : ('a, 'cmp) t -> of_:('a, 'cmp) t -> bool + + (** [are_disjoint t1 t2] returns [true] iff [is_empty (inter t1 t2)], but is more + efficient. *) + val are_disjoint : ('a, 'cmp) t -> ('a, 'cmp) t -> bool + + (** [Named] allows the validation of subset and equality relationships between sets. A + [Named.t] is a record of a set and a name, where the name is used in error messages, + and [Named.is_subset] and [Named.equal] validate subset and equality relationships + respectively. + + The error message for, e.g., + {[ + Named.is_subset { set = set1; name = "set1" } ~of_:{set = set2; name = "set2" } + ]} + + looks like + {v + ("set1 is not a subset of set2" (invalid_elements (...elements of set1 - set2...))) + v} + + so [name] should be a noun phrase that doesn't sound awkward in the above error + message. Even though it adds verbosity, choosing [name]s that start with the phrase + "the set of" often makes the error message sound more natural. + *) + module Named : sig + type ('a, 'cmp) set := ('a, 'cmp) t + + type 'a t = 'a Named.t = + { set : 'a + ; name : string + } + + (** [is_subset t1 ~of_:t2] returns [Ok ()] if [t1] is a subset of [t2] and a + human-readable error otherwise. *) + val is_subset : ('a, 'cmp) set t -> of_:('a, 'cmp) set t -> unit Or_error.t + + (** [equal t1 t2] returns [Ok ()] if [t1] is equal to [t2] and a human-readable + error otherwise. *) + val equal : ('a, 'cmp) set t -> ('a, 'cmp) set t -> unit Or_error.t + end + + (** The list or array given to [of_list] and [of_array] need not be sorted. *) + val of_list : ('a, 'cmp) Comparator.Module.t -> 'a list -> ('a, 'cmp) t + + val of_sequence : ('a, 'cmp) Comparator.Module.t -> 'a Sequence.t -> ('a, 'cmp) t + val of_array : ('a, 'cmp) Comparator.Module.t -> 'a array -> ('a, 'cmp) t + + (** [to_list] and [to_array] produce sequences sorted in ascending order according to the + comparator. *) + val to_list : ('a, _) t -> 'a list + + val to_array : ('a, _) t -> 'a array + + (** Create set from sorted array. The input must be sorted (either in ascending or + descending order as given by the comparator) and contain no duplicates, otherwise the + result is an error. The complexity of this function is [O(n)]. *) + val of_sorted_array + : ('a, 'cmp) Comparator.Module.t + -> 'a array + -> ('a, 'cmp) t Or_error.t + + (** Similar to [of_sorted_array], but without checking the input array. *) + val of_sorted_array_unchecked + : ('a, 'cmp) Comparator.Module.t + -> 'a array + -> ('a, 'cmp) t + + (** [of_increasing_iterator_unchecked c ~len ~f] behaves like [of_sorted_array_unchecked c + (Array.init len ~f)], with the additional restriction that a decreasing order is not + supported. The advantage is not requiring you to allocate an intermediate array. [f] + will be called with 0, 1, ... [len - 1], in order. *) + val of_increasing_iterator_unchecked + : ('a, 'cmp) Comparator.Module.t + -> len:int + -> f:(int -> 'a) + -> ('a, 'cmp) t + + (** [stable_dedup_list] is here rather than in the [List] module because the + implementation relies crucially on sets, and because doing so allows one to avoid uses + of polymorphic comparison by instantiating the functor at a different implementation + of [Comparator] and using the resulting [stable_dedup_list]. *) + val stable_dedup_list : ('a, _) Comparator.Module.t -> 'a list -> 'a list + [@@deprecated "[since 2023-04] Use [List.stable_dedup] instead."] + + (** [map c t ~f] returns a new set created by applying [f] to every element in + [t]. The returned set is based on the provided [comparator]. [O(n log n)]. *) + val map : ('b, 'cmp) Comparator.Module.t -> ('a, _) t -> f:('a -> 'b) -> ('b, 'cmp) t + + (** Like {!map}, except elements for which [f] returns [None] will be dropped. *) + val filter_map + : ('b, 'cmp) Comparator.Module.t + -> ('a, _) t + -> f:('a -> 'b option) + -> ('b, 'cmp) t + + (** [filter t ~f] returns the subset of [t] for which [f] evaluates to true. [O(n log + n)]. *) + val filter : ('a, 'cmp) t -> f:('a -> bool) -> ('a, 'cmp) t + + (** [fold t ~init ~f] folds over the elements of the set from smallest to largest. *) + val fold : ('a, _) t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc + + (** [fold_result ~init ~f] folds over the elements of the set from smallest to + largest, short circuiting the fold if [f accum x] is an [Error _] *) + val fold_result + : ('a, _) t + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'e) Result.t) + -> ('acc, 'e) Result.t + + (** [fold_until t ~init ~f] is a short-circuiting version of [fold]. If [f] + returns [Stop _] the computation ceases and results in that value. If [f] returns + [Continue _], the fold will proceed. *) + val fold_until + : ('a, _) t + -> init:'acc + -> f:('acc -> 'a -> ('acc, 'final) Container.Continue_or_stop.t) + -> finish:('acc -> 'final) + -> 'final + + (** Like {!fold}, except that it goes from the largest to the smallest element. *) + val fold_right : ('a, _) t -> init:'acc -> f:('a -> 'acc -> 'acc) -> 'acc + + (** [iter t ~f] calls [f] on every element of [t], going in order from the smallest to + largest. *) + val iter : ('a, _) t -> f:('a -> unit) -> unit + + (** Iterate two sets side by side. Complexity is [O(m+n)] where [m] and [n] are the sizes + of the two input sets. As an example, with the inputs [0; 1] and [1; 2], [f] will be + called with [`Left 0]; [`Both (1, 1)]; and [`Right 2]. *) + val iter2 + : ('a, 'cmp) t + -> ('a, 'cmp) t + -> f:([ `Left of 'a | `Right of 'a | `Both of 'a * 'a ] -> unit) + -> unit + + (** if [a, b = partition_tf set ~f] then [a] is the elements on which [f] produced [true], + and [b] is the elements on which [f] produces [false]. *) + val partition_tf : ('a, 'cmp) t -> f:('a -> bool) -> ('a, 'cmp) t * ('a, 'cmp) t + + (** Same as {!to_list}. *) + val elements : ('a, _) t -> 'a list + + (** Returns the smallest element of the set. [O(log n)]. *) + val min_elt : ('a, _) t -> 'a option + + (** Like {!min_elt}, but throws an exception when given an empty set. *) + val min_elt_exn : ('a, _) t -> 'a + + (** Returns the largest element of the set. [O(log n)]. *) + val max_elt : ('a, _) t -> 'a option + + (** Like {!max_elt}, but throws an exception when given an empty set. *) + val max_elt_exn : ('a, _) t -> 'a + + (** returns an arbitrary element, or [None] if the set is empty. *) + val choose : ('a, _) t -> 'a option + + (** Like {!choose}, but throws an exception on an empty set. *) + val choose_exn : ('a, _) t -> 'a + + (** [split t x] produces a triple [(t1, maybe_x, t2)]. + + [t1] is the set of elements strictly less than [x], + [maybe_x] is the member (if any) of [t] which compares equal to [x], + [t2] is the set of elements strictly larger than [x]. *) + val split : ('a, 'cmp) t -> 'a -> ('a, 'cmp) t * 'a option * ('a, 'cmp) t + + (** [split_le_gt t x] produces a pair [(t1, t2)]. + + [t1] is the set of elements less than or equal to [x], + [t2] is the set of elements strictly greater than [x]. *) + val split_le_gt : ('a, 'cmp) t -> 'a -> ('a, 'cmp) t * ('a, 'cmp) t + + (** [split_lt_ge t x] produces a pair [(t1, t2)]. + + [t1] is the set of elements strictly less than [x], + [t2] is the set of elements greater than or equal to [x]. *) + val split_lt_ge : ('a, 'cmp) t -> 'a -> ('a, 'cmp) t * ('a, 'cmp) t + + (** if [equiv] is an equivalence predicate, then [group_by set ~equiv] produces a list + of equivalence classes (i.e., a set-theoretic quotient). E.g., + + {[ + let chars = Set.of_list ['A'; 'a'; 'b'; 'c'] in + let equiv c c' = Char.equal (Char.uppercase c) (Char.uppercase c') in + group_by chars ~equiv + ]} + + produces: + + {[ + [Set.of_list ['A';'a']; Set.singleton 'b'; Set.singleton 'c'] + ]} + + [group_by] runs in O(n^2) time, so if you have a comparison function, it's usually + much faster to use [Set.of_list]. *) + val group_by : ('a, 'cmp) t -> equiv:('a -> 'a -> bool) -> ('a, 'cmp) t list + + (** [to_sequence t] converts the set [t] to a sequence of the elements between + [greater_or_equal_to] and [less_or_equal_to] inclusive in the order indicated by + [order]. If [greater_or_equal_to > less_or_equal_to] the sequence is empty. Cost is + O(log n) up front and amortized O(1) for each element produced. *) + val to_sequence + : ?order:[ `Increasing (** default *) | `Decreasing ] + -> ?greater_or_equal_to:'a + -> ?less_or_equal_to:'a + -> ('a, 'cmp) t + -> 'a Sequence.t + + (** [binary_search t ~compare which elt] returns the element in [t] specified by + [compare] and [which], if one exists. + + [t] must be sorted in increasing order according to [compare], where [compare] and + [elt] divide [t] into three (possibly empty) segments: + + {v + | < elt | = elt | > elt | + v} + + [binary_search] returns an element on the boundary of segments as specified by + [which]. See the diagram below next to the [which] variants. + + [binary_search] does not check that [compare] orders [t], and behavior is + unspecified if [compare] doesn't order [t]. Behavior is also unspecified if + [compare] mutates [t]. *) + val binary_search + : ('a, 'cmp) t + -> compare:('a -> 'key -> int) + -> [ `Last_strictly_less_than (** {v | < elt X | v} *) + | `Last_less_than_or_equal_to (** {v | <= elt X | v} *) + | `Last_equal_to (** {v | = elt X | v} *) + | `First_equal_to (** {v | X = elt | v} *) + | `First_greater_than_or_equal_to (** {v | X >= elt | v} *) + | `First_strictly_greater_than (** {v | X > elt | v} *) + ] + -> 'key + -> 'a option + + (** [binary_search_segmented t ~segment_of which] takes a [segment_of] function that + divides [t] into two (possibly empty) segments: + + {v + | segment_of elt = `Left | segment_of elt = `Right | + v} + + [binary_search_segmented] returns the element on the boundary of the segments as + specified by [which]: [`Last_on_left] yields the last element of the left segment, + while [`First_on_right] yields the first element of the right segment. It returns + [None] if the segment is empty. + + [binary_search_segmented] does not check that [segment_of] segments [t] as in the + diagram, and behavior is unspecified if [segment_of] doesn't segment [t]. Behavior + is also unspecified if [segment_of] mutates [t]. *) + val binary_search_segmented + : ('a, 'cmp) t + -> segment_of:('a -> [ `Left | `Right ]) + -> [ `Last_on_left | `First_on_right ] + -> 'a option + + (** Produces the elements of the two sets between [greater_or_equal_to] and + [less_or_equal_to] in [order], noting whether each element appears in the left set, + the right set, or both. In the both case, both elements are returned, in case the + caller can distinguish between elements that are equal to the sets' comparator. Runs + in O(length t + length t'). *) + module Merge_to_sequence_element : sig + type ('a, 'b) t = ('a, 'b) Sequence.Merge_with_duplicates_element.t = + | Left of 'a + | Right of 'b + | Both of 'a * 'b + [@@deriving_inline compare, sexp] + + include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t + include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t + + [@@@end] + end + + val merge_to_sequence + : ?order:[ `Increasing (** default *) | `Decreasing ] + -> ?greater_or_equal_to:'a + -> ?less_or_equal_to:'a + -> ('a, 'cmp) t + -> ('a, 'cmp) t + -> ('a, 'a) Merge_to_sequence_element.t Sequence.t + + (** [M] is meant to be used in combination with OCaml applicative functor types: + + {[ + type string_set = Set.M(String).t + ]} + + which stands for: + + {[ + type string_set = (String.t, String.comparator_witness) Set.t + ]} + + The point is that [Set.M(String).t] supports deriving, whereas the second syntax + doesn't (because there is no such thing as, say, String.sexp_of_comparator_witness, + instead you would want to pass the comparator directly). *) + module M (Elt : sig + type t + type comparator_witness + end) : sig + type nonrec t = (Elt.t, Elt.comparator_witness) t + end + + include For_deriving with type ('a, 'b) t := ('a, 'b) t + + (** Using comparator is a similar interface as the toplevel of [Set], except the functions + take a [~comparator:('elt, 'cmp) Comparator.t] where the functions at the toplevel of + [Set] takes a [('elt, 'cmp) comparator]. *) + module Using_comparator : sig + type nonrec ('elt, 'cmp) t = ('elt, 'cmp) t [@@deriving_inline sexp_of] + + val sexp_of_t + : ('elt -> Sexplib0.Sexp.t) + -> ('cmp -> Sexplib0.Sexp.t) + -> ('elt, 'cmp) t + -> Sexplib0.Sexp.t + + [@@@end] + + val t_of_sexp_direct + : comparator:('elt, 'cmp) Comparator.t + -> (Sexp.t -> 'elt) + -> Sexp.t + -> ('elt, 'cmp) t + + module Tree : sig + (** A [Tree.t] contains just the tree data structure that a set is based on, without + including the comparator. Accordingly, any operation on a [Tree.t] must also take + as an argument the corresponding comparator. *) + type ('a, 'cmp) t [@@deriving_inline sexp_of] + + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('cmp -> Sexplib0.Sexp.t) + -> ('a, 'cmp) t + -> Sexplib0.Sexp.t + + [@@@end] + + val t_of_sexp_direct + : comparator:('elt, 'cmp) Comparator.t + -> (Sexp.t -> 'elt) + -> Sexp.t + -> ('elt, 'cmp) t + + include + Creators_and_accessors_generic + with type ('a, 'b) set := ('a, 'b) t + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) t + with type 'a elt := 'a + with type 'c cmp := 'c + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t + + val empty_without_value_restriction : (_, _) t + end + + include + Creators_and_accessors_generic + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) Tree.t + with type ('a, 'b) set := ('a, 'b) t + with type 'a elt := 'a + with type 'c cmp := 'c + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + + val comparator_s : ('a, 'cmp) t -> ('a, 'cmp) Comparator.Module.t + val comparator : ('a, 'cmp) t -> ('a, 'cmp) Comparator.t + val hash_fold_direct : 'elt Hash.folder -> ('elt, 'cmp) t Hash.folder + + module Empty_without_value_restriction (Elt : Comparator.S1) : sig + val empty : ('a Elt.t, Elt.comparator_witness) t + end + end + + val to_tree : ('a, 'cmp) t -> ('a, 'cmp) Using_comparator.Tree.t + + val of_tree + : ('a, 'cmp) Comparator.Module.t + -> ('a, 'cmp) Using_comparator.Tree.t + -> ('a, 'cmp) t + + (** A polymorphic Set. *) + module Poly : + S_poly + with type 'elt t = ('elt, Comparator.Poly.comparator_witness) t + with type comparator_witness := Comparator.Poly.comparator_witness + with type 'elt tree := + ('elt, Comparator.Poly.comparator_witness) Using_comparator.Tree.t + with type ('elt, 'cmp) set := ('elt, 'cmp) t + + (** {2 Modules and module types for extending [Set]} + + For use in extensions of Base, like [Core]. *) + + module With_comparator = With_comparator + module With_first_class_module = With_first_class_module + module Without_comparator = Without_comparator + + module type For_deriving = For_deriving + module type S_poly = S_poly + module type Accessors_generic = Accessors_generic + module type Creators_generic = Creators_generic + module type Creators_and_accessors_generic = Creators_and_accessors_generic + module type Elt_plain = Elt_plain +end diff --git a/unikernel/duniverse/base/src/sexp.ml b/unikernel/duniverse/base/src/sexp.ml new file mode 100644 index 00000000..db8679e9 --- /dev/null +++ b/unikernel/duniverse/base/src/sexp.ml @@ -0,0 +1,63 @@ +open Globalize +open Hash.Builtin +open Ppx_compare_lib.Builtin +include Sexplib0.Sexp + +(** Type of S-expressions *) +type t = Sexplib0.Sexp.t = + | Atom of string + | List of t list +[@@deriving_inline compare ~localize, globalize, hash] + +let rec compare__local = + (fun a__001_ b__002_ -> + if Stdlib.( == ) a__001_ b__002_ + then 0 + else ( + match a__001_, b__002_ with + | Atom _a__003_, Atom _b__004_ -> compare_string__local _a__003_ _b__004_ + | Atom _, _ -> -1 + | _, Atom _ -> 1 + | List _a__005_, List _b__006_ -> + compare_list__local compare__local _a__005_ _b__006_) + : t -> t -> int) +;; + +let compare = (fun a b -> compare__local a b : t -> t -> int) + +let rec (globalize : t -> t) = + (fun x__009_ -> + match x__009_ with + | Atom arg__010_ -> Atom (globalize_string arg__010_) + | List arg__011_ -> List (globalize_list globalize arg__011_) + : t -> t) +;; + +let rec (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + (fun hsv arg -> + match arg with + | Atom _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 0 in + let hsv = hsv in + hash_fold_string hsv _a0 + | List _a0 -> + let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 1 in + let hsv = hsv in + hash_fold_list hash_fold_t hsv _a0 + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + +and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func arg = + Ppx_hash_lib.Std.Hash.get_hash_value + (let hsv = Ppx_hash_lib.Std.Hash.create () in + hash_fold_t hsv arg) + in + fun x -> func x +;; + +[@@@end] + +let t_sexp_grammar = Sexplib0.Sexp_conv.sexp_t_sexp_grammar +let of_string = () +let invariant (_ : t) = () +let equal__local a b = compare__local a b = 0 diff --git a/unikernel/duniverse/base/src/sexp.mli b/unikernel/duniverse/base/src/sexp.mli new file mode 100644 index 00000000..c2a4cfe5 --- /dev/null +++ b/unikernel/duniverse/base/src/sexp.mli @@ -0,0 +1,24 @@ +(** Type of S-expressions *) +type t = Sexplib0.Sexp.t = + | Atom of string + | List of t list +[@@deriving_inline globalize, hash] + +val globalize : t -> t + +include Ppx_hash_lib.Hashable.S with type t := t + +[@@@end] + +include module type of Sexplib0.Sexp with type t := Sexplib0.Sexp.t +include Ppx_compare_lib.Equal.S_local with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t + +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t +val invariant : t -> unit + +(** Base has never had an [of_string] function. We expose a deprecated [of_string] here + so that people can find it (e.g. with merlin), and learn what we recommend. This + [of_string] has type [unit] because we don't want it to be accidentally used. *) +val of_string : unit + [@@deprecated "[since 2018-02] Use [Parsexp.Single.parse_string_exn]"] diff --git a/unikernel/duniverse/base/src/sexp_with_comparable.ml b/unikernel/duniverse/base/src/sexp_with_comparable.ml new file mode 100644 index 00000000..55fe4e38 --- /dev/null +++ b/unikernel/duniverse/base/src/sexp_with_comparable.ml @@ -0,0 +1,4 @@ +include Comparable.Make (Sexp) +include Sexp +(* we include [sexp] last to ensure we get a faster [equal] than the one + produced by [Comparable.Make] *) diff --git a/unikernel/duniverse/base/src/sexp_with_comparable.mli b/unikernel/duniverse/base/src/sexp_with_comparable.mli new file mode 100644 index 00000000..c12943f2 --- /dev/null +++ b/unikernel/duniverse/base/src/sexp_with_comparable.mli @@ -0,0 +1,11 @@ +(*_ This module is separated from Sexp to avoid circular dependencies as many things use + s-expressions *) + +(** @inline *) +include module type of struct + include Sexp +end + +include Comparable.S with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t diff --git a/unikernel/duniverse/base/src/sexpable.ml b/unikernel/duniverse/base/src/sexpable.ml new file mode 100644 index 00000000..0ca3433c --- /dev/null +++ b/unikernel/duniverse/base/src/sexpable.ml @@ -0,0 +1,98 @@ +open! Import +include Sexplib0.Sexpable + +module Of_sexpable + (Sexpable : S) (M : sig + type t + + val to_sexpable : t -> Sexpable.t + val of_sexpable : Sexpable.t -> t + end) : S with type t := M.t = struct + let t_of_sexp sexp = + let s = Sexpable.t_of_sexp sexp in + try M.of_sexpable s with + | exn -> of_sexp_error_exn exn sexp + ;; + + let sexp_of_t t = Sexpable.sexp_of_t (M.to_sexpable t) +end + +module Of_sexpable1 + (Sexpable : S1) (M : sig + type 'a t + + val to_sexpable : 'a t -> 'a Sexpable.t + val of_sexpable : 'a Sexpable.t -> 'a t + end) : S1 with type 'a t := 'a M.t = struct + let t_of_sexp a_of_sexp sexp = + let s = Sexpable.t_of_sexp a_of_sexp sexp in + try M.of_sexpable s with + | exn -> of_sexp_error_exn exn sexp + ;; + + let sexp_of_t sexp_of_a t = Sexpable.sexp_of_t sexp_of_a (M.to_sexpable t) +end + +module Of_sexpable2 + (Sexpable : S2) (M : sig + type ('a, 'b) t + + val to_sexpable : ('a, 'b) t -> ('a, 'b) Sexpable.t + val of_sexpable : ('a, 'b) Sexpable.t -> ('a, 'b) t + end) : S2 with type ('a, 'b) t := ('a, 'b) M.t = struct + let t_of_sexp a_of_sexp b_of_sexp sexp = + let s = Sexpable.t_of_sexp a_of_sexp b_of_sexp sexp in + try M.of_sexpable s with + | exn -> of_sexp_error_exn exn sexp + ;; + + let sexp_of_t sexp_of_a sexp_of_b t = + Sexpable.sexp_of_t sexp_of_a sexp_of_b (M.to_sexpable t) + ;; +end + +module Of_sexpable3 + (Sexpable : S3) (M : sig + type ('a, 'b, 'c) t + + val to_sexpable : ('a, 'b, 'c) t -> ('a, 'b, 'c) Sexpable.t + val of_sexpable : ('a, 'b, 'c) Sexpable.t -> ('a, 'b, 'c) t + end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t = struct + let t_of_sexp a_of_sexp b_of_sexp c_of_sexp sexp = + let s = Sexpable.t_of_sexp a_of_sexp b_of_sexp c_of_sexp sexp in + try M.of_sexpable s with + | exn -> of_sexp_error_exn exn sexp + ;; + + let sexp_of_t sexp_of_a sexp_of_b sexp_of_c t = + Sexpable.sexp_of_t sexp_of_a sexp_of_b sexp_of_c (M.to_sexpable t) + ;; +end + +module Of_stringable (M : Stringable.S) : sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include S with type t := t +end +with type t := M.t = struct + let t_of_sexp sexp = + match sexp with + | Sexp.Atom s -> + (try M.of_string s with + | exn -> of_sexp_error_exn exn sexp) + | Sexp.List _ -> + of_sexp_error + "Sexpable.Of_stringable.t_of_sexp expected an atom, but got a list" + sexp + ;; + + let sexp_of_t t = Sexp.Atom (M.to_string t) + + let t_sexp_grammar : M.t Sexplib0.Sexp_grammar.t = + Sexplib0.Sexp_grammar.coerce string_sexp_grammar + ;; +end diff --git a/unikernel/duniverse/base/src/sexpable.mli b/unikernel/duniverse/base/src/sexpable.mli new file mode 100644 index 00000000..7e73dc7d --- /dev/null +++ b/unikernel/duniverse/base/src/sexpable.mli @@ -0,0 +1,54 @@ +(** Provides functors for making modules sexpable when you want the sexp representation of + one type to be the same as that for some other isomorphic type. *) + +open! Import +open! Sexplib0.Sexpable + +module Of_sexpable + (Sexpable : S) (M : sig + type t + + val to_sexpable : t -> Sexpable.t + val of_sexpable : Sexpable.t -> t + end) : S with type t := M.t + +module Of_sexpable1 + (Sexpable : S1) (M : sig + type 'a t + + val to_sexpable : 'a t -> 'a Sexpable.t + val of_sexpable : 'a Sexpable.t -> 'a t + end) : S1 with type 'a t := 'a M.t + +module Of_sexpable2 + (Sexpable : S2) (M : sig + type ('a, 'b) t + + val to_sexpable : ('a, 'b) t -> ('a, 'b) Sexpable.t + val of_sexpable : ('a, 'b) Sexpable.t -> ('a, 'b) t + end) : S2 with type ('a, 'b) t := ('a, 'b) M.t + +module Of_sexpable3 + (Sexpable : S3) (M : sig + type ('a, 'b, 'c) t + + val to_sexpable : ('a, 'b, 'c) t -> ('a, 'b, 'c) Sexpable.t + val of_sexpable : ('a, 'b, 'c) Sexpable.t -> ('a, 'b, 'c) t + end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t + +module Of_stringable (M : Stringable.S) : sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include S with type t := t +end +with type t := M.t + +(** New code should use the [[@@deriving sexp]] syntax directly. These module types ([S], + [S1], [S2], and [S3]) are exported for backwards compatibility only. +*) +include module type of Sexplib0.Sexpable +(** @inline *) diff --git a/unikernel/duniverse/base/src/sign.ml b/unikernel/duniverse/base/src/sign.ml new file mode 100644 index 00000000..4bc73934 --- /dev/null +++ b/unikernel/duniverse/base/src/sign.ml @@ -0,0 +1,34 @@ +open! Import +include Sign0 +include Identifiable.Make (Sign0) + +(* Open [Replace_polymorphic_compare] after including functor applications so + they do not shadow its definitions. This is here so that efficient versions + of the comparison functions are available within this module. *) +open! Replace_polymorphic_compare + +let to_string_hum = function + | Neg -> "negative" + | Zero -> "zero" + | Pos -> "positive" +;; + +let to_float = function + | Neg -> -1. + | Zero -> 0. + | Pos -> 1. +;; + +let flip = function + | Neg -> Pos + | Zero -> Zero + | Pos -> Neg +;; + +let ( * ) t t' = of_int (to_int t * to_int t') + +(* Include type-specific [Replace_polymorphic_compare at the end, after any + functor applications that could shadow its definitions. This is here so + that efficient versions of the comparison functions are exported by this + module. *) +include Replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/sign.mli b/unikernel/duniverse/base/src/sign.mli new file mode 100644 index 00000000..bcb36442 --- /dev/null +++ b/unikernel/duniverse/base/src/sign.mli @@ -0,0 +1,39 @@ +(** A type for representing the sign of a numeric value. *) + +open! Import + +type t = Sign0.t = + | Neg + | Zero + | Pos +[@@deriving_inline enumerate, sexp_grammar] + +include Ppx_enumerate_lib.Enumerable.S with type t := t + +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +(** This provides [to_string]/[of_string], sexp conversion, Map, Hashtbl, etc. *) +include Identifiable.S with type t := t + +include Ppx_compare_lib.Comparable.S_local with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t + +(** Returns the human-readable strings "positive", "negative", "zero". *) +val to_string_hum : t -> string + +val of_int : int -> t + +(** Map [Neg/Zero/Pos] to [-1/0/1] respectively. *) +val to_int : t -> int + +(** Map [Neg/Zero/Pos] to [-1./0./1.] respectively. + (There is no [of_float] here, but see {!Float.sign_exn}.) *) +val to_float : t -> float + +(** Map [Neg/Zero/Pos] to [Pos/Zero/Neg] respectively. *) +val flip : t -> t + +(** [Neg * Neg = Pos], etc. *) +val ( * ) : t -> t -> t diff --git a/unikernel/duniverse/base/src/sign0.ml b/unikernel/duniverse/base/src/sign0.ml new file mode 100644 index 00000000..ef34da2c --- /dev/null +++ b/unikernel/duniverse/base/src/sign0.ml @@ -0,0 +1,109 @@ +(* This is broken off to avoid circular dependency between Sign and Comparable. *) + +open! Import + +type t = + | Neg + | Zero + | Pos +[@@deriving_inline sexp, sexp_grammar, compare ~localize, hash, enumerate] + +let t_of_sexp = + (let error_source__003_ = "sign0.ml.t" in + function + | Sexplib0.Sexp.Atom ("neg" | "Neg") -> Neg + | Sexplib0.Sexp.Atom ("zero" | "Zero") -> Zero + | Sexplib0.Sexp.Atom ("pos" | "Pos") -> Pos + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("neg" | "Neg") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("zero" | "Zero") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("pos" | "Pos") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__002_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__003_ sexp__002_ + | Sexplib0.Sexp.List [] as sexp__002_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__003_ sexp__002_ + | sexp__002_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__003_ sexp__002_ + : Sexplib0.Sexp.t -> t) +;; + +let sexp_of_t = + (function + | Neg -> Sexplib0.Sexp.Atom "Neg" + | Zero -> Sexplib0.Sexp.Atom "Zero" + | Pos -> Sexplib0.Sexp.Atom "Pos" + : t -> Sexplib0.Sexp.t) +;; + +let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag { name = "Neg"; clause_kind = Atom_clause } + ; No_tag { name = "Zero"; clause_kind = Atom_clause } + ; No_tag { name = "Pos"; clause_kind = Atom_clause } + ] + } + } +;; + +let compare__local = (Stdlib.compare : t -> t -> int) +let compare = (fun a b -> compare__local a b : t -> t -> int) + +let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + (fun hsv arg -> + Ppx_hash_lib.Std.Hash.fold_int + hsv + (match arg with + | Neg -> 0 + | Zero -> 1 + | Pos -> 2) + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) +;; + +let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func arg = + Ppx_hash_lib.Std.Hash.get_hash_value + (let hsv = Ppx_hash_lib.Std.Hash.create () in + hash_fold_t hsv arg) + in + fun x -> func x +;; + +let all = ([ Neg; Zero; Pos ] : t list) + +[@@@end] + +module Replace_polymorphic_compare = struct + let ( < ) (x : t) y = Poly.( < ) x y + let ( <= ) (x : t) y = Poly.( <= ) x y + let ( <> ) (x : t) y = Poly.( <> ) x y + let ( = ) (x : t) y = Poly.( = ) x y + let ( > ) (x : t) y = Poly.( > ) x y + let ( >= ) (x : t) y = Poly.( >= ) x y + let ascending (x : t) y = Poly.ascending x y + let descending (x : t) y = Poly.descending x y + let compare (x : t) y = Poly.compare x y + let equal (x : t) y = Poly.equal x y + let equal__local (x : t) y = Poly.equal x y + let max (x : t) y = if x >= y then x else y + let min (x : t) y = if x <= y then x else y +end + +let of_string s = t_of_sexp (sexp_of_string s) +let to_string t = string_of_sexp (sexp_of_t t) + +let to_int = function + | Neg -> -1 + | Zero -> 0 + | Pos -> 1 +;; + +let _ = hash + +(* Ignore the hash function produced by [@@deriving_inline hash] *) +let hash = to_int +let module_name = "Base.Sign" +let of_int n = if n < 0 then Neg else if n = 0 then Zero else Pos diff --git a/unikernel/duniverse/base/src/sign_or_nan.ml b/unikernel/duniverse/base/src/sign_or_nan.ml new file mode 100644 index 00000000..b2a727b5 --- /dev/null +++ b/unikernel/duniverse/base/src/sign_or_nan.ml @@ -0,0 +1,154 @@ +open! Import + +module T = struct + type t = + | Neg + | Zero + | Pos + | Nan + [@@deriving_inline sexp, sexp_grammar, compare, hash, enumerate] + + let t_of_sexp = + (let error_source__003_ = "sign_or_nan.ml.T.t" in + function + | Sexplib0.Sexp.Atom ("neg" | "Neg") -> Neg + | Sexplib0.Sexp.Atom ("zero" | "Zero") -> Zero + | Sexplib0.Sexp.Atom ("pos" | "Pos") -> Pos + | Sexplib0.Sexp.Atom ("nan" | "Nan") -> Nan + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("neg" | "Neg") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("zero" | "Zero") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("pos" | "Pos") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("nan" | "Nan") :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__002_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__003_ sexp__002_ + | Sexplib0.Sexp.List [] as sexp__002_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__003_ sexp__002_ + | sexp__002_ -> + Sexplib0.Sexp_conv_error.unexpected_stag error_source__003_ sexp__002_ + : Sexplib0.Sexp.t -> t) + ;; + + let sexp_of_t = + (function + | Neg -> Sexplib0.Sexp.Atom "Neg" + | Zero -> Sexplib0.Sexp.Atom "Zero" + | Pos -> Sexplib0.Sexp.Atom "Pos" + | Nan -> Sexplib0.Sexp.Atom "Nan" + : t -> Sexplib0.Sexp.t) + ;; + + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = + { untyped = + Variant + { case_sensitivity = Case_sensitive_except_first_character + ; clauses = + [ No_tag { name = "Neg"; clause_kind = Atom_clause } + ; No_tag { name = "Zero"; clause_kind = Atom_clause } + ; No_tag { name = "Pos"; clause_kind = Atom_clause } + ; No_tag { name = "Nan"; clause_kind = Atom_clause } + ] + } + } + ;; + + let compare = (Stdlib.compare : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + (fun hsv arg -> + Ppx_hash_lib.Std.Hash.fold_int + hsv + (match arg with + | Neg -> 0 + | Zero -> 1 + | Pos -> 2 + | Nan -> 3) + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + ;; + + let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func arg = + Ppx_hash_lib.Std.Hash.get_hash_value + (let hsv = Ppx_hash_lib.Std.Hash.create () in + hash_fold_t hsv arg) + in + fun x -> func x + ;; + + let all = ([ Neg; Zero; Pos; Nan ] : t list) + + [@@@end] + + let of_string s = t_of_sexp (sexp_of_string s) + let to_string t = string_of_sexp (sexp_of_t t) + let module_name = "Base.Sign_or_nan" +end + +module Replace_polymorphic_compare = struct + let ( < ) (x : T.t) y = Poly.( < ) x y + let ( <= ) (x : T.t) y = Poly.( <= ) x y + let ( <> ) (x : T.t) y = Poly.( <> ) x y + let ( = ) (x : T.t) y = Poly.( = ) x y + let ( > ) (x : T.t) y = Poly.( > ) x y + let ( >= ) (x : T.t) y = Poly.( >= ) x y + let ascending (x : T.t) y = Poly.ascending x y + let descending (x : T.t) y = Poly.descending x y + let compare (x : T.t) y = Poly.compare x y + let compare__local (x : T.t) y = Poly.compare x y + let equal (x : T.t) y = Poly.equal x y + let equal__local (x : T.t) y = Poly.equal x y + let max (x : T.t) y = if x >= y then x else y + let min (x : T.t) y = if x <= y then x else y +end + +include T +include Identifiable.Make (T) + +(* Open [Replace_polymorphic_compare] after including functor applications so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! Replace_polymorphic_compare + +let of_sign = function + | Sign.Neg -> Neg + | Sign.Zero -> Zero + | Sign.Pos -> Pos +;; + +let to_sign_exn = function + | Neg -> Sign.Neg + | Zero -> Sign.Zero + | Pos -> Sign.Pos + | Nan -> invalid_arg "Base.Sign_or_nan.to_sign_exn: Nan" +;; + +let of_int n = of_sign (Sign.of_int n) +let to_int_exn t = Sign.to_int (to_sign_exn t) + +let flip = function + | Neg -> Pos + | Zero -> Zero + | Pos -> Neg + | Nan -> Nan +;; + +let ( * ) t t' = + match t, t' with + | Nan, _ | _, Nan -> Nan + | _ -> of_sign (Sign.( * ) (to_sign_exn t) (to_sign_exn t')) +;; + +let to_string_hum = function + | Neg -> "negative" + | Zero -> "zero" + | Pos -> "positive" + | Nan -> "not-a-number" +;; + +(* Include [Replace_polymorphic_compare] at the end, after any functor applications that + could shadow its definitions. This is here so that efficient versions of the comparison + functions are exported by this module. *) +include Replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/sign_or_nan.mli b/unikernel/duniverse/base/src/sign_or_nan.mli new file mode 100644 index 00000000..3ee9bd01 --- /dev/null +++ b/unikernel/duniverse/base/src/sign_or_nan.mli @@ -0,0 +1,42 @@ +(** An extension to [Sign] with a [Nan] constructor, for representing the sign + of float-like numeric values. *) + +open! Import + +type t = + | Neg + | Zero + | Pos + | Nan +[@@deriving_inline enumerate, sexp_grammar] + +include Ppx_enumerate_lib.Enumerable.S with type t := t + +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +(** This provides [to_string]/[of_string], sexp conversion, Map, Hashtbl, etc. *) +include Identifiable.S with type t := t + +include Ppx_compare_lib.Comparable.S_local with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t + +(** Returns the human-readable strings "positive", "negative", "zero", "not-a-number". *) +val to_string_hum : t -> string + +val of_int : int -> t + +(** Map [Neg/Zero/Pos] to [-1/0/1] respectively. [Nan] raises. *) +val to_int_exn : t -> int + +val of_sign : Sign.t -> t + +(** [Nan] raises. *) +val to_sign_exn : t -> Sign.t + +(** Map [Neg/Zero/Pos/Nan] to [Pos/Zero/Neg/Nan] respectively. *) +val flip : t -> t + +(** [Neg * Neg = Pos], etc. If either argument is [Nan] then the result is [Nan]. *) +val ( * ) : t -> t -> t diff --git a/unikernel/duniverse/base/src/source_code_position.ml b/unikernel/duniverse/base/src/source_code_position.ml new file mode 100644 index 00000000..f23ecc50 --- /dev/null +++ b/unikernel/duniverse/base/src/source_code_position.ml @@ -0,0 +1,25 @@ +open! Import + +(* This is lifted out of [M] because [Source_code_position0] exports [String0] + as [String], which does not export a hash function. *) +let hash_override { Stdlib.Lexing.pos_fname; pos_lnum; pos_bol; pos_cnum } = + String.hash pos_fname + lxor Int.hash pos_lnum + lxor Int.hash pos_bol + lxor Int.hash pos_cnum +;; + +module M = struct + include Source_code_position0 + + let hash = hash_override +end + +include M +include Comparable.Make_using_comparator (M) + +let equal__local a b = equal_int (compare__local a b) 0 + +let of_pos (pos_fname, pos_lnum, pos_cnum, _) = + { pos_fname; pos_lnum; pos_cnum; pos_bol = 0 } +;; diff --git a/unikernel/duniverse/base/src/source_code_position.mli b/unikernel/duniverse/base/src/source_code_position.mli new file mode 100644 index 00000000..63728592 --- /dev/null +++ b/unikernel/duniverse/base/src/source_code_position.mli @@ -0,0 +1,32 @@ +(** One typically obtains a [Source_code_position.t] using a [[%here]] expression, which + is implemented by the [ppx_here] preprocessor. *) + +open! Import + +(** See INRIA's OCaml documentation for a description of these fields. + + [sexp_of_t] uses the form ["FILE:LINE:COL"], and does not have a corresponding + [of_sexp]. *) +type t = Stdlib.Lexing.position = + { pos_fname : string + ; pos_lnum : int + ; pos_bol : int + ; pos_cnum : int + } +[@@deriving_inline hash, sexp_of] + +include Ppx_hash_lib.Hashable.S with type t := t + +val sexp_of_t : t -> Sexplib0.Sexp.t + +[@@@end] + +include Comparable.S with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t + +(** [to_string t] converts [t] to the form ["FILE:LINE:COL"]. *) +val to_string : t -> string + +(** [of_pos Stdlib.__POS__] is like [[%here]] but without using ppx. *) +val of_pos : string * int * int * int -> t diff --git a/unikernel/duniverse/base/src/source_code_position0.ml b/unikernel/duniverse/base/src/source_code_position0.ml new file mode 100644 index 00000000..d01a43b9 --- /dev/null +++ b/unikernel/duniverse/base/src/source_code_position0.ml @@ -0,0 +1,104 @@ +open! Import +module Int = Int0 +module String = String0 + +module T = struct + type t = Stdlib.Lexing.position = + { pos_fname : string + ; pos_lnum : int + ; pos_bol : int + ; pos_cnum : int + } + [@@deriving_inline compare ~localize, hash, sexp_of] + + let compare__local = + (fun a__001_ b__002_ -> + if Stdlib.( == ) a__001_ b__002_ + then 0 + else ( + match compare_string__local a__001_.pos_fname b__002_.pos_fname with + | 0 -> + (match compare_int__local a__001_.pos_lnum b__002_.pos_lnum with + | 0 -> + (match compare_int__local a__001_.pos_bol b__002_.pos_bol with + | 0 -> compare_int__local a__001_.pos_cnum b__002_.pos_cnum + | n -> n) + | n -> n) + | n -> n) + : t -> t -> int) + ;; + + let compare = (fun a b -> compare__local a b : t -> t -> int) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + fun hsv arg -> + let hsv = + let hsv = + let hsv = + let hsv = hsv in + hash_fold_string hsv arg.pos_fname + in + hash_fold_int hsv arg.pos_lnum + in + hash_fold_int hsv arg.pos_bol + in + hash_fold_int hsv arg.pos_cnum + ;; + + let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func arg = + Ppx_hash_lib.Std.Hash.get_hash_value + (let hsv = Ppx_hash_lib.Std.Hash.create () in + hash_fold_t hsv arg) + in + fun x -> func x + ;; + + let sexp_of_t = + (fun { pos_fname = pos_fname__004_ + ; pos_lnum = pos_lnum__006_ + ; pos_bol = pos_bol__008_ + ; pos_cnum = pos_cnum__010_ + } -> + let bnds__003_ = ([] : _ Stdlib.List.t) in + let bnds__003_ = + let arg__011_ = sexp_of_int pos_cnum__010_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_cnum"; arg__011_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + let bnds__003_ = + let arg__009_ = sexp_of_int pos_bol__008_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_bol"; arg__009_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + let bnds__003_ = + let arg__007_ = sexp_of_int pos_lnum__006_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_lnum"; arg__007_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + let bnds__003_ = + let arg__005_ = sexp_of_string pos_fname__004_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_fname"; arg__005_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List bnds__003_ + : t -> Sexplib0.Sexp.t) + ;; + + [@@@end] +end + +include T +include Comparator.Make (T) + +(* This is the same function as Ppx_here.lift_position_as_string. *) +let make_location_string ~pos_fname ~pos_lnum ~pos_cnum ~pos_bol = + String.concat + [ pos_fname; ":"; Int.to_string pos_lnum; ":"; Int.to_string (pos_cnum - pos_bol) ] +;; + +let to_string { Stdlib.Lexing.pos_fname; pos_lnum; pos_cnum; pos_bol } = + make_location_string ~pos_fname ~pos_lnum ~pos_cnum ~pos_bol +;; + +let sexp_of_t t = Sexp.Atom (to_string t) diff --git a/unikernel/duniverse/base/src/stack.ml b/unikernel/duniverse/base/src/stack.ml new file mode 100644 index 00000000..d27a24c2 --- /dev/null +++ b/unikernel/duniverse/base/src/stack.ml @@ -0,0 +1,221 @@ +open! Import +include Stack_intf + +let raise_s = Error.raise_s + +(* This implementation is similar to [Deque] in that it uses an array of ['a] and + a mutable [int] to indicate what in the array is used. We choose to implement [Stack] + directly rather than on top of [Deque] for performance reasons. E.g. a simple + microbenchmark shows that push/pop is about 20% faster. *) +type 'a t = + { mutable length : int + ; mutable elts : 'a Option_array.t + } +[@@deriving_inline sexp_of] + +let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + fun _of_a__001_ { length = length__003_; elts = elts__005_ } -> + let bnds__002_ = ([] : _ Stdlib.List.t) in + let bnds__002_ = + let arg__006_ = Option_array.sexp_of_t _of_a__001_ elts__005_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "elts"; arg__006_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__004_ = sexp_of_int length__003_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "length"; arg__004_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List bnds__002_ +;; + +[@@@end] + +let sexp_of_t_internal = sexp_of_t +let sexp_of_t = `Rebound_later +let _ = sexp_of_t +let capacity t = Option_array.length t.elts + +let invariant invariant_a ({ length; elts } as t) : unit = + try + assert (0 <= length && length <= Option_array.length elts); + for i = 0 to length - 1 do + invariant_a (Option_array.get_some_exn elts i) + done; + (* We maintain the invariant that unused elements are unset to avoid a space + leak. *) + for i = length to Option_array.length elts - 1 do + assert (not (Option_array.is_some elts i)) + done + with + | exn -> + raise_s + (Sexp.message + "Stack.invariant failed" + [ "exn", exn |> Exn.sexp_of_t; "stack", t |> sexp_of_t_internal sexp_of_opaque ]) +;; + +let create (type a) () : a t = { length = 0; elts = Option_array.empty } +let length t = t.length +let is_empty t = length t = 0 + +(* The order in which elements are visited has been chosen so as to be backwards + compatible with [Stdlib.Stack] *) +let fold t ~init ~f = + let r = ref init in + for i = t.length - 1 downto 0 do + r := f !r (Option_array.get_some_exn t.elts i) + done; + !r +;; + +let iter t ~f = + for i = t.length - 1 downto 0 do + f (Option_array.get_some_exn t.elts i) + done +;; + +module C = Container.Make (struct + type nonrec 'a t = 'a t + + let fold = fold + let iter = `Custom iter + let length = `Custom length +end) + +let mem = C.mem +let exists = C.exists +let for_all = C.for_all +let count = C.count +let sum = C.sum +let find = C.find +let find_map = C.find_map +let to_list = C.to_list +let to_array = C.to_array +let min_elt = C.min_elt +let max_elt = C.max_elt +let fold_result = C.fold_result +let fold_until = C.fold_until + +let of_list (type a) (l : a list) = + if List.is_empty l + then create () + else ( + let length = List.length l in + let elts = Option_array.create ~len:(2 * length) in + let r = ref l in + for i = length - 1 downto 0 do + match !r with + | [] -> assert false + | a :: l -> + Option_array.set_some elts i a; + r := l + done; + { length; elts }) +;; + +let sexp_of_t sexp_of_a t = List.sexp_of_t sexp_of_a (to_list t) +let t_of_sexp a_of_sexp sexp = of_list (List.t_of_sexp a_of_sexp sexp) + +let t_sexp_grammar (type a) (grammar : a Sexplib0.Sexp_grammar.t) + : a t Sexplib0.Sexp_grammar.t + = + Sexplib0.Sexp_grammar.coerce (List.t_sexp_grammar grammar) +;; + +let resize t size = + let arr = Option_array.create ~len:size in + Option_array.blit ~src:t.elts ~dst:arr ~src_pos:0 ~dst_pos:0 ~len:t.length; + t.elts <- arr +;; + +let set_capacity t new_capacity = + let new_capacity = max new_capacity (length t) in + if new_capacity <> capacity t then resize t new_capacity +;; + +let push t a = + if t.length = Option_array.length t.elts then resize t (2 * (t.length + 1)); + Option_array.set_some t.elts t.length a; + t.length <- t.length + 1 +;; + +let pop_nonempty t = + let i = t.length - 1 in + let result = Option_array.get_some_exn t.elts i in + Option_array.set_none t.elts i; + t.length <- i; + result +;; + +let pop_error = Error.of_string "Stack.pop of empty stack" +let pop t = if is_empty t then None else Some (pop_nonempty t) +let pop_exn t = if is_empty t then Error.raise pop_error else pop_nonempty t +let top_nonempty t = Option_array.get_some_exn t.elts (t.length - 1) +let top_error = Error.of_string "Stack.top of empty stack" +let top t = if is_empty t then None else Some (top_nonempty t) +let top_exn t = if is_empty t then Error.raise top_error else top_nonempty t +let copy { length; elts } = { length; elts = Option_array.copy elts } + +let clear t = + if t.length > 0 + then ( + for i = 0 to t.length - 1 do + Option_array.set_none t.elts i + done; + t.length <- 0) +;; + +let until_empty t f = + let rec loop () = + if t.length > 0 + then ( + f (pop_nonempty t); + loop ()) + in + loop () [@nontail] +;; + +let filter_map t ~f = + let t_result = create () in + for i = 0 to t.length - 1 do + match f (Option_array.get_some_exn t.elts i) with + | None -> () + | Some x -> push t_result x + done; + t_result +;; + +let filter t ~f = + let t_result = create () in + for i = 0 to t.length - 1 do + let x = Option_array.get_some_exn t.elts i in + if f x then push t_result x + done; + t_result +;; + +let filter_inplace t ~f = + let write_index = ref 0 in + Exn.protect + ~f:(fun () -> + for read_index = 0 to t.length - 1 do + let x = Option_array.unsafe_get_some_assuming_some t.elts read_index in + if f x + then ( + if !write_index < read_index + then Option_array.unsafe_set_some t.elts !write_index x; + incr write_index) + done) + ~finally:(fun () -> + for i = !write_index to t.length - 1 do + Option_array.unsafe_set_none t.elts i + done; + t.length <- !write_index) [@nontail] +;; + +let singleton x = + let t = create () in + push t x; + t +;; diff --git a/unikernel/duniverse/base/src/stack.mli b/unikernel/duniverse/base/src/stack.mli new file mode 100644 index 00000000..937ae3ca --- /dev/null +++ b/unikernel/duniverse/base/src/stack.mli @@ -0,0 +1 @@ +include Stack_intf.Stack (** @inline *) diff --git a/unikernel/duniverse/base/src/stack_intf.ml b/unikernel/duniverse/base/src/stack_intf.ml new file mode 100644 index 00000000..761943c8 --- /dev/null +++ b/unikernel/duniverse/base/src/stack_intf.ml @@ -0,0 +1,89 @@ +(** An interface for stacks that follows [Core]'s conventions, as opposed to OCaml's + standard [Stack] module. *) + +open! Import + +module type S = sig + type 'a t [@@deriving_inline sexp, sexp_grammar] + + include Sexplib0.Sexpable.S1 with type 'a t := 'a t + + val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Invariant.S1 with type 'a t := 'a t + + (** [fold], [iter], [find], and [find_map] visit the elements in order from the top of + the stack to the bottom. [to_list] and [to_array] return the elements in order from + the top of the stack to the bottom. + + Iteration functions ([iter], [fold], etc.) have unspecified behavior (although they + should still be memory-safe) when the stack is mutated while they are running (e.g. + by having the passed-in function call [push] or [pop] on the stack). + *) + include Container.S1 with type 'a t := 'a t + + (** [of_list l] returns a stack whose top is the first element of [l] and bottom is the + last element of [l]. *) + val of_list : 'a list -> 'a t + + (** [create ()] returns an empty stack. *) + val create : unit -> _ t + + (** [singleton a] creates a new stack containing only [a]. *) + val singleton : 'a -> 'a t + + (** [push t a] adds [a] to the top of stack [t]. *) + val push : 'a t -> 'a -> unit + + (** [pop t] removes and returns the top element of [t] as [Some a], or returns [None] if + [t] is empty. *) + val pop : 'a t -> 'a option + + val pop_exn : 'a t -> 'a + + (** [top t] returns [Some a], where [a] is the top of [t], unless [is_empty t], in which + case [top] returns [None]. *) + val top : 'a t -> 'a option + + val top_exn : 'a t -> 'a + + (** [clear t] discards all elements from [t]. *) + val clear : _ t -> unit + + (** [copy t] returns a copy of [t]. *) + val copy : 'a t -> 'a t + + (** [until_empty t f] repeatedly pops an element [a] off of [t] and runs [f a], until + [t] becomes empty. It is fine if [f] adds more elements to [t], in which case the + most-recently-added element will be processed next. *) + val until_empty : 'a t -> ('a -> unit) -> unit + + (** [filter_map t ~f] creates a new stack with only the elements for which [f] returns + [Some] *) + val filter_map : 'a t -> f:('a -> 'b option) -> 'b t + + (** [filter t ~f] creates a new stack with only the elements that satisfy [f]. *) + val filter : 'a t -> f:('a -> bool) -> 'a t + + (** [filter_inplace t ~f] removes all elements of [t] that don't satisfy [f]. *) + val filter_inplace : 'a t -> f:('a -> bool) -> unit +end + +(** A stack implemented with an array. + + The implementation will grow the array as necessary, and will never automatically + shrink the array. One can use [set_capacity] to explicitly resize the array. *) +module type Stack = sig + module type S = S + + include S (** @open *) + + (** [capacity t] returns the length of the array backing [t]. *) + val capacity : _ t -> int + + (** [set_capacity t capacity] sets the length of the array backing [t] to [max capacity + (length t)]. To shrink as much as possible, do [set_capacity t 0]. *) + val set_capacity : _ t -> int -> unit +end diff --git a/unikernel/duniverse/base/src/staged.ml b/unikernel/duniverse/base/src/staged.ml new file mode 100644 index 00000000..d4701652 --- /dev/null +++ b/unikernel/duniverse/base/src/staged.ml @@ -0,0 +1,6 @@ +open! Import + +type 'a t = 'a + +let stage = Fn.id +let unstage = Fn.id diff --git a/unikernel/duniverse/base/src/staged.mli b/unikernel/duniverse/base/src/staged.mli new file mode 100644 index 00000000..a0b9f9c8 --- /dev/null +++ b/unikernel/duniverse/base/src/staged.mli @@ -0,0 +1,42 @@ +(** A type for making staging explicit in the type of a function. + + For example, you might want to have a function that creates a function for allocating + unique identifiers. Rather than using the type: + + {[ + val make_id_allocator : unit -> unit -> int + ]} + + you would have + + {[ + val make_id_allocator : unit -> (unit -> int) Staged.t + ]} + + Such a function could be defined as follows: + + {[ + let make_id_allocator () = + let ctr = ref 0 in + stage (fun () -> incr ctr; !ctr) + ]} + + and could be invoked as follows: + + {[ + let (id1,id2) = + let alloc = unstage (make_id_allocator ()) in + (alloc (), alloc ()) + ]} + + both {!stage} and {!unstage} functions are available in the toplevel namespace. + + (Note that in many cases, including perhaps the one above, it's preferable to create a + custom type rather than use [Staged].) *) + +open! Import + +type +'a t + +val stage : 'a -> 'a t +val unstage : 'a t -> 'a diff --git a/unikernel/duniverse/base/src/string.ml b/unikernel/duniverse/base/src/string.ml new file mode 100644 index 00000000..992eb749 --- /dev/null +++ b/unikernel/duniverse/base/src/string.ml @@ -0,0 +1,2172 @@ +open! Import +module Array = Array0 +module Bytes = Bytes0 +module Int = Int0 +module Uchar = Uchar0 +include String0 +include String_intf + +let invalid_argf = Printf.invalid_argf +let raise_s = Error.raise_s +let stage = Staged.stage + +module T = struct + type t = string [@@deriving_inline globalize, hash, sexp, sexp_grammar] + + let (globalize : t -> t) = (globalize_string : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_string + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_string in + fun x -> func x + ;; + + let t_of_sexp = (string_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_string : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = string_sexp_grammar + + [@@@end] + + let hashable : t Hashable.t = { hash; compare; sexp_of_t } + let compare = compare +end + +include T +include Comparator.Make (T) + +type elt = char + +let invariant (_ : t) = () + +(* This is copied/adapted from 'blit.ml'. + [sub], [subo] could be implemented using [Blit.Make(Bytes)] plus unsafe casts to/from + string but were inlined here to avoid using [Bytes.unsafe_of_string] as much as possible. +*) +let unsafe_sub src ~pos ~len = + if len = 0 + then "" + else ( + let dst = Bytes.create len in + Bytes.unsafe_blit_string ~src ~src_pos:pos ~dst ~dst_pos:0 ~len; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst) +;; + +let sub src ~pos ~len = + if pos = 0 && len = String.length src + then src + else ( + Ordered_collection_common.check_pos_len_exn ~pos ~len ~total_length:(length src); + unsafe_sub src ~pos ~len) +;; + +let subo ?(pos = 0) ?len src = + sub + src + ~pos + ~len: + (match len with + | Some i -> i + | None -> length src - pos) +;; + +let rec contains_unsafe t ~pos ~end_ char = + pos < end_ + && (Char.equal (unsafe_get t pos) char || contains_unsafe t ~pos:(pos + 1) ~end_ char) +;; + +let contains ?(pos = 0) ?len t char = + let total_length = String.length t in + let len = Option.value len ~default:(total_length - pos) in + Ordered_collection_common.check_pos_len_exn ~pos ~len ~total_length; + contains_unsafe t ~pos ~end_:(pos + len) char +;; + +let is_empty t = length t = 0 + +let[@inline] index_from_internal string ~len ~not_found ~found char ~pos = + let rec loop ~pos = + if pos >= len + then not_found () + else if Char.equal (unsafe_get string pos) char + then found pos + else loop ~pos:(pos + 1) + in + loop ~pos [@nontail] +;; + +let index t char = + index_from_internal + t + char + ~pos:0 + ~len:(length t) + ~found:Option.some + ~not_found:(fun () -> None) [@nontail] +;; + +let index_exn t char = + index_from_internal + t + ~pos:0 + ~len:(length t) + ~found:Fn.id + ~not_found:(fun () -> raise (Not_found_s (Atom "String.index_exn: not found"))) + char [@nontail] +;; + +let index_from t pos char = + index_from_internal t char ~pos ~len:(length t) ~found:Option.some ~not_found:(fun () -> + None) [@nontail] +;; + +let index_from_exn = + let not_found () = raise (Not_found_s (Atom "String.index_from_exn: not found")) in + let index_from_exn t pos char = + let len = length t in + if pos < 0 || pos > len + then invalid_arg "String.index_from_exn" + else index_from_internal t ~pos ~len ~not_found ~found:Fn.id char + in + (* named to preserve symbol in compiled binary *) + index_from_exn +;; + +let[@inline] rindex_from_internal string char ~found ~not_found ~pos = + let rec loop ~pos = + if pos < 0 + then not_found () + else if Char.equal (unsafe_get string pos) char + then found pos + else loop ~pos:(pos - 1) + in + loop ~pos [@nontail] +;; + +let rindex t char = + rindex_from_internal + t + char + ~pos:(length t - 1) + ~found:Option.some + ~not_found:(fun () -> None) [@nontail] +;; + +let rindex_exn t char = + rindex_from_internal + t + char + ~pos:(length t - 1) + ~found:Fn.id + ~not_found:(fun () -> raise (Not_found_s (Atom "String.rindex_exn: not found"))) + [@nontail] +;; + +let rindex_from t pos char = + rindex_from_internal t char ~pos ~found:Option.some ~not_found:(fun () -> None) [@nontail + ] +;; + +let rindex_from_exn = + let not_found () = raise (Not_found_s (Atom "String.rindex_from_exn: not found")) in + let rindex_from_exn t pos char = + if pos < -1 || pos >= length t + then invalid_arg "String.rindex_from_exn" + else rindex_from_internal t ~pos ~not_found ~found:Fn.id char + in + (* named to preserve symbol in compiled binary *) + rindex_from_exn +;; + +module Search_pattern0 = struct + type t = + { pattern : string + ; case_sensitive : bool + ; kmp_array : int array + } + + let sexp_of_t { pattern; case_sensitive; kmp_array = _ } : Sexp.t = + List + [ List [ Atom "pattern"; sexp_of_string pattern ] + ; List [ Atom "case_sensitive"; sexp_of_bool case_sensitive ] + ] + ;; + + let pattern t = t.pattern + let case_sensitive t = t.case_sensitive + + (* Find max number of matched characters at [next_text_char], given the current + [matched_chars]. Try to extend the current match, if chars don't match, try to match + fewer chars. If chars match then extend the match. *) + let kmp_internal_loop ~matched_chars ~next_text_char ~pattern ~kmp_array ~char_equal = + let matched_chars = ref matched_chars in + while + !matched_chars > 0 + && not (char_equal next_text_char (unsafe_get pattern !matched_chars)) + do + matched_chars := Array.unsafe_get kmp_array (!matched_chars - 1) + done; + if char_equal next_text_char (unsafe_get pattern !matched_chars) + then matched_chars := !matched_chars + 1; + !matched_chars + ;; + + let get_char_equal ~case_sensitive = + match case_sensitive with + | true -> Char.equal + | false -> Char.Caseless.equal + ;; + + (* Classic KMP pre-processing of the pattern: build the int array, which, for each i, + contains the length of the longest non-trivial prefix of s which is equal to a suffix + ending at s.[i] *) + let create pattern ~case_sensitive = + let n = length pattern in + let kmp_array = Array.create ~len:n (-1) in + if n > 0 + then ( + let char_equal = get_char_equal ~case_sensitive in + Array.unsafe_set kmp_array 0 0; + let matched_chars = ref 0 in + for i = 1 to n - 1 do + matched_chars + := kmp_internal_loop + ~matched_chars:!matched_chars + ~next_text_char:(unsafe_get pattern i) + ~pattern + ~kmp_array + ~char_equal; + Array.unsafe_set kmp_array i !matched_chars + done); + { pattern; case_sensitive; kmp_array } + ;; + + (* Classic KMP: use the pre-processed pattern to optimize look-behinds on non-matches. + We return int to avoid allocation in [index_exn]. -1 means no match. *) + let index_internal ?(pos = 0) { pattern; case_sensitive; kmp_array } ~in_:text = + if pos < 0 || pos > length text - length pattern + then -1 + else ( + let char_equal = get_char_equal ~case_sensitive in + let j = ref pos in + let matched_chars = ref 0 in + let k = length pattern in + let n = length text in + while !j < n && !matched_chars < k do + let next_text_char = unsafe_get text !j in + matched_chars + := kmp_internal_loop + ~matched_chars:!matched_chars + ~next_text_char + ~pattern + ~kmp_array + ~char_equal; + j := !j + 1 + done; + if !matched_chars = k then !j - k else -1) + ;; + + let matches t str = index_internal t ~in_:str >= 0 + + let index ?pos t ~in_ = + let p = index_internal ?pos t ~in_ in + if p < 0 then None else Some p + ;; + + let index_exn ?pos t ~in_ = + let p = index_internal ?pos t ~in_ in + if p >= 0 + then p + else + raise_s + (Sexp.message "Substring not found" [ "substring", sexp_of_string t.pattern ]) + ;; + + let index_all { pattern; case_sensitive; kmp_array } ~may_overlap ~in_:text = + if length pattern = 0 + then List.init (1 + length text) ~f:Fn.id + else ( + let char_equal = get_char_equal ~case_sensitive in + let matched_chars = ref 0 in + let k = length pattern in + let n = length text in + let found = ref [] in + for j = 0 to n do + if !matched_chars = k + then ( + found := (j - k) :: !found; + (* we just found a match in the previous iteration *) + match may_overlap with + | true -> matched_chars := Array.unsafe_get kmp_array (k - 1) + | false -> matched_chars := 0); + if j < n + then ( + let next_text_char = unsafe_get text j in + matched_chars + := kmp_internal_loop + ~matched_chars:!matched_chars + ~next_text_char + ~pattern + ~kmp_array + ~char_equal) + done; + List.rev !found) + ;; + + let replace_first ?pos t ~in_:s ~with_ = + match index ?pos t ~in_:s with + | None -> s + | Some i -> + let len_s = length s in + let len_t = length t.pattern in + let len_with = length with_ in + let dst = Bytes.create (len_s + len_with - len_t) in + Bytes.blit_string ~src:s ~src_pos:0 ~dst ~dst_pos:0 ~len:i; + Bytes.blit_string ~src:with_ ~src_pos:0 ~dst ~dst_pos:i ~len:len_with; + Bytes.blit_string + ~src:s + ~src_pos:(i + len_t) + ~dst + ~dst_pos:(i + len_with) + ~len:(len_s - i - len_t); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst + ;; + + let replace_all t ~in_:s ~with_ = + let matches = index_all t ~may_overlap:false ~in_:s in + match matches with + | [] -> s + | _ :: _ -> + let len_s = length s in + let len_t = length t.pattern in + let len_with = length with_ in + let num_matches = List.length matches in + let dst = Bytes.create (len_s + ((len_with - len_t) * num_matches)) in + let next_dst_pos = ref 0 in + let next_src_pos = ref 0 in + List.iter matches ~f:(fun i -> + let len = i - !next_src_pos in + Bytes.blit_string ~src:s ~src_pos:!next_src_pos ~dst ~dst_pos:!next_dst_pos ~len; + Bytes.blit_string + ~src:with_ + ~src_pos:0 + ~dst + ~dst_pos:(!next_dst_pos + len) + ~len:len_with; + next_dst_pos := !next_dst_pos + len + len_with; + next_src_pos := !next_src_pos + len + len_t); + Bytes.blit_string + ~src:s + ~src_pos:!next_src_pos + ~dst + ~dst_pos:!next_dst_pos + ~len:(len_s - !next_src_pos); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst + ;; + + let split_on t s = + let pattern_len = String.length t.pattern in + let matches = index_all t ~may_overlap:false ~in_:s in + List.map2_exn + (-pattern_len :: matches) + (matches @ [ String.length s ]) + ~f:(fun i j -> sub s ~pos:(i + pattern_len) ~len:(j - i - pattern_len)) + ;; + + module Private = struct + type public = t + + type nonrec t = t = + { pattern : string + ; case_sensitive : bool + ; kmp_array : int array + } + [@@deriving_inline equal ~localize, sexp_of] + + let equal__local = + (fun a__003_ b__004_ -> + if Stdlib.( == ) a__003_ b__004_ + then true + else + Stdlib.( && ) + (equal_string__local a__003_.pattern b__004_.pattern) + (Stdlib.( && ) + (equal_bool__local a__003_.case_sensitive b__004_.case_sensitive) + (equal_array__local equal_int__local a__003_.kmp_array b__004_.kmp_array)) + : t -> t -> bool) + ;; + + let equal = (fun a b -> equal__local a b : t -> t -> bool) + + let sexp_of_t = + (fun { pattern = pattern__008_ + ; case_sensitive = case_sensitive__010_ + ; kmp_array = kmp_array__012_ + } -> + let bnds__007_ = ([] : _ Stdlib.List.t) in + let bnds__007_ = + let arg__013_ = sexp_of_array sexp_of_int kmp_array__012_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "kmp_array"; arg__013_ ] :: bnds__007_ + : _ Stdlib.List.t) + in + let bnds__007_ = + let arg__011_ = sexp_of_bool case_sensitive__010_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "case_sensitive"; arg__011_ ] + :: bnds__007_ + : _ Stdlib.List.t) + in + let bnds__007_ = + let arg__009_ = sexp_of_string pattern__008_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pattern"; arg__009_ ] :: bnds__007_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List bnds__007_ + : t -> Sexplib0.Sexp.t) + ;; + + [@@@end] + + let representation = Fn.id + end +end + +module Search_pattern_helper = struct + module Search_pattern = Search_pattern0 +end + +open Search_pattern_helper + +let substr_index_gen ~case_sensitive ?pos t ~pattern = + Search_pattern.index ?pos (Search_pattern.create ~case_sensitive pattern) ~in_:t +;; + +let substr_index_exn_gen ~case_sensitive ?pos t ~pattern = + Search_pattern.index_exn ?pos (Search_pattern.create ~case_sensitive pattern) ~in_:t +;; + +let substr_index_all_gen ~case_sensitive t ~may_overlap ~pattern = + Search_pattern.index_all + (Search_pattern.create ~case_sensitive pattern) + ~may_overlap + ~in_:t +;; + +let substr_replace_first_gen ~case_sensitive ?pos t ~pattern = + Search_pattern.replace_first ?pos (Search_pattern.create ~case_sensitive pattern) ~in_:t +;; + +let substr_replace_all_gen ~case_sensitive t ~pattern = + Search_pattern.replace_all (Search_pattern.create ~case_sensitive pattern) ~in_:t +;; + +let is_substring_gen ~case_sensitive t ~substring = + Option.is_some (substr_index_gen t ~pattern:substring ~case_sensitive) +;; + +let substr_index = substr_index_gen ~case_sensitive:true +let substr_index_exn = substr_index_exn_gen ~case_sensitive:true +let substr_index_all = substr_index_all_gen ~case_sensitive:true +let substr_replace_first = substr_replace_first_gen ~case_sensitive:true +let substr_replace_all = substr_replace_all_gen ~case_sensitive:true +let is_substring = is_substring_gen ~case_sensitive:true + +let is_substring_at_gen = + let rec loop ~str ~str_pos ~sub ~sub_pos ~sub_len ~char_equal = + if sub_pos = sub_len + then true + else if char_equal (unsafe_get str str_pos) (unsafe_get sub sub_pos) + then loop ~str ~str_pos:(str_pos + 1) ~sub ~sub_pos:(sub_pos + 1) ~sub_len ~char_equal + else false + in + fun str ~pos:str_pos ~substring:sub ~char_equal -> + let str_len = length str in + let sub_len = length sub in + if str_pos < 0 || str_pos > str_len + then + invalid_argf + "String.is_substring_at: invalid index %d for string of length %d" + str_pos + str_len + (); + str_pos + sub_len <= str_len + && loop ~str ~str_pos ~sub ~sub_pos:0 ~sub_len ~char_equal +;; + +let is_suffix_gen string ~suffix ~char_equal = + let string_len = length string in + let suffix_len = length suffix in + string_len >= suffix_len + && is_substring_at_gen + string + ~pos:(string_len - suffix_len) + ~substring:suffix + ~char_equal +;; + +let is_prefix_gen string ~prefix ~char_equal = + let string_len = length string in + let prefix_len = length prefix in + string_len >= prefix_len + && is_substring_at_gen string ~pos:0 ~substring:prefix ~char_equal +;; + +module Caseless = struct + module T = struct + type t = string [@@deriving_inline sexp, sexp_grammar] + + let t_of_sexp = (string_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_string : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = string_sexp_grammar + + [@@@end] + + let char_compare_caseless c1 c2 = Char.compare (Char.lowercase c1) (Char.lowercase c2) + + let rec compare_loop ~pos ~string1 ~len1 ~string2 ~len2 = + if pos = len1 + then if pos = len2 then 0 else -1 + else if pos = len2 + then 1 + else ( + let c = char_compare_caseless (unsafe_get string1 pos) (unsafe_get string2 pos) in + match c with + | 0 -> compare_loop ~pos:(pos + 1) ~string1 ~len1 ~string2 ~len2 + | _ -> c) + ;; + + let compare__local string1 string2 = + if phys_equal string1 string2 + then 0 + else + compare_loop + ~pos:0 + ~string1 + ~len1:(String.length string1) + ~string2 + ~len2:(String.length string2) + ;; + + let compare a b = compare__local a b + + let hash_fold_t state t = + let len = length t in + let state = ref (hash_fold_int state len) in + for pos = 0 to len - 1 do + state := hash_fold_char !state (Char.lowercase (unsafe_get t pos)) + done; + !state + ;; + + let hash t = Hash.run hash_fold_t t + let is_suffix s ~suffix = is_suffix_gen s ~suffix ~char_equal:Char.Caseless.equal + let is_prefix s ~prefix = is_prefix_gen s ~prefix ~char_equal:Char.Caseless.equal + let substr_index = substr_index_gen ~case_sensitive:false + let substr_index_exn = substr_index_exn_gen ~case_sensitive:false + let substr_index_all = substr_index_all_gen ~case_sensitive:false + let substr_replace_first = substr_replace_first_gen ~case_sensitive:false + let substr_replace_all = substr_replace_all_gen ~case_sensitive:false + let is_substring = is_substring_gen ~case_sensitive:false + let is_substring_at = is_substring_at_gen ~char_equal:Char.Caseless.equal + end + + include T + include Comparable.Make (T) +end + +let of_string = Fn.id +let to_string = Fn.id + +let init n ~f = + if n < 0 then invalid_argf "String.init %d" n (); + let t = Bytes.create n in + for i = 0 to n - 1 do + Bytes.set t i (f i) + done; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:t +;; + +let to_list s = + let rec loop acc i = if i < 0 then acc else loop (s.[i] :: acc) (i - 1) in + loop [] (length s - 1) +;; + +let to_list_rev s = + let len = length s in + let rec loop acc i = if i = len then acc else loop (s.[i] :: acc) (i + 1) in + loop [] 0 +;; + +let rev t = + let len = length t in + let res = Bytes.create len in + for i = 0 to len - 1 do + Bytes.unsafe_set res i (unsafe_get t (len - 1 - i)) + done; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:res +;; + +(** Efficient string splitting *) + +let lsplit2_exn = + let not_found () = raise (Not_found_s (Atom "String.lsplit2_exn: not found")) in + let lsplit2_exn line ~on:delim = + let len = length line in + let pos = index_from_internal line ~pos:0 ~len ~not_found ~found:Fn.id delim in + sub line ~pos:0 ~len:pos, sub line ~pos:(pos + 1) ~len:(len - pos - 1) + in + (* named to preserve symbol in compiled binary *) + lsplit2_exn +;; + +let rsplit2_exn = + let not_found () = raise (Not_found_s (Atom "String.rsplit2_exn: not found")) in + let rsplit2_exn line ~on:delim = + let len = length line in + let pos = rindex_from_internal line ~pos:(len - 1) ~not_found ~found:Fn.id delim in + sub line ~pos:0 ~len:pos, sub line ~pos:(pos + 1) ~len:(len - pos - 1) + in + (* named to preserve symbol in compiled binary *) + rsplit2_exn +;; + +let lsplit2 line ~on = + try Some (lsplit2_exn line ~on) with + | Not_found_s _ | Stdlib.Not_found -> None +;; + +let rsplit2 line ~on = + try Some (rsplit2_exn line ~on) with + | Not_found_s _ | Stdlib.Not_found -> None +;; + +let rec char_list_mem l (c : char) = + match l with + | [] -> false + | hd :: tl -> Char.equal hd c || char_list_mem tl c +;; + +let split_gen str ~on = + let is_delim = + match on with + | `char c' -> fun c -> Char.equal c c' + | `char_list l -> fun c -> char_list_mem l c + in + let len = length str in + let rec loop acc last_pos pos = + if pos = -1 + then sub str ~pos:0 ~len:last_pos :: acc + else if is_delim str.[pos] + then ( + let pos1 = pos + 1 in + let sub_str = sub str ~pos:pos1 ~len:(last_pos - pos1) in + loop (sub_str :: acc) pos (pos - 1)) + else loop acc last_pos (pos - 1) + in + loop [] len (len - 1) +;; + +let split str ~on = split_gen str ~on:(`char on) +let split_on_chars str ~on:chars = split_gen str ~on:(`char_list chars) +let is_suffix s ~suffix = is_suffix_gen s ~suffix ~char_equal:Char.equal +let is_prefix s ~prefix = is_prefix_gen s ~prefix ~char_equal:Char.equal + +let is_substring_at s ~pos ~substring = + is_substring_at_gen s ~pos ~substring ~char_equal:Char.equal +;; + +let wrap_sub_n t n ~name ~pos ~len ~on_error = + if n < 0 + then invalid_arg (name ^ " expecting nonnegative argument") + else ( + try sub t ~pos ~len with + | _ -> on_error) +;; + +let drop_prefix t n = + wrap_sub_n ~name:"drop_prefix" t n ~pos:n ~len:(length t - n) ~on_error:"" +;; + +let drop_suffix t n = + wrap_sub_n ~name:"drop_suffix" t n ~pos:0 ~len:(length t - n) ~on_error:"" +;; + +let prefix t n = wrap_sub_n ~name:"prefix" t n ~pos:0 ~len:n ~on_error:t +let suffix t n = wrap_sub_n ~name:"suffix" t n ~pos:(length t - n) ~len:n ~on_error:t + +let lfindi ?(pos = 0) t ~f = + let n = length t in + let rec loop i = if i = n then None else if f i t.[i] then Some i else loop (i + 1) in + loop pos [@nontail] +;; + +let find t ~f = + match lfindi t ~f:(fun _ c -> f c) with + | None -> None + | Some i -> Some t.[i] +;; + +let find_map t ~f = + let n = length t in + let rec loop i = + if i = n + then None + else ( + match f t.[i] with + | None -> loop (i + 1) + | Some _ as res -> res) + in + loop 0 [@nontail] +;; + +let rfindi ?pos t ~f = + let rec loop i = if i < 0 then None else if f i t.[i] then Some i else loop (i - 1) in + let pos = + match pos with + | Some pos -> pos + | None -> length t - 1 + in + loop pos [@nontail] +;; + +let last_non_drop ~drop t = rfindi t ~f:(fun _ c -> not (drop c)) [@nontail] + +let rstrip ?(drop = Char.is_whitespace) t = + match last_non_drop t ~drop with + | None -> "" + | Some i -> if i = length t - 1 then t else prefix t (i + 1) +;; + +let first_non_drop ~drop t = lfindi t ~f:(fun _ c -> not (drop c)) [@nontail] + +let lstrip ?(drop = Char.is_whitespace) t = + match first_non_drop t ~drop with + | None -> "" + | Some 0 -> t + | Some n -> drop_prefix t n +;; + +(* [strip t] could be implemented as [lstrip (rstrip t)]. The implementation + below saves (at least) a factor of two allocation, by only allocating the + final result. This also saves some amount of time. *) +let strip ?(drop = Char.is_whitespace) t = + let length = length t in + if length = 0 || not (drop t.[0] || drop t.[length - 1]) + then t + else ( + match first_non_drop t ~drop with + | None -> "" + | Some first -> + (match last_non_drop t ~drop with + | None -> assert false + | Some last -> sub t ~pos:first ~len:(last - first + 1))) +;; + +let mapi t ~f = + let l = length t in + let t' = Bytes.create l in + for i = 0 to l - 1 do + Bytes.unsafe_set t' i (f i t.[i]) + done; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:t' +;; + +(* repeated code to avoid requiring an extra allocation for a closure on each call. *) +let map t ~f = + let l = length t in + let t' = Bytes.create l in + for i = 0 to l - 1 do + Bytes.unsafe_set t' i (f t.[i]) + done; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:t' +;; + +let to_array s = Array.init (length s) ~f:(fun i -> s.[i]) + +let exists = + let rec loop s i ~len ~f = i < len && (f s.[i] || loop s (i + 1) ~len ~f) in + fun s ~f -> loop s 0 ~len:(length s) ~f +;; + +let for_all = + let rec loop s i ~len ~f = i = len || (f s.[i] && loop s (i + 1) ~len ~f) in + fun s ~f -> loop s 0 ~len:(length s) ~f +;; + +let fold = + let rec loop t i ac ~f ~len = + if i = len then ac else loop t (i + 1) (f ac t.[i]) ~f ~len + in + fun t ~init ~f -> loop t 0 init ~f ~len:(length t) +;; + +let foldi = + let rec loop t i ac ~f ~len = + if i = len then ac else loop t (i + 1) (f i ac t.[i]) ~f ~len + in + fun t ~init ~f -> loop t 0 init ~f ~len:(length t) +;; + +let iteri t ~f = + for i = 0 to length t - 1 do + f i (unsafe_get t i) + done +;; + +let count t ~f = Container.count ~fold t ~f +let sum m t ~f = Container.sum ~fold m t ~f +let min_elt t = Container.min_elt ~fold t +let max_elt t = Container.max_elt ~fold t +let fold_result t ~init ~f = Container.fold_result ~fold ~init ~f t +let fold_until t ~init ~f ~finish = Container.fold_until ~fold ~init ~f t ~finish +let find_mapi t ~f = Indexed_container.find_mapi ~iteri t ~f +let findi t ~f = Indexed_container.findi ~iteri t ~f +let counti t ~f = Indexed_container.counti ~foldi t ~f +let for_alli t ~f = Indexed_container.for_alli ~iteri t ~f +let existsi t ~f = Indexed_container.existsi ~iteri t ~f + +let mem = + let rec loop t c ~pos:i ~len = + i < len && (Char.equal c (unsafe_get t i) || loop t c ~pos:(i + 1) ~len) + in + fun t c -> loop t c ~pos:0 ~len:(length t) +;; + +let tr ~target ~replacement s = + if Char.equal target replacement + then s + else if mem s target + then map s ~f:(fun c -> if Char.equal c target then replacement else c) + else s +;; + +let tr_multi ~target ~replacement = + if is_empty target + then stage Fn.id + else if is_empty replacement + then invalid_arg "tr_multi replacement is empty string" + else ( + match Bytes_tr.tr_create_map ~target ~replacement with + | None -> stage Fn.id + | Some tr_map -> + stage (fun s -> + if exists s ~f:(fun c -> Char.( <> ) c (unsafe_get tr_map (Char.to_int c))) + then map s ~f:(fun c -> unsafe_get tr_map (Char.to_int c)) + else s)) +;; + +(* fast version, if we ever need it: + {[ + let concat_array ~sep ar = + let ar_len = Array.length ar in + if ar_len = 0 then "" + else + let sep_len = length sep in + let res_len_ref = ref (sep_len * (ar_len - 1)) in + for i = 0 to ar_len - 1 do + res_len_ref := !res_len_ref + length ar.(i) + done; + let res = create !res_len_ref in + let str_0 = ar.(0) in + let len_0 = length str_0 in + blit ~src:str_0 ~src_pos:0 ~dst:res ~dst_pos:0 ~len:len_0; + let pos_ref = ref len_0 in + for i = 1 to ar_len - 1 do + let pos = !pos_ref in + blit ~src:sep ~src_pos:0 ~dst:res ~dst_pos:pos ~len:sep_len; + let new_pos = pos + sep_len in + let str_i = ar.(i) in + let len_i = length str_i in + blit ~src:str_i ~src_pos:0 ~dst:res ~dst_pos:new_pos ~len:len_i; + pos_ref := new_pos + len_i + done; + res + ]} *) + +let concat_array ?sep ar = concat ?sep (Array.to_list ar) +let concat_map ?sep s ~f = concat_array ?sep (Array.map (to_array s) ~f) +let concat_mapi ?sep t ~f = concat_array ?sep (Array.mapi (to_array t) ~f) + +let concat_lines = + let rec line_lengths ~lines ~newline_len ~sum = + match lines with + | [] -> sum + | line :: lines -> + let sum = sum + String.length line + newline_len in + line_lengths ~lines ~newline_len ~sum + in + let rec write_lines ~buf ~lines ~crlf ~pos = + match lines with + | [] -> pos + | line :: lines -> + Bytes.unsafe_blit_string + ~src:line + ~src_pos:0 + ~dst:buf + ~dst_pos:pos + ~len:(String.length line); + let pos = pos + String.length line in + let pos = + if crlf + then ( + Bytes.unsafe_set buf pos '\r'; + pos + 1) + else pos + in + Bytes.unsafe_set buf pos '\n'; + let pos = pos + 1 in + write_lines ~buf ~lines ~crlf ~pos + in + fun ?(crlf = false) lines -> + let newline_len = if crlf then 2 else 1 in + let len = line_lengths ~newline_len ~lines ~sum:0 in + let buf = Bytes.create len in + let written = write_lines ~buf ~lines ~crlf ~pos:0 in + assert (written = len); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:buf +;; + +(* [filter t f] is implemented by the following algorithm. + + Let [n = length t]. + + 1. Find the lowest [i] such that [not (f t.[i])]. + + 2. If there is no such [i], then return [t]. + + 3. If there is such an [i], allocate a string, [out], to hold the result. [out] has + length [n - 1], which is the maximum possible output size given that there is at least + one character not satisfying [f]. + + 4. Copy characters at indices 0 ... [i - 1] from [t] to [out]. + + 5. Walk through characters at indices [i+1] ... [n-1] of [t], copying those that + satisfy [f] from [t] to [out]. + + 6. If we completely filled [out], then return it. If not, return the prefix of [out] + that we did fill in. + + This algorithm has the property that it doesn't allocate a new string if there's + nothing to filter, which is a common case. *) +let filter t ~f = + let n = length t in + let i = ref 0 in + while !i < n && f t.[!i] do + incr i + done; + if !i = n + then t + else ( + let out = Bytes.create (n - 1) in + Bytes.blit_string ~src:t ~src_pos:0 ~dst:out ~dst_pos:0 ~len:!i; + let out_pos = ref !i in + incr i; + while !i < n do + let c = t.[!i] in + if f c + then ( + Bytes.set out !out_pos c; + incr out_pos); + incr i + done; + let out = Bytes.unsafe_to_string ~no_mutation_while_string_reachable:out in + if !out_pos = n - 1 then out else sub out ~pos:0 ~len:!out_pos) +;; + +(* repeated code to avoid requiring an extra allocation for a closure on each call. *) +let filteri t ~f = + let n = length t in + let i = ref 0 in + while !i < n && f !i t.[!i] do + incr i + done; + if !i = n + then t + else ( + let out = Bytes.create (n - 1) in + Bytes.blit_string ~src:t ~src_pos:0 ~dst:out ~dst_pos:0 ~len:!i; + let out_pos = ref !i in + incr i; + while !i < n do + let c = t.[!i] in + if f !i c + then ( + Bytes.set out !out_pos c; + incr out_pos); + incr i + done; + let out = Bytes.unsafe_to_string ~no_mutation_while_string_reachable:out in + if !out_pos = n - 1 then out else sub out ~pos:0 ~len:!out_pos) +;; + +let chop_prefix s ~prefix = + if is_prefix s ~prefix then Some (drop_prefix s (length prefix)) else None +;; + +let chop_prefix_if_exists s ~prefix = + if is_prefix s ~prefix then drop_prefix s (length prefix) else s +;; + +let chop_prefix_exn s ~prefix = + match chop_prefix s ~prefix with + | Some str -> str + | None -> invalid_argf "String.chop_prefix_exn %S %S" s prefix () +;; + +let chop_suffix s ~suffix = + if is_suffix s ~suffix then Some (drop_suffix s (length suffix)) else None +;; + +let chop_suffix_if_exists s ~suffix = + if is_suffix s ~suffix then drop_suffix s (length suffix) else s +;; + +let chop_suffix_exn s ~suffix = + match chop_suffix s ~suffix with + | Some str -> str + | None -> invalid_argf "String.chop_suffix_exn %S %S" s suffix () +;; + +module For_common_prefix_and_suffix = struct + (* When taking a string prefix or suffix, we extract from the shortest input available + in case we can just return one of our inputs without allocating a new string. *) + + let shorter a b = if length a <= length b then a else b + + let shortest list = + match list with + | [] -> "" + | first :: rest -> List.fold rest ~init:first ~f:shorter + ;; + + (* Our generic accessors for common prefix/suffix abstract over [get_pos], which is + either [pos_from_left] or [pos_from_right]. *) + + let pos_from_left (_ : t) (i : int) = i + let pos_from_right t i = length t - i - 1 + + let rec common_generic2_length_loop a b ~get_pos ~max_len ~len_so_far = + if len_so_far >= max_len + then max_len + else if Char.equal + (unsafe_get a (get_pos a len_so_far)) + (unsafe_get b (get_pos b len_so_far)) + then common_generic2_length_loop a b ~get_pos ~max_len ~len_so_far:(len_so_far + 1) + else len_so_far + ;; + + let common_generic2_length a b ~get_pos = + let max_len = min (length a) (length b) in + common_generic2_length_loop a b ~get_pos ~max_len ~len_so_far:0 + ;; + + let rec common_generic_length_loop first list ~get_pos ~max_len = + match list with + | [] -> max_len + | second :: rest -> + let max_len = + (* We call [common_generic2_length_loop] rather than [common_generic2_length] so + that [max_len] limits our traversal of [first] and [second]. *) + common_generic2_length_loop first second ~get_pos ~max_len ~len_so_far:0 + in + common_generic_length_loop second rest ~get_pos ~max_len + ;; + + let common_generic_length list ~get_pos = + match list with + | [] -> 0 + | first :: rest -> + (* Precomputing [max_len] based on [shortest list] saves us work in longer strings, + at the cost of an extra pass over the spine of [list]. + + For example, if you're looking for the longest prefix of the strings: + + {v + let long_a = List.init 1000 ~f:(Fn.const 'a') + [ long_a; long_a; 'aa' ] + v} + + the approach below will just check the first two characters of all the strings. + *) + let max_len = length (shortest list) in + common_generic_length_loop first rest ~get_pos ~max_len + ;; + + (* Our generic accessors that produce a string abstract over [take], which is either + [prefix] or [suffix]. *) + + let common_generic2 a b ~get_pos ~take = + let len = common_generic2_length a b ~get_pos in + (* Use the shorter of the two strings, so that if the shorter one is the shared + prefix, [take] won't allocate another string. *) + take (shorter a b) len + ;; + + let common_generic list ~get_pos ~take = + match list with + | [] -> "" + | first :: rest -> + (* As with [common_generic_length], we base [max_len] on [shortest list]. We also + use this result for [take], below, to potentially avoid allocating a string. *) + let s = shortest list in + let max_len = length s in + if max_len = 0 + then "" + else ( + let len = + (* We call directly into [common_generic_length_loop] rather than + [common_generic_length] to avoid recomputing [shortest list]. *) + common_generic_length_loop first rest ~get_pos ~max_len + in + take s len) + ;; +end + +include struct + open For_common_prefix_and_suffix + + let common_prefix list = common_generic list ~take:prefix ~get_pos:pos_from_left + let common_suffix list = common_generic list ~take:suffix ~get_pos:pos_from_right + let common_prefix2 a b = common_generic2 a b ~take:prefix ~get_pos:pos_from_left + let common_suffix2 a b = common_generic2 a b ~take:suffix ~get_pos:pos_from_right + let common_prefix_length list = common_generic_length list ~get_pos:pos_from_left + let common_suffix_length list = common_generic_length list ~get_pos:pos_from_right + let common_prefix2_length a b = common_generic2_length a b ~get_pos:pos_from_left + let common_suffix2_length a b = common_generic2_length a b ~get_pos:pos_from_right +end + +(* There used to be a custom implementation that was faster for very short strings + (peaking at 40% faster for 4-6 char long strings). + This new function is around 20% faster than the default hash function, but slower + than the previous custom implementation. However, the new OCaml function is well + behaved, and this implementation is less likely to diverge from the default OCaml + implementation does, which is a desirable property. (The only way to avoid the + divergence is to expose the macro redefined in hash_stubs.c in the hash.h header of + the OCaml compiler.) *) +module Hash = struct + external hash : string -> int = "Base_hash_string" [@@noalloc] +end + +(* [include Hash] to make the [external] version override the [hash] from + [Hashable.Make_binable], so that we get a little bit of a speedup by exposing it as + external in the mli. *) +let _ = hash + +include Hash + +(* for interactive top-levels -- modules deriving from String should have String's pretty + printer. *) +let pp ppf string = Stdlib.Format.fprintf ppf "%S" string +let of_char c = make 1 c + +let of_char_list l = + let t = Bytes.create (List.length l) in + List.iteri l ~f:(fun i c -> Bytes.set t i c); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:t +;; + +let of_list = of_char_list +let of_array a = init (Array.length a) ~f:(Array.get a) + +let to_sequence t = + let len = length t in + Sequence.unfold_step ~init:0 ~f:(fun pos -> + if pos >= len then Done else Yield { value = unsafe_get t pos; state = pos + 1 }) +;; + +let of_sequence s = of_list (Sequence.to_list s) +let append = ( ^ ) + +let pad_right ?(char = ' ') s ~len = + let src_len = length s in + if src_len >= len + then s + else ( + let res = Bytes.create len in + Bytes.blit_string ~src:s ~dst:res ~src_pos:0 ~dst_pos:0 ~len:src_len; + Bytes.fill ~pos:src_len ~len:(len - src_len) res char; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:res) +;; + +let pad_left ?(char = ' ') s ~len = + let src_len = length s in + if src_len >= len + then s + else ( + let res = Bytes.create len in + Bytes.blit_string ~src:s ~dst:res ~src_pos:0 ~dst_pos:(len - src_len) ~len:src_len; + Bytes.fill ~pos:0 ~len:(len - src_len) res char; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:res) +;; + +(* Called upon first difference generated by filtering. Allocates [buffer_len] bytes + for new result, and copies [prefix_len] unchanged characters from [src]. + Always returns a local buffer. *) +let local_copy_prefix src ~prefix_len ~buffer_len = + let dst = Bytes.create_local buffer_len in + Bytes.Primitives.unsafe_blit_string ~src ~dst ~src_pos:0 ~dst_pos:0 ~len:prefix_len; + dst +;; + +(* Copies a perhaps-local buffer into a definitely-global string. *) +let local_copy_to_string buf ~pos = + let str = Bytes.unsafe_to_string ~no_mutation_while_string_reachable:buf in + unsafe_sub str ~pos:0 ~len:pos [@nontail] +;; + +include struct + open struct + (* filter_map helpers *) + + (* Filters from string [src] into an allocated buffer [dst]; + copies the allocated buffer to a heap-allocated result string. + + Pre-conditions: + [src_len = length src] + [src != dst] + [0 <= src_pos < src_len] + [0 <= dst_pos < length dst] + *) + let filter_mapi_into src dst ~f ~src_pos ~dst_pos ~src_len = + let dst_pos = ref dst_pos in + for src_pos = src_pos to src_len - 1 do + match f src_pos (unsafe_get src src_pos) with + | None -> () + | Some c -> + Bytes.unsafe_set dst !dst_pos c; + incr dst_pos + done; + local_copy_to_string dst ~pos:!dst_pos + ;; + + (* Filters [t]. If the result turns out to be identical to the input, returns [t] + directly without needing to allocate a buffer and traverse the string twice. + + Pre-condition: [len == length t] + Pre-condition: [0 <= pos <= len] *) + let rec filter_mapi_maybe_id t ~f ~pos ~len = + if pos = len + then t + else ( + let c1 = unsafe_get t pos in + let next = Int.succ pos in + match f pos c1 with + | Some c2 when Char.equal c1 c2 -> + (* if nothing has changed, continue *) + filter_mapi_maybe_id t ~f ~pos:next ~len + | option -> + (* If a character has been changed or dropped, begin an output buffer up to + [pos], and write the new character into it. *) + let copy = local_copy_prefix t ~prefix_len:pos ~buffer_len:len in + let dst_pos = + match option with + | None -> pos + | Some c -> + Bytes.unsafe_set copy pos c; + next + in + filter_mapi_into t copy ~f ~src_pos:next ~dst_pos ~src_len:len [@nontail]) + ;; + end + + (* filter_map functions *) + + let filter_mapi t ~f = filter_mapi_maybe_id t ~f ~pos:0 ~len:(length t) + let filter_map t ~f = filter_mapi t ~f:(fun _ c -> f c) [@nontail] +end + +include struct + open struct + (* partition helpers *) + + let partition_map_into src ~fsts ~snds ~f ~len ~src_pos ~fst_pos ~snd_pos = + let fst_pos = ref fst_pos in + let snd_pos = ref snd_pos in + for src_pos = src_pos to len - 1 do + match (f (unsafe_get src src_pos) : (_, _) Either.t) with + | First c -> + Bytes.unsafe_set fsts !fst_pos c; + incr fst_pos + | Second c -> + Bytes.unsafe_set snds !snd_pos c; + incr snd_pos + done; + local_copy_to_string fsts ~pos:!fst_pos, local_copy_to_string snds ~pos:!snd_pos + ;; + + let partition_map_difference src ~f ~len ~pos:src_pos ~fst_pos ~snd_pos either = + let fsts = local_copy_prefix src ~prefix_len:fst_pos ~buffer_len:len in + let snds = local_copy_prefix src ~prefix_len:snd_pos ~buffer_len:len in + let fst_pos, snd_pos = + match (either : (_, _) Either.t) with + | First c -> + Bytes.unsafe_set fsts fst_pos c; + fst_pos + 1, snd_pos + | Second c -> + Bytes.unsafe_set snds snd_pos c; + fst_pos, snd_pos + 1 + in + partition_map_into + src + ~fsts + ~snds + ~f + ~len + ~src_pos:(src_pos + 1) + ~fst_pos + ~snd_pos [@nontail] + ;; + + let rec partition_map_first_maybe_id src ~f ~pos ~len = + if pos = len + then src, "" + else ( + let c1 = unsafe_get src pos in + match (f c1 : (_, _) Either.t) with + | First c2 when Char.equal c1 c2 -> + partition_map_first_maybe_id src ~f ~len ~pos:(pos + 1) + | either -> + partition_map_difference + src + ~f + ~len + ~pos + ~fst_pos:pos + ~snd_pos:0 + either [@nontail]) + ;; + + let rec partition_map_second_maybe_id src ~f ~pos ~len = + if pos = len + then "", src + else ( + let c1 = unsafe_get src pos in + match (f c1 : (_, _) Either.t) with + | Second c2 when Char.equal c1 c2 -> + partition_map_second_maybe_id src ~f ~len ~pos:(pos + 1) + | either -> + partition_map_difference + src + ~f + ~len + ~pos + ~fst_pos:0 + ~snd_pos:pos + either [@nontail]) + ;; + end + + (* partition functions *) + + let partition_map src ~f = + let len = length src in + if len = 0 + then "", "" + else ( + let c1 = unsafe_get src 0 in + match (f c1 : (_, _) Either.t) with + | First c2 when Char.equal c1 c2 -> partition_map_first_maybe_id src ~f ~len ~pos:1 + | Second c2 when Char.equal c1 c2 -> + partition_map_second_maybe_id src ~f ~len ~pos:1 + | either -> + partition_map_difference + src + ~f + ~len + ~pos:0 + ~fst_pos:0 + ~snd_pos:0 + either [@nontail]) + ;; + + let partition_tf t ~f = + partition_map t ~f:(fun c -> if f c then First c else Second c) [@nontail] + ;; +end + +let edit_distance s1 s2 = + (* We maintain a table of edit distance between all indices of the shorter string, and + the current and previous indices of the longer string. *) + let s1, s2 = if String.length s1 <= String.length s2 then s1, s2 else s2, s1 in + let table = Array.create_local ~len:(2 * (1 + String.length s1)) 0 in + let at i j = (i * 2) + (j mod 2) in + for i = 1 to String.length s1 do + (* Insert [i] characters when [j=0]. *) + table.(at i 0) <- i + done; + for j = 1 to String.length s2 do + (* Insert [j] characters when [i=0]. *) + table.(at 0 j) <- j; + for i = 1 to String.length s1 do + if Char.equal s1.[i - 1] s2.[j - 1] + then + (* Nothing to edit for the current character. *) + table.(at i j) <- table.(at (i - 1) (j - 1)) + else ( + (* Edit the current character by substitution, addition, or deletion. *) + let sub = table.(at (i - 1) (j - 1)) in + let add = table.(at (i - 1) j) in + let del = table.(at i (j - 1)) in + table.(at i j) <- 1 + min sub (min add del)) + done + done; + (* Return the final result. *) + table.(at (String.length s1) (String.length s2)) +;; + +module Escaping = struct + (* If this is changed, make sure to update [escape], which attempts to ensure all the + invariants checked here. *) + let build_and_validate_escapeworthy_map escapeworthy_map escape_char func = + let escapeworthy_map = + if List.Assoc.mem escapeworthy_map ~equal:Char.equal escape_char + then escapeworthy_map + else (escape_char, escape_char) :: escapeworthy_map + in + let arr = Array.create ~len:256 (-1) in + let vals = Array.create ~len:256 false in + let rec loop = function + | [] -> Ok arr + | (c_from, c_to) :: l -> + let k, v = + match func with + | `Escape -> Char.to_int c_from, c_to + | `Unescape -> Char.to_int c_to, c_from + in + if arr.(k) <> -1 || vals.(Char.to_int v) + then + Or_error.error_s + (Sexp.message + "escapeworthy_map not one-to-one" + [ "c_from", sexp_of_char c_from + ; "c_to", sexp_of_char c_to + ; ( "escapeworthy_map" + , sexp_of_list (sexp_of_pair sexp_of_char sexp_of_char) escapeworthy_map + ) + ]) + else ( + arr.(k) <- Char.to_int v; + vals.(Char.to_int v) <- true; + loop l) + in + loop escapeworthy_map + ;; + + let escape_gen ~escapeworthy_map ~escape_char = + match build_and_validate_escapeworthy_map escapeworthy_map escape_char `Escape with + | Error _ as x -> x + | Ok escapeworthy -> + Ok + (fun src -> + (* calculate a list of (index of char to escape * escaped char) first, the order + is from tail to head *) + let to_escape_len = ref 0 in + let to_escape = + foldi src ~init:[] ~f:(fun i acc c -> + match escapeworthy.(Char.to_int c) with + | -1 -> acc + | n -> + (* (index of char to escape * escaped char) *) + incr to_escape_len; + (i, Char.unsafe_of_int n) :: acc) + in + match to_escape with + | [] -> src + | _ -> + (* [to_escape] divide [src] to [List.length to_escape + 1] pieces separated by + the chars to escape. + + Lets take + {[ + escape_gen_exn + ~escapeworthy_map:[('a', 'A'); ('b', 'B'); ('c', 'C')] + ~escape_char:'_' + ]} + for example, and assume the string to escape is + + "000a111b222c333" + + then [to_escape] is [(11, 'C'); (7, 'B'); (3, 'A')]. + + Then we create a [dst] of length [length src + 3] to store the + result, copy piece "333" to [dst] directly, then copy '_' and 'C' to [dst]; + then move on to next; after 3 iterations, copy piece "000" and we are done. + + Finally the result will be + + "000_A111_B222_C333" *) + let src_len = length src in + let dst_len = src_len + !to_escape_len in + let dst = Bytes.create dst_len in + let rec loop last_idx last_dst_pos = function + | [] -> + (* copy "000" at last *) + Bytes.blit_string ~src ~src_pos:0 ~dst ~dst_pos:0 ~len:last_idx + | (idx, escaped_char) :: to_escape -> + (*[idx] = the char to escape*) + (* take first iteration for example *) + (* calculate length of "333", minus 1 because we don't copy 'c' *) + let len = last_idx - idx - 1 in + (* set the dst_pos to copy to *) + let dst_pos = last_dst_pos - len in + (* copy "333", set [src_pos] to [idx + 1] to skip 'c' *) + Bytes.blit_string ~src ~src_pos:(idx + 1) ~dst ~dst_pos ~len; + (* backoff [dst_pos] by 2 to copy '_' and 'C' *) + let dst_pos = dst_pos - 2 in + Bytes.set dst dst_pos escape_char; + Bytes.set dst (dst_pos + 1) escaped_char; + loop idx dst_pos to_escape + in + (* set [last_dst_pos] and [last_idx] to length of [dst] and [src] first *) + loop src_len dst_len to_escape; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst) + ;; + + let escape_gen_exn ~escapeworthy_map ~escape_char = + Or_error.ok_exn (escape_gen ~escapeworthy_map ~escape_char) |> stage + ;; + + let escape ~escapeworthy ~escape_char = + (* For [escape_gen_exn], we don't know how to fix invalid escapeworthy_map so we have + to raise exception; but in this case, we know how to fix duplicated elements in + escapeworthy list, so we just fix it instead of raising exception to make this + function easier to use. *) + let escapeworthy_map = + escapeworthy + |> List.dedup_and_sort ~compare:Char.compare + |> List.map ~f:(fun c -> c, c) + in + escape_gen_exn ~escapeworthy_map ~escape_char + ;; + + (* In an escaped string, any char is either `Escaping, `Escaped or `Literal. For + example, the escape statuses of chars in string "a_a__" with escape_char = '_' are + + a : `Literal + _ : `Escaping + a : `Escaped + _ : `Escaping + _ : `Escaped + + [update_escape_status str ~escape_char i previous_status] gets escape status of + str.[i] basing on escape status of str.[i - 1] *) + let update_escape_status str ~escape_char i = function + | `Escaping -> `Escaped + | `Literal | `Escaped -> + if Char.equal str.[i] escape_char then `Escaping else `Literal + ;; + + let unescape_gen ~escapeworthy_map ~escape_char = + match build_and_validate_escapeworthy_map escapeworthy_map escape_char `Unescape with + | Error _ as x -> x + | Ok escapeworthy -> + Ok + (fun src -> + (* Continue the example in [escape_gen_exn], now we unescape + + "000_A111_B222_C333" + + back to + + "000a111b222c333" + + Then [to_unescape] is [14; 9; 4], which is indexes of '_'s. + + Then we create a string [dst] to store the result, copy "333" to it, then copy + 'c', then move on to next iteration. After 3 iterations copy "000" and we are + done. *) + (* indexes of escape chars *) + let to_unescape = + let rec loop i status acc = + if i >= length src + then acc + else ( + let status = update_escape_status src ~escape_char i status in + loop + (i + 1) + status + (match status with + | `Escaping -> i :: acc + | `Escaped | `Literal -> acc)) + in + loop 0 `Literal [] + in + match to_unescape with + | [] -> src + | idx :: to_unescape' -> + let dst = Bytes.create (length src - List.length to_unescape) in + let rec loop last_idx last_dst_pos = function + | [] -> + (* copy "000" at last *) + Bytes.blit_string ~src ~src_pos:0 ~dst ~dst_pos:0 ~len:last_idx + | idx :: to_unescape -> + (* [idx] = index of escaping char *) + (* take 1st iteration as example, calculate the length of "333", minus 2 to + skip '_C' *) + let len = last_idx - idx - 2 in + (* point [dst_pos] to the position to copy "333" to *) + let dst_pos = last_dst_pos - len in + (* copy "333" *) + Bytes.blit_string ~src ~src_pos:(idx + 2) ~dst ~dst_pos ~len; + (* backoff [dst_pos] by 1 to copy 'c' *) + let dst_pos = dst_pos - 1 in + Bytes.set + dst + dst_pos + (match escapeworthy.(Char.to_int src.[idx + 1]) with + | -1 -> src.[idx + 1] + | n -> Char.unsafe_of_int n); + (* update [last_dst_pos] and [last_idx] *) + loop idx dst_pos to_unescape + in + if idx < length src - 1 + then + (* set [last_dst_pos] and [last_idx] to length of [dst] and [src] *) + loop (length src) (Bytes.length dst) to_unescape + else + (* for escaped string ending with an escaping char like "000_", just ignore + the last escaping char *) + loop (length src - 1) (Bytes.length dst) to_unescape'; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst) + ;; + + let unescape_gen_exn ~escapeworthy_map ~escape_char = + Or_error.ok_exn (unescape_gen ~escapeworthy_map ~escape_char) |> stage + ;; + + let unescape ~escape_char = unescape_gen_exn ~escapeworthy_map:[] ~escape_char + + let preceding_escape_chars str ~escape_char pos = + let rec loop p cnt = + if p < 0 || Char.( <> ) str.[p] escape_char then cnt else loop (p - 1) (cnt + 1) + in + loop (pos - 1) 0 + ;; + + (* In an escaped string, any char is either `Escaping, `Escaped or `Literal. For + example, the escape statuses of chars in string "a_a__" with escape_char = '_' are + + a : `Literal + _ : `Escaping + a : `Escaped + _ : `Escaping + _ : `Escaped + + [update_escape_status str ~escape_char i previous_status] gets escape status of + str.[i] basing on escape status of str.[i - 1] *) + let update_escape_status str ~escape_char i = function + | `Escaping -> `Escaped + | `Literal | `Escaped -> + if Char.equal str.[i] escape_char then `Escaping else `Literal + ;; + + let escape_status str ~escape_char pos = + let odd = preceding_escape_chars str ~escape_char pos mod 2 = 1 in + match odd, Char.equal str.[pos] escape_char with + | true, (true | false) -> `Escaped + | false, true -> `Escaping + | false, false -> `Literal + ;; + + let check_bound str pos function_name = + if pos >= length str || pos < 0 then invalid_argf "%s: out of bounds" function_name () + ;; + + let is_char_escaping str ~escape_char pos = + check_bound str pos "is_char_escaping"; + match escape_status str ~escape_char pos with + | `Escaping -> true + | `Escaped | `Literal -> false + ;; + + let is_char_escaped str ~escape_char pos = + check_bound str pos "is_char_escaped"; + match escape_status str ~escape_char pos with + | `Escaped -> true + | `Escaping | `Literal -> false + ;; + + let is_char_literal str ~escape_char pos = + check_bound str pos "is_char_literal"; + match escape_status str ~escape_char pos with + | `Literal -> true + | `Escaped | `Escaping -> false + ;; + + let index_from str ~escape_char pos char = + check_bound str pos "index_from"; + let rec loop i status = + if i >= pos + && (match status with + | `Literal -> true + | `Escaped | `Escaping -> false) + && Char.equal str.[i] char + then Some i + else ( + let i = i + 1 in + if i >= length str + then None + else loop i (update_escape_status str ~escape_char i status)) + in + loop pos (escape_status str ~escape_char pos) + ;; + + let index_from_exn str ~escape_char pos char = + match index_from str ~escape_char pos char with + | None -> + raise_s + (Sexp.message + "index_from_exn: not found" + [ "str", sexp_of_t str + ; "escape_char", sexp_of_char escape_char + ; "pos", sexp_of_int pos + ; "char", sexp_of_char char + ]) + | Some pos -> pos + ;; + + let index str ~escape_char char = index_from str ~escape_char 0 char + let index_exn str ~escape_char char = index_from_exn str ~escape_char 0 char + + let rindex_from str ~escape_char pos char = + check_bound str pos "rindex_from"; + (* if the target char is the same as [escape_char], we have no way to determine which + escape_char is literal, so just return None *) + if Char.equal char escape_char + then None + else ( + let rec loop pos = + if pos < 0 + then None + else ( + let escape_chars = preceding_escape_chars str ~escape_char pos in + if escape_chars mod 2 = 0 && Char.equal str.[pos] char + then Some pos + else loop (pos - escape_chars - 1)) + in + loop pos) + ;; + + let rindex_from_exn str ~escape_char pos char = + match rindex_from str ~escape_char pos char with + | None -> + raise_s + (Sexp.message + "rindex_from_exn: not found" + [ "str", sexp_of_t str + ; "escape_char", sexp_of_char escape_char + ; "pos", sexp_of_int pos + ; "char", sexp_of_char char + ]) + | Some pos -> pos + ;; + + let rindex str ~escape_char char = + if is_empty str then None else rindex_from str ~escape_char (length str - 1) char + ;; + + let rindex_exn str ~escape_char char = + rindex_from_exn str ~escape_char (length str - 1) char + ;; + + (* [split_gen str ~escape_char ~on] works similarly to [String.split_gen], with an + additional requirement: only split on literal chars, not escaping or escaped *) + let split_gen str ~escape_char ~on = + let is_delim = + match on with + | `char c' -> fun c -> Char.equal c c' + | `char_list l -> fun c -> char_list_mem l c + in + let len = length str in + let rec loop acc status last_pos pos = + if pos = len + then List.rev (sub str ~pos:last_pos ~len:(len - last_pos) :: acc) + else ( + let status = update_escape_status str ~escape_char pos status in + if (match status with + | `Literal -> true + | `Escaped | `Escaping -> false) + && is_delim str.[pos] + then ( + let sub_str = sub str ~pos:last_pos ~len:(pos - last_pos) in + loop (sub_str :: acc) status (pos + 1) (pos + 1)) + else loop acc status last_pos (pos + 1)) + in + loop [] `Literal 0 0 + ;; + + let split str ~on = split_gen str ~on:(`char on) + let split_on_chars str ~on:chars = split_gen str ~on:(`char_list chars) + + let split_at str pos = + sub str ~pos:0 ~len:pos, sub str ~pos:(pos + 1) ~len:(length str - pos - 1) + ;; + + let lsplit2 str ~on ~escape_char = + Option.map (index str ~escape_char on) ~f:(fun x -> split_at str x) + ;; + + let rsplit2 str ~on ~escape_char = + Option.map (rindex str ~escape_char on) ~f:(fun x -> split_at str x) + ;; + + let lsplit2_exn str ~on ~escape_char = split_at str (index_exn str ~escape_char on) + let rsplit2_exn str ~on ~escape_char = split_at str (rindex_exn str ~escape_char on) + + (* [last_non_drop_literal] and [first_non_drop_literal] are either both [None] or both + [Some]. If [Some], then the former is >= the latter. *) + let last_non_drop_literal ~drop ~escape_char t = + rfindi t ~f:(fun i c -> + (not (drop c)) + || is_char_escaping t ~escape_char i + || is_char_escaped t ~escape_char i) [@nontail] + ;; + + let first_non_drop_literal ~drop ~escape_char t = + lfindi t ~f:(fun i c -> + (not (drop c)) + || is_char_escaping t ~escape_char i + || is_char_escaped t ~escape_char i) [@nontail] + ;; + + let rstrip_literal ?(drop = Char.is_whitespace) t ~escape_char = + match last_non_drop_literal t ~drop ~escape_char with + | None -> "" + | Some i -> if i = length t - 1 then t else prefix t (i + 1) + ;; + + let lstrip_literal ?(drop = Char.is_whitespace) t ~escape_char = + match first_non_drop_literal t ~drop ~escape_char with + | None -> "" + | Some 0 -> t + | Some n -> drop_prefix t n + ;; + + (* [strip t] could be implemented as [lstrip (rstrip t)]. The implementation + below saves (at least) a factor of two allocation, by only allocating the + final result. This also saves some amount of time. *) + let strip_literal ?(drop = Char.is_whitespace) t ~escape_char = + let length = length t in + (* performance hack: avoid copying [t] in common cases *) + if length = 0 || not (drop t.[0] || drop t.[length - 1]) + then t + else ( + match first_non_drop_literal t ~drop ~escape_char with + | None -> "" + | Some first -> + (match last_non_drop_literal t ~drop ~escape_char with + | None -> assert false + | Some last -> sub t ~pos:first ~len:(last - first + 1))) + ;; +end + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! String_replace_polymorphic_compare + +let between t ~low ~high = low <= t && t <= high +let clamp_unchecked t ~min ~max = if t < min then min else if t <= max then t else max + +let clamp_exn t ~min ~max = + assert (min <= max); + clamp_unchecked t ~min ~max +;; + +let clamp t ~min ~max = + if min > max + then + Or_error.error_s + (Sexp.message + "clamp requires [min <= max]" + [ "min", T.sexp_of_t min; "max", T.sexp_of_t max ]) + else Ok (clamp_unchecked t ~min ~max) +;; + +(* Override [Search_pattern] with default case-sensitivity argument at the end of the + file, so that call sites above are forced to supply case-sensitivity explicitly. *) +module Search_pattern = struct + include Search_pattern0 + + let create ?(case_sensitive = true) pattern = create pattern ~case_sensitive +end + +module Make_utf (Format : sig + val codec_name : string + val module_name : string + val is_valid : t -> bool + val byte_length : Uchar.t -> int + val get_decode_result : t -> byte_pos:int -> Uchar.utf_decode + val set : bytes -> int -> Uchar.t -> int +end) = +struct + type elt = Uchar.t + type t = string + + let codec_name = Format.codec_name + let is_valid = Format.is_valid + + let raise_get_message = + lazy + (Printf.sprintf + "%s.get: invalid %s encoding at given position" + Format.module_name + Format.codec_name) + ;; + + let[@cold] raise_get t pos = + raise_s + (Sexp.message (Lazy.force raise_get_message) [ "", Atom t; "pos", sexp_of_int pos ]) + ;; + + let get t ~byte_pos = + (* Even if [t] is validated, we need to validate [pos], so we check the decoding *) + let decode = Format.get_decode_result t ~byte_pos in + if Uchar.utf_decode_is_valid decode + then Uchar.utf_decode_uchar decode + else raise_get t byte_pos + ;; + + let to_string = Fn.id + let of_string_unchecked = Fn.id + + let raise_of_string_message = + concat [ Format.module_name; ".of_string: invalid "; codec_name ] + ;; + + let[@cold] raise_of_string string = + raise_s (Sexp.message raise_of_string_message [ "", Atom string ]) + ;; + + let of_string string = + match is_valid string with + | true -> string + | false -> raise_of_string string + ;; + + include Sexpable.Of_stringable (struct + type nonrec t = t + + let of_string = of_string + let to_string = to_string + end) + + include Identifiable.Make (struct + type nonrec t = t + + let compare = compare + let hash = hash + let hash_fold_t = hash_fold_t + let of_string = of_string + let to_string = to_string + let sexp_of_t = sexp_of_t + let t_of_sexp = t_of_sexp + let module_name = Format.module_name + end) + + let to_sequence t = + let open Int_replace_polymorphic_compare in + let len = length t in + Sequence.unfold ~init:0 ~f:(fun byte_pos -> + if byte_pos >= len + then None + else ( + let decode = Format.get_decode_result t ~byte_pos in + Some (Uchar.utf_decode_uchar decode, byte_pos + Uchar.utf_decode_length decode))) + ;; + + let fold t ~init:acc ~f = + let len = length t in + let rec loop byte_pos acc = + if Int_replace_polymorphic_compare.equal byte_pos len + then acc + else ( + let decode = Format.get_decode_result t ~byte_pos in + loop + (byte_pos + Uchar.utf_decode_length decode) + (f acc (Uchar.utf_decode_uchar decode))) + in + loop 0 acc [@nontail] + ;; + + let sanitize t = + let len = fold t ~init:0 ~f:(fun pos uchar -> pos + Format.byte_length uchar) in + let bytes = Bytes.create len in + let pos = fold t ~init:0 ~f:(fun pos uchar -> pos + Format.set bytes pos uchar) in + assert (Int_replace_polymorphic_compare.equal pos len); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:bytes + ;; + + let of_list uchars = + let len = List.fold uchars ~init:0 ~f:(fun n u -> n + Format.byte_length u) in + let bytes = Bytes.create len in + let pos = + List.fold uchars ~init:0 ~f:(fun pos uchar -> pos + Format.set bytes pos uchar) + in + assert (Int_replace_polymorphic_compare.equal pos len); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:bytes + ;; + + let of_array uchars = + let len = ref 0 in + for i = 0 to Array.length uchars - 1 do + len := !len + Format.byte_length uchars.(i) + done; + let bytes = Bytes.create !len in + let pos = ref 0 in + for i = 0 to Array.length uchars - 1 do + pos := !pos + Format.set bytes !pos uchars.(i) + done; + assert (Int_replace_polymorphic_compare.equal !pos !len); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:bytes + ;; + + let concat list = concat ~sep:"" list + + let split t ~on = + let len = length t in + let[@tail_mod_cons] rec loop ~start ~until = + if Int_replace_polymorphic_compare.equal until len + then [ sub t ~pos:start ~len:(until - start) ] + else ( + let uchar = get t ~byte_pos:until in + let next = until + Format.byte_length uchar in + if Uchar.equal uchar on + then sub t ~pos:start ~len:(until - start) :: loop ~start:next ~until:next + else loop ~start ~until:next) + in + loop ~start:0 ~until:0 [@nontail] + ;; + + module C = Indexed_container.Make0_with_creators (struct + module Elt = Uchar + + type nonrec t = t + + let fold = fold + let concat = concat + let of_list = of_list + let of_array = of_array + let init = `Define_using_of_array + let length = `Define_using_fold + let foldi = `Define_using_fold + let iter = `Define_using_fold + let iteri = `Define_using_fold + let concat_mapi = `Define_using_concat + end) + + let append = C.append + let concat_map = C.concat_map + let concat_mapi = C.concat_mapi + let count = C.count + let counti = C.counti + let exists = C.exists + let existsi = C.existsi + let filter = C.filter + let filter_map = C.filter_map + let filter_mapi = C.filter_mapi + let filteri = C.filteri + let find = C.find + let find_map = C.find_map + let find_mapi = C.find_mapi + let findi = C.findi + let fold_result = C.fold_result + let fold_until = C.fold_until + let foldi = C.foldi + let for_all = C.for_all + let for_alli = C.for_alli + let init = C.init + let is_empty = C.is_empty + let iter = C.iter + let iteri = C.iteri + let length = C.length + let map = C.map + let mapi = C.mapi + let max_elt = C.max_elt + let mem = C.mem + let min_elt = C.min_elt + let partition_map = C.partition_map + let partition_tf = C.partition_tf + let sum = C.sum + let to_array = C.to_array + let to_list = C.to_list + let length_in_uchars = length +end + +module Utf8 = Make_utf (struct + let codec_name = "UTF-8" + let module_name = "Base.String.Utf8" + let is_valid = is_valid_utf_8 + let byte_length = Uchar.utf_8_byte_length + let get_decode_result = get_utf_8_uchar + let set = Bytes.set_uchar_utf_8 +end) + +module Utf16le = Make_utf (struct + let codec_name = "UTF-16LE" + let module_name = "Base.String.Utf16le" + let is_valid = is_valid_utf_16le + let byte_length = Uchar.utf_16_byte_length + let get_decode_result = get_utf_16le_uchar + let set = Bytes.set_uchar_utf_16le +end) + +module Utf16be = Make_utf (struct + let codec_name = "UTF-16BE" + let module_name = "Base.String.Utf16be" + let is_valid = is_valid_utf_16be + let byte_length = Uchar.utf_16_byte_length + let get_decode_result = get_utf_16be_uchar + let set = Bytes.set_uchar_utf_16be +end) + +module Make_utf32 (Format : sig + val codec_name : string + val module_name : string + val get_decode_result : t -> byte_pos:int -> Uchar.utf_decode + val set : bytes -> int -> Uchar.t -> int +end) = +Make_utf (struct + open Int_replace_polymorphic_compare + + let byte_length _ = 4 + let codec_name = Format.codec_name + let module_name = Format.module_name + let set = Format.set + let get_decode_result = Format.get_decode_result + + let is_valid t = + let len = String.length t in + match len mod 4 with + | 0 -> + let rec loop byte_pos = + match byte_pos < len with + | false -> true + | true -> + let result = Format.get_decode_result t ~byte_pos in + Uchar.utf_decode_is_valid result && loop (byte_pos + 4) + in + loop 0 [@nontail] + | _ -> false + ;; +end) + +module Utf32le = Make_utf32 (struct + let codec_name = "UTF-32LE" + let module_name = "Base.String.Utf32le" + let get_decode_result = get_utf_32le_uchar + let set = Bytes.set_uchar_utf_32le +end) + +module Utf32be = Make_utf32 (struct + let codec_name = "UTF-32BE" + let module_name = "Base.String.Utf32be" + let get_decode_result = get_utf_32be_uchar + let set = Bytes.set_uchar_utf_32be +end) + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include String_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/string.mli b/unikernel/duniverse/base/src/string.mli new file mode 100644 index 00000000..719b9bc6 --- /dev/null +++ b/unikernel/duniverse/base/src/string.mli @@ -0,0 +1 @@ +include String_intf.String (** @inline *) diff --git a/unikernel/duniverse/base/src/string0.ml b/unikernel/duniverse/base/src/string0.ml new file mode 100644 index 00000000..cc7a5e1d --- /dev/null +++ b/unikernel/duniverse/base/src/string0.ml @@ -0,0 +1,126 @@ +(* [String0] defines string functions that are primitives or can be simply defined in + terms of [Stdlib.String]. [String0] is intended to completely express the part of + [Stdlib.String] that [Base] uses -- no other file in Base other than string0.ml should + use [Stdlib.String]. [String0] has few dependencies, and so is available early in Base's + build order. + + All Base files that need to use strings, including the subscript syntax [x.[i]] which + the OCaml parser desugars into calls to [String], and come before [Base.String] in + build order should do + + {[ + module String = String0 + ]} + + Defining [module String = String0] is also necessary because it prevents + ocamldep from mistakenly causing a file to depend on [Base.String]. *) + +open! Import0 + +open struct + module Sys = Sys0 + module Uchar = Uchar0 +end + +module String = struct + external get : (string[@local_opt]) -> (int[@local_opt]) -> char = "%string_safe_get" + external length : (string[@local_opt]) -> int = "%string_length" + + external unsafe_get + : (string[@local_opt]) + -> (int[@local_opt]) + -> char + = "%string_unsafe_get" +end + +include String + +let max_length = Sys.max_string_length +let ( ^ ) = ( ^ ) +let capitalize = Stdlib.String.capitalize_ascii +let compare = Stdlib.String.compare +let escaped = Stdlib.String.escaped +let lowercase = Stdlib.String.lowercase_ascii +let make = Stdlib.String.make +let sub = Stdlib.String.sub +let uncapitalize = Stdlib.String.uncapitalize_ascii +let uppercase = Stdlib.String.uppercase_ascii +let is_valid_utf_8 = Stdlib.String.is_valid_utf_8 +let is_valid_utf_16le = Stdlib.String.is_valid_utf_16le +let is_valid_utf_16be = Stdlib.String.is_valid_utf_16be +let get_utf_8_uchar t ~byte_pos = Stdlib.String.get_utf_8_uchar t byte_pos +let get_utf_16le_uchar t ~byte_pos = Stdlib.String.get_utf_16le_uchar t byte_pos +let get_utf_16be_uchar t ~byte_pos = Stdlib.String.get_utf_16be_uchar t byte_pos + +open struct + let get_utf_32_uchar ~get_int32 t ~byte_pos = + let len = String.length t in + match byte_pos >= 0 && byte_pos < len with + | false -> raise (Invalid_argument "index out of bounds") + | true -> + (match len - byte_pos with + | (1 | 2 | 3) as bytes_read -> + (* Fewer than 4 bytes remain in [t], so we know the decoding is invalid. *) + Uchar.utf_decode_invalid bytes_read + | _ -> + let int32 = get_int32 t byte_pos in + (match Int_conversions.int32_is_representable_as_int int32 with + | false -> Uchar.utf_decode_invalid 4 + | true -> + let int = Int_conversions.int32_to_int_trunc int32 in + (match Uchar.is_valid int with + | true -> Uchar.utf_decode 4 (Uchar.unsafe_of_int int) + | false -> Uchar.utf_decode_invalid 4))) + ;; +end + +let get_utf_32le_uchar t ~byte_pos = + get_utf_32_uchar t ~byte_pos ~get_int32:Stdlib.String.get_int32_le +;; + +let get_utf_32be_uchar t ~byte_pos = + get_utf_32_uchar t ~byte_pos ~get_int32:Stdlib.String.get_int32_be +;; + +let concat ?(sep = "") l = + match l with + | [] -> "" + (* The stdlib does not specialize this case because it could break existing projects. *) + | [ x ] -> x + | l -> Stdlib.String.concat ~sep l +;; + +let iter t ~f = + for i = 0 to length t - 1 do + f (unsafe_get t i) + done +;; + +let split_lines = + let back_up_at_newline ~t ~pos ~eol = + pos := !pos - if !pos > 0 && Char0.equal t.[!pos - 1] '\r' then 2 else 1; + eol := !pos + 1 + in + fun t -> + let n = length t in + if n = 0 + then [] + else ( + (* Invariant: [-1 <= pos < eol]. *) + let pos = ref (n - 1) in + let eol = ref n in + let ac = ref [] in + (* We treat the end of the string specially, because if the string ends with a + newline, we don't want an extra empty string at the end of the output. *) + if Char0.equal t.[!pos] '\n' then back_up_at_newline ~t ~pos ~eol; + while !pos >= 0 do + if not (Char0.equal t.[!pos] '\n') + then decr pos + else ( + (* Because [pos < eol], we know that [start <= eol]. *) + let start = !pos + 1 in + ac := sub t ~pos:start ~len:(!eol - start) :: !ac; + back_up_at_newline ~t ~pos ~eol) + done; + sub t ~pos:0 ~len:!eol :: !ac) +;; diff --git a/unikernel/duniverse/base/src/string_intf.ml b/unikernel/duniverse/base/src/string_intf.ml new file mode 100644 index 00000000..155743ab --- /dev/null +++ b/unikernel/duniverse/base/src/string_intf.ml @@ -0,0 +1,656 @@ +open! Import + +(** Interface for Unicode encodings, such as UTF-8. Written with an abstract type, and + specialized below. *) +module type Utf = sig + type t [@@deriving_inline sexp_grammar] + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + (** [t_of_sexp] and [of_string] will raise if the input is invalid in this encoding. See + [sanitize] below to construct a valid [t] from arbitrary input. *) + include Identifiable.S with type t := t + + (** Interpret [t] as a container of Unicode scalar values, rather than of ASCII + characters. Indexes, length, etc. are with respect to [Uchar.t]. *) + include Indexed_container.S0_with_creators with type t := t and type elt = Uchar0.t + + (** Produce a sequence of unicode characters. *) + val to_sequence : t -> Uchar0.t Sequence.t + + (** Reports whether a string is valid in this encoding. *) + val is_valid : string -> bool + + (** Create a [t] from a string by replacing any byte sequences that are invalid in this + encoding with [Uchar.replacement_char]. This can be used to decode strings that may + be encoded incorrectly. *) + val sanitize : string -> t + + (** Decodes the Unicode scalar value at the given byte index in this encoding. Raises if + [byte_pos] does not refer to the start of a Unicode scalar value. *) + val get : t -> byte_pos:int -> Uchar0.t + + (** Creates a [t] without sanitizing or validating the string. Other functions in this + interface may raise or produce unpredictable results if the string is invalid in + this encoding. *) + val of_string_unchecked : string -> t + + (** Similar to [String.split], but splits on a [Uchar.t] in [t]. If you want to split on + a [char], first convert it with [Uchar.of_char], but note that the actual byte(s) on + which [t] is split may not be the same as the [char] byte depending on both [char] + and the encoding of [t]. For example, splitting on 'α' in UTF-8 or on '\n' in UTF-16 + is actually splitting on a 2-byte sequence. *) + val split : t -> on:Uchar0.t -> t list + + (** The name of this encoding scheme; e.g., "UTF-8". *) + val codec_name : string + + (** Counts the number of unicode scalar values in [t]. + + This function is not a good proxy for display width, as some scalar values have + display widths > 1. Many native applications such as terminal emulators use + [wcwidth] (see [man 3 wcwidth]) to compute the display width of a scalar value. See + the uucp library's [Uucp.Break.tty_width_hint] for an implementation of [wcwidth]'s + logic. However, this is merely best-effort, as display widths will vary based on the + font and underlying text shaping engine (see docs on [tty_width_hint] for details). + + For applications that support Grapheme clusters (many terminal emulators do not), + [t] should first be split into Grapheme clusters and then the display width of each + of those Grapheme clusters needs to be computed (which is the max display width of + the scalars that are in the cluster). + + There are some active efforts to improve the current state of affairs: + - https://github.com/wez/wezterm/issues/4320 + - https://www.unicode.org/L2/L2023/23194-text-terminal-wg-report.pdf *) + val length_in_uchars : t -> int + + (** [length] could be misinterpreted as counting bytes. We direct users to other, + clearer options. *) + val length : t -> int + [@@alert + length_in_uchars + "Use [length_in_uchars] to count unicode scalar values or [String.length] to \ + count bytes"] +end + +(** Iterface for Unicode encodings, specialized for string representation. *) +module type Utf_as_string = Utf with type t = private string + +module type String = sig + (** An extension of the standard [StringLabels]. If you [open Base], you'll get these + extensions in the [String] module. *) + + open! Import + + type t = string [@@deriving_inline globalize, sexp, sexp_grammar] + + val globalize : t -> t + + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + val sub : (t, t) Blit.sub + + (** [sub] with no bounds checking, and always returns a new copy *) + val unsafe_sub : t -> pos:int -> len:int -> t + + val subo : (t, t) Blit.subo + + include Indexed_container.S0_with_creators with type t := t with type elt = char + include Identifiable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Invariant.S with type t := t + + (** Maximum length of a string. *) + val max_length : int + + val mem : t -> char -> bool + external length : (t[@local_opt]) -> int = "%string_length" + external get : (t[@local_opt]) -> (int[@local_opt]) -> char = "%string_safe_get" + + (** [unsafe_get t i] is like [get t i] but does not perform bounds checking. The caller + must ensure that it is a memory-safe operation. *) + external unsafe_get + : (string[@local_opt]) + -> (int[@local_opt]) + -> char + = "%string_unsafe_get" + + val make : int -> char -> t + + (** String append. Also available unqualified, but re-exported here for documentation + purposes. + + Note that [a ^ b] must copy both [a] and [b] into a newly-allocated result string, so + [a ^ b ^ c ^ ... ^ z] is quadratic in the number of strings. [String.concat] does not + have this problem -- it allocates the result buffer only once. *) + val ( ^ ) : t -> t -> t + + (** Concatenates all strings in the list using separator [sep] (with a default separator + [""]). *) + val concat : ?sep:t -> t list -> t + + (** Special characters are represented by escape sequences, following the lexical + conventions of OCaml. *) + val escaped : t -> t + + val contains : ?pos:int -> ?len:int -> t -> char -> bool + + (** Operates on the whole string using the US-ASCII character set, + e.g. [uppercase "foo" = "FOO"]. *) + val uppercase : t -> t + + val lowercase : t -> t + + (** Operates on just the first character using the US-ASCII character set, + e.g. [capitalize "foo" = "Foo"]. *) + val capitalize : t -> t + + val uncapitalize : t -> t + + (** [Caseless] compares and hashes strings ignoring case, so that for example + [Caseless.equal "OCaml" "ocaml"] and [Caseless.("apple" < "Banana")] are [true]. + + [Caseless] also provides case-insensitive [is_suffix] and [is_prefix] functions, so + that for example [Caseless.is_suffix "OCaml" ~suffix:"AmL"] and [Caseless.is_prefix + "OCaml" ~prefix:"oc"] are [true]. *) + module Caseless : sig + type nonrec t = t [@@deriving_inline hash, sexp, sexp_grammar] + + include Ppx_hash_lib.Hashable.S with type t := t + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + include Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + + val is_suffix : t -> suffix:t -> bool + val is_prefix : t -> prefix:t -> bool + val is_substring : t -> substring:t -> bool + val is_substring_at : t -> pos:int -> substring:t -> bool + val substr_index : ?pos:int -> t -> pattern:t -> int option + val substr_index_exn : ?pos:int -> t -> pattern:t -> int + val substr_index_all : t -> may_overlap:bool -> pattern:t -> int list + val substr_replace_first : ?pos:int -> t -> pattern:t -> with_:t -> t + val substr_replace_all : t -> pattern:t -> with_:t -> t + end + + (** [index] gives the index of the first appearance of [char] in the string when + searching from left to right, or [None] if it's not found. [rindex] does the same but + searches from the right. + + For example, [String.index "Foo" 'o'] is [Some 1] while [String.rindex "Foo" 'o'] is + [Some 2]. + + The [_exn] versions return the actual index (instead of an option) when [char] is + found, and raise [Stdlib.Not_found] or [Not_found_s] otherwise. + *) + + val index : t -> char -> int option + val index_exn : t -> char -> int + val index_from : t -> int -> char -> int option + val index_from_exn : t -> int -> char -> int + val rindex : t -> char -> int option + val rindex_exn : t -> char -> int + val rindex_from : t -> int -> char -> int option + val rindex_from_exn : t -> int -> char -> int + + (** Produce a sequence of the characters in a string. *) + val to_sequence : t -> char Sequence.t + + (** Read the characters in a full sequence and produce a string. *) + val of_sequence : char Sequence.t -> t + + (** Substring search and replace functions. They use the Knuth-Morris-Pratt algorithm + (KMP) under the hood. + + The functions in the [Search_pattern] module allow the program to preprocess the + searched pattern once and then use it many times without further allocations. *) + module Search_pattern : sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + (** [create pattern] preprocesses [pattern] as per KMP, building an [int array] of + length [length pattern]. All inputs are valid. *) + val create : ?case_sensitive:bool (** default = true *) -> string -> t + + (** [pattern t] returns the string pattern used to create [t]. *) + val pattern : t -> string + + (** [case_sensitive t] returns whether [t] matches strings case-sensitively. *) + val case_sensitive : t -> bool + + (** [matches pat str] returns true if [str] matches [pat] *) + val matches : t -> string -> bool + + (** [pos < 0] or [pos >= length string] result in no match (hence [index] returns + [None] and [index_exn] raises). *) + val index : ?pos:int -> t -> in_:string -> int option + + val index_exn : ?pos:int -> t -> in_:string -> int + + (** [may_overlap] determines whether after a successful match, [index_all] should start + looking for another one at the very next position ([~may_overlap:true]), or jump to + the end of that match and continue from there ([~may_overlap:false]), e.g.: + + - [index_all (create "aaa") ~may_overlap:false ~in_:"aaaaBaaaaaa" = [0; 5; 8]] + - [index_all (create "aaa") ~may_overlap:true ~in_:"aaaaBaaaaaa" = [0; 1; 5; 6; 7; + 8]] + + E.g., [replace_all] internally calls [index_all ~may_overlap:false]. *) + val index_all : t -> may_overlap:bool -> in_:string -> int list + + (** Note that the result of [replace_all pattern ~in_:text ~with_:r] may still + contain [pattern], e.g., + + {[ + replace_all (create "bc") ~in_:"aabbcc" ~with_:"cb" = "aabcbc" + ]} *) + val replace_first : ?pos:int -> t -> in_:string -> with_:string -> string + + val replace_all : t -> in_:string -> with_:string -> string + + (** Similar to [String.split] or [String.split_on_chars], but instead uses a given + search pattern as the separator. Separators are non-overlapping. *) + val split_on : t -> string -> string list + + (**/**) + + (*_ See the Jane Street Style Guide for an explanation of [Private] submodules: + + https://opensource.janestreet.com/standards/#private-submodules *) + module Private : sig + type public = t + + type t = + { pattern : string + ; case_sensitive : bool + ; kmp_array : int array + } + [@@deriving_inline equal ~localize, sexp_of] + + include Ppx_compare_lib.Equal.S with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + val representation : public -> t + end + end + + (** Substring search and replace convenience functions. They call [Search_pattern.create] + and then forget the preprocessed pattern when the search is complete. [pos < 0] or + [pos >= length t] result in no match (hence [substr_index] returns [None] and + [substr_index_exn] raises). [may_overlap] indicates whether to report overlapping + matches, see [Search_pattern.index_all]. *) + val substr_index : ?pos:int -> t -> pattern:t -> int option + + val substr_index_exn : ?pos:int -> t -> pattern:t -> int + val substr_index_all : t -> may_overlap:bool -> pattern:t -> int list + val substr_replace_first : ?pos:int -> t -> pattern:t -> with_:t -> t + + (** As with [Search_pattern.replace_all], the result may still contain [pattern]. *) + val substr_replace_all : t -> pattern:t -> with_:t -> t + + (** [is_substring ~substring:"bar" "foo bar baz"] is true. *) + val is_substring : t -> substring:t -> bool + + (** [is_substring_at "foo bar baz" ~pos:4 ~substring:"bar"] is true. *) + val is_substring_at : t -> pos:int -> substring:t -> bool + + (** Returns the reversed list of characters contained in a list. *) + val to_list_rev : t -> char list + + (** [rev t] returns [t] in reverse order. *) + val rev : t -> t + + (** [is_suffix s ~suffix] returns [true] if [s] ends with [suffix]. *) + + val is_suffix : t -> suffix:t -> bool + + (** [is_prefix s ~prefix] returns [true] if [s] starts with [prefix]. *) + val is_prefix : t -> prefix:t -> bool + + (** If the string [s] contains the character [on], then [lsplit2_exn s ~on] returns a pair + containing [s] split around the first appearance of [on] (from the left). Raises + [Stdlib.Not_found] or [Not_found_s] when [on] cannot be found in [s]. *) + val lsplit2_exn : t -> on:char -> t * t + + (** If the string [s] contains the character [on], then [rsplit2_exn s ~on] returns a pair + containing [s] split around the first appearance of [on] (from the right). Raises + [Stdlib.Not_found] or [Not_found_s] when [on] cannot be found in [s]. *) + val rsplit2_exn : t -> on:char -> t * t + + (** [lsplit2 s ~on] optionally returns [s] split into two strings around the + first appearance of [on] from the left. *) + val lsplit2 : t -> on:char -> (t * t) option + + (** [rsplit2 s ~on] optionally returns [s] split into two strings around the first + appearance of [on] from the right. *) + val rsplit2 : t -> on:char -> (t * t) option + + (** [split s ~on] returns a list of substrings of [s] that are separated by [on]. + Consecutive [on] characters will cause multiple empty strings in the result. + Splitting the empty string returns a list of the empty string, not the empty list. *) + val split : t -> on:char -> t list + + (** [split_on_chars s ~on] returns a list of all substrings of [s] that are separated by + one of the chars from [on]. [on] are not grouped. So a grouping of [on] in the + source string will produce multiple empty string splits in the result. *) + val split_on_chars : t -> on:char list -> t list + + (** [split_lines t] returns the list of lines that comprise [t]. The lines do not include + the trailing ["\n"] or ["\r\n"]. *) + val split_lines : t -> t list + + (** [lfindi ?pos t ~f] returns the smallest [i >= pos] such that [f i t.[i]], if there is + such an [i]. By default, [pos = 0]. *) + val lfindi : ?pos:int -> t -> f:(int -> char -> bool) -> int option + + (** [rfindi ?pos t ~f] returns the largest [i <= pos] such that [f i t.[i]], if there is + such an [i]. By default [pos = length t - 1]. *) + val rfindi : ?pos:int -> t -> f:(int -> char -> bool) -> int option + + (** [lstrip ?drop s] returns a string with consecutive chars satisfying [drop] (by default + white space, e.g. tabs, spaces, newlines, and carriage returns) stripped from the + beginning of [s]. *) + val lstrip : ?drop:(char -> bool) -> t -> t + + (** [rstrip ?drop s] returns a string with consecutive chars satisfying [drop] (by default + white space, e.g. tabs, spaces, newlines, and carriage returns) stripped from the end + of [s]. *) + val rstrip : ?drop:(char -> bool) -> t -> t + + (** [strip ?drop s] returns a string with consecutive chars satisfying [drop] (by default + white space, e.g. tabs, spaces, newlines, and carriage returns) stripped from the + beginning and end of [s]. *) + val strip : ?drop:(char -> bool) -> t -> t + + (** Like [map], but allows the replacement of a single character with zero or two or more + characters. *) + val concat_map : ?sep:t -> t -> f:(char -> t) -> t + + val concat_mapi : ?sep:t -> t -> f:(int -> char -> t) -> t + + (** [tr ~target ~replacement s] replaces every instance of [target] in [s] with + [replacement]. *) + val tr : target:char -> replacement:char -> t -> t + + (** [tr_multi ~target ~replacement] returns a function that replaces every + instance of a character in [target] with the corresponding character in + [replacement]. + + If [replacement] is shorter than [target], it is lengthened by repeating + its last character. Empty [replacement] is illegal unless [target] also is. + + If [target] contains multiple copies of the same character, the last + corresponding [replacement] character is used. Note that character ranges + are {b not} supported, so [~target:"a-z"] means the literal characters ['a'], + ['-'], and ['z']. *) + val tr_multi : target:t -> replacement:t -> (t -> t) Staged.t + + (** [chop_suffix_exn s ~suffix] returns [s] without the trailing [suffix], + raising [Invalid_argument] if [suffix] is not a suffix of [s]. *) + val chop_suffix_exn : t -> suffix:t -> t + + (** [chop_prefix_exn s ~prefix] returns [s] without the leading [prefix], + raising [Invalid_argument] if [prefix] is not a prefix of [s]. *) + val chop_prefix_exn : t -> prefix:t -> t + + val chop_suffix : t -> suffix:t -> t option + val chop_prefix : t -> prefix:t -> t option + + (** [chop_suffix_if_exists s ~suffix] returns [s] without the trailing [suffix], or just + [s] if [suffix] isn't a suffix of [s]. + + Equivalent to [chop_suffix s ~suffix |> Option.value ~default:s], but avoids + allocating the intermediate option. *) + val chop_suffix_if_exists : t -> suffix:t -> t + + (** [chop_prefix_if_exists s ~prefix] returns [s] without the leading [prefix], or just + [s] if [prefix] isn't a prefix of [s]. + + Equivalent to [chop_prefix s ~prefix |> Option.value ~default:s], but avoids + allocating the intermediate option. *) + val chop_prefix_if_exists : t -> prefix:t -> t + + (** [suffix s n] returns the longest suffix of [s] of length less than or equal to [n]. *) + val suffix : t -> int -> t + + (** [prefix s n] returns the longest prefix of [s] of length less than or equal to [n]. *) + val prefix : t -> int -> t + + (** [drop_suffix s n] drops the longest suffix of [s] of length less than or equal to + [n]. *) + val drop_suffix : t -> int -> t + + (** [drop_prefix s n] drops the longest prefix of [s] of length less than or equal to + [n]. *) + val drop_prefix : t -> int -> t + + (** Produces the longest common suffix, or [""] if the list is empty. *) + val common_suffix : t list -> t + + (** Produces the longest common prefix, or [""] if the list is empty. *) + val common_prefix : t list -> t + + (** Produces the length of the longest common suffix, or 0 if the list is empty. *) + val common_suffix_length : t list -> int + + (** Produces the length of the longest common prefix, or 0 if the list is empty. *) + val common_prefix_length : t list -> int + + (** Produces the longest common suffix. *) + val common_suffix2 : t -> t -> t + + (** Produces the longest common prefix. *) + val common_prefix2 : t -> t -> t + + (** Produces the length of the longest common suffix. *) + val common_suffix2_length : t -> t -> int + + (** Produces the length of the longest common prefix. *) + val common_prefix2_length : t -> t -> int + + (** [concat_array sep ar] like {!String.concat}, but operates on arrays. *) + val concat_array : ?sep:t -> t array -> t + + (** Builds a multiline text from a list of lines. Each line is terminated and then + concatenated. Equivalent to: + + {[ + String.concat (List.map lines ~f:(fun line -> + line ^ if crlf then "\r\n" else "\n")) + ]} + *) + val concat_lines : ?crlf:bool (** default [false] *) -> string list -> string + + (** Slightly faster hash function on strings. *) + external hash : t -> int = "Base_hash_string" + [@@noalloc] + + (** Fast equality function on strings, doesn't use [compare_val]. *) + val equal : t -> t -> bool + + val equal__local : t -> t -> bool + val of_char : char -> t + val of_char_list : char list -> t + + (** [pad_left ?char s ~len] returns [s] padded to the length [len] by adding characters + [char] to the beginning of the string. If s is already longer than [len] it is + returned unchanged. *) + val pad_left : ?char:char (** default is [' '] *) -> string -> len:int -> string + + (** [pad_right ?char ~s len] returns [s] padded to the length [len] by adding characters + [char] to the end of the string. If s is already longer than [len] it is returned + unchanged. *) + val pad_right : ?char:char (** default is [' '] *) -> string -> len:int -> string + + (** Reports the Levenshtein edit distance between two strings. Computes the minimum number + of single-character insertions, deletions, and substitutions needed to transform one + into the other. + + For strings of length M and N, its time complexity is O(M*N) and its space complexity + is O(min(M,N)). *) + val edit_distance : string -> string -> int + + (** Operations for escaping and unescaping strings, with parameterized escape and + escapeworthy characters. Escaping/unescaping using this module is more efficient than + using Pcre. Benchmark code can be found in core/benchmarks/string_escaping.ml. *) + module Escaping : sig + (** [escape_gen_exn escapeworthy_map escape_char] returns a function that will escape a + string [s] as follows: if [(c1,c2)] is in [escapeworthy_map], then all occurrences + of [c1] are replaced by [escape_char] concatenated to [c2]. + + Raises an exception if [escapeworthy_map] is not one-to-one. If [escape_char] is + not in [escapeworthy_map], then it will be escaped to itself.*) + val escape_gen_exn + : escapeworthy_map:(char * char) list + -> escape_char:char + -> (string -> string) Staged.t + + val escape_gen + : escapeworthy_map:(char * char) list + -> escape_char:char + -> (string -> string) Or_error.t + + (** [escape ~escapeworthy ~escape_char s] is + {[ + escape_gen_exn ~escapeworthy_map:(List.zip_exn escapeworthy escapeworthy) + ~escape_char + ]} + Duplicates and [escape_char] will be removed from [escapeworthy]. So, no + exception will be raised *) + val escape : escapeworthy:char list -> escape_char:char -> (string -> string) Staged.t + + (** [unescape_gen_exn] is the inverse operation of [escape_gen_exn]. That is, + {[ + let escape = Staged.unstage (escape_gen_exn ~escapeworthy_map ~escape_char) in + let unescape = Staged.unstage (unescape_gen_exn ~escapeworthy_map ~escape_char) in + assert (s = unescape (escape s)) + ]} + always succeed when ~escapeworthy_map is not causing exceptions. *) + val unescape_gen_exn + : escapeworthy_map:(char * char) list + -> escape_char:char + -> (string -> string) Staged.t + + val unescape_gen + : escapeworthy_map:(char * char) list + -> escape_char:char + -> (string -> string) Or_error.t + + (** [unescape ~escape_char] is defined as [unescape_gen_exn ~map:\[\] ~escape_char] *) + val unescape : escape_char:char -> (string -> string) Staged.t + + (** Any char in an escaped string is either escaping, escaped, or literal. For example, + for escaped string ["0_a0__0"] with [escape_char] as ['_'], pos 1 and 4 are + escaping, 2 and 5 are escaped, and the rest are literal. + + [is_char_escaping s ~escape_char pos] returns true if the char at [pos] is escaping, + false otherwise. *) + val is_char_escaping : string -> escape_char:char -> int -> bool + + (** [is_char_escaped s ~escape_char pos] returns true if the char at [pos] is escaped, + false otherwise. *) + val is_char_escaped : string -> escape_char:char -> int -> bool + + (** [is_char_literal s ~escape_char pos] returns true if the char at [pos] is not + escaped or escaping. *) + val is_char_literal : string -> escape_char:char -> int -> bool + + (** [index s ~escape_char char] finds the first literal (not escaped) instance of [char] + in s starting from 0. *) + val index : string -> escape_char:char -> char -> int option + + val index_exn : string -> escape_char:char -> char -> int + + (** [rindex s ~escape_char char] finds the first literal (not escaped) instance of + [char] in [s] starting from the end of [s] and proceeding towards 0. *) + val rindex : string -> escape_char:char -> char -> int option + + val rindex_exn : string -> escape_char:char -> char -> int + + (** [index_from s ~escape_char pos char] finds the first literal (not escaped) instance + of [char] in [s] starting from [pos] and proceeding towards the end of [s]. *) + val index_from : string -> escape_char:char -> int -> char -> int option + + val index_from_exn : string -> escape_char:char -> int -> char -> int + + (** [rindex_from s ~escape_char pos char] finds the first literal (not escaped) + instance of [char] in [s] starting from [pos] and towards 0. *) + val rindex_from : string -> escape_char:char -> int -> char -> int option + + val rindex_from_exn : string -> escape_char:char -> int -> char -> int + + (** [split s ~escape_char ~on] returns a list of substrings of [s] that are separated by + literal versions of [on]. Consecutive [on] characters will cause multiple empty + strings in the result. Splitting the empty string returns a list of the empty + string, not the empty list. + + E.g., [split ~escape_char:'_' ~on:',' "foo,bar_,baz" = ["foo"; "bar_,baz"]]. *) + val split : string -> on:char -> escape_char:char -> string list + + (** [split_on_chars s ~on] returns a list of all substrings of [s] that are separated by + one of the literal chars from [on]. [on] are not grouped. So a grouping of [on] in + the source string will produce multiple empty string splits in the result. + + E.g., [split_on_chars ~escape_char:'_' ~on:[',';'|'] "foo_|bar,baz|0" -> + ["foo_|bar"; "baz"; "0"]]. *) + val split_on_chars : string -> on:char list -> escape_char:char -> string list + + (** [lsplit2 s ~on ~escape_char] splits s into a pair on the first literal instance of + [on] (meaning the first unescaped instance) starting from the left. *) + val lsplit2 : string -> on:char -> escape_char:char -> (string * string) option + + val lsplit2_exn : string -> on:char -> escape_char:char -> string * string + + (** [rsplit2 s ~on ~escape_char] splits [s] into a pair on the first literal + instance of [on] (meaning the first unescaped instance) starting from the + right. *) + val rsplit2 : string -> on:char -> escape_char:char -> (string * string) option + + val rsplit2_exn : string -> on:char -> escape_char:char -> string * string + + (** These are the same as [lstrip], [rstrip], and [strip] for generic strings, except + that they only drop literal characters -- they do not drop characters that are + escaping or escaped. This makes sense if you're trying to get rid of junk + whitespace (for example), because escaped whitespace seems more likely to be + deliberate and not junk. *) + val lstrip_literal : ?drop:(char -> bool) -> t -> escape_char:char -> t + + val rstrip_literal : ?drop:(char -> bool) -> t -> escape_char:char -> t + val strip_literal : ?drop:(char -> bool) -> t -> escape_char:char -> t + end + + (** UTF-8 encoding. See [Utf] interface. *) + module Utf8 : Utf_as_string + + (** UTF-16 little-endian encoding. See [Utf] interface. *) + module Utf16le : Utf_as_string + + (** UTF-16 big-endian encoding. See [Utf] interface. *) + module Utf16be : Utf_as_string + + (** UTF-32 little-endian encoding. See [Utf] interface. *) + module Utf32le : Utf_as_string + + (** UTF-32 big-endian encoding. See [Utf] interface. *) + module Utf32be : Utf_as_string + + module type Utf = Utf + module type Utf_as_string = Utf_as_string +end diff --git a/unikernel/duniverse/base/src/stringable.ml b/unikernel/duniverse/base/src/stringable.ml new file mode 100644 index 00000000..f5efcd0c --- /dev/null +++ b/unikernel/duniverse/base/src/stringable.ml @@ -0,0 +1,10 @@ +(** Provides type-specific conversion functions to and from [string]. *) + +open! Import + +module type S = sig + type t + + val of_string : string -> t + val to_string : t -> string +end diff --git a/unikernel/duniverse/base/src/sys.ml b/unikernel/duniverse/base/src/sys.ml new file mode 100644 index 00000000..40789d00 --- /dev/null +++ b/unikernel/duniverse/base/src/sys.ml @@ -0,0 +1,2 @@ +open! Import +include Sys0 diff --git a/unikernel/duniverse/base/src/sys.mli b/unikernel/duniverse/base/src/sys.mli new file mode 100644 index 00000000..d2fc75ce --- /dev/null +++ b/unikernel/duniverse/base/src/sys.mli @@ -0,0 +1,124 @@ +(** Cross-platform system configuration values. *) + +(** The command line arguments given to the process. + The first element is the command name used to invoke the program. + The following elements are the command-line arguments given to the program. + + When running in JavaScript in the browser, it is [[| "a.out" |]]. + + [get_argv] is a function because the external function [caml_sys_modify_argv] can + replace the array starting in OCaml 4.09. *) +val get_argv : unit -> string array + +(** A single result from [get_argv ()]. This value is indefinitely deprecated. It is kept + for compatibility with {!Stdlib.Sys}. *) +val argv : string array + [@@deprecated + "[since 2019-08] Use [Sys.get_argv] instead, which has the correct behavior when \ + [caml_sys_modify_argv] is called."] + +(** [interactive] is set to [true] when being executed in the [ocaml] REPL, and [false] + otherwise. *) +val interactive : bool ref + +(** [os_type] describes the operating system that the OCaml program is running on. + + Its value is one of: + - ["Unix"] (for all Unix versions, including Linux and macOS); + - ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or MinGW); or + - ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin) + + When running in JavaScript, it is ["Unix"]. *) +val os_type : string + +(** [unix] is [true] if [os_type = "Unix"]. *) +val unix : bool + +(** [win32] is [true] if [os_type = "Win32"]. *) +val win32 : bool + +(** [cygwin] is [true] if [os_type = "Cygwin"]. *) +val cygwin : bool + +(** Currently, the official distribution only supports [Native] and [Bytecode], + but it can be other backends with alternative compilers, for example, + JavaScript. *) +type backend_type = Sys0.backend_type = + | Native + | Bytecode + | Other of string + +(** Backend type currently executing the OCaml program. *) +val backend_type : backend_type + +(** [word_size_in_bits] is the number of bits in one word on the machine currently + executing the OCaml program. Generally speaking it will be either [32] or [64]. When + running in JavaScript, it will be [32]. *) +val word_size_in_bits : int + +(** [int_size_in_bits] is the number of bits in the [int] type. Generally, on + 32-bit platforms, its value will be [31], and on 64 bit platforms its value + will be [63]. When running in JavaScript, it will be [32]. {!Int.num_bits} + is the same as this value. *) +val int_size_in_bits : int + +(** [big_endian] is true when the program is running on a big-endian + architecture. When running in JavaScript, it will be [false]. *) +val big_endian : bool + +(** [max_string_length] is the maximum allowed length of a [string] or [Bytes.t]. + {!String.max_length} is the same as this value. *) +val max_string_length : int + +(** [max_array_length] is the maximum allowed length of an ['a array]. + {!Array.max_length} is the same as this value. *) +val max_array_length : int + +(** Returns the name of the runtime variant the program is running on. This is normally + the argument given to [-runtime-variant] at compile time, but for byte-code it can be + changed after compilation. + + When running in JavaScript or utop it will be [""], while if compiled with DEBUG + (debugging of the runtime) it will be ["d"], and if compiled with CAML_INSTR + (instrumentation of the runtime) it will be ["i"]. *) +val runtime_variant : unit -> string + +(** Returns the value of the runtime parameters, in the same format as the contents of the + [OCAMLRUNPARAM] environment variable. When running in JavaScript, it will be [""]. *) +val runtime_parameters : unit -> string + +(** [ocaml_version] is the OCaml version with which the program was compiled. It is a + string of the form ["major.minor[.patchlevel][+additional-info]"], where major, minor, + and patchlevel are integers, and additional-info is an arbitrary string. The + [[.patchlevel]] and [[+additional-info]] parts may be absent. *) +val ocaml_version : string + +(** Controls whether the OCaml runtime system can emit warnings on stderr. Currently, the + only supported warning is triggered when a channel created by [open_*] functions is + finalized without being closed. Runtime warnings are enabled by default. *) +val enable_runtime_warnings : bool -> unit + +(** Returns whether runtime warnings are currently enabled. *) +val runtime_warnings_enabled : unit -> bool + +(** Return the value associated to a variable in the process environment. Return [None] if + the variable is unbound or the process has special privileges, as determined by + [secure_getenv(3)] on Linux. *) +val getenv : string -> string option + +val getenv_exn : string -> string + +(** For the purposes of optimization, [opaque_identity] behaves like an unknown (and thus + possibly side-effecting) function. At runtime, [opaque_identity] disappears + altogether. A typical use of this function is to prevent pure computations from being + optimized away in benchmarking loops. For example: + + {[ + for _round = 1 to 100_000 do + ignore (Sys.opaque_identity (my_pure_computation ())) + done + ]} *) +external opaque_identity : ('a[@local_opt]) -> ('a[@local_opt]) = "%opaque" + +(** Like [opaque_identity]. Forces its argument to be globally allocated. *) +external opaque_identity_global : 'a -> 'a = "%opaque" diff --git a/unikernel/duniverse/base/src/sys0.ml b/unikernel/duniverse/base/src/sys0.ml new file mode 100644 index 00000000..7d4b5d51 --- /dev/null +++ b/unikernel/duniverse/base/src/sys0.ml @@ -0,0 +1,56 @@ +(* [Sys0] defines functions that are primitives or can be simply defined in + terms of [Stdlib.Sys]. [Sys0] is intended to completely express the part of + [Stdlib.Sys] that [Base] uses -- no other file in Base other than sys.ml + should use [Stdlib.Sys]. [Sys0] has few dependencies, and so is available + early in Base's build order. All Base files that need to use these + functions and come before [Base.Sys] in build order should do + [module Sys = Sys0]. Defining [module Sys = Sys0] is also necessary because + it prevents ocamldep from mistakenly causing a file to depend on [Base.Sys]. *) + +open! Import0 + +type backend_type = Stdlib.Sys.backend_type = + | Native + | Bytecode + | Other of string + +let backend_type = Stdlib.Sys.backend_type +let interactive = Stdlib.Sys.interactive +let os_type = Stdlib.Sys.os_type +let unix = Stdlib.Sys.unix +let win32 = Stdlib.Sys.win32 +let cygwin = Stdlib.Sys.cygwin +let word_size_in_bits = Stdlib.Sys.word_size +let int_size_in_bits = Stdlib.Sys.int_size +let big_endian = Stdlib.Sys.big_endian +let max_string_length = Stdlib.Sys.max_string_length +let max_array_length = Stdlib.Sys.max_array_length +let runtime_variant = Stdlib.Sys.runtime_variant +let runtime_parameters = Stdlib.Sys.runtime_parameters +let argv = Stdlib.Sys.argv +let get_argv () = Stdlib.Sys.argv +let ocaml_version = Stdlib.Sys.ocaml_version +let enable_runtime_warnings = Stdlib.Sys.enable_runtime_warnings +let runtime_warnings_enabled = Stdlib.Sys.runtime_warnings_enabled + +module Make_immediate64 + (Imm : Stdlib.Sys.Immediate64.Immediate) + (Non_imm : Stdlib.Sys.Immediate64.Non_immediate) = + Stdlib.Sys.Immediate64.Make (Imm) (Non_imm) + +let getenv_exn var = + try Stdlib.Sys.getenv var with + | Stdlib.Not_found -> + Printf.failwithf "Sys.getenv_exn: environment variable %s is not set" var () +;; + +let getenv var = + match Stdlib.Sys.getenv var with + | x -> Some x + | exception Stdlib.Not_found -> None +;; + +external opaque_identity : ('a[@local_opt]) -> ('a[@local_opt]) = "%opaque" +external opaque_identity_global : 'a -> 'a = "%opaque" + +exception Break = Stdlib.Sys.Break diff --git a/unikernel/duniverse/base/src/t.ml b/unikernel/duniverse/base/src/t.ml new file mode 100644 index 00000000..8a3eb380 --- /dev/null +++ b/unikernel/duniverse/base/src/t.ml @@ -0,0 +1,21 @@ +(** This module defines various abstract interfaces that are convenient when one needs a + module that matches a bare signature with just a type. This sometimes occurs in + functor arguments and in interfaces. *) + +open! Import + +module type T = sig + type t +end + +module type T1 = sig + type 'a t +end + +module type T2 = sig + type ('a, 'b) t +end + +module type T3 = sig + type ('a, 'b, 'c) t +end diff --git a/unikernel/duniverse/base/src/type_equal.ml b/unikernel/duniverse/base/src/type_equal.ml new file mode 100644 index 00000000..d795ab0e --- /dev/null +++ b/unikernel/duniverse/base/src/type_equal.ml @@ -0,0 +1,309 @@ +open! Import + +type ('a, 'b) t = T : ('a, 'a) t [@@deriving_inline sexp_of] + +let sexp_of_t : + 'a 'b. + ('a -> Sexplib0.Sexp.t) -> ('b -> Sexplib0.Sexp.t) -> ('a, 'b) t -> Sexplib0.Sexp.t + = + fun (type a__003_ b__004_) + : ((a__003_ -> Sexplib0.Sexp.t) -> (b__004_ -> Sexplib0.Sexp.t) + -> (a__003_, b__004_) t -> Sexplib0.Sexp.t) -> + fun _of_a__001_ _of_b__002_ T -> Sexplib0.Sexp.Atom "T" +;; + +[@@@end] + +type ('a, 'b) equal = ('a, 'b) t + +include Type_equal_intf.Type_equal_defns (struct + type ('a, 'b) t = ('a, 'b) equal +end) + +let refl = T +let sym (type a b) (T : (a, b) t) : (b, a) t = T +let trans (type a b c) (T : (a, b) t) (T : (b, c) t) : (a, c) t = T +let conv (type a b) (T : (a, b) t) (a : a) : b = a + +module Lift (X : sig + type 'a t +end) = +struct + let lift (type a b) (T : (a, b) t) : (a X.t, b X.t) t = T +end + +module Lift2 (X : sig + type ('a1, 'a2) t +end) = +struct + let lift (type a1 b1 a2 b2) (T : (a1, b1) t) (T : (a2, b2) t) + : ((a1, a2) X.t, (b1, b2) X.t) t + = + T + ;; +end + +module Lift3 (X : sig + type ('a1, 'a2, 'a3) t +end) = +struct + let lift (type a1 b1 a2 b2 a3 b3) (T : (a1, b1) t) (T : (a2, b2) t) (T : (a3, b3) t) + : ((a1, a2, a3) X.t, (b1, b2, b3) X.t) t + = + T + ;; +end + +let detuple2 (type a1 a2 b1 b2) (T : (a1 * a2, b1 * b2) t) : (a1, b1) t * (a2, b2) t = + T, T +;; + +let tuple2 (type a1 a2 b1 b2) (T : (a1, b1) t) (T : (a2, b2) t) : (a1 * a2, b1 * b2) t = T + +module Id = struct + (* [key] is an extensible GADT used to mint, and pattern match on, type witnesses. *) + type _ key = .. + + module Uid = struct + (* A unique id contains an [int] representing a (possibly parameterized) type, and a + list of uids for the parameters to that type. *) + type t = T of int * t list [@@deriving_inline compare, hash, sexp_of] + + let rec compare = + (fun a__005_ b__006_ -> + if Stdlib.( == ) a__005_ b__006_ + then 0 + else ( + match a__005_, b__006_ with + | T (_a__007_, _a__009_), T (_b__008_, _b__010_) -> + (match compare_int _a__007_ _b__008_ with + | 0 -> compare_list compare _a__009_ _b__010_ + | n -> n)) + : t -> t -> int) + ;; + + let rec (hash_fold_t : + Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + = + (fun hsv arg -> + match arg with + | T (_a0, _a1) -> + let hsv = hsv in + let hsv = + let hsv = hsv in + hash_fold_int hsv _a0 + in + hash_fold_list hash_fold_t hsv _a1 + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func arg = + Ppx_hash_lib.Std.Hash.get_hash_value + (let hsv = Ppx_hash_lib.Std.Hash.create () in + hash_fold_t hsv arg) + in + fun x -> func x + ;; + + let rec sexp_of_t = + (fun (T (arg0__013_, arg1__014_)) -> + let res0__015_ = sexp_of_int arg0__013_ + and res1__016_ = sexp_of_list sexp_of_t arg1__014_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "T"; res0__015_; res1__016_ ] + : t -> Sexplib0.Sexp.t) + ;; + + [@@@end] + + include Comparable.Make (struct + type nonrec t = t + + let compare = compare + let sexp_of_t = sexp_of_t + end) + + (* We use the extension constructor id for a [key] as the unique id for its type. *) + let create (key : _ key) args = + let tag = + Stdlib.Obj.Extension_constructor.id (Stdlib.Obj.Extension_constructor.of_val key) + in + T (tag, args) + ;; + end + + (* Every type-equal id must support these operations. *) + module type S = sig + type t + + (* How to render values of the type. *) + val sexp_of_t : t -> Sexp.t + + (* A unique id for this type. *) + val uid : Uid.t + + (* Name of the type-equal id. *) + val id_name : string + + (* Sexp of the type-equal id. *) + val id_sexp : Sexp.t + + (* [key] value for the type. *) + val type_key : t key + + (* type equality: given another key, produce an [equal] if they represent the same + type instance *) + val type_equal : 'a key -> (t, 'a) equal option + end + + (* An [Id.t] is a first-class module implementing the above operations. *) + type 'a t = (module S with type t = 'a) + + let uid (type a) ((module A) : a t) = A.uid + let name (type a) ((module A) : a t) = A.id_name + let sexp_of_t (type a) _ ((module A) : a t) = A.id_sexp + let to_sexp (type a) ((module A) : a t) = A.sexp_of_t + let hash t = Uid.hash (uid t) + let hash_fold_t state t = Uid.hash_fold_t state (uid t) + + let same_witness (type a b) ((module A) : a t) ((module B) : b t) = + A.type_equal B.type_key + ;; + + let same_witness_exn t1 t2 = + match same_witness t1 t2 with + | Some equal -> equal + | None -> + Error.raise_s + (Sexp.message + "Type_equal.Id.same_witness_exn got different ids" + [ ( "" + , sexp_of_pair (sexp_of_t sexp_of_opaque) (sexp_of_t sexp_of_opaque) (t1, t2) + ) + ]) + ;; + + let same t1 t2 = + match same_witness t1 t2 with + | Some _ -> true + | None -> false + ;; + + include Type_equal_intf.Type_equal_id_defns (struct + type nonrec 'a t = 'a t + end) + + module Create0 (T : Arg0) = struct + type _ key += T0 : T.t key + + let type_equal_id : T.t t = + (module struct + type t = T.t + + let id_name = T.name + let id_sexp = Sexp.Atom id_name + let sexp_of_t = T.sexp_of_t + let type_key = T0 + let uid = Uid.create type_key [] + + let type_equal (type other) (otherkey : other key) : (t, other) equal option = + match otherkey with + | T0 -> Some T + | _ -> None + ;; + end) + ;; + end + + module Create1 (T : Arg1) = struct + type _ key += T1 : 'a key -> 'a T.t key + + let type_equal_id (type a) ((module A) : a t) : a T.t t = + (module struct + type t = A.t T.t + + let id_name = T.name + let id_sexp = Sexp.List [ Atom id_name; A.id_sexp ] + let sexp_of_t t = T.sexp_of_t A.sexp_of_t t + let type_key = T1 A.type_key + let uid = Uid.create type_key [ A.uid ] + + let type_equal (type other) (otherkey : other key) : (t, other) equal option = + match otherkey with + | T1 akey -> + (match A.type_equal akey with + | Some T -> Some T + | None -> None) + | _ -> None + ;; + end) + ;; + end + + module Create2 (T : Arg2) = struct + type _ key += T2 : 'a key * 'b key -> ('a, 'b) T.t key + + let type_equal_id (type a b) ((module A) : a t) ((module B) : b t) : (a, b) T.t t = + (module struct + type t = (A.t, B.t) T.t + + let id_name = T.name + let id_sexp = Sexp.List [ Atom id_name; A.id_sexp; B.id_sexp ] + let sexp_of_t t = T.sexp_of_t A.sexp_of_t B.sexp_of_t t + let type_key = T2 (A.type_key, B.type_key) + let uid = Uid.create type_key [ A.uid; B.uid ] + + let type_equal (type other) (otherkey : other key) : (t, other) equal option = + match otherkey with + | T2 (akey, bkey) -> + (match A.type_equal akey, B.type_equal bkey with + | Some T, Some T -> Some T + | None, _ | _, None -> None) + | _ -> None + ;; + end) + ;; + end + + module Create3 (T : Arg3) = struct + type _ key += T3 : 'a key * 'b key * 'c key -> ('a, 'b, 'c) T.t key + + let type_equal_id + (type a b c) + ((module A) : a t) + ((module B) : b t) + ((module C) : c t) + : (a, b, c) T.t t + = + (module struct + type t = (A.t, B.t, C.t) T.t + + let id_name = T.name + let id_sexp = Sexp.List [ Atom id_name; A.id_sexp; B.id_sexp; C.id_sexp ] + let sexp_of_t t = T.sexp_of_t A.sexp_of_t B.sexp_of_t C.sexp_of_t t + let type_key = T3 (A.type_key, B.type_key, C.type_key) + let uid = Uid.create type_key [ A.uid; B.uid; C.uid ] + + let type_equal (type other) (otherkey : other key) : (t, other) equal option = + match otherkey with + | T3 (akey, bkey, ckey) -> + (match A.type_equal akey, B.type_equal bkey, C.type_equal ckey with + | Some T, Some T, Some T -> Some T + | None, _, _ | _, None, _ | _, _, None -> None) + | _ -> None + ;; + end) + ;; + end + + let create (type a) ~name sexp_of_t = + let module T = + Create0 (struct + type t = a + + let name = name + let sexp_of_t = sexp_of_t + end) + in + T.type_equal_id + ;; +end diff --git a/unikernel/duniverse/base/src/type_equal.mli b/unikernel/duniverse/base/src/type_equal.mli new file mode 100644 index 00000000..b1dead84 --- /dev/null +++ b/unikernel/duniverse/base/src/type_equal.mli @@ -0,0 +1 @@ +include Type_equal_intf.Type_equal (** @inline *) diff --git a/unikernel/duniverse/base/src/type_equal_intf.ml b/unikernel/duniverse/base/src/type_equal_intf.ml new file mode 100644 index 00000000..41789cb6 --- /dev/null +++ b/unikernel/duniverse/base/src/type_equal_intf.ml @@ -0,0 +1,363 @@ +(** The purpose of [Type_equal] is to represent type equalities that the type checker + otherwise would not know, perhaps because the type equality depends on dynamic data, + or perhaps because the type system isn't powerful enough. + + A value of type [(a, b) Type_equal.t] represents that types [a] and [b] are equal. + One can think of such a value as a proof of type equality. The [Type_equal] module + has operations for constructing and manipulating such proofs. For example, the + functions [refl], [sym], and [trans] express the usual properties of reflexivity, + symmetry, and transitivity of equality. + + If one has a value [t : (a, b) Type_equal.t] that proves types [a] and [b] are equal, + there are two ways to use [t] to safely convert a value of type [a] to a value of type + [b]: [Type_equal.conv] or pattern matching on [Type_equal.T]: + + {[ + let f (type a) (type b) (t : (a, b) Type_equal.t) (a : a) : b = + Type_equal.conv t a + + let f (type a) (type b) (t : (a, b) Type_equal.t) (a : a) : b = + let Type_equal.T = t in a + ]} + + At runtime, conversion by either means is just the identity -- nothing is changing + about the value. Consistent with this, a value of type [Type_equal.t] is always just + a constructor [Type_equal.T]; the value has no interesting semantic content. + [Type_equal] gets its power from the ability to, in a type-safe way, prove to the type + checker that two types are equal. The [Type_equal.t] value that is passed is + necessary for the type-checker's rules to be correct, but the compiler could, in + principle, not pass around values of type [Type_equal.t] at runtime. +*) + +open! Import +open T + +(**/**) + +module Type_equal_defns (Type_equal : T.T2) = struct + (** The [Lift*] module types are used by the [Lift*] functors. See below. *) + + module type Lift = sig + type 'a t + + val lift : ('a, 'b) Type_equal.t -> ('a t, 'b t) Type_equal.t + end + + module type Lift2 = sig + type ('a, 'b) t + + val lift + : ('a1, 'b1) Type_equal.t + -> ('a2, 'b2) Type_equal.t + -> (('a1, 'a2) t, ('b1, 'b2) t) Type_equal.t + end + + module type Lift3 = sig + type ('a, 'b, 'c) t + + val lift + : ('a1, 'b1) Type_equal.t + -> ('a2, 'b2) Type_equal.t + -> ('a3, 'b3) Type_equal.t + -> (('a1, 'a2, 'a3) t, ('b1, 'b2, 'b3) t) Type_equal.t + end + + (** [Injective] is an interface that states that a type is injective, where the type is + viewed as a function from types to other types. It predates OCaml's support for + explicit injectivity annotations in the type system. + + The typical prior usage was: + + {[ + type 'a t + include Injective with type 'a t := 'a t + ]} + + For example, ['a list] is an injective type, because whenever ['a list = 'b list], + we know that ['a] = ['b]. On the other hand, if we define: + + {[ + type 'a t = unit + ]} + + then clearly [t] isn't injective, because, e.g., [int t = bool t], but + [int <> bool]. + + If [module M : Injective], then [M.strip] provides a way to get a proof that two + types are equal from a proof that both types transformed by [M.t] are equal. A + typical implementation looked like this: + + {[ + let strip (type a) (type b) + (Type_equal.T : (a t, b t) Type_equal.t) : (a, b) Type_equal.t = + Type_equal.T + ]} + + This will not type check for all type constructors (certainly not for non-injective + ones!), but it's always safe to try the above implementation if you are unsure. If + OCaml accepts this definition, then the type is injective. On the other hand, if + OCaml doesn't, then the type may or may not be injective. For example, if the + definition of the type depends on abstract types that match [Injective], OCaml will + not automatically use their injectivity, and one will have to write a more + complicated definition of [strip] that causes OCaml to use that fact. For example: + + {[ + module F (M : Type_equal.Injective) : Type_equal.Injective = struct + type 'a t = 'a M.t * int + + let strip (type a) (type b) + (e : (a t, b t) Type_equal.t) : (a, b) Type_equal.t = + let e1, _ = Type_equal.detuple2 e in + M.strip e1 + ;; + end + ]} + + If in the definition of [F] we had written the simpler implementation of [strip] that + didn't use [M.strip], then OCaml would have reported a type error. + *) + module type Injective = sig + type 'a t + + val strip : ('a t, 'b t) Type_equal.t -> ('a, 'b) Type_equal.t + end + [@@deprecated + "[since 2023-08] OCaml now supports injectivity annotations. [type !'a t] declares \ + that ['a t] is injective with respect to ['a]."] + + (** [Injective2] is for a binary type that is injective in both type arguments. *) + module type Injective2 = sig + type ('a1, 'a2) t + + val strip + : (('a1, 'a2) t, ('b1, 'b2) t) Type_equal.t + -> ('a1, 'b1) Type_equal.t * ('a2, 'b2) Type_equal.t + end + [@@deprecated + "[since 2023-08] OCaml now supports injectivity annotations. [type !'a t] declares \ + that ['a t] is injective with respect to ['a]."] + + (** [Composition_preserves_injectivity] is a functor that proves that composition of + injective types is injective. *) + module Composition_preserves_injectivity (M1 : Injective) (M2 : Injective) : + Injective with type 'a t = 'a M1.t M2.t = struct + type 'a t = 'a M1.t M2.t + + let strip e = M1.strip (M2.strip e) + end + [@@alert "-deprecated"] + [@@deprecated + "[since 2023-08] OCaml now supports injectivity annotations. [type !'a t] declares \ + that ['a t] is injective with respect to ['a]."] +end + +module Type_equal_id_defns (Id : sig + type 'a t +end) = +struct + module type Arg0 = sig + type t [@@deriving_inline sexp_of] + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + val name : string + end + + module type Arg1 = sig + type !'a t [@@deriving_inline sexp_of] + + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + + [@@@end] + + val name : string + end + + module type Arg2 = sig + type (!'a, !'b) t [@@deriving_inline sexp_of] + + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t + + [@@@end] + + val name : string + end + + module type Arg3 = sig + type (!'a, !'b, !'c) t [@@deriving_inline sexp_of] + + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('c -> Sexplib0.Sexp.t) + -> ('a, 'b, 'c) t + -> Sexplib0.Sexp.t + + [@@@end] + + val name : string + end + + module type S0 = sig + type t + + val type_equal_id : t Id.t + end + + module type S1 = sig + type 'a t + + val type_equal_id : 'a Id.t -> 'a t Id.t + end + + module type S2 = sig + type ('a, 'b) t + + val type_equal_id : 'a Id.t -> 'b Id.t -> ('a, 'b) t Id.t + end + + module type S3 = sig + type ('a, 'b, 'c) t + + val type_equal_id : 'a Id.t -> 'b Id.t -> 'c Id.t -> ('a, 'b, 'c) t Id.t + end +end + +(**/**) + +module type Type_equal = sig + type ('a, 'b) t = T : ('a, 'a) t [@@deriving_inline sexp_of] + + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t + + [@@@end] + + (** just an alias, needed when [t] gets shadowed below *) + type ('a, 'b) equal := ('a, 'b) t + + (** @inline *) + include module type of Type_equal_defns (struct + type ('a, 'b) t = ('a, 'b) equal + end) + + (** [refl], [sym], and [trans] construct proofs that type equality is reflexive, + symmetric, and transitive. *) + + val refl : ('a, 'a) t + val sym : ('a, 'b) t -> ('b, 'a) t + val trans : ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t + + (** [conv t x] uses the type equality [t : (a, b) t] as evidence to safely cast [x] + from type [a] to type [b]. [conv] is semantically just the identity function. + + In a program that has [t : (a, b) t] where one has a value of type [a] that one + wants to treat as a value of type [b], it is often sufficient to pattern match on + [Type_equal.T] rather than use [conv]. However, there are situations where OCaml's + type checker will not use the type equality [a = b], and one must use [conv]. For + example: + + {[ + module F (M1 : sig type t end) (M2 : sig type t end) : sig + val f : (M1.t, M2.t) equal -> M1.t -> M2.t + end = struct + let f equal (m1 : M1.t) = conv equal m1 + end + ]} + + If one wrote the body of [F] using pattern matching on [T]: + + {[ + let f (T : (M1.t, M2.t) equal) (m1 : M1.t) = (m1 : M2.t) + ]} + + this would give a type error. *) + val conv : ('a, 'b) t -> 'a -> 'b + + (** It is always safe to conclude that if type [a] equals [b], then for any type ['a t], + type [a t] equals [b t]. The OCaml type checker uses this fact when it can. However, + sometimes, e.g., when using [conv], one needs to explicitly use this fact to + construct an appropriate [Type_equal.t]. The [Lift*] functors do this. *) + + module Lift (T : T1) : Lift with type 'a t := 'a T.t + module Lift2 (T : T2) : Lift2 with type ('a, 'b) t := ('a, 'b) T.t + module Lift3 (T : T3) : Lift3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) T.t + + (** [tuple2] and [detuple2] convert between equality on a 2-tuple and its components. *) + + val detuple2 : ('a1 * 'a2, 'b1 * 'b2) t -> ('a1, 'b1) t * ('a2, 'b2) t + val tuple2 : ('a1, 'b1) t -> ('a2, 'b2) t -> ('a1 * 'a2, 'b1 * 'b2) t + + (** [Id] provides identifiers for types, and the ability to test (via [Id.same]) at + runtime if two identifiers are equal, and if so to get a proof of equality of their + types. Unlike values of type [Type_equal.t], values of type [Id.t] do have semantic + content and must have a nontrivial runtime representation. *) + module Id : sig + type 'a t [@@deriving_inline sexp_of] + + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + + [@@@end] + + (** @inline *) + include module type of Type_equal_id_defns (struct + type nonrec 'a t = 'a t + end) + + (** Every [Id.t] contains a unique id that is distinct from the [Uid.t] in any other + [Id.t]. *) + module Uid : sig + type t [@@deriving_inline hash, sexp_of] + + include Ppx_hash_lib.Hashable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + include Comparable.S with type t := t + end + + val uid : _ t -> Uid.t + + (** [create ~name] defines a new type identity. Two calls to [create] will result in + two distinct identifiers, even for the same arguments with the same type. If the + type ['a] doesn't support sexp conversion, then a good practice is to have the + converter be [[%sexp_of: _]], (or [sexp_of_opaque], if not using ppx_sexp_conv). + *) + val create : name:string -> ('a -> Sexp.t) -> 'a t + + (** Accessors *) + + val hash : _ t -> int + val name : _ t -> string + val to_sexp : 'a t -> 'a -> Sexp.t + val hash_fold_t : Hash.state -> _ t -> Hash.state + + (** [same_witness t1 t2] and [same_witness_exn t1 t2] return a type equality proof iff + the two identifiers are the same (i.e., physically equal, resulting from the same + call to [create]). This is a useful way to achieve a sort of dynamic typing. + [same_witness] does not allocate a [Some] every time it is called. + + [same t1 t2 = is_some (same_witness t1 t2)]. + *) + + val same : _ t -> _ t -> bool + val same_witness : 'a t -> 'b t -> ('a, 'b) equal option + val same_witness_exn : 'a t -> 'b t -> ('a, 'b) equal + + module Create0 (T : Arg0) : S0 with type t := T.t + module Create1 (T : Arg1) : S1 with type 'a t := 'a T.t + module Create2 (T : Arg2) : S2 with type ('a, 'b) t := ('a, 'b) T.t + module Create3 (T : Arg3) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) T.t + end +end diff --git a/unikernel/duniverse/base/src/uchar.ml b/unikernel/duniverse/base/src/uchar.ml new file mode 100644 index 00000000..bc737e23 --- /dev/null +++ b/unikernel/duniverse/base/src/uchar.ml @@ -0,0 +1,201 @@ +open! Import +module Bytes = Bytes0 +module String = String0 +include Uchar_intf + +let failwithf = Printf.failwithf + +include Uchar0 + +let module_name = "Base.Uchar" +let hash_fold_t state t = Hash.fold_int state (to_int t) +let hash t = Hash.run hash_fold_t t + +(* Not for export. String formats exported via [Utf*] modules below. *) +let to_string_internal t = Printf.sprintf "U+%04X" (to_int t) +let sexp_of_t t = Sexp.Atom (to_string_internal t) + +let t_of_sexp sexp = + match sexp with + | Sexp.List _ -> of_sexp_error "Uchar.t_of_sexp: atom needed" sexp + | Sexp.Atom s -> + (try Stdlib.Scanf.sscanf s "U+%X" (fun i -> Uchar0.of_int i) with + | _ -> of_sexp_error "Uchar.t_of_sexp: atom of the form U+XXXX needed" sexp) +;; + +let t_sexp_grammar : t Sexplib0.Sexp_grammar.t = + Sexplib0.Sexp_grammar.coerce string_sexp_grammar +;; + +include Pretty_printer.Register (struct + type nonrec t = t + + let module_name = module_name + let to_string = to_string_internal +end) + +include Comparable.Make (struct + type nonrec t = t + + let compare = compare + let sexp_of_t = sexp_of_t +end) + +(* Open replace_polymorphic_compare after including functor instantiations so they do not + shadow its definitions. This is here so that efficient versions of the comparison + functions are available within this module. *) +open! Uchar_replace_polymorphic_compare + +let invariant (_ : t) = () +let int_is_scalar = is_valid + +let succ_exn c = + try Uchar0.succ c with + | Invalid_argument msg -> failwithf "Uchar.succ_exn: %s" msg () +;; + +let succ c = + try Some (Uchar0.succ c) with + | Invalid_argument _ -> None +;; + +let pred_exn c = + try Uchar0.pred c with + | Invalid_argument msg -> failwithf "Uchar.pred_exn: %s" msg () +;; + +let pred c = + try Some (Uchar0.pred c) with + | Invalid_argument _ -> None +;; + +let of_scalar i = if int_is_scalar i then Some (unsafe_of_int i) else None + +let of_scalar_exn i = + if int_is_scalar i + then unsafe_of_int i + else failwithf "Uchar.of_int_exn got a invalid Unicode scalar value: %04X" i () +;; + +let to_scalar t = Uchar0.to_int t +let to_char c = if is_char c then Some (unsafe_to_char c) else None + +let to_char_exn c = + if is_char c + then unsafe_to_char c + else failwithf "Uchar.to_char_exn got a non latin-1 character: U+%04X" (to_int c) () +;; + +module Decode_result = struct + type t = Uchar0.utf_decode + + let compare : t -> t -> int = Poly.compare + let equal : t -> t -> bool = Poly.equal + + let hash_fold_t : Hash.state -> t -> Hash.state = + fun state t -> hash_fold_int state (Hashable.hash t) + ;; + + let hash : t -> int = Hashable.hash + let is_valid = Uchar0.utf_decode_is_valid + let bytes_consumed = Uchar0.utf_decode_length + let uchar_or_replacement_char = Uchar0.utf_decode_uchar + let sexp_of_t t = sexp_of_t (uchar_or_replacement_char t) + + let uchar t = + match is_valid t with + | true -> Some (uchar_or_replacement_char t) + | false -> None + ;; + + let[@zero_alloc] uchar_exn t = + match is_valid t with + | true -> uchar_or_replacement_char t + | false -> + Error.raise_s + (Atom "Uchar.Decode_result.uchar_exn was called on an invalid decode result") + ;; +end + +module Make_utf (Format : sig + val codec_name : string + val module_name : string + val byte_length : t -> int + val get_decode_result : string -> byte_pos:int -> Decode_result.t + val set : bytes -> int -> t -> int +end) : Utf = struct + let codec_name = Format.codec_name + let byte_length = Format.byte_length + + let to_string t = + let len = byte_length t in + let bytes = Bytes.create len in + let pos = Format.set bytes 0 t in + assert (Int_replace_polymorphic_compare.equal pos len); + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:bytes + ;; + + let of_string_message = + Format.module_name ^ ".of_string: expected a single Unicode character" + ;; + + let[@cold] raise_of_string string = + Error.raise_s (Sexp.message of_string_message [ "string", Atom string ]) + ;; + + let of_string string = + let decode = Format.get_decode_result string ~byte_pos:0 in + let string_len = String.length string in + let decode_len = Decode_result.bytes_consumed decode in + if Int_replace_polymorphic_compare.equal string_len decode_len + && Decode_result.is_valid decode + then Decode_result.uchar_or_replacement_char decode + else raise_of_string string + ;; +end + +module Utf8 = Make_utf (struct + let codec_name = "UTF-8" + let module_name = "Base.Uchar.Utf8" + let byte_length = utf_8_byte_length + let get_decode_result = String.get_utf_8_uchar + let set = Bytes.set_uchar_utf_8 +end) + +module Utf16le = Make_utf (struct + let codec_name = "UTF-16LE" + let module_name = "Base.Uchar.Utf16le" + let byte_length = utf_16_byte_length + let get_decode_result = String.get_utf_16le_uchar + let set = Bytes.set_uchar_utf_16le +end) + +module Utf16be = Make_utf (struct + let codec_name = "UTF-16BE" + let module_name = "Base.Uchar.Utf16be" + let byte_length = utf_16_byte_length + let get_decode_result = String.get_utf_16be_uchar + let set = Bytes.set_uchar_utf_16be +end) + +module Utf32le = Make_utf (struct + let codec_name = "UTF-32LE" + let module_name = "Base.Uchar.Utf32le" + let byte_length _ = 4 + let get_decode_result = String.get_utf_32le_uchar + let set = Bytes.set_uchar_utf_32le +end) + +module Utf32be = Make_utf (struct + let codec_name = "UTF-32BE" + let module_name = "Base.Uchar.Utf32be" + let byte_length _ = 4 + let get_decode_result = String.get_utf_32be_uchar + let set = Bytes.set_uchar_utf_32be +end) + +(* Include type-specific [Replace_polymorphic_compare] at the end, after + including functor application that could shadow its definitions. This is + here so that efficient versions of the comparison functions are exported by + this module. *) +include Uchar_replace_polymorphic_compare diff --git a/unikernel/duniverse/base/src/uchar.mli b/unikernel/duniverse/base/src/uchar.mli new file mode 100644 index 00000000..43fe4802 --- /dev/null +++ b/unikernel/duniverse/base/src/uchar.mli @@ -0,0 +1 @@ +include Uchar_intf.Uchar (** @inline *) diff --git a/unikernel/duniverse/base/src/uchar0.ml b/unikernel/duniverse/base/src/uchar0.ml new file mode 100644 index 00000000..f7ecda25 --- /dev/null +++ b/unikernel/duniverse/base/src/uchar0.ml @@ -0,0 +1,29 @@ +open! Import0 + +type t = Stdlib.Uchar.t + +let succ = Stdlib.Uchar.succ +let pred = Stdlib.Uchar.pred +let is_valid = Stdlib.Uchar.is_valid +let is_char = Stdlib.Uchar.is_char +let unsafe_to_char = Stdlib.Uchar.unsafe_to_char +let unsafe_of_int = Stdlib.Uchar.unsafe_of_int +let of_int = Stdlib.Uchar.of_int +let to_int = Stdlib.Uchar.to_int +let of_char = Stdlib.Uchar.of_char +let compare = Stdlib.Uchar.compare +let equal = Stdlib.Uchar.equal +let min_value = Stdlib.Uchar.min +let max_value = Stdlib.Uchar.max +let byte_order_mark = Stdlib.Uchar.bom +let replacement_char = Stdlib.Uchar.rep +let utf_8_byte_length = Stdlib.Uchar.utf_8_byte_length +let utf_16_byte_length = Stdlib.Uchar.utf_16_byte_length + +type utf_decode = Stdlib.Uchar.utf_decode + +let utf_decode_is_valid = Stdlib.Uchar.utf_decode_is_valid +let utf_decode_uchar = Stdlib.Uchar.utf_decode_uchar +let utf_decode_length = Stdlib.Uchar.utf_decode_length +let utf_decode = Stdlib.Uchar.utf_decode +let utf_decode_invalid = Stdlib.Uchar.utf_decode_invalid diff --git a/unikernel/duniverse/base/src/uchar_intf.ml b/unikernel/duniverse/base/src/uchar_intf.ml new file mode 100644 index 00000000..400b2c80 --- /dev/null +++ b/unikernel/duniverse/base/src/uchar_intf.ml @@ -0,0 +1,146 @@ +open! Import + +(** Interface for encoding and decoding individual Unicode scalar values. See [String.Utf] + for working with Unicode strings. *) +module type Utf = sig + (** [to_string] encodes a Unicode scalar value in this encoding. + + [of_string] interprets a string as one Unicode scalar value in this encoding, and + raises if the string cannot be interpreted as such. *) + include Stringable.S with type t := Uchar0.t + + (** Returns the number of bytes used for a given scalar value in this encoding. *) + val byte_length : Uchar0.t -> int + + (** The name of this encoding scheme; e.g., "UTF-8". *) + val codec_name : string +end + +module type Uchar = sig + (** Unicode operations. + + A [Uchar.t] represents a Unicode scalar value, which is the basic unit of Unicode. + + See also [String.Utf*] submodules for Unicode support with multiple [Uchar.t] values + encoded in a string. *) + + open! Import + + type t = Uchar0.t [@@deriving_inline hash, sexp, sexp_grammar] + + include Ppx_hash_lib.Hashable.S with type t := t + include Sexplib0.Sexpable.S with type t := t + + val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + + [@@@end] + + type uchar := t + + include Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_compare_lib.Equal.S_local with type t := t + include Pretty_printer.S with type t := t + include Invariant.S with type t := t + + (** [succ_exn t] is the scalar value after [t] in the set of Unicode scalar values, and + raises if [t = max_value]. *) + val succ : t -> t option + + val succ_exn : t -> t + + (** [pred_exn t] is the scalar value before [t] in the set of Unicode scalar values, and + raises if [t = min_value]. *) + val pred : t -> t option + + val pred_exn : t -> t + + (** [is_char t] is [true] iff [n] is in the latin-1 character set. *) + val is_char : t -> bool + + (** [to_char_exn t] is [t] as a [char] if it is in the latin-1 character set, and raises + otherwise. *) + val to_char : t -> char option + + val to_char_exn : t -> char + + (** [of_char c] is [c] as a Unicode scalar value. *) + val of_char : char -> t + + (** [int_is_scalar n] is [true] iff [n] is an Unicode scalar value (i.e., in the ranges + [0x0000]...[0xD7FF] or [0xE000]...[0x10FFFF]). *) + val int_is_scalar : int -> bool + + (** [of_scalar_exn n] is [n] as a Unicode scalar value. Raises if [not (int_is_scalar + i)]. *) + val of_scalar : int -> t option + + val of_scalar_exn : int -> t + + (** [to_scalar t] is [t] as an integer scalar value. *) + val to_scalar : t -> int + + (** Number of bytes needed to represent [t] in UTF-8. *) + val utf_8_byte_length : t -> int + [@@deprecated "[since 2023-11] use [Utf8.byte_length]"] + + (** Number of bytes needed to represent [t] in UTF-16. *) + val utf_16_byte_length : t -> int + [@@deprecated "[since 2023-11] use [Utf16le.byte_length] or [Utf16be.byte_length]"] + + val min_value : t + val max_value : t + + (** U+FEFF, the byte order mark. https://en.wikipedia.org/wiki/Byte_order_mark *) + val byte_order_mark : t + + (** U+FFFD, the Unicode replacement character. + https://en.wikipedia.org/wiki/Specials_(Unicode_block)#Replacement_character *) + val replacement_char : t + + (** Result of decoding a UTF codec that may contain invalid encodings. *) + module Decode_result : sig + type t = Uchar0.utf_decode + [@@immediate] [@@deriving_inline compare, equal, hash, sexp_of] + + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Equal.S with type t := t + include Ppx_hash_lib.Hashable.S with type t := t + + val sexp_of_t : t -> Sexplib0.Sexp.t + + [@@@end] + + (** [true] iff [t] represents a Unicode scalar value. *) + val is_valid : t -> bool + + (** Number of bytes consumed to decode [t]. *) + val bytes_consumed : t -> int + + (** Returns the corresponding [uchar] if [is_valid t]. *) + val uchar : t -> uchar option + + (** Like [uchar]. Raises if [not (is_valid t)]. *) + val uchar_exn : t -> uchar + + (** Like [uchar]. Returns [replacement_char] if [not (is_valid t)]. *) + val uchar_or_replacement_char : t -> uchar + end + + (** UTF-8 encoding. See [Utf] interface. *) + module Utf8 : Utf + + (** UTF-16 little-endian encoding. See [Utf] interface. *) + module Utf16le : Utf + + (** UTF-16 big-endian encoding. See [Utf] interface. *) + module Utf16be : Utf + + (** UTF-32 little-endian encoding. See [Utf] interface. *) + module Utf32le : Utf + + (** UTF-32 big-endian encoding. See [Utf] interface. *) + module Utf32be : Utf + + module type Utf = Utf +end diff --git a/unikernel/duniverse/base/src/uniform_array.ml b/unikernel/duniverse/base/src/uniform_array.ml new file mode 100644 index 00000000..44dd7343 --- /dev/null +++ b/unikernel/duniverse/base/src/uniform_array.ml @@ -0,0 +1,397 @@ +open! Import + +(* WARNING: + We use non-memory-safe things throughout the [Trusted] module. + Most of it is only safe in combination with the type signature (e.g. exposing + [val copy : 'a t -> 'b t] would be a big mistake). *) +module Trusted : sig + type 'a t + + val empty : 'a t + val unsafe_create_uninitialized : len:int -> 'a t + val create_obj_array : len:int -> 'a t + val create : len:int -> 'a -> 'a t + val singleton : 'a -> 'a t + val get : 'a t -> int -> 'a + val set : 'a t -> int -> 'a -> unit + val swap : _ t -> int -> int -> unit + val unsafe_get : 'a t -> int -> 'a + val unsafe_get_local : 'a t -> int -> 'a + val unsafe_set : 'a t -> int -> 'a -> unit + val unsafe_set_omit_phys_equal_check : 'a t -> int -> 'a -> unit + val unsafe_set_int : 'a t -> int -> int -> unit + val unsafe_set_int_assuming_currently_int : 'a t -> int -> int -> unit + val unsafe_set_assuming_currently_int : 'a t -> int -> 'a -> unit + val unsafe_set_with_caml_modify : 'a t -> int -> 'a -> unit + val unsafe_to_array_inplace__promise_not_a_float : 'a t -> 'a array + val set_with_caml_modify : 'a t -> int -> 'a -> unit + val length : 'a t -> int + val unsafe_blit : ('a t, 'a t) Blit.blit + val copy : 'a t -> 'a t + val unsafe_clear_if_pointer : _ t -> int -> unit + val sub : 'a t -> pos:int -> len:int -> 'a t +end = struct + type 'a t = Obj_array.t + + let empty = Obj_array.empty + let unsafe_create_uninitialized ~len = Obj_array.create_zero ~len + let create_obj_array ~len = Obj_array.create_zero ~len + let create ~len x = Obj_array.create ~len (Stdlib.Obj.repr x) + let singleton x = Obj_array.singleton (Stdlib.Obj.repr x) + let swap t i j = Obj_array.swap t i j + let get arr i = Stdlib.Obj.obj (Obj_array.get arr i) + let set arr i x = Obj_array.set arr i (Stdlib.Obj.repr x) + let unsafe_get_local arr i = Stdlib.Obj.obj (Obj_array.unsafe_get arr i) + let unsafe_get arr i = unsafe_get_local arr i + let unsafe_set arr i x = Obj_array.unsafe_set arr i (Stdlib.Obj.repr x) + let unsafe_set_int arr i x = Obj_array.unsafe_set_int arr i x + + let unsafe_set_int_assuming_currently_int arr i x = + Obj_array.unsafe_set_int_assuming_currently_int arr i x + ;; + + let unsafe_set_assuming_currently_int arr i x = + Obj_array.unsafe_set_assuming_currently_int arr i (Stdlib.Obj.repr x) + ;; + + (* [t] is just an array under the hood, it just has special considerations about [t] not + being a float. *) + let unsafe_to_array_inplace__promise_not_a_float arr = Stdlib.Obj.magic arr + let length = Obj_array.length + let unsafe_blit = Obj_array.unsafe_blit + let copy = Obj_array.copy + + let unsafe_set_omit_phys_equal_check t i x = + Obj_array.unsafe_set_omit_phys_equal_check t i (Stdlib.Obj.repr x) + ;; + + let unsafe_set_with_caml_modify t i x = + Obj_array.unsafe_set_with_caml_modify t i (Stdlib.Obj.repr x) + ;; + + let set_with_caml_modify t i x = Obj_array.set_with_caml_modify t i (Stdlib.Obj.repr x) + let unsafe_clear_if_pointer = Obj_array.unsafe_clear_if_pointer + let sub = Obj_array.sub +end + +include Trusted + +let invariant t = + assert (Stdlib.Obj.tag (Stdlib.Obj.repr t) <> Stdlib.Obj.double_array_tag) +;; + +let init l ~f = + if l < 0 + then invalid_arg "Uniform_array.init" + else ( + let res = unsafe_create_uninitialized ~len:l in + for i = 0 to l - 1 do + unsafe_set res i (f i) + done; + res) +;; + +let of_array arr = init ~f:(Array.unsafe_get arr) (Array.length arr) [@nontail] +let map a ~f = init ~f:(fun i -> f (unsafe_get a i)) (length a) [@nontail] +let mapi a ~f = init ~f:(fun i -> f i (unsafe_get a i)) (length a) [@nontail] + +let iter a ~f = + for i = 0 to length a - 1 do + f (unsafe_get a i) + done +;; + +let iteri a ~f = + for i = 0 to length a - 1 do + f i (unsafe_get a i) + done +;; + +let foldi a ~init ~f = + let acc = ref init in + for i = 0 to length a - 1 do + acc := f i !acc (unsafe_get a i) + done; + !acc +;; + +let fold t ~init ~f = + let r = ref init in + for i = 0 to length t - 1 do + r := f !r (unsafe_get t i) + done; + !r +;; + +let to_list t = List.init ~f:(get t) (length t) + +let of_list l = + let len = List.length l in + let res = unsafe_create_uninitialized ~len in + List.iteri l ~f:(fun i x -> set res i x); + res +;; + +let of_list_rev l = + let len = List.length l in + let res = unsafe_create_uninitialized ~len in + List.iteri l ~f:(fun i x -> set res (len - i - 1) x); + res +;; + +(* It is not safe for [to_array] to be the identity function because we have code that + relies on [float array]s being unboxed, for example in [bin_write_array]. *) +let to_array t = Array.init (length t) ~f:(fun i -> unsafe_get t i) + +let exists t ~f = + let i = ref (length t - 1) in + let result = ref false in + while !i >= 0 && not !result do + if f (unsafe_get t !i) then result := true else decr i + done; + !result +;; + +let existsi t ~f = + let i = ref (length t - 1) in + let result = ref false in + while !i >= 0 && not !result do + if f !i (unsafe_get t !i) then result := true else decr i + done; + !result +;; + +let for_all t ~f = + let i = ref (length t - 1) in + let result = ref true in + while !i >= 0 && !result do + if not (f (unsafe_get t !i)) then result := false else decr i + done; + !result +;; + +let for_alli t ~f = + let length = length t in + let i = ref (length - 1) in + let result = ref true in + while !i >= 0 && !result do + if not (f !i (unsafe_get t !i)) then result := false else decr i + done; + !result +;; + +let filter_mapi t ~f = + let r = ref empty in + let k = ref 0 in + for i = 0 to length t - 1 do + match f i (unsafe_get t i) with + | None -> () + | Some a -> + if !k = 0 then r := create ~len:(length t) a; + unsafe_set !r !k a; + incr k + done; + if !k = length t then !r else if !k > 0 then sub ~pos:0 ~len:!k !r else empty +;; + +let filteri t ~f = filter_mapi t ~f:(fun i x -> if f i x then Some x else None) [@nontail] +let filter_map t ~f = filter_mapi t ~f:(fun _i a -> f a) [@nontail] +let filter t ~f = filter_map t ~f:(fun x -> if f x then Some x else None) [@nontail] + +let fold2_exn t1 t2 ~init ~f = + let len = length t1 in + if length t2 <> len then invalid_arg "Array.fold2_exn"; + let acc = ref init in + for i = 0 to len - 1 do + acc := f !acc (unsafe_get t1 i) (unsafe_get t2 i) + done; + !acc +;; + +let map2_exn t1 t2 ~f = + let len = length t1 in + if length t2 <> len then invalid_arg "Array.map2_exn"; + init len ~f:(fun i -> f (unsafe_get t1 i) (unsafe_get t2 i)) [@nontail] +;; + +let concat ts = + let total_len = List.sum (module Int) ts ~f:(fun t -> length t) in + let res = unsafe_create_uninitialized ~len:total_len in + ignore + (List.fold ts ~init:0 ~f:(fun so_far t -> + let len = length t in + for i = 0 to len - 1 do + set res (so_far + i) (get t i) + done; + so_far + len) + : int); + res +;; + +let concat_mapi t ~f = to_list t |> List.mapi ~f |> concat +let concat_map t ~f = to_list t |> List.map ~f |> concat + +let partition_map t ~f = + let left, right = ref empty, ref empty in + let left_idx, right_idx = ref 0, ref 0 in + let append data idx value = + if !idx = 0 then data := create ~len:(length t) value; + unsafe_set !data !idx value; + incr idx + in + for i = 0 to length t - 1 do + match (f (unsafe_get t i) : _ Either.t) with + | First a -> append left left_idx a + | Second a -> append right right_idx a + done; + let trim data idx = + if !idx = length t + then !data + else if !idx > 0 + then sub ~pos:0 ~len:!idx !data + else empty + in + trim left left_idx, trim right right_idx +;; + +let find_map t ~f = + let length = length t in + if length = 0 + then None + else ( + let i = ref 0 in + let value_found = ref None in + while Option.is_none !value_found && !i < length do + let value = unsafe_get t !i in + value_found := f value; + incr i + done; + !value_found) +;; + +let find_mapi t ~f = + let length = length t in + if length = 0 + then None + else ( + let i = ref 0 in + let value_found = ref None in + while Option.is_none !value_found && !i < length do + let value = unsafe_get t !i in + value_found := f !i value; + incr i + done; + !value_found) +;; + +let findi t ~f = + let length = length t in + if length = 0 + then None + else ( + let i = ref 0 in + let found = ref false in + let value_found = ref (unsafe_get t 0) in + while (not !found) && !i < length do + let value = unsafe_get t !i in + if f !i value + then ( + value_found := value; + found := true) + else incr i + done; + if !found then Some (!i, !value_found) else None) +;; + +let find t ~f = Option.map (findi t ~f:(fun _i x -> f x)) ~f:(fun (_i, x) -> x) + +let findi t ~f = + let len = length t in + let rec loop f i = + if i >= len + then None + else ( + let x = unsafe_get t i in + match f i x with + | false -> loop f (i + 1) + | true -> Some (i, x)) + in + loop f 0 +;; + +let t_sexp_grammar (type elt) (grammar : elt Sexplib0.Sexp_grammar.t) + : elt t Sexplib0.Sexp_grammar.t + = + Sexplib0.Sexp_grammar.coerce (Array.t_sexp_grammar grammar) +;; + +include + Sexpable.Of_sexpable1 + (Array) + (struct + type nonrec 'a t = 'a t + + let to_sexpable = to_array + let of_sexpable = of_array + end) + +include Blit.Make1 (struct + type nonrec 'a t = 'a t + + let length = length + + let create_like ~len t = + if len = 0 + then empty + else ( + assert (length t > 0); + create ~len (get t 0)) + ;; + + let unsafe_blit = unsafe_blit +end) + +let min_elt t ~compare = Container.min_elt ~fold t ~compare +let max_elt t ~compare = Container.max_elt ~fold t ~compare + +(* This is the same as the ppx_compare [compare_array] but uses our [unsafe_get] and [length]. *) +let compare__local compare_elt a b = + if phys_equal a b + then 0 + else ( + let len_a = length a in + let len_b = length b in + let ret = compare len_a len_b in + if ret <> 0 + then ret + else ( + let rec loop i = + if i = len_a + then 0 + else ( + let l = unsafe_get_local a i + and r = unsafe_get_local b i in + let res = compare_elt l r in + if res <> 0 then res else loop (i + 1)) + in + loop 0 [@nontail])) +;; + +let compare compare_elt a b = compare__local compare_elt a b + +module Sort = Array.Private.Sorter (struct + type nonrec 'a t = 'a t + + let length = length + let get = unsafe_get + let set = unsafe_set +end) + +let sort = Sort.sort + +include Binary_searchable.Make1 (struct + type nonrec 'a t = 'a t + + let length = length + let get = unsafe_get +end) diff --git a/unikernel/duniverse/base/src/uniform_array.mli b/unikernel/duniverse/base/src/uniform_array.mli new file mode 100644 index 00000000..c889b257 --- /dev/null +++ b/unikernel/duniverse/base/src/uniform_array.mli @@ -0,0 +1,135 @@ +(** Same semantics as ['a Array.t], except it's guaranteed that the representation array + is not tagged with [Double_array_tag], the tag for float arrays. + + This means it's safer to use in the presence of [Obj.magic], but it's slower than + normal [Array] if you use it with floats. + + It can often be faster than [Array] if you use it with non-floats. *) + +open! Import + +(** See [Base.Array] for comments. *) +type 'a t [@@deriving_inline sexp, sexp_grammar, compare ~localize] + +include Sexplib0.Sexpable.S1 with type 'a t := 'a t + +val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + +include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t +include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + +[@@@end] + +val invariant : _ t -> unit +val empty : _ t +val create : len:int -> 'a -> 'a t +val singleton : 'a -> 'a t +val init : int -> f:(int -> 'a) -> 'a t +val length : 'a t -> int +val get : 'a t -> int -> 'a +val unsafe_get : 'a t -> int -> 'a +val unsafe_get_local : 'a t -> int -> 'a +val set : 'a t -> int -> 'a -> unit +val unsafe_set : 'a t -> int -> 'a -> unit +val swap : _ t -> int -> int -> unit + +(** [unsafe_set_omit_phys_equal_check] is like [unsafe_set], except it doesn't do a + [phys_equal] check to try to skip [caml_modify]. It is safe to call this even if the + values are [phys_equal]. *) +val unsafe_set_omit_phys_equal_check : 'a t -> int -> 'a -> unit + +(** [unsafe_set_with_caml_modify] always calls [caml_modify] before setting and never gets + the old value. This is like [unsafe_set_omit_phys_equal_check] except it doesn't + check whether the old value and the value being set are integers to try to skip + [caml_modify]. *) +val unsafe_set_with_caml_modify : 'a t -> int -> 'a -> unit + +(** Same as [unsafe_set_with_caml_modify], but with bounds check. *) +val set_with_caml_modify : 'a t -> int -> 'a -> unit + +val map : 'a t -> f:('a -> 'b) -> 'b t +val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t +val iter : 'a t -> f:('a -> unit) -> unit + +(** Like {!iter}, but the function is applied to the index of the element as first + argument, and the element itself as second argument. *) +val iteri : 'a t -> f:(int -> 'a -> unit) -> unit + +val fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc +val foldi : 'a t -> init:'acc -> f:(int -> 'acc -> 'a -> 'acc) -> 'acc + +(** [unsafe_to_array_inplace__promise_not_a_float] converts from a [t] to an [array] in + place. This function is unsafe if the underlying type is a float. *) +val unsafe_to_array_inplace__promise_not_a_float : 'a t -> 'a array + +(** [of_array] and [to_array] return fresh arrays with the same contents rather than + returning a reference to the underlying array. *) +val of_array : 'a array -> 'a t + +val to_array : 'a t -> 'a array +val of_list : 'a list -> 'a t +val of_list_rev : 'a list -> 'a t +val to_list : 'a t -> 'a list + +include Blit.S1 with type 'a t := 'a t + +val copy : 'a t -> 'a t +val exists : 'a t -> f:('a -> bool) -> bool +val existsi : 'a t -> f:(int -> 'a -> bool) -> bool +val for_all : 'a t -> f:('a -> bool) -> bool +val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool +val concat : 'a t list -> 'a t +val concat_map : 'a t -> f:('a -> 'b t) -> 'b t +val concat_mapi : 'a t -> f:(int -> 'a -> 'b t) -> 'b t +val partition_map : 'a t -> f:('a -> ('b, 'c) Either.t) -> 'b t * 'c t +val filter : 'a t -> f:('a -> bool) -> 'a t +val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t +val filter_map : 'a t -> f:('a -> 'b option) -> 'b t +val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t +val find : 'a t -> f:('a -> bool) -> 'a option +val findi : 'a t -> f:(int -> 'a -> bool) -> (int * 'a) option +val find_map : 'a t -> f:('a -> 'b option) -> 'b option +val find_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b option + +(** Functions with the 2 suffix raise an exception if the lengths of the two given arrays + aren't the same. *) +val map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + +val fold2_exn : 'a t -> 'b t -> init:'acc -> f:('acc -> 'a -> 'b -> 'acc) -> 'acc +val min_elt : 'a t -> compare:('a -> 'a -> int) -> 'a option +val max_elt : 'a t -> compare:('a -> 'a -> int) -> 'a option + +(** [sort] uses constant heap space. + + To sort only part of the array, specify [pos] to be the index to start sorting from + and [len] indicating how many elements to sort. *) +val sort : ?pos:int -> ?len:int -> 'a t -> compare:('a -> 'a -> int) -> unit + +include Binary_searchable.S1 with type 'a t := 'a t + +(** {2 Extra lowlevel and unsafe functions} *) + +(** The behavior is undefined if you access an element before setting it. *) +val unsafe_create_uninitialized : len:int -> _ t + +(** New obj array filled with [Obj.repr 0] *) +val create_obj_array : len:int -> Stdlib.Obj.t t + +(** [unsafe_set_assuming_currently_int t i obj] sets index [i] of [t] to [obj], but only + works correctly if the value there is an immediate, i.e. [Stdlib.Obj.is_int (get t i)]. + This precondition saves a dynamic check. + + [unsafe_set_int_assuming_currently_int] is similar, except the value being set is an + int. + + [unsafe_set_int] is similar but does not assume anything about the target. *) +val unsafe_set_assuming_currently_int : Stdlib.Obj.t t -> int -> Stdlib.Obj.t -> unit + +val unsafe_set_int_assuming_currently_int : Stdlib.Obj.t t -> int -> int -> unit +val unsafe_set_int : Stdlib.Obj.t t -> int -> int -> unit + +(** [unsafe_clear_if_pointer t i] prevents [t.(i)] from pointing to anything to prevent + space leaks. It does this by setting [t.(i)] to [Stdlib.Obj.repr 0]. As a performance + hack, it only does this when [not (Stdlib.Obj.is_int t.(i))]. It is an error to access + the cleared index before setting it again. *) +val unsafe_clear_if_pointer : Stdlib.Obj.t t -> int -> unit diff --git a/unikernel/duniverse/base/src/unit.ml b/unikernel/duniverse/base/src/unit.ml new file mode 100644 index 00000000..c64d5d19 --- /dev/null +++ b/unikernel/duniverse/base/src/unit.ml @@ -0,0 +1,39 @@ +open! Import + +module T = struct + type t = unit [@@deriving_inline enumerate, globalize, hash, sexp, sexp_grammar] + + let all = ([ () ] : t list) + let (globalize : t -> t) = (globalize_unit : t -> t) + + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_unit + + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_unit in + fun x -> func x + ;; + + let t_of_sexp = (unit_of_sexp : Sexplib0.Sexp.t -> t) + let sexp_of_t = (sexp_of_unit : t -> Sexplib0.Sexp.t) + let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = unit_sexp_grammar + + [@@@end] + + let compare _ _ = 0 + let compare__local _ _ = 0 + let equal__local _ _ = true + + let of_string = function + | "()" -> () + | _ -> failwith "Base.Unit.of_string: () expected" + ;; + + let to_string () = "()" + let module_name = "Base.Unit" +end + +include T +include Identifiable.Make (T) + +let invariant () = () diff --git a/unikernel/duniverse/base/src/unit.mli b/unikernel/duniverse/base/src/unit.mli new file mode 100644 index 00000000..d5889ddf --- /dev/null +++ b/unikernel/duniverse/base/src/unit.mli @@ -0,0 +1,20 @@ +(** Module for the type [unit]. *) + +open! Import + +type t = unit [@@deriving_inline enumerate, globalize, sexp, sexp_grammar] + +include Ppx_enumerate_lib.Enumerable.S with type t := t + +val globalize : t -> t + +include Sexplib0.Sexpable.S with type t := t + +val t_sexp_grammar : t Sexplib0.Sexp_grammar.t + +[@@@end] + +include Identifiable.S with type t := t +include Ppx_compare_lib.Equal.S_local with type t := t +include Ppx_compare_lib.Comparable.S_local with type t := t +include Invariant.S with type t := t diff --git a/unikernel/duniverse/base/src/variant.ml b/unikernel/duniverse/base/src/variant.ml new file mode 100644 index 00000000..cfc794b3 --- /dev/null +++ b/unikernel/duniverse/base/src/variant.ml @@ -0,0 +1,6 @@ +type 'constructor t = + { name : string + ; (* the position of the constructor in the type definition, starting from 0 *) + rank : int + ; constructor : 'constructor + } diff --git a/unikernel/duniverse/base/src/variant.mli b/unikernel/duniverse/base/src/variant.mli new file mode 100644 index 00000000..ba0e7e2b --- /dev/null +++ b/unikernel/duniverse/base/src/variant.mli @@ -0,0 +1,9 @@ +(** First-class representative of an individual variant in a variant type, used in + [[@@deriving variants]]. *) + +type 'constructor t = + { name : string + (** The position of the constructor in the type definition, starting from 0 *) + ; rank : int + ; constructor : 'constructor + } diff --git a/unikernel/duniverse/base/src/variantslib.ml b/unikernel/duniverse/base/src/variantslib.ml new file mode 100644 index 00000000..95994d5d --- /dev/null +++ b/unikernel/duniverse/base/src/variantslib.ml @@ -0,0 +1,3 @@ +(** This module is for use by ppx_variants_conv, and is thus not in the interface of + Base. *) +module Variant = Variant diff --git a/unikernel/duniverse/base/src/with_return.ml b/unikernel/duniverse/base/src/with_return.ml new file mode 100644 index 00000000..51b505e1 --- /dev/null +++ b/unikernel/duniverse/base/src/with_return.ml @@ -0,0 +1,35 @@ +(* belongs in Common, but moved here to avoid circular dependencies *) + +open! Import + +type 'a return = { return : 'b. 'a -> 'b } [@@unboxed] + +let with_return (type a) f = + (* Raised to indicate ~return was called. Local so that the exception is tied to a + particular call of [with_return]. *) + let exception Return of a in + let is_alive = ref true in + let return a = + if not !is_alive + then failwith "use of [return] from a [with_return] that already returned"; + Exn.raise_without_backtrace (Return a) + in + try + let a = f { return } in + is_alive := false; + a + with + | exn -> + is_alive := false; + (match exn with + | Return a -> a + | _ -> raise exn) +;; + +let with_return_option f = + with_return (fun return -> + f { return = (fun a -> return.return (Some a)) }; + None) [@nontail] +;; + +let prepend { return } ~f = { return = (fun x -> return (f x)) } diff --git a/unikernel/duniverse/base/src/with_return.mli b/unikernel/duniverse/base/src/with_return.mli new file mode 100644 index 00000000..1c9a0dda --- /dev/null +++ b/unikernel/duniverse/base/src/with_return.mli @@ -0,0 +1,53 @@ +(** [with_return f] allows for something like the return statement in C within [f]. + + There are three ways [f] can terminate: + + + If [f] calls [r.return x], then [x] is returned by [with_return]. + + If [f] evaluates to a value [x], then [x] is returned by [with_return]. + + If [f] raises an exception, it escapes [with_return]. + + Here is a typical example: + + {[ + let find l ~f = + with_return (fun r -> + List.iter l ~f:(fun x -> if f x then r.return (Some x)); + None + ) + ]} + + It is only because of a deficiency of ML types that [with_return] doesn't have type: + + {[ val with_return : 'a. (('a -> ('b. 'b)) -> 'a) -> 'a ]} + + but we can slightly increase the scope of ['b] without changing the meaning of the + type, and then we get: + + {[ + type 'a return = { return : 'b . 'a -> 'b } + val with_return : ('a return -> 'a) -> 'a + ]} + + But the actual reason we chose to use a record type with polymorphic field is that + otherwise we would have to clobber the namespace of functions with [return] and that + is undesirable because [return] would get hidden as soon as we open any monad. We + considered names different than [return] but everything seemed worse than just having + [return] as a record field. We are clobbering the namespace of record fields but that + is much more acceptable. *) + +open! Import + +type -'a return = private { return : 'b. 'a -> 'b } [@@unboxed] + +val with_return : ('a return -> 'a) -> 'a + +(** Note that [with_return_option] allocates ~5 words more than the equivalent + [with_return] call. *) +val with_return_option : ('a return -> unit) -> 'a option + +(** [prepend a ~f] returns a value [x] such that each call to [x.return] first applies [f] + before applying [a.return]. The call to [f] is "prepended" to the call to the + original [a.return]. A possible use case is to hand [x] over to another function + which returns ['b], a subtype of ['a], or to capture a common transformation [f] + applied to returned values at several call sites. *) +val prepend : 'a return -> f:('b -> 'a) -> 'b return diff --git a/unikernel/duniverse/base/src/word_size.ml b/unikernel/duniverse/base/src/word_size.ml new file mode 100644 index 00000000..91e80579 --- /dev/null +++ b/unikernel/duniverse/base/src/word_size.ml @@ -0,0 +1,28 @@ +open! Import +module Sys = Sys0 + +type t = + | W32 + | W64 +[@@deriving_inline sexp_of] + +let sexp_of_t = + (function + | W32 -> Sexplib0.Sexp.Atom "W32" + | W64 -> Sexplib0.Sexp.Atom "W64" + : t -> Sexplib0.Sexp.t) +;; + +[@@@end] + +let num_bits = function + | W32 -> 32 + | W64 -> 64 +;; + +let word_size = + match Sys.word_size_in_bits with + | 32 -> W32 + | 64 -> W64 + | _ -> failwith "unknown word size" +;; diff --git a/unikernel/duniverse/base/src/word_size.mli b/unikernel/duniverse/base/src/word_size.mli new file mode 100644 index 00000000..626b2807 --- /dev/null +++ b/unikernel/duniverse/base/src/word_size.mli @@ -0,0 +1,17 @@ +(** For determining the word size that the program is using. *) + +open! Import + +type t = + | W32 + | W64 +[@@deriving_inline sexp_of] + +val sexp_of_t : t -> Sexplib0.Sexp.t + +[@@@end] + +val num_bits : t -> int + +(** Returns the word size of this program, not necessarily of the OS. *) +val word_size : t diff --git a/unikernel/duniverse/base/test/allocation/base_test_allocation.ml b/unikernel/duniverse/base/test/allocation/base_test_allocation.ml new file mode 100644 index 00000000..3e216ecf --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/base_test_allocation.ml @@ -0,0 +1 @@ +(*_ This library deliberately does not export anything. *) diff --git a/unikernel/duniverse/base/test/allocation/bin/dune b/unikernel/duniverse/base/test/allocation/bin/dune new file mode 100644 index 00000000..ff97ffd7 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/bin/dune @@ -0,0 +1,8 @@ +(executables + (modes byte exe) + (names test_option_array_allocation) + (libraries base expect_test_helpers_core compiler-libs.common + core_kernel.version_util) + (ocamlopt_flags :standard -O3) + (preprocess + (pps ppx_jane))) diff --git a/unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.ml b/unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.ml new file mode 100644 index 00000000..1df44f45 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.ml @@ -0,0 +1,58 @@ +open! Base +open Option_array +open Expect_test_helpers_core + +let () = + let t = of_array [| None |] in + assert ( + require_no_allocation [%here] (fun () -> + match get t 0 with + | None -> true + | Some _ -> false)) +;; + +let () = + let t = of_array [| Some 0 |] in + let get_some () = + match get t 0 with + | None -> false + | Some _ -> true + in + (* After inlining, [match get t 0 with] is: + + {[ + match + let cheap_option = Uniform_array.get t 0 in + if Cheap_option.is_some cheap_option + then Some (Cheap_option.value_unsafe cheap_option) + else None + with + ]} + + This situation is called "match-in-match" (the inner [if] is essentially a match). + The OCaml compiler and Flambda optimizer don't handle match-in-match well, and so + cannot eliminate the allocation of [Some]. Flambda2 is expected to eliminate the + allocation, at which point we can [require_no_allocation] (possibly annotating the + test with [@tags "fast-flambda"]). + + Note that Flambda 2 only eliminates the allocation in optimized mode. + In classic mode, it will remain. This file is compiled with optimized mode. + *) + let compiler_eliminates_the_allocation = + (* [Version_util.x_library_inlining] is the whole reason this is a separate + executable. *) + Config.flambda2 && Version_util.x_library_inlining + in + if compiler_eliminates_the_allocation + then assert (require_no_allocation [%here] get_some) + else + let module Gc = Core.Gc.For_testing in + let _, { Gc.Allocation_report.minor_words_allocated; _ } = + Gc.measure_allocation get_some + in + if minor_words_allocated <= 2 + then () + else + failwith + (Printf.sprintf "Allocated more words than expected: %d" minor_words_allocated) +;; diff --git a/unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.mli b/unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/dune b/unikernel/duniverse/base/test/allocation/dune new file mode 100644 index 00000000..6782ae64 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/dune @@ -0,0 +1,5 @@ +(library + (name base_test_allocation) + (libraries async base expect_test_helpers_async expect_test_helpers_core) + (preprocess + (pps ppx_jane))) diff --git a/unikernel/duniverse/base/test/allocation/test_array_allocation.ml b/unikernel/duniverse/base/test/allocation/test_array_allocation.ml new file mode 100644 index 00000000..e05a92ee --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_array_allocation.ml @@ -0,0 +1,32 @@ +open! Base +open Expect_test_helpers_core + +let%expect_test "Array.sort [||] only allocates when computing bounds" = + require_allocation_does_not_exceed (Minor_words 3) [%here] (fun () -> + Array.sort ~compare:Int.compare [||]); + [%expect {| |}] +;; + +let%expect_test "Array.sort [| 5; 2; 3; 4; 1 |] only allocates when computing bounds" = + let arr = [| 5; 2; 3; 4; 1 |] in + require_allocation_does_not_exceed (Minor_words 3) [%here] (fun () -> + Array.sort ~compare:Int.compare arr); + [%expect {| |}] +;; + +let%expect_test "equal does not allocate" = + let arr1 = [| 1; 2; 3; 4 |] in + let arr2 = [| 1; 2; 4; 3 |] in + require + [%here] + (require_no_allocation [%here] (fun () -> not (Array.equal Int.equal arr1 arr2))); + [%expect {| |}] +;; + +let%expect_test "foldi does not allocate" = + let arr = [| 1; 2; 3; 4 |] in + let f i x y = i + x + y in + require + [%here] + (require_no_allocation [%here] (fun () -> 16 = Array.foldi ~init:0 ~f arr)) +;; diff --git a/unikernel/duniverse/base/test/allocation/test_array_allocation.mli b/unikernel/duniverse/base/test/allocation/test_array_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_array_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_char_allocation.ml b/unikernel/duniverse/base/test/allocation/test_char_allocation.ml new file mode 100644 index 00000000..e78cc5d3 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_char_allocation.ml @@ -0,0 +1,10 @@ +open! Base +open Expect_test_helpers_core + +let%expect_test _ = + let x = Sys.opaque_identity 'a' in + let y = Sys.opaque_identity 'b' in + require_no_allocation [%here] (fun () -> + ignore (Sys.opaque_identity (Char.Caseless.equal x y) : bool)); + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/allocation/test_char_allocation.mli b/unikernel/duniverse/base/test/allocation/test_char_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_char_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_float_allocation.ml b/unikernel/duniverse/base/test/allocation/test_float_allocation.ml new file mode 100644 index 00000000..208d2d37 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_float_allocation.ml @@ -0,0 +1,10 @@ +open! Base +open Stdio +open Float + +let%expect_test "iround_nearest_exn noalloc" = + let t = Sys.opaque_identity 205.414 in + Expect_test_helpers_core.require_no_allocation [%here] (fun () -> iround_nearest_exn t) + |> printf "%d\n"; + [%expect {| 205 |}] +;; diff --git a/unikernel/duniverse/base/test/allocation/test_float_allocation.mli b/unikernel/duniverse/base/test/allocation/test_float_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_float_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.ml b/unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.ml new file mode 100644 index 00000000..54fbb03e --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.ml @@ -0,0 +1,90 @@ +open! Base +open Expect_test_helpers_core + +let () = Int_conversions.sexp_of_int_style := `Underscores + +let%expect_test "find_and_call_1_and_2" = + let test x = + let t = Hashtbl.create (module Int) ~size:16 ~growth_allowed:false in + for i = 0 to x - 1 do + Hashtbl.add_exn t ~key:i ~data:(i * 7) + done; + let if_found a b = assert (a = b) in + let if_not_found a b = + assert (a = x); + assert (b = x * 7) + in + require_no_allocation [%here] (fun () -> + for i = 0 to x do + Hashtbl.find_and_call1 t i ~a:(i * 7) ~if_found ~if_not_found + done); + let if_found ~key ~data:a b = + assert (a = b); + assert (key = a / 7) + in + let if_not_found a b = + assert (a = x); + assert (b = x * 7) + in + require_no_allocation [%here] (fun () -> + for i = 0 to x do + Hashtbl.findi_and_call1 t i ~a:(i * 7) ~if_found ~if_not_found + done); + let if_found a b c = + assert (a = b); + assert (b = c / 2) + in + let if_not_found a b c = + assert (a = x); + assert (b = x * 7); + assert (c = x * 14) + in + require_no_allocation [%here] (fun () -> + for i = 0 to x do + Hashtbl.find_and_call2 t i ~a:(i * 7) ~b:(i * 14) ~if_found ~if_not_found + done); + let if_found ~key ~data:a b c = + assert (a = b); + assert (b = c / 2); + assert (key = a / 7) + in + let if_not_found a b c = + assert (a = x); + assert (b = x * 7); + assert (c = x * 14) + in + require_no_allocation [%here] (fun () -> + for i = 0 to x do + Hashtbl.findi_and_call2 t i ~a:(i * 7) ~b:(i * 14) ~if_found ~if_not_found + done); + print_s (Int.sexp_of_t x) + in + (* try various load factors, to exercise all branches of matching on the structure of + the avl tree *) + test 1; + test 3; + test 10; + test 17; + test 25; + test 29; + test 33; + test 3133; + [%expect {| + 1 + 3 + 10 + 17 + 25 + 29 + 33 + 3_133 + |}] +;; + +let%expect_test ("find_or_add shouldn't allocate" [@tags "no-js"]) = + let default = Fn.const () in + let t = Hashtbl.create (module Int) ~size:16 ~growth_allowed:false in + Hashtbl.add_exn t ~key:100 ~data:(); + require_no_allocation [%here] (fun () -> Hashtbl.find_or_add t 100 ~default); + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.mli b/unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_list_allocation.ml b/unikernel/duniverse/base/test/allocation/test_list_allocation.ml new file mode 100644 index 00000000..98483459 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_list_allocation.ml @@ -0,0 +1,22 @@ +open! Base +open Expect_test_helpers_core + +let%expect_test "is_prefix does not allocate" = + let list = Sys.opaque_identity [ 1; 2; 3 ] in + let prefix = Sys.opaque_identity [ 1; 2 ] in + let equal = Int.equal in + let (_ : bool) = + require_no_allocation [%here] (fun () -> List.is_prefix list ~equal ~prefix) + in + [%expect {| |}] +;; + +let%expect_test "is_suffix does not allocate" = + let list = Sys.opaque_identity [ 1; 2; 3 ] in + let suffix = Sys.opaque_identity [ 2; 3 ] in + let equal = Int.equal in + let (_ : bool) = + require_no_allocation [%here] (fun () -> List.is_suffix list ~equal ~suffix) + in + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/allocation/test_list_allocation.mli b/unikernel/duniverse/base/test/allocation/test_list_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_list_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_option_array_allocation.ml b/unikernel/duniverse/base/test/allocation/test_option_array_allocation.ml new file mode 100644 index 00000000..0463d4cf --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_option_array_allocation.ml @@ -0,0 +1,11 @@ +open! Async +open Expect_test_helpers_async + +let%expect_test _ = + (* Sadly, the test is sensitive to cross-library inlining, which we can only detect + using the build info in version_util, which isn't available while compiling a test. + So we delegate the whole test to this executable: *) + let%bind () = run "bin/test_option_array_allocation.exe" [] in + [%expect {| |}]; + return () +;; diff --git a/unikernel/duniverse/base/test/allocation/test_option_array_allocation.mli b/unikernel/duniverse/base/test/allocation/test_option_array_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_option_array_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_string_allocation.ml b/unikernel/duniverse/base/test/allocation/test_string_allocation.ml new file mode 100644 index 00000000..7814a6d0 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_string_allocation.ml @@ -0,0 +1,182 @@ +open! Base +open Expect_test_helpers_core + +let%expect_test _ = + let x = Sys.opaque_identity "one string" in + let y = Sys.opaque_identity "another" in + require_no_allocation [%here] (fun () -> + ignore (Sys.opaque_identity (String.Caseless.equal x y) : bool)); + [%expect {| |}] +;; + +let%expect_test "empty substring" = + let string = String.init 10 ~f:Char.of_int_exn in + let test here f = + let substring = require_no_allocation here f in + assert (String.is_empty substring) + in + test [%here] (fun () -> String.sub string ~pos:0 ~len:0); + test [%here] (fun () -> String.prefix string 0); + test [%here] (fun () -> String.suffix string 0); + test [%here] (fun () -> String.drop_prefix string 10); + test [%here] (fun () -> String.drop_suffix string 10); + [%expect {| |}] +;; + +let%expect_test "mem does not allocate" = + let string = Sys.opaque_identity "abracadabra" in + let char = Sys.opaque_identity 'd' in + require_no_allocation [%here] (fun () -> ignore (String.mem string char : bool)); + [%expect {| |}] +;; + +let%expect_test "fold does not allocate" = + let string = Sys.opaque_identity "abracadabra" in + let char = Sys.opaque_identity 'd' in + let f acc c = if Char.equal c char then true else acc in + require_no_allocation [%here] (fun () -> + ignore (String.fold string ~init:false ~f : bool)); + [%expect {| |}] +;; + +let%expect_test "foldi does not allocate" = + let string = Sys.opaque_identity "abracadabra" in + let char = Sys.opaque_identity 'd' in + let f _i acc c = if Char.equal c char then true else acc in + require_no_allocation [%here] (fun () -> + ignore (String.foldi string ~init:false ~f : bool)); + [%expect {| |}] +;; + +let%test_module "common prefix and suffix" = + (module struct + let require_int_equal a b ~message = require_equal [%here] (module Int) a b ~message + + let require_string_equal a b ~message = + require_equal [%here] (module String) a b ~message + ;; + + let simulate_common_length ~get_common2_length list = + let rec loop acc prev list ~get_common2_length = + match list with + | [] -> acc + | head :: tail -> + loop (Int.min acc (get_common2_length prev head)) head tail ~get_common2_length + in + match list with + | [] -> 0 + | [ head ] -> String.length head + | head :: tail -> loop Int.max_value head tail ~get_common2_length + ;; + + let get_shortest_and_longest list = + let compare_by_length a b = Comparable.lift Int.compare ~f:String.length a b in + Option.both + (List.min_elt list ~compare:compare_by_length) + (List.max_elt list ~compare:compare_by_length) + ;; + + let test_generic get_common get_common2 get_common_length get_common2_length = + Staged.stage (fun list -> + let common = get_common list in + print_s [%sexp (common : string)]; + let len = get_common_length list in + require_int_equal len (String.length common) ~message:"wrong length"; + let common2 = List.reduce list ~f:get_common2 |> Option.value ~default:"" in + require_string_equal common common2 ~message:"pairwise result mismatch"; + let len2 = simulate_common_length ~get_common2_length list in + require_int_equal len len2 ~message:"pairwise length mismatch"; + if not (String.is_empty common || List.mem list common ~equal:String.equal) + then print_endline "(may allocate)" + else ( + ignore (require_no_allocation [%here] (fun () -> get_common list) : string); + Option.iter (get_shortest_and_longest list) ~f:(fun (shortest, longest) -> + ignore + (require_no_allocation [%here] (fun () -> get_common2 shortest longest) + : string); + ignore + (require_no_allocation [%here] (fun () -> get_common2 longest shortest) + : string)))) + ;; + + let test_prefix = + test_generic + String.common_prefix + String.common_prefix2 + String.common_prefix_length + String.common_prefix2_length + |> Staged.unstage + ;; + + let test_suffix = + test_generic + String.common_suffix + String.common_suffix2 + String.common_suffix_length + String.common_suffix2_length + |> Staged.unstage + ;; + + let%expect_test "empty" = + test_prefix []; + [%expect {| "" |}]; + test_suffix []; + [%expect {| "" |}] + ;; + + let%expect_test "singleton" = + test_prefix [ "abut" ]; + [%expect {| abut |}]; + test_suffix [ "tuba" ]; + [%expect {| tuba |}] + ;; + + let%expect_test "doubleton, alloc" = + test_prefix [ "hello"; "help"; "hex" ]; + [%expect {| + he + (may allocate) + |}]; + test_suffix [ "crest"; "zest"; "1st" ]; + [%expect {| + st + (may allocate) + |}] + ;; + + let%expect_test "doubleton, no alloc" = + test_prefix [ "hello"; "help"; "he" ]; + [%expect {| he |}]; + test_suffix [ "crest"; "zest"; "st" ]; + [%expect {| st |}] + ;; + + let%expect_test "many, alloc" = + test_prefix [ "this"; "that"; "the other"; "these"; "those"; "thy"; "thou" ]; + [%expect {| + th + (may allocate) + |}]; + test_suffix [ "fourth"; "fifth"; "sixth"; "seventh"; "eleventh"; "twelfth" ]; + [%expect {| + th + (may allocate) + |}] + ;; + + let%expect_test "many, no alloc" = + test_prefix [ "inconsequential"; "invariant"; "in"; "inner"; "increment" ]; + [%expect {| in |}]; + test_suffix [ "fat"; "cat"; "sat"; "at"; "bat" ]; + [%expect {| at |}] + ;; + + let%expect_test "many, nothing in common" = + let lorem_ipsum = [ "lorem"; "ipsum"; "dolor"; "sit"; "amet" ] in + test_prefix lorem_ipsum; + [%expect {| "" |}]; + test_suffix lorem_ipsum; + [%expect {| "" |}] + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/allocation/test_string_allocation.mli b/unikernel/duniverse/base/test/allocation/test_string_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_string_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_type_equal_allocation.ml b/unikernel/duniverse/base/test/allocation/test_type_equal_allocation.ml new file mode 100644 index 00000000..c7d2fcd0 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_type_equal_allocation.ml @@ -0,0 +1,9 @@ +open! Base +open Expect_test_helpers_core + +let t1 = Type_equal.Id.create ~name:"t1" [%sexp_of: _] + +let%expect_test "Type_equal.Id.to_sexp allocation" = + require_no_allocation [%here] (fun () -> + ignore (Type_equal.Id.to_sexp t1 : 'a -> Sexp.t)) +;; diff --git a/unikernel/duniverse/base/test/allocation/test_type_equal_allocation.mli b/unikernel/duniverse/base/test/allocation/test_type_equal_allocation.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_type_equal_allocation.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/allocation/test_zero_alloc.ml b/unikernel/duniverse/base/test/allocation/test_zero_alloc.ml new file mode 100644 index 00000000..25ebe219 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_zero_alloc.ml @@ -0,0 +1,20 @@ +let[@zero_alloc] [@inline never] foo x = Base.Printf.failwithf "%d" x () +let[@zero_alloc] [@inline never] bar x y = Base.Printf.invalid_argf "%d" (x + y) () + +let%expect_test "foo" = + let x = Sys.opaque_identity 5 in + (try foo x with + | Failure s -> + print_string s; + print_newline ()); + [%expect {| 5 |}] +;; + +let%expect_test "bar" = + let x = Sys.opaque_identity 5 in + (try bar x x with + | Invalid_argument s -> + print_string s; + print_newline ()); + [%expect {| 10 |}] +;; diff --git a/unikernel/duniverse/base/test/allocation/test_zero_alloc.mli b/unikernel/duniverse/base/test/allocation/test_zero_alloc.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/allocation/test_zero_alloc.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/avltree_unit_tests.ml b/unikernel/duniverse/base/test/avltree_unit_tests.ml new file mode 100644 index 00000000..d132df53 --- /dev/null +++ b/unikernel/duniverse/base/test/avltree_unit_tests.ml @@ -0,0 +1,429 @@ +open! Import + +let%test_module _ = + (module ( + struct + open Avltree + + type ('k, 'v) t = ('k, 'v) Avltree.t = private + | Empty + | Node of + { mutable left : ('k, 'v) t + ; key : 'k + ; mutable value : 'v + ; mutable height : int + ; mutable right : ('k, 'v) t + } + | Leaf of + { key : 'k + ; mutable value : 'v + } + + module For_quickcheck = struct + module Key = struct + include Int + + type t = int [@@deriving quickcheck] + + let quickcheck_generator = + Base_quickcheck.Generator.small_positive_or_zero_int + ;; + end + + module Data = struct + include String + + type t = string [@@deriving quickcheck] + + let quickcheck_generator = + Base_quickcheck.Generator.string_of + Base_quickcheck.Generator.char_lowercase + ;; + end + + let compare = Key.compare + + module Constructor = struct + type t = + | Add of Key.t * Data.t + | Replace of Key.t * Data.t + | Remove of Key.t + [@@deriving quickcheck, sexp_of] + + let apply_to_tree t tree = + match t with + | Add (key, data) -> + add tree ~key ~data ~compare ~added:(ref false) ~replace:false + | Replace (key, data) -> + add tree ~key ~data ~compare ~added:(ref false) ~replace:true + | Remove key -> remove tree key ~compare ~removed:(ref false) + ;; + + let apply_to_map t map = + match t with + | Add (key, data) -> + if Map.mem map key then map else Map.set map ~key ~data + | Replace (key, data) -> Map.set map ~key ~data + | Remove key -> Map.remove map key + ;; + end + + module Constructors = struct + type t = Constructor.t list [@@deriving quickcheck, sexp_of] + end + + let reify constructors = + List.fold + constructors + ~init:(empty, Map.empty (module Key)) + ~f:(fun (t, map) constructor -> + ( Constructor.apply_to_tree constructor t + , Constructor.apply_to_map constructor map )) + ;; + + let merge map1 map2 = + Map.merge map1 map2 ~f:(fun ~key variant -> + match variant with + | `Left data | `Right data -> Some data + | `Both (data1, data2) -> + Error.raise_s + [%message + "duplicate data for key" + (key : Key.t) + (data1 : Data.t) + (data2 : Data.t)]) + ;; + + let rec to_map = function + | Empty -> Map.empty (module Key) + | Leaf { key; value = data } -> Map.singleton (module Key) key data + | Node { left; key; value = data; height = _; right } -> + merge + (Map.singleton (module Key) key data) + (merge (to_map left) (to_map right)) + ;; + end + + open For_quickcheck + + let empty = empty + + let%test_unit _ = + match empty with + | Empty -> () + | _ -> assert false + ;; + + let is_empty = is_empty + let%test _ = is_empty empty + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: bool] (is_empty t) ~expect:(Map.is_empty map)) + ;; + + let invariant = invariant + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + invariant t ~compare; + [%test_result: Data.t Map.M(Key).t] (to_map t) ~expect:map) + ;; + + let add = add + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructor.t list * Key.t * Data.t * bool + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, data, replace) -> + let t, map = reify constructors in + (* test [added], other aspects of [add] are tested via [reify] in the + [invariant] test above *) + let added = ref false in + let (_ : (Key.t, Data.t) t) = + add t ~key ~data ~compare ~added ~replace + in + [%test_result: bool] !added ~expect:(not (Map.mem map key))) + ;; + + let remove = remove + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + (* test [removed], other aspects of [remove] are tested via [reify] in the + [invariant] test above *) + let removed = ref false in + let (_ : (Key.t, Data.t) t) = remove t key ~compare ~removed in + [%test_result: bool] !removed ~expect:(Map.mem map key)) + ;; + + let find = find + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: Data.t option] + (find t key ~compare) + ~expect:(Map.find map key)) + ;; + + let mem = mem + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: bool] (mem t key ~compare) ~expect:(Map.mem map key)) + ;; + + let first = first + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) option] + (first t) + ~expect:(Map.min_elt map)) + ;; + + let last = last + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) option] + (last t) + ~expect:(Map.max_elt map)) + ;; + + let find_and_call = find_and_call + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: [ `Found of Data.t | `Not_found of Key.t ]] + (find_and_call + t + key + ~compare + ~if_found:(fun data -> `Found data) + ~if_not_found:(fun key -> `Not_found key)) + ~expect: + (match Map.find map key with + | None -> `Not_found key + | Some data -> `Found data)) + ;; + + let findi_and_call = findi_and_call + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: [ `Found of Key.t * Data.t | `Not_found of Key.t ]] + (findi_and_call + t + key + ~compare + ~if_found:(fun ~key ~data -> `Found (key, data)) + ~if_not_found:(fun key -> `Not_found key)) + ~expect: + (match Map.find map key with + | None -> `Not_found key + | Some data -> `Found (key, data))) + ;; + + let find_and_call1 = find_and_call1 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Data.t * int | `Not_found of Key.t * int ]] + (find_and_call1 + t + key + ~compare + ~a + ~if_found:(fun data a -> `Found (data, a)) + ~if_not_found:(fun key a -> `Not_found (key, a))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a) + | Some data -> `Found (data, a))) + ;; + + let findi_and_call1 = findi_and_call1 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Key.t * Data.t * int | `Not_found of Key.t * int ]] + (findi_and_call1 + t + key + ~compare + ~a + ~if_found:(fun ~key ~data a -> `Found (key, data, a)) + ~if_not_found:(fun key a -> `Not_found (key, a))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a) + | Some data -> `Found (key, data, a))) + ;; + + let find_and_call2 = find_and_call2 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int * string + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a, b) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Data.t * int * string + | `Not_found of Key.t * int * string + ]] + (find_and_call2 + t + key + ~compare + ~a + ~b + ~if_found:(fun data a b -> `Found (data, a, b)) + ~if_not_found:(fun key a b -> `Not_found (key, a, b))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a, b) + | Some data -> `Found (data, a, b))) + ;; + + let findi_and_call2 = findi_and_call2 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int * string + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a, b) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Key.t * Data.t * int * string + | `Not_found of Key.t * int * string + ]] + (findi_and_call2 + t + key + ~compare + ~a + ~b + ~if_found:(fun ~key ~data a b -> `Found (key, data, a, b)) + ~if_not_found:(fun key a b -> `Not_found (key, a, b))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a, b) + | Some data -> `Found (key, data, a, b))) + ;; + + let iter = iter + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) list] + (let q = Queue.create () in + iter t ~f:(fun ~key ~data -> Queue.enqueue q (key, data)); + Queue.to_list q) + ~expect:(Map.to_alist map)) + ;; + + let mapi_inplace = mapi_inplace + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) list] + (mapi_inplace t ~f:(fun ~key:_ ~data -> data ^ data); + fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc)) + ~expect: + (Map.map map ~f:(fun data -> data ^ data) + |> Map.to_alist + |> List.rev)) + ;; + + let fold = fold + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) list] + (fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc)) + ~expect:(Map.to_alist map |> List.rev)) + ;; + + let choose_exn = choose_exn + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: bool] + (is_some (Option.try_with (fun () -> choose_exn t))) + ~expect:(not (Map.is_empty map))) + ;; + end : + module type of Avltree)) +;; diff --git a/unikernel/duniverse/base/test/avltree_unit_tests.mli b/unikernel/duniverse/base/test/avltree_unit_tests.mli new file mode 100644 index 00000000..8b9cdbbc --- /dev/null +++ b/unikernel/duniverse/base/test/avltree_unit_tests.mli @@ -0,0 +1 @@ +(* intentionally blank *) diff --git a/unikernel/duniverse/base/test/base_test.ml b/unikernel/duniverse/base/test/base_test.ml new file mode 100644 index 00000000..3e216ecf --- /dev/null +++ b/unikernel/duniverse/base/test/base_test.ml @@ -0,0 +1 @@ +(*_ This library deliberately does not export anything. *) diff --git a/unikernel/duniverse/base/test/dune b/unikernel/duniverse/base/test/dune new file mode 100644 index 00000000..afd1ada9 --- /dev/null +++ b/unikernel/duniverse/base/test/dune @@ -0,0 +1,7 @@ +(library + (name base_test) + (libraries base base_container_tests core.base_for_tests base_test_helpers + expect_test_helpers_core.expect_test_helpers_base sexplib + sexp_grammar_validation num stdio) + (preprocess + (pps ppx_jane -dont-apply=pipebang -no-check-on-extensions))) diff --git a/unikernel/duniverse/base/test/hashtbl_tests.ml b/unikernel/duniverse/base/test/hashtbl_tests.ml new file mode 100644 index 00000000..f8a39289 --- /dev/null +++ b/unikernel/duniverse/base/test/hashtbl_tests.ml @@ -0,0 +1,373 @@ +open! Base + +module type Hashtbl_for_testing = sig + include Hashtbl.Accessors with type 'key key = 'key + include Invariant.S2 with type ('key, 'data) t := ('key, 'data) t + + (* we don't define [module Poly : Hashtbl.S_poly] because we want to require only + the minimal number of constructors necessary to implement the tests, and also avoid + conflicting with any existing names. *) + + val create_poly : ?size:int -> unit -> ('key, 'data) t + val of_alist_poly_exn : ('key * 'data) list -> ('key, 'data) t + val of_alist_poly_or_error : ('key * 'data) list -> ('key, 'data) t Or_error.t +end + +module Make (Hashtbl : Hashtbl_for_testing) = struct + open Poly + + let test_data = [ "a", 1; "b", 2; "c", 3 ] + + let test_hash = + let h = Hashtbl.create_poly () ~size:10 in + List.iter test_data ~f:(fun (k, v) -> Hashtbl.set h ~key:k ~data:v); + h + ;; + + (* This is a very strong notion of equality on hash tables *) + let equal t t' equal_data = + let subtable t t' = + try + List.for_all (Hashtbl.keys t) ~f:(fun key -> + equal_data (Hashtbl.find_exn t key) (Hashtbl.find_exn t' key)) + with + | Invalid_argument _ -> false + in + subtable t t' && subtable t' t + ;; + + let%test "find" = + let found = Hashtbl.find test_hash "a" in + let not_found = Hashtbl.find test_hash "A" in + Hashtbl.invariant ignore ignore test_hash; + match found, not_found with + | Some _, None -> true + | _ -> false + ;; + + (* In js_of_ocaml, strings can be hashconst-ed. *) + let%test ("findi_and_call" [@tags "no-js"]) = + let our_hash = Hashtbl.copy test_hash in + let test_string = "test string" in + Hashtbl.add_exn our_hash ~key:test_string ~data:10; + let test_string' = "test " ^ "string" in + assert (not (phys_equal test_string test_string')); + Hashtbl.findi_and_call + our_hash + test_string' + ~if_found:(fun ~key ~data -> phys_equal test_string key && data = 10) + ~if_not_found:(fun _ -> false) + ;; + + let%test_unit "add" = + let our_hash = Hashtbl.copy test_hash in + let duplicate = Hashtbl.add our_hash ~key:"a" ~data:4 in + let no_duplicate = Hashtbl.add our_hash ~key:"d" ~data:5 in + assert (Hashtbl.find our_hash "a" = Some 1); + assert (Hashtbl.find our_hash "d" = Some 5); + Hashtbl.invariant ignore ignore our_hash; + assert ( + match duplicate, no_duplicate with + | `Duplicate, `Ok -> true + | _ -> false) + ;; + + let%test "iter" = + let predicted = + List.sort ~compare:Int.descending (List.map test_data ~f:(fun (_, v) -> v)) + in + let found = + let found = ref [] in + Hashtbl.iter test_hash ~f:(fun v -> found := v :: !found); + !found |> List.sort ~compare:Int.descending + in + List.equal Int.equal predicted found + ;; + + let%test "iter_keys" = + let predicted = + List.sort ~compare:String.descending (List.map test_data ~f:(fun (k, _) -> k)) + in + let found = + let found = ref [] in + Hashtbl.iter_keys test_hash ~f:(fun k -> found := k :: !found); + !found |> List.sort ~compare:String.descending + in + List.equal String.equal predicted found + ;; + + let%test_module "of_alist" = + (module struct + let%test "size" = + let predicted = List.length test_data in + let found = Hashtbl.length (Hashtbl.of_alist_poly_exn test_data) in + predicted = found + ;; + + let%test "right keys" = + let predicted = List.map test_data ~f:(fun (k, _) -> k) in + let found = Hashtbl.keys (Hashtbl.of_alist_poly_exn test_data) in + let sp = List.sort ~compare:Poly.ascending predicted in + let sf = List.sort ~compare:Poly.ascending found in + sp = sf + ;; + end) + ;; + + let%test_module "of_alist_or_error" = + (module struct + let%test "unique" = Result.is_ok (Hashtbl.of_alist_poly_or_error test_data) + + let%test "duplicate" = + Result.is_error (Hashtbl.of_alist_poly_or_error (test_data @ test_data)) + ;; + end) + ;; + + let%test "size and right keys" = + let predicted = List.map test_data ~f:(fun (k, _) -> k) in + let found = Hashtbl.keys test_hash in + let sp = List.sort ~compare:Poly.ascending predicted in + let sf = List.sort ~compare:Poly.ascending found in + sp = sf + ;; + + let%test "size and right data" = + let predicted = List.map test_data ~f:(fun (_, v) -> v) in + let found = Hashtbl.data test_hash in + let sp = List.sort ~compare:Poly.ascending predicted in + let sf = List.sort ~compare:Poly.ascending found in + sp = sf + ;; + + let%test "map" = + let add1 x = x + 1 in + let predicted_data = + List.sort ~compare:Poly.ascending (List.map test_data ~f:(fun (k, v) -> k, add1 v)) + in + let found_alist = + Hashtbl.map test_hash ~f:add1 + |> Hashtbl.to_alist + |> List.sort ~compare:Poly.ascending + in + List.equal Poly.equal predicted_data found_alist + ;; + + let%test_unit "filter_map" = + let f x = Some x in + let result = Hashtbl.filter_map test_hash ~f in + assert (equal test_hash result Int.( = )); + let is_even x = x % 2 = 0 in + let add1_to_even x = if is_even x then Some (x + 1) else None in + let predicted_data = + List.filter_map test_data ~f:(fun (k, v) -> + if is_even v then Some (k, v + 1) else None) + in + let found = Hashtbl.filter_map test_hash ~f:add1_to_even in + let found_alist = List.sort ~compare:Poly.ascending (Hashtbl.to_alist found) in + assert (List.equal Poly.equal predicted_data found_alist) + ;; + + let%test "filter_inplace" = + let f x = x <> 2 in + let predicted_data = + List.sort ~compare:Poly.ascending (List.filter test_data ~f:(fun (_, v) -> f v)) + in + let test_hash = Hashtbl.copy test_hash in + Hashtbl.filter_inplace test_hash ~f; + let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in + List.equal Poly.equal predicted_data found_alist + ;; + + let%test "filter_keys_inplace" = + let f x = x = "c" in + let predicted_data = + List.sort ~compare:Poly.ascending (List.filter test_data ~f:(fun (k, _) -> f k)) + in + let test_hash = Hashtbl.copy test_hash in + Hashtbl.filter_keys_inplace test_hash ~f; + let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in + List.equal Poly.equal predicted_data found_alist + ;; + + let%test "filter_map_inplace" = + let f x = if x = 1 then None else Some (x * 2) in + let predicted_data = + List.sort + ~compare:Poly.ascending + (List.filter_map test_data ~f:(fun (k, v) -> Option.map (f v) ~f:(fun x -> k, x))) + in + let test_hash = Hashtbl.copy test_hash in + Hashtbl.filter_map_inplace test_hash ~f; + let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in + List.equal Poly.equal predicted_data found_alist + ;; + + let%test "map_inplace" = + let f x = x + 3 in + let predicted_data = + List.sort ~compare:Poly.ascending (List.map test_data ~f:(fun (k, v) -> k, f v)) + in + let test_hash = Hashtbl.copy test_hash in + Hashtbl.map_inplace test_hash ~f; + let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in + List.equal Poly.equal predicted_data found_alist + ;; + + let%test_unit "insert-find-remove" = + let t = Hashtbl.create_poly () ~size:1 in + let inserted = ref [] in + Random.init 123; + let verify_inserted t = + let missing = + List.fold !inserted ~init:[] ~f:(fun acc (key, data) -> + match Hashtbl.find t key with + | None -> `Missing key :: acc + | Some d -> if data = d then acc else `Wrong_data (key, data) :: acc) + in + match missing with + | [] -> () + | _ -> + raise_s + [%message + "some inserts are missing" + (missing : [ `Missing of int | `Wrong_data of int * int ] list)] + in + let equal = Int.equal in + let rec loop i t = + if i < 2000 + then ( + let k = Random.int 10_000 in + inserted := List.Assoc.add (List.Assoc.remove !inserted ~equal k) ~equal k i; + Hashtbl.set t ~key:k ~data:i; + Hashtbl.invariant ignore ignore t; + verify_inserted t; + loop (i + 1) t) + in + loop 0 t; + List.iter !inserted ~f:(fun (x, _) -> + Hashtbl.remove t x; + Hashtbl.invariant ignore ignore t; + (match Hashtbl.find t x with + | None -> () + | Some _ -> failwith (Printf.sprintf "present after removal: %d" x)); + inserted := List.Assoc.remove !inserted ~equal x; + verify_inserted t) + ;; + + let%test_unit "clear" = + let t = Hashtbl.create_poly () ~size:1 in + let l = List.range 0 100 in + let verify_present l = List.for_all l ~f:(Hashtbl.mem t) in + let verify_not_present l = List.for_all l ~f:(fun i -> not (Hashtbl.mem t i)) in + List.iter l ~f:(fun i -> Hashtbl.set t ~key:i ~data:(i * i)); + List.iter l ~f:(fun i -> Hashtbl.set t ~key:i ~data:(i * i)); + assert (Hashtbl.length t = 100); + assert (verify_present l); + Hashtbl.clear t; + Hashtbl.invariant ignore ignore t; + assert (Hashtbl.length t = 0); + assert (verify_not_present l); + let l = List.take l 42 in + List.iter l ~f:(fun i -> Hashtbl.set t ~key:i ~data:(i * i)); + assert (Hashtbl.length t = 42); + assert (verify_present l); + Hashtbl.invariant ignore ignore t + ;; + + let%test_unit "mem" = + let t = Hashtbl.create_poly () ~size:1 in + Hashtbl.invariant ignore ignore t; + assert (not (Hashtbl.mem t "Fred")); + Hashtbl.invariant ignore ignore t; + Hashtbl.set t ~key:"Fred" ~data:"Wilma"; + Hashtbl.invariant ignore ignore t; + assert (Hashtbl.mem t "Fred"); + Hashtbl.invariant ignore ignore t; + Hashtbl.remove t "Fred"; + Hashtbl.invariant ignore ignore t; + assert (not (Hashtbl.mem t "Fred")); + Hashtbl.invariant ignore ignore t + ;; + + let%test_unit "exists" = + let t = Hashtbl.create_poly () in + assert (not (Hashtbl.exists t ~f:(fun _ -> failwith "can't be called"))); + assert (not (Hashtbl.existsi t ~f:(fun ~key:_ ~data:_ -> failwith "can't be called"))); + Hashtbl.set t ~key:7 ~data:3; + assert (not (Hashtbl.exists t ~f:(Int.equal 4))); + Hashtbl.set t ~key:8 ~data:4; + assert (Hashtbl.exists t ~f:(Int.equal 4)); + Hashtbl.set t ~key:9 ~data:5; + assert (Hashtbl.existsi t ~f:(fun ~key ~data -> key + data = 14)) + ;; + + let%test_unit "for_all" = + let t = Hashtbl.create_poly () in + assert (Hashtbl.for_all t ~f:(fun _ -> failwith "can't be called")); + assert (Hashtbl.for_alli t ~f:(fun ~key:_ ~data:_ -> failwith "can't be called")); + Hashtbl.set t ~key:7 ~data:3; + assert (Hashtbl.for_all t ~f:(fun x -> Int.equal x 3)); + Hashtbl.set t ~key:8 ~data:4; + assert (not (Hashtbl.for_all t ~f:(fun x -> Int.equal x 3))); + Hashtbl.set t ~key:9 ~data:5; + assert (Hashtbl.for_alli t ~f:(fun ~key ~data -> key - 4 = data)) + ;; + + let%test_unit "count" = + let t = Hashtbl.create_poly () in + assert (Hashtbl.count t ~f:(fun _ -> failwith "can't be called") = 0); + assert (Hashtbl.counti t ~f:(fun ~key:_ ~data:_ -> failwith "can't be called") = 0); + Hashtbl.set t ~key:7 ~data:3; + assert (Hashtbl.count t ~f:(fun x -> Int.equal x 3) = 1); + Hashtbl.set t ~key:8 ~data:4; + assert (Hashtbl.count t ~f:(fun x -> Int.equal x 3) = 1); + Hashtbl.set t ~key:9 ~data:5; + assert (Hashtbl.counti t ~f:(fun ~key ~data -> key - 4 = data) = 3) + ;; + + let%test_unit "merge" = + let make alist = Hashtbl.of_alist_poly_exn alist in + let t1 = make [ 1, 111; 2, 222; 3, 333 ] in + let t2 = make [ 1, 123; 2, 222; 4, 444 ] in + [%test_result: (int * [ `Left of int | `Right of int | `Both of int * int ]) List.t] + (Hashtbl.merge t1 t2 ~f:(fun ~key:_ -> function + | `Left x -> Some (`Left x) + | `Right y -> Some (`Right y) + | `Both (x, y) -> if x = y then None else Some (`Both (x, y))) + |> Hashtbl.to_alist + |> List.sort ~compare:(fun (x, _) (y, _) -> Int.compare x y)) + ~expect:[ 1, `Both (111, 123); 3, `Left 333; 4, `Right 444 ] + ;; +end + +(* typechecking this code is a compile-time test that [Creators] is a specialization of + [Creators_generic]. *) +module _ : sig end = struct + module Make_creators_check + (Type : T.T2) + (Key : T.T1) + (Options : T.T3) + (_ : Hashtbl.Private.Creators_generic + with type ('a, 'b) t := ('a, 'b) Type.t + with type 'a key := 'a Key.t + with type ('a, 'b, 'z) create_options := ('a, 'b, 'z) Options.t) = + struct end + + module _ (M : Hashtbl.Creators) = + Make_creators_check + (struct + type ('a, 'b) t = ('a, 'b) M.t + end) + (struct + type 'a t = 'a + end) + (struct + type ('a, 'b, 'z) t = ('a, 'b, 'z) Hashtbl.create_options + end) + (struct + include M + + let create ?growth_allowed ?size m () = create ?growth_allowed ?size m + end) +end diff --git a/unikernel/duniverse/base/test/hashtbl_tests.mli b/unikernel/duniverse/base/test/hashtbl_tests.mli new file mode 100644 index 00000000..d46745f0 --- /dev/null +++ b/unikernel/duniverse/base/test/hashtbl_tests.mli @@ -0,0 +1,12 @@ +open! Base + +module type Hashtbl_for_testing = sig + include Hashtbl.Accessors with type 'key key = 'key + include Invariant.S2 with type ('key, 'data) t := ('key, 'data) t + + val create_poly : ?size:int -> unit -> ('key, 'data) t + val of_alist_poly_exn : ('key * 'data) list -> ('key, 'data) t + val of_alist_poly_or_error : ('key * 'data) list -> ('key, 'data) t Or_error.t +end + +module Make (Hashtbl : Hashtbl_for_testing) : sig end diff --git a/unikernel/duniverse/base/test/helpers/dune b/unikernel/duniverse/base/test/helpers/dune new file mode 100644 index 00000000..ada37138 --- /dev/null +++ b/unikernel/duniverse/base/test/helpers/dune @@ -0,0 +1,5 @@ +(library + (name base_test_helpers) + (libraries base) + (preprocess + (pps ppx_jane))) diff --git a/unikernel/duniverse/base/test/helpers/test_container.ml b/unikernel/duniverse/base/test/helpers/test_container.ml new file mode 100644 index 00000000..10ef2e6a --- /dev/null +++ b/unikernel/duniverse/base/test/helpers/test_container.ml @@ -0,0 +1,210 @@ +open! Base +open! Container + +module Test_generic (Elt : sig + type 'a t + + val of_int : int -> int t + val to_int : int t -> int +end) (Container : sig + type 'a t [@@deriving sexp] + + include Generic with type ('a, _, _) t := 'a t with type 'a elt := 'a Elt.t + + val mem : 'a t -> 'a Elt.t -> equal:('a Elt.t -> 'a Elt.t -> bool) -> bool + val of_list : 'a Elt.t list -> [ `Ok of 'a t | `Skip_test ] +end) : sig + type 'a t [@@deriving sexp] + + include Generic with type ('a, _, _) t := 'a t + + val mem : 'a t -> 'a Elt.t -> equal:('a Elt.t -> 'a Elt.t -> bool) -> bool +end +with type 'a t := 'a Container.t +with type 'a elt := 'a Elt.t = +(* This signature constraint reminds us to add unit tests when functions are added to + [Generic]. *) +struct + open Container + + let find = find + let find_map = find_map + let fold = fold + let is_empty = is_empty + let iter = iter + let length = length + let mem = mem + let sexp_of_t = sexp_of_t + let t_of_sexp = t_of_sexp + let to_array = to_array + let to_list = to_list + let fold_result = fold_result + let fold_until = fold_until + + let%test_unit _ = + let ( = ) = Poly.equal in + let compare = Poly.compare in + List.iter [ 0; 1; 2; 3; 4; 8; 128 ] ~f:(fun n -> + let list = List.init n ~f:Elt.of_int in + match Container.of_list list with + | `Skip_test -> () + | `Ok c -> + let sort l = List.sort l ~compare in + let sorts_are_equal l1 l2 = sort l1 = sort l2 in + assert (n = Container.length c); + assert (n = 0 = Container.is_empty c); + assert (sorts_are_equal list (Container.fold c ~init:[] ~f:(fun ac e -> e :: ac))); + assert (sorts_are_equal list (Container.to_list c)); + assert (sorts_are_equal list (Array.to_list (Container.to_array c))); + assert (n > 0 = Option.is_some (Container.find c ~f:(fun e -> Elt.to_int e = 0))); + assert ( + n > 0 = Option.is_some (Container.find c ~f:(fun e -> Elt.to_int e = n - 1))); + assert (Option.is_none (Container.find c ~f:(fun e -> Elt.to_int e = n))); + assert (n > 0 = Container.mem c (Elt.of_int 0) ~equal:( = )); + if n > 0 then assert (Container.mem c (Elt.of_int (n - 1)) ~equal:( = )); + assert (not (Container.mem c (Elt.of_int n) ~equal:( = ))); + assert ( + n + > 0 + = Option.is_some + (Container.find_map c ~f:(fun e -> + if Elt.to_int e = 0 then Some () else None))); + assert ( + n + > 0 + = Option.is_some + (Container.find_map c ~f:(fun e -> + if Elt.to_int e = n - 1 then Some () else None))); + assert ( + Option.is_none + (Container.find_map c ~f:(fun e -> if Elt.to_int e = n then Some () else None))); + let r = ref 0 in + Container.iter c ~f:(fun e -> r := !r + Elt.to_int e); + assert (!r = List.fold list ~init:0 ~f:(fun n e -> n + Elt.to_int e)); + assert (!r = sum (module Int) c ~f:Elt.to_int); + let c2 = [%of_sexp: int Container.t] ([%sexp_of: int Container.t] c) in + assert (sorts_are_equal list (Container.to_list c2)); + let compare_elt a b = Int.compare (Elt.to_int a) (Elt.to_int b) in + if n = 0 + then ( + assert (!r = 0); + assert (min_elt ~compare:compare_elt c = None); + assert (max_elt ~compare:compare_elt c = None)) + else ( + assert (!r = n * (n - 1) / 2); + assert (Option.map ~f:Elt.to_int (min_elt ~compare:compare_elt c) = Some 0); + assert ( + Option.map ~f:Elt.to_int (max_elt ~compare:compare_elt c) = Some (Int.pred n))); + let mid = Container.length c / 2 in + (match + Container.fold_result c ~init:0 ~f:(fun count _elt -> + if count = mid then Error count else Ok (count + 1)) + with + | Ok 0 -> assert (Container.length c = 0) + | Ok _ -> failwith "Expected fold to stop early" + | Error x -> assert (mid = x))) + ;; + + let min_elt = min_elt + let max_elt = max_elt + let count = count + let sum = sum + let exists = exists + let for_all = for_all + + let%test_unit _ = + List.iter + [ [] + ; [ true ] + ; [ false ] + ; [ false; false ] + ; [ true; false ] + ; [ false; true ] + ; [ true; true ] + ] + ~f:(fun bools -> + let count_should_be = + List.fold bools ~init:0 ~f:(fun n b -> if b then n + 1 else n) + in + let forall_should_be = List.fold bools ~init:true ~f:(fun ac b -> b && ac) in + let exists_should_be = List.fold bools ~init:false ~f:(fun ac b -> b || ac) in + match + Container.of_list (List.map bools ~f:(fun b -> Elt.of_int (if b then 1 else 0))) + with + | `Skip_test -> () + | `Ok container -> + let is_one e = Elt.to_int e = 1 in + let ( = ) = Poly.equal in + assert (forall_should_be = Container.for_all container ~f:is_one); + assert (exists_should_be = Container.exists container ~f:is_one); + assert (count_should_be = Container.count container ~f:is_one)) + ;; +end + +module Test_S1_allow_skipping_tests (Container : sig + type 'a t [@@deriving sexp] + + include Container.S1 with type 'a t := 'a t + + val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ] +end) = +struct + include + Test_generic + (struct + type 'a t = 'a + + let of_int = Fn.id + let to_int = Fn.id + end) + (Container) +end + +module Test_S1 (Container : sig + type 'a t [@@deriving sexp] + + include Container.S1 with type 'a t := 'a t + + val of_list : 'a list -> 'a t +end) = +Test_S1_allow_skipping_tests (struct + include Container + + let of_list l = `Ok (of_list l) +end) + +module Test_S0 (Container : sig + module Elt : sig + type t [@@deriving sexp] + + val of_int : int -> t + val to_int : t -> int + end + + type t [@@deriving sexp] + + include Container.S0 with type t := t and type elt := Elt.t + + val of_list : Elt.t list -> t +end) = +struct + include + Test_generic + (struct + include Container.Elt + + type 'a t = Container.Elt.t + end) + (struct + include Container + + type 'a t = Container.t [@@deriving sexp] + + let of_list l = `Ok (of_list l) + let mem t x ~equal:_ = Container.mem t x + end) + + (* [mem] in the second functor argument above ignores its [~equal], so this [~equal] + should never be called. *) + let mem t x = mem t x ~equal:(fun _ _ -> assert false) +end diff --git a/unikernel/duniverse/base/test/helpers/test_container.mli b/unikernel/duniverse/base/test/helpers/test_container.mli new file mode 100644 index 00000000..736359a3 --- /dev/null +++ b/unikernel/duniverse/base/test/helpers/test_container.mli @@ -0,0 +1,57 @@ +open! Base +open! Container + +module Test_S1_allow_skipping_tests (Container : sig + type 'a t [@@deriving sexp] + + include Container.S1 with type 'a t := 'a t + + val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ] +end) : sig + type 'a t [@@deriving sexp] + + include Generic with type ('a, _, _) t := 'a t + + val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool +end +with type 'a t := 'a Container.t +with type 'a elt := 'a + +module Test_S1 (Container : sig + type 'a t [@@deriving sexp] + + include Container.S1 with type 'a t := 'a t + + val of_list : 'a list -> 'a t +end) : sig + type 'a t [@@deriving sexp] + + include Generic with type ('a, _, _) t := 'a t + + val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool +end +with type 'a t := 'a Container.t +with type 'a elt := 'a + +module Test_S0 (Container : sig + module Elt : sig + type t [@@deriving sexp] + + val of_int : int -> t + val to_int : t -> int + end + + type t [@@deriving sexp] + + include Container.S0 with type t := t and type elt := Elt.t + + val of_list : Elt.t list -> t +end) : sig + type 'a t [@@deriving sexp] + + include Generic with type ('a, _, _) t := 'a t + + val mem : 'a t -> 'a elt -> bool +end +with type 'a t := Container.t +with type 'a elt := Container.Elt.t diff --git a/unikernel/duniverse/base/test/helpers/test_stack.ml b/unikernel/duniverse/base/test/helpers/test_stack.ml new file mode 100644 index 00000000..e935e7bd --- /dev/null +++ b/unikernel/duniverse/base/test/helpers/test_stack.ml @@ -0,0 +1,296 @@ +open! Base +open! Stack + +module Debug (Stack : S) : S with type 'a t = 'a Stack.t = struct + open Stack + + type nonrec 'a t = 'a t + + let invariant = invariant + let t_sexp_grammar = t_sexp_grammar + + let check_and_return t = + invariant ignore t; + t + ;; + + let debug t f = + let result = Result.try_with f in + invariant ignore t; + Result.ok_exn result + ;; + + (* The return-type annotations are to prevent an error where we don't supply all the + arguments to the function, and thus wouldn't be checking the invariant after fully + applying the function. *) + let clear t : unit = debug t (fun () -> clear t) + let copy t : _ t = check_and_return (debug t (fun () -> copy t)) + let count t ~f : int = debug t (fun () -> count t ~f) [@nontail] + let sum m t ~f = debug t (fun () -> sum m t ~f) [@nontail] + let create () : _ t = check_and_return (create ()) + let exists t ~f : bool = debug t (fun () -> exists t ~f) [@nontail] + let find t ~f : _ option = debug t (fun () -> find t ~f) [@nontail] + let find_map t ~f : _ option = debug t (fun () -> find_map t ~f) [@nontail] + let fold (type a) t ~init ~f : a = debug t (fun () -> fold t ~init ~f) [@nontail] + let for_all t ~f : bool = debug t (fun () -> for_all t ~f) [@nontail] + let is_empty t : bool = debug t (fun () -> is_empty t) + let iter t ~f : unit = debug t (fun () -> iter t ~f) [@nontail] + let length t : int = debug t (fun () -> length t) + let mem t a ~equal : bool = debug t (fun () -> mem t a ~equal) [@nontail] + let of_list l : _ t = check_and_return (of_list l) + let pop t : _ option = debug t (fun () -> pop t) + let pop_exn (type a) t : a = debug t (fun () -> pop_exn t) + let push t a : unit = debug t (fun () -> push t a) + let sexp_of_t sexp_of_a t : Sexp.t = debug t (fun () -> [%sexp_of: a t] t) + let singleton x : _ t = check_and_return (singleton x) + let t_of_sexp a_of_sexp sexp : _ t = check_and_return ([%of_sexp: a t] sexp) + let to_array t : _ array = debug t (fun () -> to_array t) + let to_list t : _ list = debug t (fun () -> to_list t) + let top t : _ option = debug t (fun () -> top t) + let top_exn (type a) t : a = debug t (fun () -> top_exn t) + let until_empty t f : unit = debug t (fun () -> until_empty t f) [@nontail] + let min_elt t ~compare : _ option = debug t (fun () -> min_elt t ~compare) [@nontail] + let max_elt t ~compare : _ option = debug t (fun () -> max_elt t ~compare) [@nontail] + let fold_result t ~init ~f = debug t (fun () -> fold_result t ~init ~f) [@nontail] + + let fold_until t ~init ~f ~finish = + debug t (fun () -> fold_until t ~init ~f ~finish) [@nontail] + ;; + + let filter_map t ~f = debug t (fun () -> filter_map t ~f) [@nontail] + let filter t ~f = debug t (fun () -> filter t ~f) [@nontail] + let filter_inplace t ~f = debug t (fun () -> filter_inplace t ~f) [@nontail] +end + +module Test (Stack : S) : S with type 'a t = 'a Stack.t = +(* This signature is here to remind us to add a unit test whenever we add something to + the stack interface. *) +struct + open Stack + + type nonrec 'a t = 'a t + + include Test_container.Test_S1 (Stack) + + let t_sexp_grammar = t_sexp_grammar + let invariant = invariant + let create = create + let is_empty = is_empty + let top_exn = top_exn + let pop_exn = pop_exn + let pop = pop + let top = top + let singleton = singleton + + let%test_unit _ = + let empty = create () in + invariant ignore empty; + invariant (fun b -> assert b) (of_list [ true ]); + assert (is_empty empty); + let t = create () in + push t 0; + assert (not (is_empty t)); + assert (Exn.does_raise (fun () -> top_exn empty)); + let t = create () in + push t 0; + [%test_result: int] (top_exn t) ~expect:0; + assert (Exn.does_raise (fun () -> pop_exn empty)); + let t = create () in + push t 0; + [%test_result: int] (pop_exn t) ~expect:0; + assert (Option.is_none (pop empty)); + assert (Option.is_some (pop (of_list [ 0 ]))); + assert (Option.is_none (top empty)); + assert (Option.is_some (top (of_list [ 0 ]))); + assert (Option.is_some (top (singleton 0))); + assert (Option.is_some (pop (singleton 0))); + assert ( + let t = singleton 0 in + ignore (pop_exn t : int); + Option.is_none (top t)) + ;; + + let min_elt = min_elt + let max_elt = max_elt + + let%test_unit _ = + let empty = create () in + [%test_result: _ option] (min_elt ~compare:Int.compare empty) ~expect:None; + [%test_result: _ option] (max_elt ~compare:Int.compare empty) ~expect:None; + [%test_result: int] (sum (module Int) ~f:Fn.id empty) ~expect:0 + ;; + + let push = push + let copy = copy + let until_empty = until_empty + + let%test_unit _ = + let t = + let t = create () in + push t 0; + push t 1; + push t 2; + t + in + [%test_result: bool] (is_empty t) ~expect:false; + [%test_result: int] (length t) ~expect:3; + [%test_result: int option] (top t) ~expect:(Some 2); + [%test_result: int] (top_exn t) ~expect:2; + [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 0); + [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 2); + [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:3; + let t' = copy t in + [%test_result: int] (pop_exn t') ~expect:2; + [%test_result: int] (pop_exn t') ~expect:1; + [%test_result: int] (pop_exn t') ~expect:0; + [%test_result: int] (length t') ~expect:0; + [%test_result: bool] (is_empty t') ~expect:true; + let t' = copy t in + [%test_result: int option] (pop t') ~expect:(Some 2); + [%test_result: int option] (pop t') ~expect:(Some 1); + [%test_result: int option] (pop t') ~expect:(Some 0); + [%test_result: int] (length t') ~expect:0; + [%test_result: bool] (is_empty t') ~expect:true; + (* test that t was not modified by pops applied to copies *) + [%test_result: int] (length t) ~expect:3; + [%test_result: int] (top_exn t) ~expect:2; + [%test_result: int list] (to_list t) ~expect:[ 2; 1; 0 ]; + [%test_result: int array] (to_array t) ~expect:[| 2; 1; 0 |]; + [%test_result: int] (length t) ~expect:3; + [%test_result: int] (top_exn t) ~expect:2; + let t' = copy t in + let n = ref 0 in + until_empty t' (fun x -> n := !n + x); + [%test_result: int] !n ~expect:3; + [%test_result: bool] (is_empty t') ~expect:true; + [%test_result: int] (length t') ~expect:0 + ;; + + let%test_unit _ = + let t = create () in + [%test_result: bool] (is_empty t) ~expect:true; + [%test_result: int] (length t) ~expect:0; + [%test_result: _ list] (to_list t) ~expect:[]; + [%test_result: _ option] (pop t) ~expect:None; + push t 13; + [%test_result: bool] (is_empty t) ~expect:false; + [%test_result: int] (length t) ~expect:1; + [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 13); + [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 13); + [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:13; + [%test_result: int] (pop_exn t) ~expect:13; + [%test_result: bool] (is_empty t) ~expect:true; + [%test_result: int] (length t) ~expect:0; + push t 13; + push t 14; + [%test_result: bool] (is_empty t) ~expect:false; + [%test_result: int] (length t) ~expect:2; + [%test_result: int list] (to_list t) ~expect:[ 14; 13 ]; + [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 13); + [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 14); + [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:27; + [%test_result: bool] (Option.is_some (pop t)) ~expect:true; + [%test_result: bool] (Option.is_some (pop t)) ~expect:true + ;; + + let of_list = of_list + + let%test_unit _ = + for n = 0 to 5 do + let l = List.init n ~f:Fn.id in + [%test_result: int list] (to_list (of_list l)) ~expect:l + done + ;; + + let clear = clear + + let%test_unit _ = + for n = 0 to 5 do + let t = of_list (List.init n ~f:Fn.id) in + clear t; + assert (is_empty t); + push t 13; + [%test_result: int] (length t) ~expect:1 + done + ;; + + let%test_unit "float test" = + let s = create () in + push s 1.0; + push s 2.0; + push s 3.0 + ;; + + let filter_map = filter_map + + let%test_unit "filter_map" = + let s = create () in + push s 0; + push s 1; + push s 2; + push s 3; + [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ]; + let s = filter_map s ~f:(fun i -> if i % 2 <> 0 then Some (i * 2) else None) in + [%test_result: int list] (to_list s) ~expect:[ 6; 2 ]; + let s = filter_map s ~f:(fun i -> if i < 4 then Some (i * 2) else None) in + [%test_result: int list] (to_list s) ~expect:[ 4 ] + ;; + + let filter = filter + + let%test_unit "filter" = + let s = create () in + push s 0; + push s 1; + push s 2; + push s 3; + [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ]; + let s = filter s ~f:(fun i -> i % 2 <> 0) in + [%test_result: int list] (to_list s) ~expect:[ 3; 1 ]; + let s = filter s ~f:(fun i -> i < 2) in + [%test_result: int list] (to_list s) ~expect:[ 1 ] + ;; + + let filter_inplace = filter_inplace + + let%test_unit "filter_inplace" = + let s = create () in + push s 0; + push s 1; + push s 2; + push s 3; + [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ]; + filter_inplace s ~f:(fun i -> i % 2 <> 0); + [%test_result: int list] (to_list s) ~expect:[ 3; 1 ]; + filter_inplace s ~f:(fun i -> i < 2); + [%test_result: int list] (to_list s) ~expect:[ 1 ] + ;; + + let%test_unit "filter_inplace raises after removing" = + let s = create () in + push s 0; + push s 1; + push s 2; + push s 3; + [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ]; + assert ( + Exn.does_raise (fun () -> + filter_inplace s ~f:(fun i -> + if Int.(i = 2) then raise_s [%message "exn"] else false))); + [%test_result: int list] (to_list s) ~expect:[] + ;; + + let%test_unit "filter_inplace raises after keeping" = + let s = create () in + push s 0; + push s 1; + push s 2; + push s 3; + [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ]; + assert ( + Exn.does_raise (fun () -> + filter_inplace s ~f:(fun i -> + if Int.(i = 2) then raise_s [%message "exn"] else true))); + [%test_result: int list] (to_list s) ~expect:[ 1; 0 ] + ;; +end diff --git a/unikernel/duniverse/base/test/helpers/test_stack.mli b/unikernel/duniverse/base/test/helpers/test_stack.mli new file mode 100644 index 00000000..1051f3fc --- /dev/null +++ b/unikernel/duniverse/base/test/helpers/test_stack.mli @@ -0,0 +1,3 @@ +open! Base +module Debug (S : Stack.S) : Stack.S with type 'a t = 'a S.t +module Test (S : Stack.S) : sig end diff --git a/unikernel/duniverse/base/test/import.ml b/unikernel/duniverse/base/test/import.ml new file mode 100644 index 00000000..184abf93 --- /dev/null +++ b/unikernel/duniverse/base/test/import.ml @@ -0,0 +1,46 @@ +include Base +include Stdio +include Base_for_tests +include Base_test_helpers +include Base_quickcheck.Export +include Expect_test_helpers_base + +let () = Int_conversions.sexp_of_int_style := `Underscores +let is_none = Option.is_none +let is_some = Option.is_some +let ok_exn = Or_error.ok_exn +let stage = Staged.stage +let unstage = Staged.unstage + +module type Hash = sig + type t [@@deriving hash, sexp_of] +end + +let check_hash_coherence (type t) here (module T : Hash with type t = t) ts = + List.iter ts ~f:(fun t -> + let hash1 = T.hash t in + let hash2 = [%hash: T.t] t in + require + here + (hash1 = hash2) + ~cr:CR_soon + ~if_false_then_print_s: + (lazy [%message "" ~value:(t : T.t) (hash1 : int) (hash2 : int)])) +;; + +module type Int_hash = sig + include Hash + + val of_int_exn : int -> t + val min_value : t + val max_value : t +end + +let check_int_hash_coherence (type t) here (module I : Int_hash with type t = t) = + check_hash_coherence + here + (module I) + [ I.min_value; I.of_int_exn 0; I.of_int_exn 37; I.max_value ] +;; + +let test_conversion ~to_string f x = printf "%s --> %s\n" (to_string x) (to_string (f x)) diff --git a/unikernel/duniverse/base/test/map_full_interface/base_test_map_full_interface.ml b/unikernel/duniverse/base/test/map_full_interface/base_test_map_full_interface.ml new file mode 100644 index 00000000..9b28931c --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/base_test_map_full_interface.ml @@ -0,0 +1 @@ +(*_ This library deliberately exports nothing. *) diff --git a/unikernel/duniverse/base/test/map_full_interface/dune b/unikernel/duniverse/base/test/map_full_interface/dune new file mode 100644 index 00000000..0881dcef --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/dune @@ -0,0 +1,6 @@ +(library + (name base_test_map_full_interface) + (libraries base base_quickcheck + expect_test_helpers_core.expect_test_helpers_base sexp_grammar) + (preprocess + (pps ppx_jane))) diff --git a/unikernel/duniverse/base/test/map_full_interface/functor.ml b/unikernel/duniverse/base/test/map_full_interface/functor.ml new file mode 100644 index 00000000..16de64b1 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/functor.ml @@ -0,0 +1,1579 @@ +(** Comprehensive testing of [Base.Map]. + + This file tests all exports of [Base.Map]. Every time a new export is added, we have + to add a new definition somewhere here. Every time we add a definition, we should add + a test unless the definition is untestable (e.g., a module type) or trivial (e.g., a + module containing only ppx-derived definitions). We should document categories of + untested definitions, mark them as untested, and keep them separate from definitions + that need tests. *) + +open! Base +open Base_quickcheck +open Expect_test_helpers_base +include Functor_intf.Definitions + +open struct + (** quickcheck configuration *) + + let quickcheck_config = + let test_count = + (* In js_of_ocaml, quickcheck is slow due to 64-bit arithmetic, and some map + operations are especially slow due to use of exceptions and exception handlers. + So on "other" backends, we turn the test count down. *) + match Sys.backend_type with + | Native | Bytecode -> 10_000 + | Other _ -> 1_000 + in + { Base_quickcheck.Test.default_config with test_count } + ;; + + let quickcheck_m here m ~f = quickcheck_m here m ~f ~config:quickcheck_config +end + +module Instance (Cmp : sig + type comparator_witness + + val comparator : (int, comparator_witness) Comparator.t +end) = +struct + module Key = struct + type t = int [@@deriving quickcheck, sexp_of] + type comparator_witness = Cmp.comparator_witness + + let comparator = Cmp.comparator + let compare = comparator.compare + let equal = [%compare.equal: t] + let quickcheck_generator = Base_quickcheck.Generator.small_strictly_positive_int + + include Comparable.Infix (struct + type nonrec t = t + + let compare = compare + end) + end + + type 'a t = 'a Map.M(Key).t [@@deriving equal, sexp_of] + + let key x = x + let int x = x + let tree x = x + + let quickcheck_generator gen = + Base_quickcheck.Generator.map_t_m + (module Key) + Base_quickcheck.Generator.small_strictly_positive_int + gen + ;; + + let quickcheck_observer obs = + Base_quickcheck.Observer.map_t Base_quickcheck.Observer.int obs + ;; + + let quickcheck_shrinker shr = + Base_quickcheck.Shrinker.map_t Base_quickcheck.Shrinker.int shr + ;; +end + +(** A functor like [Instance], but for tree types. *) +module Instance_tree (Cmp : sig + type comparator_witness + + val comparator : (int, comparator_witness) Comparator.t +end) = +struct + module M = Instance (Cmp) + include M + + type 'a t = (int, 'a, Cmp.comparator_witness) Map.Using_comparator.Tree.t + + let of_tree tree = Map.Using_comparator.of_tree ~comparator:Cmp.comparator tree + let to_tree t = Map.Using_comparator.to_tree t + + let quickcheck_generator gen = + Base_quickcheck.Generator.map (M.quickcheck_generator gen) ~f:to_tree + ;; + + let quickcheck_observer obs = + Base_quickcheck.Observer.unmap (M.quickcheck_observer obs) ~f:of_tree + ;; + + let quickcheck_shrinker shr = + Base_quickcheck.Shrinker.map (M.quickcheck_shrinker shr) ~f:to_tree ~f_inverse:of_tree + ;; + + let equal equal_a = Map.Using_comparator.Tree.equal ~comparator:Cmp.comparator equal_a + let sexp_of_t sexp_of_a t = M.sexp_of_t sexp_of_a (of_tree t) +end + +(** Functor for [List.t] *) +module Lst (T : sig + type t [@@deriving equal, sexp_of] +end) = +struct + type t = T.t list [@@deriving equal, sexp_of] +end + +(** Functor for [Or_error], ignoring error contents when comparing. *) +module Ok (T : sig + type t [@@deriving equal, sexp_of] +end) = +struct + type t = (T.t, (Error.t[@equal.ignore])) Result.t [@@deriving equal, sexp_of] +end + +(** Functor for [Option.t] *) +module Opt (T : sig + type t [@@deriving equal, sexp_of] +end) = +struct + type t = T.t option [@@deriving equal, sexp_of] +end + +(** Functor for pairs of a single type. Random generation frequently generates pairs of + identical values. *) +module Pair (T : sig + type t [@@deriving equal, quickcheck, sexp_of] +end) = +struct + type t = T.t * T.t [@@deriving equal, quickcheck, sexp_of] + + let quickcheck_generator = + let open Base_quickcheck.Generator.Let_syntax in + match%bind Base_quickcheck.Generator.bool with + | true -> [%generator: t] + | false -> + let%map x = [%generator: T.t] in + x, x + ;; +end + +(* Used in [test__*.ml]. *) +module Test_creators_and_accessors + (Types : Types) + (Impl : S with module Types := Types) + (Instance : Instance with module Types := Types) : S with module Types := Types = struct + open Instance + open Impl + + open struct + (** Test helpers, not to be exported. *) + + module Alist = struct + type t = (Key.t * int) list [@@deriving compare, equal, quickcheck, sexp_of] + end + + module Alist_merge = struct + type t = (Key.t * (int, int) Map.Merge_element.t) list [@@deriving equal, sexp_of] + end + + module Alist_multi = struct + type t = (Key.t * int list) list [@@deriving equal, quickcheck, sexp_of] + end + + module Diff = struct + type t = (Key.t, int) Map.Symmetric_diff_element.t list [@@deriving equal, sexp_of] + end + + module Inst = struct + type t = int Instance.t [@@deriving equal, quickcheck, sexp_of] + end + + module Inst_and_key = struct + type t = Inst.t * Key.t [@@deriving quickcheck, sexp_of] + end + + module Inst_and_key_and_data = struct + type t = Inst.t * Key.t * int [@@deriving quickcheck, sexp_of] + end + + module Inst_inst = struct + type t = Inst.t Instance.t [@@deriving equal, quickcheck, sexp_of] + end + + module Inst_pair = struct + type t = (int * int) Instance.t [@@deriving equal, quickcheck, sexp_of] + end + + module Inst_multi = struct + type t = int list Instance.t [@@deriving equal, quickcheck, sexp_of] + end + + module Key_and_data = struct + type t = Key.t * int [@@deriving equal, sexp_of] + end + + module Key_and_data_inst = struct + type t = (Key.t * int) Instance.t [@@deriving equal, sexp_of] + end + + module Key_and_data_inst_multi = struct + type t = (Key.t * int) list Instance.t [@@deriving equal, sexp_of] + end + + module Maybe_bound = struct + include Maybe_bound + + type 'a t = 'a Maybe_bound.t = + | Incl of 'a + | Excl of 'a + | Unbounded + [@@deriving quickcheck, sexp_of] + end + + let ok_or_duplicate_key = function + | `Ok x -> Ok x + | `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)] + ;; + end + + (** creators *) + + let empty = empty + let () = require_equal [%here] (module Sexp) [%sexp (create empty : int t)] [%sexp []] + let singleton = singleton + + let () = + require_equal + [%here] + (module Sexp) + [%sexp (create singleton (key 1) 2 : int t)] + [%sexp [ [ 1; 2 ] ]] + ;; + + let of_alist = of_alist + let of_alist_or_error = of_alist_or_error + let of_alist_exn = of_alist_exn + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let t_or_error = create of_alist_or_error alist in + let t_exn = Or_error.try_with (fun () -> create of_alist_exn alist) in + let t_or_duplicate = + match create of_alist alist with + | `Ok t -> Ok t + | `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)] + in + require_equal + [%here] + (module Ok (Alist)) + (Or_error.map t_or_error ~f:to_alist) + (let compare a b = Comparable.lift Key.compare ~f:fst a b in + if List.contains_dup alist ~compare + then Or_error.error_string "duplicate" + else Ok (List.sort alist ~compare)); + require_equal [%here] (module Ok (Inst)) t_exn t_or_error; + require_equal [%here] (module Ok (Inst)) t_or_duplicate t_or_error) + ;; + + let of_alist_multi = of_alist_multi + let of_alist_fold = of_alist_fold + let of_alist_reduce = of_alist_reduce + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let t_multi = create of_alist_multi alist in + let t_fold = + create of_alist_fold alist ~init:[] ~f:(fun xs x -> x :: xs) |> map ~f:List.rev + in + let t_reduce = + create of_alist_reduce (List.Assoc.map alist ~f:List.return) ~f:(fun x y -> + x @ y) + in + require_equal + [%here] + (module Alist_multi) + (to_alist t_multi) + (List.Assoc.sort_and_group alist ~compare:Key.compare); + require_equal [%here] (module Inst_multi) t_fold t_multi; + require_equal [%here] (module Inst_multi) t_reduce t_multi) + ;; + + let of_sequence = of_sequence + let of_sequence_or_error = of_sequence_or_error + let of_sequence_exn = of_sequence_exn + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let seq = Sequence.of_list alist in + let t_or_error = create of_sequence_or_error seq in + let t_exn = Or_error.try_with (fun () -> create of_sequence_exn seq) in + let t_or_duplicate = + match create of_sequence seq with + | `Ok t -> Ok t + | `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)] + in + let expect = create of_alist_or_error alist in + require_equal [%here] (module Ok (Inst)) t_or_error expect; + require_equal [%here] (module Ok (Inst)) t_exn expect; + require_equal [%here] (module Ok (Inst)) t_or_duplicate expect) + ;; + + let of_sequence_multi = of_sequence_multi + let of_sequence_fold = of_sequence_fold + let of_sequence_reduce = of_sequence_reduce + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let seq = Sequence.of_list alist in + let t_multi = create of_sequence_multi seq in + let t_fold = + create of_sequence_fold seq ~init:[] ~f:(fun xs x -> x :: xs) |> map ~f:List.rev + in + let t_reduce = + create + of_sequence_reduce + (alist |> List.Assoc.map ~f:List.return |> Sequence.of_list) + ~f:(fun x y -> x @ y) + in + let expect = create of_alist_multi alist in + require_equal [%here] (module Inst_multi) t_multi expect; + require_equal [%here] (module Inst_multi) t_fold expect; + require_equal [%here] (module Inst_multi) t_reduce expect) + ;; + + let of_list_with_key = of_list_with_key + let of_list_with_key_or_error = of_list_with_key_or_error + let of_list_with_key_exn = of_list_with_key_exn + let of_list_with_key_multi = of_list_with_key_multi + let of_list_with_key_fold = of_list_with_key_fold + let of_list_with_key_reduce = of_list_with_key_reduce + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun list -> + let alist = List.map list ~f:(fun (key, data) -> key, (key, data)) in + require_equal + [%here] + (module Ok (Key_and_data_inst)) + (create of_list_with_key list ~get_key:fst |> ok_or_duplicate_key) + (create of_alist alist |> ok_or_duplicate_key); + require_equal + [%here] + (module Ok (Key_and_data_inst)) + (create of_list_with_key_or_error list ~get_key:fst) + (create of_alist_or_error alist); + require_equal + [%here] + (module Ok (Key_and_data_inst)) + (Or_error.try_with (fun () -> create of_list_with_key_exn list ~get_key:fst)) + (Or_error.try_with (fun () -> create of_alist_exn alist)); + require_equal + [%here] + (module Key_and_data_inst_multi) + (create of_list_with_key_multi list ~get_key:fst) + (create of_alist_multi alist); + require_equal + [%here] + (module Key_and_data_inst_multi) + (create of_list_with_key_fold list ~get_key:fst ~init:[] ~f:(fun acc x -> + x :: acc) + |> map ~f:List.rev) + (create of_alist_multi alist); + require_equal + [%here] + (module Key_and_data_inst_multi) + (create + of_list_with_key_reduce + (List.map list ~f:List.return) + ~get_key:(fun x -> x |> List.hd_exn |> fst) + ~f:(fun x y -> x @ y)) + (create of_alist_multi alist)) + ;; + + let of_increasing_sequence = of_increasing_sequence + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let seq = Sequence.of_list alist in + let actual = create of_increasing_sequence seq in + let expect = + if List.is_sorted alist ~compare:(fun a b -> + Comparable.lift Key.compare ~f:fst a b) + then create of_alist_or_error alist + else Or_error.error_string "decreasing keys" + in + require_equal [%here] (module Ok (Inst)) actual expect) + ;; + + let of_sorted_array = of_sorted_array + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let actual = create of_sorted_array (Array.of_list alist) in + let expect = + let compare a b = Comparable.lift Key.compare ~f:fst a b in + if List.is_sorted_strictly ~compare alist + || List.is_sorted_strictly ~compare (List.rev alist) + then create of_alist_or_error alist + else Or_error.error_string "unsorted" + in + require_equal [%here] (module Ok (Inst)) actual expect) + ;; + + let of_sorted_array_unchecked = of_sorted_array_unchecked + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let alist = + List.dedup_and_sort alist ~compare:(fun a b -> + Comparable.lift Key.compare ~f:fst a b) + in + let actual_fwd = create of_sorted_array_unchecked (Array.of_list alist) in + let actual_rev = create of_sorted_array_unchecked (Array.of_list_rev alist) in + let expect = create of_alist_exn alist in + require_equal [%here] (module Inst) actual_fwd expect; + require_equal [%here] (module Inst) actual_rev expect) + ;; + + let of_increasing_iterator_unchecked = of_increasing_iterator_unchecked + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let alist = + List.dedup_and_sort alist ~compare:(fun a b -> + Comparable.lift Key.compare ~f:fst a b) + in + let actual = + let array = Array.of_list alist in + create + of_increasing_iterator_unchecked + ~len:(Array.length array) + ~f:(Array.get array) + in + let expect = create of_alist_exn alist in + require_equal [%here] (module Inst) actual expect) + ;; + + let of_iteri = of_iteri + let of_iteri_exn = of_iteri_exn + + let () = + quickcheck_m + [%here] + (module Alist) + ~f:(fun alist -> + let iteri ~f = List.iter alist ~f:(fun (key, data) -> f ~key ~data) [@nontail] in + let actual_or_duplicate = + match create of_iteri ~iteri with + | `Ok t -> Ok t + | `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)] + in + let actual_exn = Or_error.try_with (fun () -> create of_iteri_exn ~iteri) in + let expect = create of_alist_or_error alist in + require_equal [%here] (module Ok (Inst)) actual_or_duplicate expect; + require_equal [%here] (module Ok (Inst)) actual_exn expect) + ;; + + let map_keys = map_keys + let map_keys_exn = map_keys_exn + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + let f key = Comparable.min Key.compare k key in + let actual_or_duplicate = + match create map_keys t ~f with + | `Ok t -> Ok t + | `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)] + in + let actual_exn = Or_error.try_with (fun () -> create map_keys_exn t ~f) in + let expect = + to_alist t + |> List.map ~f:(fun (key, data) -> f key, data) + |> create of_alist_or_error + in + require_equal [%here] (module Ok (Inst)) actual_or_duplicate expect; + require_equal [%here] (module Ok (Inst)) actual_exn expect) + ;; + + let transpose_keys = transpose_keys + + let () = + quickcheck_m + [%here] + (module Inst_inst) + ~f:(fun t -> + let transpose_keys = create (access transpose_keys) in + let transposed = transpose_keys t in + require [%here] (access invariants transposed); + let round_trip = transpose_keys transposed in + require_equal + [%here] + (module Inst_inst) + (filter t ~f:(Fn.non is_empty)) + round_trip) + ;; + + (** accessors *) + + let invariants = invariants + + let () = + quickcheck_m [%here] (module Inst) ~f:(fun t -> require [%here] (access invariants t)) + ;; + + let is_empty = is_empty + let length = length + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + let len = length t in + require_equal [%here] (module Bool) (is_empty t) (len = 0); + require_equal [%here] (module Int) len (List.length (to_alist t))) + ;; + + let mem = mem + let find = find + let find_exn = find_exn + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, key) -> + let expect = List.Assoc.find (to_alist t) key ~equal:Key.equal in + require_equal [%here] (module Bool) (access mem t key) (Option.is_some expect); + require_equal [%here] (module Opt (Int)) (access find t key) expect; + require_equal + [%here] + (module Opt (Int)) + (Option.try_with (fun () -> access find_exn t key)) + expect) + ;; + + let set = set + + let () = + quickcheck_m + [%here] + (module Inst_and_key_and_data) + ~f:(fun (t, key, data) -> + require_equal + [%here] + (module Alist) + (to_alist (access set t ~key ~data)) + (List.sort + ~compare:(fun a b -> Comparable.lift Key.compare ~f:fst a b) + ((key, data) :: List.Assoc.remove (to_alist t) key ~equal:Key.equal))) + ;; + + let add = add + let add_exn = add_exn + + let () = + quickcheck_m + [%here] + (module Inst_and_key_and_data) + ~f:(fun (t, key, data) -> + let t_add = + match access add t ~key ~data with + | `Ok t -> Ok t + | `Duplicate -> Or_error.error_string "duplicate" + in + let t_add_exn = Or_error.try_with (fun () -> access add_exn t ~key ~data) in + let expect = + if access mem t key + then Or_error.error_string "duplicate" + else Ok (access set t ~key ~data) + in + require_equal [%here] (module Ok (Inst)) t_add expect; + require_equal [%here] (module Ok (Inst)) t_add_exn expect) + ;; + + let remove = remove + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, key) -> + require_equal + [%here] + (module Alist) + (to_alist (access remove t key)) + (List.Assoc.remove (to_alist t) key ~equal:Key.equal)) + ;; + + let change = change + + let () = + quickcheck_m + [%here] + (module struct + type t = Inst.t * Key.t * int option [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t, key, maybe_data) -> + let actual = + access change t key ~f:(fun previous -> + require_equal [%here] (module Opt (Int)) previous (access find t key); + maybe_data) + in + let expect = + match maybe_data with + | None -> access remove t key + | Some data -> access set t ~key ~data + in + require_equal [%here] (module Inst) actual expect) + ;; + + let update = update + + let () = + quickcheck_m + [%here] + (module Inst_and_key_and_data) + ~f:(fun (t, key, data) -> + let actual = + access update t key ~f:(fun previous -> + require_equal [%here] (module Opt (Int)) previous (access find t key); + data) + in + let expect = access set t ~key ~data in + require_equal [%here] (module Inst) actual expect) + ;; + + let find_multi = find_multi + let add_multi = add_multi + let remove_multi = remove_multi + + let () = + quickcheck_m + [%here] + (module struct + type t = Inst_multi.t * Key.t * int [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t, key, data) -> + require_equal + [%here] + (module Lst (Int)) + (access find_multi t key) + (access find t key |> Option.value ~default:[]); + require_equal + [%here] + (module Inst_multi) + (access add_multi t ~key ~data) + (access update t key ~f:(fun option -> data :: Option.value option ~default:[])); + require_equal + [%here] + (module Inst_multi) + (access remove_multi t key) + (access change t key ~f:(function + | None | Some ([] | [ _ ]) -> None + | Some (_ :: (_ :: _ as rest)) -> Some rest))) + ;; + + let iter_keys = iter_keys + let iter = iter + let iteri = iteri + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + let actuali = + let q = Queue.create () in + iteri t ~f:(fun ~key ~data -> Queue.enqueue q (key, data)); + Queue.to_list q + in + let actual_keys = + let q = Queue.create () in + iter_keys t ~f:(Queue.enqueue q); + Queue.to_list q + in + let actual = + let q = Queue.create () in + iter t ~f:(Queue.enqueue q); + Queue.to_list q + in + require_equal [%here] (module Alist) actuali (to_alist t); + require_equal [%here] (module Lst (Key)) actual_keys (keys t); + require_equal [%here] (module Lst (Int)) actual (data t)) + ;; + + let map = map + let mapi = mapi + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + require_equal + [%here] + (module Inst) + (map t ~f:Int.succ) + (t |> to_alist |> List.Assoc.map ~f:Int.succ |> create of_alist_exn); + require_equal + [%here] + (module struct + type t = (Key.t * int) Instance.t [@@deriving equal, sexp_of] + end) + (mapi t ~f:(fun ~key ~data -> key, data)) + (t |> to_alist |> List.map ~f:(fun (k, v) -> k, (k, v)) |> create of_alist_exn)) + ;; + + let filter_keys = filter_keys + let filter = filter + let filteri = filteri + + module Physical_equality (T : sig + type t [@@deriving sexp_of] + end) = + struct + type t = T.t [@@deriving sexp_of] + + let equal a b = phys_equal a b + end + + let () = + quickcheck_m + [%here] + (module Inst_and_key_and_data) + ~f:(fun (t, k, d) -> + require_equal + [%here] + (module Physical_equality (Inst)) + (filter ~f:(fun _ -> true) t) + t; + require_equal + [%here] + (module Alist) + (to_alist (filter_keys t ~f:(fun key -> Key.( <= ) key k))) + (List.filter (to_alist t) ~f:(fun (key, _) -> Key.( <= ) key k)); + require_equal + [%here] + (module Alist) + (to_alist (filter t ~f:(fun data -> data <= d))) + (List.filter (to_alist t) ~f:(fun (_, data) -> data <= d)); + require_equal + [%here] + (module Alist) + (to_alist (filteri t ~f:(fun ~key ~data -> Key.( <= ) key k && data <= d))) + (List.filter (to_alist t) ~f:(fun (key, data) -> Key.( <= ) key k && data <= d))) + ;; + + let filter_map = filter_map + let filter_mapi = filter_mapi + + let () = + quickcheck_m + [%here] + (module Inst_and_key_and_data) + ~f:(fun (t, k, d) -> + require_equal + [%here] + (module Alist) + (to_alist (filter_map t ~f:(fun data -> Option.some_if (data >= d) (data - d)))) + (List.filter_map (to_alist t) ~f:(fun (key, data) -> + Option.some_if (data >= d) (key, data - d))); + require_equal + [%here] + (module Alist) + (to_alist + (filter_mapi t ~f:(fun ~key ~data -> + Option.some_if (Key.( <= ) key k && data >= d) (data - d)))) + (List.filter_map (to_alist t) ~f:(fun (key, data) -> + Option.some_if (Key.( <= ) key k && data >= d) (key, data - d)))) + ;; + + let partition_mapi = partition_mapi + let partition_map = partition_map + let partitioni_tf = partitioni_tf + let partition_tf = partition_tf + + let () = + quickcheck_m + [%here] + (module Inst_and_key_and_data) + ~f:(fun (t, k, d) -> + require_equal + [%here] + (module Physical_equality (Inst)) + (fst (partition_tf ~f:(fun _ -> true) t)) + t; + require_equal + [%here] + (module Pair (Alist)) + (let a, b = partition_tf t ~f:(fun data -> data <= d) in + to_alist a, to_alist b) + (List.partition_tf (to_alist t) ~f:(fun (_, data) -> data <= d)); + require_equal + [%here] + (module Pair (Alist)) + (let a, b = + partitioni_tf t ~f:(fun ~key ~data -> Key.( <= ) key k && data <= d) + in + to_alist a, to_alist b) + (List.partition_tf (to_alist t) ~f:(fun (key, data) -> + Key.( <= ) key k && data <= d)); + require_equal + [%here] + (module Pair (Alist)) + (let a, b = + partition_map t ~f:(fun data -> + if data >= d then First (data - d) else Second d) + in + to_alist a, to_alist b) + (List.partition_map (to_alist t) ~f:(fun (key, data) -> + if data >= d then First (key, data - d) else Second (key, d))); + require_equal + [%here] + (module Pair (Alist)) + (let a, b = + partition_mapi t ~f:(fun ~key ~data -> + if Key.( <= ) key k && data >= d then First (data - d) else Second d) + in + to_alist a, to_alist b) + (List.partition_map (to_alist t) ~f:(fun (key, data) -> + if Key.( <= ) key k && data >= d + then First (key, data - d) + else Second (key, d)))) + ;; + + let fold = fold + let fold_right = fold_right + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + require_equal + [%here] + (module Alist) + (fold t ~init:[] ~f:(fun ~key ~data list -> (key, data) :: list)) + (List.rev (to_alist t)); + require_equal + [%here] + (module Alist) + (fold_right t ~init:[] ~f:(fun ~key ~data list -> (key, data) :: list)) + (to_alist t)) + ;; + + let fold_until = fold_until + let iteri_until = iteri_until + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, threshold) -> + require_equal + [%here] + (module struct + type t = int list * Base.Map.Finished_or_unfinished.t + [@@deriving equal, sexp_of] + end) + (let q = Queue.create () in + let status = + iteri_until t ~f:(fun ~key ~data -> + if Key.( >= ) key threshold + then Stop + else ( + Queue.enqueue q data; + Continue)) + in + Queue.to_list q, status) + (let list = + to_alist t + |> List.take_while ~f:(fun (key, _) -> Key.( < ) key threshold) + |> List.map ~f:snd + in + list, if List.length list = length t then Finished else Unfinished)) + ;; + + let combine_errors = combine_errors + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, threshold) -> + let t = + mapi t ~f:(fun ~key ~data -> + if Key.( <= ) key threshold then Ok data else Or_error.error_string "too big") + in + require_equal + [%here] + (module Ok (Inst)) + (access combine_errors t) + (to_alist t + |> List.map ~f:(fun (key, result) -> + Or_error.map result ~f:(fun data -> key, data)) + |> Or_error.combine_errors + |> Or_error.map ~f:(create of_alist_exn))) + ;; + + let unzip = unzip + + let () = + quickcheck_m + [%here] + (module Inst_pair) + ~f:(fun t -> + require_equal + [%here] + (module Pair (Alist)) + (let a, b = unzip t in + to_alist a, to_alist b) + (to_alist t + |> List.map ~f:(fun (key, (a, b)) -> (key, a), (key, b)) + |> List.unzip)) + ;; + + let equal = equal + let compare_direct = compare_direct + + let () = + quickcheck_m + [%here] + (module Pair (Inst)) + ~f:(fun (a, b) -> + require_equal + [%here] + (module Ordering) + (Ordering.of_int (access compare_direct Int.compare a b)) + (Ordering.of_int (Alist.compare (to_alist a) (to_alist b))); + require_equal + [%here] + (module Bool) + (access compare_direct Int.compare a b = 0) + (access equal Int.equal a b)) + ;; + + let keys = keys + let data = data + let to_alist = to_alist + let to_sequence = to_sequence + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + let alist = to_alist t in + require_equal [%here] (module Inst) (create of_alist_exn alist) t; + require_equal [%here] (module Lst (Key)) (keys t) (List.map alist ~f:fst); + require_equal [%here] (module Lst (Int)) (data t) (List.map alist ~f:snd); + require_equal + [%here] + (module Alist) + (Sequence.to_list ((access to_sequence) t)) + alist) + ;; + + let () = + quickcheck_m + [%here] + (module struct + type t = Inst.t * [ `Decreasing | `Increasing ] [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t, key_order) -> + let alist = to_alist t ~key_order in + require_equal + [%here] + (module Lst (Key_and_data)) + alist + (match key_order with + | `Increasing -> to_alist t + | `Decreasing -> List.rev (to_alist t)); + require_equal + [%here] + (module Lst (Key_and_data)) + alist + (Sequence.to_list + ((access to_sequence) + t + ~order: + (match key_order with + | `Decreasing -> `Decreasing_key + | `Increasing -> `Increasing_key)))) + ;; + + let () = + quickcheck_m + [%here] + (module struct + type t = Inst.t * [ `Decreasing_key | `Increasing_key ] * Key.t * Key.t + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t, order, keys_greater_or_equal_to, keys_less_or_equal_to) -> + let alist = + Sequence.to_list + ((access to_sequence) + t + ~order + ~keys_greater_or_equal_to + ~keys_less_or_equal_to) + in + require_equal + [%here] + (module Lst (Key_and_data)) + alist + (List.filter + (match order with + | `Decreasing_key -> List.rev (to_alist t) + | `Increasing_key -> to_alist t) + ~f:(fun (key, _) -> + Key.( <= ) keys_greater_or_equal_to key + && Key.( <= ) key keys_less_or_equal_to))) + ;; + + let merge = merge + let iter2 = iter2 + let fold2 = fold2 + + let () = + quickcheck_m + [%here] + (module struct + module Inst2 = Pair (Inst) + + type t = Inst2.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun ((a, b), k) -> + let merge_alist = + access merge a b ~f:(fun ~key elt -> + Option.some_if (Key.( > ) key k) (key, elt)) + |> data + in + let iter2_alist = + let q = Queue.create () in + access iter2 a b ~f:(fun ~key ~data:elt -> + if Key.( > ) key k then Queue.enqueue q (key, elt)); + Queue.to_list q + in + let fold2_alist = + access fold2 a b ~init:[] ~f:(fun ~key ~data:elt acc -> + if Key.( > ) key k then (key, elt) :: acc else acc) + |> List.rev + in + let expect = + [ map a ~f:Either.first; map b ~f:Either.second ] + |> List.concat_map ~f:to_alist + |> List.Assoc.sort_and_group ~compare:Key.compare + |> List.filter_map ~f:(fun (key, list) -> + let elt = + match (list : _ Either.t list) with + | [ First x ] -> `Left x + | [ Second y ] -> `Right y + | [ First x; Second y ] -> `Both (x, y) + | _ -> assert false + in + Option.some_if (Key.( > ) key k) (key, elt)) + in + require_equal [%here] (module Alist_merge) merge_alist expect; + require_equal [%here] (module Alist_merge) iter2_alist expect; + require_equal [%here] (module Alist_merge) fold2_alist expect) + ;; + + let merge_disjoint_exn = merge_disjoint_exn + + let () = + quickcheck_m + [%here] + (module Pair (Inst)) + ~f:(fun (a, b) -> + let actual = Option.try_with (fun () -> access merge_disjoint_exn a b) in + let expect = + if existsi a ~f:(fun ~key ~data:_ -> access mem b key) + then None + else + Some + (access merge a b ~f:(fun ~key:_ elt -> + match elt with + | `Left x | `Right x -> Some x + | `Both _ -> assert false)) + in + require_equal [%here] (module Opt (Inst)) actual expect) + ;; + + let merge_skewed = merge_skewed + + let () = + quickcheck_m + [%here] + (module Pair (Inst)) + ~f:(fun (a, b) -> + let actual = access merge_skewed a b ~combine:(fun ~key a b -> int key + a + b) in + let expect = + access merge a b ~f:(fun ~key elt -> + match elt with + | `Left a -> Some a + | `Right b -> Some b + | `Both (a, b) -> Some (int key + a + b)) + in + require_equal [%here] (module Inst) actual expect) + ;; + + let symmetric_diff = symmetric_diff + let fold_symmetric_diff = fold_symmetric_diff + + let () = + quickcheck_m + [%here] + (module Pair (Inst)) + ~f:(fun (a, b) -> + let diff_alist = + access symmetric_diff a b ~data_equal:Int.equal |> Sequence.to_list + in + let fold_alist = + access + fold_symmetric_diff + a + b + ~data_equal:(fun x y -> Int.equal x y) + ~init:[] + ~f:(fun acc pair -> pair :: acc) + |> List.rev + in + let expect = + access merge a b ~f:(fun ~key:_ elt -> + match elt with + | `Left x -> Some (`Left x) + | `Right y -> Some (`Right y) + | `Both (x, y) -> if x = y then None else Some (`Unequal (x, y))) + |> to_alist + in + require_equal [%here] (module Diff) diff_alist expect; + require_equal [%here] (module Diff) fold_alist expect) + ;; + + let min_elt = min_elt + let max_elt = max_elt + let min_elt_exn = min_elt_exn + let max_elt_exn = max_elt_exn + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + require_equal + [%here] + (module Opt (Key_and_data)) + (min_elt t) + (List.hd (to_alist t)); + require_equal + [%here] + (module Opt (Key_and_data)) + (max_elt t) + (List.last (to_alist t)); + require_equal + [%here] + (module Opt (Key_and_data)) + (Option.try_with (fun () -> min_elt_exn t)) + (List.hd (to_alist t)); + require_equal + [%here] + (module Opt (Key_and_data)) + (Option.try_with (fun () -> max_elt_exn t)) + (List.last (to_alist t))) + ;; + + let for_all = for_all + let for_alli = for_alli + let exists = exists + let existsi = existsi + let count = count + let counti = counti + + let () = + quickcheck_m + [%here] + (module Inst_and_key_and_data) + ~f:(fun (t, k, d) -> + let f data = data <= d in + let fi ~key ~data = Key.( <= ) key k && data <= d in + let fp (key, data) = fi ~key ~data in + let data = data t in + let alist = to_alist t in + require_equal [%here] (module Bool) (for_all t ~f) (List.for_all data ~f); + require_equal [%here] (module Bool) (for_alli t ~f:fi) (List.for_all alist ~f:fp); + require_equal [%here] (module Bool) (exists t ~f) (List.exists data ~f); + require_equal [%here] (module Bool) (existsi t ~f:fi) (List.exists alist ~f:fp); + require_equal [%here] (module Int) (count t ~f) (List.count data ~f); + require_equal [%here] (module Int) (counti t ~f:fi) (List.count alist ~f:fp)) + ;; + + let sum = sum + let sumi = sumi + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + let f data = data * 2 in + let fi ~key ~data = (Instance.int key * 2) + (data * 3) in + let fp (key, data) = fi ~key ~data in + let m = (module Int : Container.Summable with type t = int) in + let data = data t in + let alist = to_alist t in + require_equal [%here] (module Int) (sum m t ~f) (List.sum m data ~f); + require_equal [%here] (module Int) (sumi m t ~f:fi) (List.sum m alist ~f:fp)) + ;; + + let split = split + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + require_equal + [%here] + (module struct + type t = Inst.t * (Key.t * int) option * Inst.t [@@deriving equal, sexp_of] + end) + (access split t k) + (let before, equal, after = + List.partition3_map (to_alist t) ~f:(fun (key, data) -> + match Ordering.of_int (Key.compare key k) with + | Less -> `Fst (key, data) + | Equal -> `Snd (key, data) + | Greater -> `Trd (key, data)) + in + create of_alist_exn before, List.hd equal, create of_alist_exn after)) + ;; + + let split_le_gt = split_le_gt + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + require_equal + [%here] + (module struct + type t = Inst.t * Inst.t [@@deriving equal, sexp_of] + end) + (access split_le_gt t k) + (let before, after = + List.partition_tf (to_alist t) ~f:(fun (key, _) -> Key.( <= ) key k) + in + create of_alist_exn before, create of_alist_exn after)) + ;; + + let split_lt_ge = split_lt_ge + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + require_equal + [%here] + (module struct + type t = Inst.t * Inst.t [@@deriving equal, sexp_of] + end) + (access split_lt_ge t k) + (let before, after = + List.partition_tf (to_alist t) ~f:(fun (key, _) -> Key.( < ) key k) + in + create of_alist_exn before, create of_alist_exn after)) + ;; + + let append = append + + let () = + quickcheck_m + [%here] + (module Pair (Inst)) + ~f:(fun (a, b) -> + require_equal + [%here] + (module Ok (Inst)) + (match access append ~lower_part:a ~upper_part:b with + | `Ok t -> Ok t + | `Overlapping_key_ranges -> Or_error.error_string "overlap") + (match max_elt a, min_elt b with + | Some (x, _), Some (y, _) when Key.( >= ) x y -> + Or_error.error_string "overlap" + | _ -> Ok (create of_alist_exn (to_alist a @ to_alist b))); + let a' = + (* we rely on the fact that the [Inst] generator uses positive keys *) + create map_keys_exn a ~f:(fun k -> key (-int k)) + in + require_equal + [%here] + (module Ok (Inst)) + (match access append ~lower_part:a' ~upper_part:b with + | `Ok t -> Ok t + | `Overlapping_key_ranges -> Or_error.error_string "overlap") + (Ok (create of_alist_exn (to_alist a' @ to_alist b)))) + ;; + + let subrange = subrange + let fold_range_inclusive = fold_range_inclusive + let range_to_alist = range_to_alist + + let () = + quickcheck_m + [%here] + (module struct + type t = Inst.t * Key.t Maybe_bound.t * Key.t Maybe_bound.t + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t, lower_bound, upper_bound) -> + let subrange_alist = access subrange t ~lower_bound ~upper_bound |> to_alist in + let min = + match lower_bound with + | Unbounded -> key Int.min_value + | Incl min -> min + | Excl too_small -> + (* key generator does not generate [max_value], so this cannot overflow *) + key (int too_small + 1) + in + let max = + match upper_bound with + | Unbounded -> key Int.max_value + | Incl max -> max + | Excl too_large -> + (* key generator does not generate [min_value], so this cannot overflow *) + key (int too_large - 1) + in + let fold_alist = + access fold_range_inclusive t ~min ~max ~init:[] ~f:(fun ~key ~data acc -> + (key, data) :: acc) + |> List.rev + in + let range_alist = access range_to_alist t ~min ~max in + let expect = + if Maybe_bound.bounds_crossed + ~lower:lower_bound + ~upper:upper_bound + ~compare:Key.compare + then [] + else + List.filter (to_alist t) ~f:(fun (key, _) -> + Maybe_bound.interval_contains_exn + key + ~lower:lower_bound + ~upper:upper_bound + ~compare:Key.compare) + in + require_equal [%here] (module Alist) subrange_alist expect; + require_equal [%here] (module Alist) fold_alist expect; + require_equal [%here] (module Alist) range_alist expect) + ;; + + let closest_key = closest_key + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + let alist = to_alist t in + let rev_alist = List.rev alist in + require_equal + [%here] + (module Opt (Key_and_data)) + (access closest_key t `Less_than k) + (List.find rev_alist ~f:(fun (key, _) -> Key.( < ) key k)); + require_equal + [%here] + (module Opt (Key_and_data)) + (access closest_key t `Less_or_equal_to k) + (List.find rev_alist ~f:(fun (key, _) -> Key.( <= ) key k)); + require_equal + [%here] + (module Opt (Key_and_data)) + (access closest_key t `Greater_or_equal_to k) + (List.find alist ~f:(fun (key, _) -> Key.( >= ) key k)); + require_equal + [%here] + (module Opt (Key_and_data)) + (access closest_key t `Greater_than k) + (List.find alist ~f:(fun (key, _) -> Key.( > ) key k))) + ;; + + let nth = nth + let nth_exn = nth_exn + let rank = rank + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + List.iteri (to_alist t) ~f:(fun i (key, data) -> + require_equal [%here] (module Opt (Key_and_data)) (nth t i) (Some (key, data)); + require_equal + [%here] + (module Opt (Key_and_data)) + (Option.try_with (fun () -> nth_exn t i)) + (nth t i); + require_equal [%here] (module Opt (Int)) (access rank t key) (Some i)); + require_equal [%here] (module Opt (Key_and_data)) (nth t (length t)) None; + require_equal + [%here] + (module Opt (Int)) + (access rank t k) + (List.find_mapi (to_alist t) ~f:(fun i (key, _) -> + Option.some_if (Key.equal key k) i))) + ;; + + let binary_search = binary_search + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + let targets = [%all: Binary_searchable.Which_target_by_key.t] in + let compare (key, _) k = Key.compare key k in + List.iter targets ~f:(fun which_target -> + require_equal + [%here] + (module Opt (Key_and_data)) + (access + binary_search + t + ~compare:(fun ~key ~data k' -> + require_equal [%here] (module Key) k' k; + require_equal [%here] (module Opt (Int)) (access find t key) (Some data); + compare (key, data) k') + which_target + k) + (let array = Array.of_list (to_alist t) in + Array.binary_search array ~compare which_target k + |> Option.map ~f:(Array.get array)))) + ;; + + let binary_search_segmented = binary_search_segmented + + let () = + quickcheck_m + [%here] + (module Inst_and_key) + ~f:(fun (t, k) -> + let targets = [%all: Binary_searchable.Which_target_by_segment.t] in + let segment_of (key, _) = if Key.( <= ) key k then `Left else `Right in + List.iter targets ~f:(fun which_target -> + require_equal + [%here] + (module Opt (Key_and_data)) + (access + binary_search_segmented + t + ~segment_of:(fun ~key ~data -> + require_equal [%here] (module Opt (Int)) (access find t key) (Some data); + segment_of (key, data)) + which_target) + (let array = Array.of_list (to_alist t) in + Array.binary_search_segmented array ~segment_of which_target + |> Option.map ~f:(Array.get array)))) + ;; + + let binary_search_subrange = binary_search_subrange + + let () = + quickcheck_m + [%here] + (module struct + type t = Inst.t * Key.t Maybe_bound.t * Key.t Maybe_bound.t + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t, lower_bound, upper_bound) -> + require_equal + [%here] + (module Inst) + (access + binary_search_subrange + t + ~compare:(fun ~key ~data bound -> + require_equal [%here] (module Opt (Int)) (access find t key) (Some data); + Key.compare key bound) + ~lower_bound + ~upper_bound) + (access subrange t ~lower_bound ~upper_bound)) + ;; + + module Make_applicative_traversals (A : Applicative.Lazy_applicative) = struct + module M = Make_applicative_traversals (A) + + let mapi = M.mapi + let filter_mapi = M.filter_mapi + end + + let () = + let module M = + Make_applicative_traversals (struct + module M = struct + type 'a t = 'a + + let return x = x + let apply f x = f x + let of_thunk f = f () + let map = `Define_using_apply + end + + include M + include Applicative.Make (M) + end) + in + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + let f1 ~key:_ ~data = (data * 2) + 1 in + let f2 ~key:_ ~data = if data < 0 then None else Some data in + require_equal [%here] (module Inst) (mapi t ~f:f1) (M.mapi t ~f:f1); + require_equal [%here] (module Inst) (filter_mapi t ~f:f2) (M.filter_mapi t ~f:f2)) + ;; + + (** tree conversion *) + + let to_tree = to_tree + let of_tree = of_tree + + let () = + quickcheck_m + [%here] + (module Inst) + ~f:(fun t -> + let tree = to_tree t in + let round_trip = create of_tree tree in + require_equal [%here] (module Inst) t round_trip; + require_equal + [%here] + (module Alist) + (to_alist t) + (Map.Using_comparator.Tree.to_alist (Instance.tree tree))) + ;; +end diff --git a/unikernel/duniverse/base/test/map_full_interface/functor.mli b/unikernel/duniverse/base/test/map_full_interface/functor.mli new file mode 100644 index 00000000..b831749b --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/functor.mli @@ -0,0 +1 @@ +include Functor_intf.Functor diff --git a/unikernel/duniverse/base/test/map_full_interface/functor_intf.ml b/unikernel/duniverse/base/test/map_full_interface/functor_intf.ml new file mode 100644 index 00000000..b568dfc7 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/functor_intf.ml @@ -0,0 +1,130 @@ +open! Base + +module Definitions = struct + (** The types that distinguish instances of [Map.Creators_and_accessors_generic]. *) + module type Types = sig + type 'k key + type 'c cmp + type ('k, 'v, 'c) t + type ('k, 'v, 'c) tree + type ('k, 'c, 'a) create_options + type ('k, 'c, 'a) access_options + end + + (** Like [Map.Creators_and_accessors_generic], but based on [Types] for easier + instantiation. *) + module type S = sig + module Types : Types + + include + Map.Creators_and_accessors_generic + with type ('a, 'b, 'c) t := ('a, 'b, 'c) Types.t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Types.tree + with type 'a key := 'a Types.key + with type 'a cmp := 'a Types.cmp + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Types.create_options + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Types.access_options + end + + (** Helpers for testing a tree or map type that is an instance of [S]. *) + module type Instance = sig + module Types : Types + + module Key : sig + type t = int Types.key [@@deriving compare, equal, quickcheck, sexp_of] + + include Comparable.Infix with type t := t + end + + type 'a t = (int, 'a, Int.comparator_witness) Types.t + [@@deriving equal, quickcheck, sexp_of] + + (** Construct a [Key.t]. *) + val key : int -> Key.t + + (** Extract an int from a [Key.t]. *) + val int : Key.t -> int + + (** Extract a tree (without a comparator) from [t]. *) + val tree + : (Key.t, 'a, Int.comparator_witness) Types.tree + -> (Key.t, 'a, Int.comparator_witness Types.cmp) Map.Using_comparator.Tree.t + + (** Pass a comparator to a creator function, if necessary. *) + val create : (int, Int.comparator_witness, 'a) Types.create_options -> 'a + + (** Pass a comparator to an accessor function, if necessary *) + val access : (int, Int.comparator_witness, 'a) Types.access_options -> 'a + end +end + +module type Functor = sig + include module type of struct + include Definitions + end + + (** Expect tests for everything exported from [Map.Creators_and_accessors_generic]. *) + module Test_creators_and_accessors + (Types : Types) + (Impl : S with module Types := Types) + (Instance : Instance with module Types := Types) : S with module Types := Types + + (** A functor to generate all of [Instance] but [create] and [access] for a map type. *) + module Instance (Cmp : sig + type comparator_witness + + val comparator : (int, comparator_witness) Comparator.t + end) : sig + module Key : sig + type t = int [@@deriving compare, equal, quickcheck, sexp_of] + + include + Comparator.S with type t := t and type comparator_witness = Cmp.comparator_witness + + include Comparable.Infix with type t := t + end + + type 'a t = 'a Map.M(Key).t [@@deriving equal, quickcheck, sexp_of] + + val key : 'a -> 'a + val int : 'a -> 'a + val tree : 'a -> 'a + end + + (** A functor like [Instance], but for tree types. *) + module Instance_tree (Cmp : sig + type comparator_witness + + val comparator : (int, comparator_witness) Comparator.t + end) : sig + module Key : sig + type t = int [@@deriving compare, equal, quickcheck, sexp_of] + + include + Comparator.S + with type t := int + and type comparator_witness = Cmp.comparator_witness + + include Comparable.Infix with type t := t + end + + type 'a t = (int, 'a, Cmp.comparator_witness) Map.Using_comparator.Tree.t + [@@deriving equal, quickcheck, sexp_of] + + val key : 'a -> 'a + val int : 'a -> 'a + val tree : 'a -> 'a + end + + module Ok (T : sig + type t [@@deriving equal, sexp_of] + end) : sig + type t = T.t Or_error.t [@@deriving equal, sexp_of] + end + + module Pair (T : sig + type t [@@deriving equal, quickcheck, sexp_of] + end) : sig + type t = T.t * T.t [@@deriving equal, quickcheck, sexp_of] + end +end diff --git a/unikernel/duniverse/base/test/map_full_interface/test_all.ml b/unikernel/duniverse/base/test/map_full_interface/test_all.ml new file mode 100644 index 00000000..be1c303b --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_all.ml @@ -0,0 +1,315 @@ +open! Base +open Base_quickcheck +open Expect_test_helpers_base +open Functor +open Map + +open struct + (** Instantiating key and data both as [int]. *) + module Instance_int = struct + module I = Instance (Int) + + type t = int I.t [@@deriving equal, quickcheck, sexp_of] + end +end + +(** module types *) + +module type Accessors_generic = Accessors_generic +module type Creators_and_accessors_generic = Creators_and_accessors_generic +module type Creators_generic = Creators_generic +module type For_deriving = For_deriving +module type S_poly = S_poly + +(** type-only modules for module type instantiation - untested *) + +module With_comparator = With_comparator +module With_first_class_module = With_first_class_module +module Without_comparator = Without_comparator + +(** supporting datatypes - untested *) + +module Continue_or_stop = Continue_or_stop +module Finished_or_unfinished = Finished_or_unfinished +module Merge_element = Merge_element +module Or_duplicate = Or_duplicate +module Symmetric_diff_element = Symmetric_diff_element + +(** types *) + +type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + +(** module types for ppx deriving *) + +module type Compare_m = Compare_m +module type Equal_m = Equal_m +module type Hash_fold_m = Hash_fold_m +module type M_sexp_grammar = M_sexp_grammar +module type M_of_sexp = M_of_sexp +module type Sexp_of_m = Sexp_of_m + +(** functor for ppx deriving - tested below *) + +module M = M + +(** sexp conversions and grammar *) + +let sexp_of_m__t = sexp_of_m__t +let m__t_of_sexp = m__t_of_sexp + +let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + let sexp = [%sexp_of: int M(Int).t] t in + require_equal [%here] (module Sexp) sexp [%sexp (to_alist t : (int * int) list)]; + let round_trip = [%of_sexp: int M(Int).t] sexp in + require_equal [%here] (module Instance_int) round_trip t); + [%expect {| |}] +;; + +let m__t_sexp_grammar = m__t_sexp_grammar + +let%expect_test _ = + print_s [%sexp ([%sexp_grammar: int M(Int).t] : _ Sexp_grammar.t)]; + [%expect + {| + (Tagged ( + (key sexp_grammar.assoc) + (value ()) + (grammar ( + List ( + Many ( + List ( + Cons + (Tagged ((key sexp_grammar.assoc.key) (value ()) (grammar Integer))) + (Cons + (Tagged ( + (key sexp_grammar.assoc.value) (value ()) (grammar Integer))) + Empty)))))))) + |}] +;; + +(** comparisons *) + +let compare_m__t = compare_m__t +let equal_m__t = equal_m__t + +let%expect_test _ = + quickcheck_m + [%here] + (module Pair (Instance_int)) + ~f:(fun (a, b) -> + require_equal + [%here] + (module Ordering) + (Ordering.of_int ([%compare: int M(Int).t] a b)) + (Ordering.of_int ([%compare: (int * int) list] (to_alist a) (to_alist b))); + require_equal + [%here] + (module Bool) + ([%equal: int M(Int).t] a b) + ([%equal: (int * int) list] (to_alist a) (to_alist b))); + [%expect {| |}] +;; + +(** hash functions *) + +let hash_fold_m__t = hash_fold_m__t +let hash_fold_direct = hash_fold_direct + +let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + let actual_m = Hash.run [%hash_fold: int M(Int).t] t in + let actual_direct = Hash.run (hash_fold_direct Int.hash_fold_t Int.hash_fold_t) t in + let expect = Hash.run [%hash_fold: (int * int) list] (to_alist t) in + require_equal [%here] (module Int) actual_m expect; + require_equal [%here] (module Int) actual_direct expect); + [%expect {| |}] +;; + +(** comparator accessors - untested *) + +let comparator_s = comparator_s +let comparator = comparator + +(** creators and accessors *) + +include (Test_toplevel : Test_toplevel.S) + +(** polymorphic comparison interface *) +module Poly = struct + open Poly + + type nonrec ('k, 'v) t = ('k, 'v) t + type nonrec ('k, 'v) tree = ('k, 'v) tree + type nonrec comparator_witness = comparator_witness + + include (Test_poly : Test_poly.S) +end + +(** comparator interface *) + +module Using_comparator = struct + open Using_comparator + + (** type *) + + type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + + (** comparator accessor - untested *) + + let comparator = comparator + + (** sexp conversions *) + + let sexp_of_t = sexp_of_t + let t_of_sexp_direct = t_of_sexp_direct + + let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + let sexp = sexp_of_t Int.sexp_of_t Int.sexp_of_t [%sexp_of: _] t in + require_equal [%here] (module Sexp) sexp ([%sexp_of: int Map.M(Int).t] t); + let round_trip = + t_of_sexp_direct ~comparator:Int.comparator Int.t_of_sexp Int.t_of_sexp sexp + in + require_equal [%here] (module Instance_int) round_trip t); + [%expect {| |}] + ;; + + (** hash function *) + + let hash_fold_direct = hash_fold_direct + + let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + require_equal + [%here] + (module Int) + (Hash.run (hash_fold_direct Int.hash_fold_t Int.hash_fold_t) t) + (Hash.run [%hash_fold: int Map.M(Int).t] t)); + [%expect {| |}] + ;; + + (** functor for polymorphic definition - untested *) + + module Empty_without_value_restriction (Cmp : Comparator.S1) = struct + open Empty_without_value_restriction (Cmp) + + let empty = empty + end + + (** creators and accessors *) + + include (Test_using_comparator : Test_using_comparator.S) + + (** tree interface *) + + module Tree = struct + open Tree + + (** type *) + + type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + + (** sexp conversions *) + + let sexp_of_t = sexp_of_t + let t_of_sexp_direct = t_of_sexp_direct + + let%expect_test _ = + let module Tree_int = struct + module I = Instance_tree (Int) + + type t = int I.t [@@deriving equal, quickcheck, sexp_of] + end + in + quickcheck_m + [%here] + (module Tree_int) + ~f:(fun tree -> + let sexp = sexp_of_t Int.sexp_of_t Int.sexp_of_t [%sexp_of: _] tree in + require_equal + [%here] + (module Sexp) + sexp + ([%sexp_of: int Map.M(Int).t] + (Using_comparator.of_tree tree ~comparator:Int.comparator)); + let round_trip = + t_of_sexp_direct ~comparator:Int.comparator Int.t_of_sexp Int.t_of_sexp sexp + in + require_equal [%here] (module Tree_int) round_trip tree); + [%expect {| |}] + ;; + + (** polymorphic constructor - untested *) + + let empty_without_value_restriction = empty_without_value_restriction + + (** builders *) + + module Build_increasing = struct + open Build_increasing + + type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + + (** tree builder functions *) + + let empty = empty + let add_exn = add_exn + let to_tree = to_tree + + let%expect_test _ = + let module Tree_int = struct + module I = Instance_tree (Int) + + type t = int I.t [@@deriving equal, quickcheck, sexp_of] + end + in + quickcheck_m + [%here] + (module struct + type t = + ((int[@generator Base_quickcheck.Generator.small_strictly_positive_int]) + * int) + list + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun alist -> + let actual = + List.fold_result alist ~init:empty ~f:(fun builder (key, data) -> + Or_error.try_with (fun () -> + add_exn builder ~comparator:Int.comparator ~key ~data)) + |> Or_error.map ~f:to_tree + in + Or_error.iter actual ~f:(fun map -> + require [%here] (Tree.invariants map ~comparator:Int.comparator)); + let expect = + match List.is_sorted_strictly alist ~compare:[%compare: int * _] with + | false -> Error (Error.of_string "not sorted") + | true -> + Ok + (Map.Using_comparator.Tree.of_sequence_exn + ~comparator:Int.comparator + (Sequence.of_list alist)) + in + require_equal [%here] (module Ok (Tree_int)) actual expect); + [%expect {| |}] + ;; + end + + (** creators and accessors *) + + include (Test_tree : Test_tree.S) + end +end diff --git a/unikernel/duniverse/base/test/map_full_interface/test_all.mli b/unikernel/duniverse/base/test/map_full_interface/test_all.mli new file mode 100644 index 00000000..834b2c55 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_all.mli @@ -0,0 +1,5 @@ +open! Base + +include module type of struct + include Map +end [@remove_aliases] diff --git a/unikernel/duniverse/base/test/map_full_interface/test_poly.ml b/unikernel/duniverse/base/test/map_full_interface/test_poly.ml new file mode 100644 index 00000000..d1df570b --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_poly.ml @@ -0,0 +1,15 @@ +open! Base +include Test_poly_intf.Definitions +include (Base.Map.Poly : S) + +let%expect_test "[Base.Map.Poly] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map.Poly) + (struct + include Functor.Instance (Comparator.Poly) + + let create x = x + let access x = x + end) in + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/map_full_interface/test_poly.mli b/unikernel/duniverse/base/test/map_full_interface/test_poly.mli new file mode 100644 index 00000000..bc6d76f5 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_poly.mli @@ -0,0 +1 @@ +include Test_poly_intf.Test_poly diff --git a/unikernel/duniverse/base/test/map_full_interface/test_poly_intf.ml b/unikernel/duniverse/base/test/map_full_interface/test_poly_intf.ml new file mode 100644 index 00000000..5f3e7eba --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_poly_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = Comparator.Poly.comparator_witness + type ('key, 'data, 'cmp) t = ('key, 'data) Map.Poly.t + type ('key, 'data, 'cmp) tree = ('key, 'data) Map.Poly.tree + type ('key, 'cmp, 'fn) create_options = 'fn + type ('key, 'cmp, 'fn) access_options = 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_poly = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/unikernel/duniverse/base/test/map_full_interface/test_toplevel.ml b/unikernel/duniverse/base/test/map_full_interface/test_toplevel.ml new file mode 100644 index 00000000..d0d9ca8d --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_toplevel.ml @@ -0,0 +1,15 @@ +open! Base +include Test_toplevel_intf.Definitions +include (Base.Map : S) + +let%expect_test "[Base.Map] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map) + (struct + include Functor.Instance (Int) + + let create f = f ((module Int) : _ Comparator.Module.t) + let access x = x + end) in + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/map_full_interface/test_toplevel.mli b/unikernel/duniverse/base/test/map_full_interface/test_toplevel.mli new file mode 100644 index 00000000..038567e7 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_toplevel.mli @@ -0,0 +1 @@ +include Test_toplevel_intf.Test_toplevel diff --git a/unikernel/duniverse/base/test/map_full_interface/test_toplevel_intf.ml b/unikernel/duniverse/base/test/map_full_interface/test_toplevel_intf.ml new file mode 100644 index 00000000..56ffc9cd --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_toplevel_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = 'cmp + type ('key, 'data, 'cmp) t = ('key, 'data, 'cmp) Map.t + type ('key, 'data, 'cmp) tree = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'cmp, 'fn) create_options = ('key, 'cmp) Comparator.Module.t -> 'fn + type ('key, 'cmp, 'fn) access_options = 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_toplevel = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/unikernel/duniverse/base/test/map_full_interface/test_tree.ml b/unikernel/duniverse/base/test/map_full_interface/test_tree.ml new file mode 100644 index 00000000..90747818 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_tree.ml @@ -0,0 +1,15 @@ +open! Base +include Test_tree_intf.Definitions +include (Base.Map.Using_comparator.Tree : S) + +let%expect_test "[Base.Map.Using_comparator.Tree] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map.Using_comparator.Tree) + (struct + include Functor.Instance_tree (Int) + + let create f = f ~comparator:Int.comparator + let access f = f ~comparator:Int.comparator + end) in + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/map_full_interface/test_tree.mli b/unikernel/duniverse/base/test/map_full_interface/test_tree.mli new file mode 100644 index 00000000..5181eb66 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_tree.mli @@ -0,0 +1 @@ +include Test_tree_intf.Test_tree diff --git a/unikernel/duniverse/base/test/map_full_interface/test_tree_intf.ml b/unikernel/duniverse/base/test/map_full_interface/test_tree_intf.ml new file mode 100644 index 00000000..f375dcd9 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_tree_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = 'cmp + type ('key, 'data, 'cmp) t = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'data, 'cmp) tree = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'cmp, 'fn) create_options = comparator:('key, 'cmp) Comparator.t -> 'fn + type ('key, 'cmp, 'fn) access_options = comparator:('key, 'cmp) Comparator.t -> 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_tree = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/unikernel/duniverse/base/test/map_full_interface/test_using_comparator.ml b/unikernel/duniverse/base/test/map_full_interface/test_using_comparator.ml new file mode 100644 index 00000000..cf37efab --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_using_comparator.ml @@ -0,0 +1,15 @@ +open! Base +include Test_using_comparator_intf.Definitions +include (Base.Map.Using_comparator : S) + +let%expect_test "[Base.Map.Using_comparator] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map.Using_comparator) + (struct + include Functor.Instance (Int) + + let create f = f ~comparator:Int.comparator + let access x = x + end) in + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/map_full_interface/test_using_comparator.mli b/unikernel/duniverse/base/test/map_full_interface/test_using_comparator.mli new file mode 100644 index 00000000..8a43dcd6 --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_using_comparator.mli @@ -0,0 +1 @@ +include Test_using_comparator_intf.Test_using_comparator diff --git a/unikernel/duniverse/base/test/map_full_interface/test_using_comparator_intf.ml b/unikernel/duniverse/base/test/map_full_interface/test_using_comparator_intf.ml new file mode 100644 index 00000000..7c134d9b --- /dev/null +++ b/unikernel/duniverse/base/test/map_full_interface/test_using_comparator_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = 'cmp + type ('key, 'data, 'cmp) t = ('key, 'data, 'cmp) Map.Using_comparator.t + type ('key, 'data, 'cmp) tree = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'cmp, 'fn) create_options = comparator:('key, 'cmp) Comparator.t -> 'fn + type ('key, 'cmp, 'fn) access_options = 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_using_comparator = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/unikernel/duniverse/base/test/test_am_testing.ml b/unikernel/duniverse/base/test/test_am_testing.ml new file mode 100644 index 00000000..6e2940ec --- /dev/null +++ b/unikernel/duniverse/base/test/test_am_testing.ml @@ -0,0 +1,7 @@ +open! Base +open! Import + +let%expect_test _ = + print_s [%sexp (Exported_for_specific_uses.am_testing : bool)]; + [%expect {| true |}] +;; diff --git a/unikernel/duniverse/base/test/test_am_testing.mli b/unikernel/duniverse/base/test/test_am_testing.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_am_testing.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_am_testing.mlt b/unikernel/duniverse/base/test/test_am_testing.mlt new file mode 100644 index 00000000..21cbdb15 --- /dev/null +++ b/unikernel/duniverse/base/test/test_am_testing.mlt @@ -0,0 +1,9 @@ +open! Base +open! Expect_test_helpers_base + +let () = print_s [%sexp (Exported_for_specific_uses.am_testing : bool)] + +[%%expect + {| +true +|}] diff --git a/unikernel/duniverse/base/test/test_applicative.ml b/unikernel/duniverse/base/test/test_applicative.ml new file mode 100644 index 00000000..afc751e8 --- /dev/null +++ b/unikernel/duniverse/base/test/test_applicative.ml @@ -0,0 +1,337 @@ +open! Import + +module Test_applicative_s (A : Applicative.S with type 'a t := 'a Or_error.t) : + Applicative.S with type 'a t := 'a Or_error.t = struct + let error = Or_error.error_string + let return = A.return + + let%expect_test _ = + print_s [%sexp (return "okay" : string Or_error.t)]; + [%expect {| (Ok okay) |}] + ;; + + let apply = A.apply + + let%expect_test _ = + let test x y = print_s [%sexp (apply x y : string Or_error.t)] in + test (Ok String.capitalize) (Ok "okay"); + [%expect {| (Ok Okay) |}]; + test (error "not okay") (Ok "okay"); + [%expect {| (Error "not okay") |}]; + test (Ok String.capitalize) (error "not okay"); + [%expect {| (Error "not okay") |}]; + test (error "no fun") (error "no arg"); + [%expect {| (Error ("no fun" "no arg")) |}] + ;; + + let ( <*> ) = A.( <*> ) + + let%expect_test _ = + let test x y = print_s [%sexp (x <*> y : string Or_error.t)] in + test (Ok String.capitalize) (Ok "okay"); + [%expect {| (Ok Okay) |}]; + test (error "not okay") (Ok "okay"); + [%expect {| (Error "not okay") |}]; + test (Ok String.capitalize) (error "not okay"); + [%expect {| (Error "not okay") |}]; + test (error "no fun") (error "no arg"); + [%expect {| (Error ("no fun" "no arg")) |}] + ;; + + let ( *> ) = A.( *> ) + + let%expect_test _ = + let test x y = print_s [%sexp (x *> y : string Or_error.t)] in + test (Ok ()) (Ok "kay"); + [%expect {| (Ok kay) |}]; + test (error "not okay") (Ok "kay"); + [%expect {| (Error "not okay") |}]; + test (Ok ()) (error "not okay"); + [%expect {| (Error "not okay") |}]; + test (error "no fst") (error "no snd"); + [%expect {| (Error ("no fst" "no snd")) |}] + ;; + + let ( <* ) = A.( <* ) + + let%expect_test _ = + let test x y = print_s [%sexp (x <* y : string Or_error.t)] in + test (Ok "okay") (Ok ()); + [%expect {| (Ok okay) |}]; + test (error "not okay") (Ok ()); + [%expect {| (Error "not okay") |}]; + test (Ok "okay") (error "not okay"); + [%expect {| (Error "not okay") |}]; + test (error "no fst") (error "no snd"); + [%expect {| (Error ("no fst" "no snd")) |}] + ;; + + let both = A.both + + let%expect_test _ = + let test x y = print_s [%sexp (both x y : (string * string) Or_error.t)] in + test (Ok "o") (Ok "kay"); + [%expect {| (Ok (o kay)) |}]; + test (error "not okay") (Ok "kay"); + [%expect {| (Error "not okay") |}]; + test (Ok "o") (error "not okay"); + [%expect {| (Error "not okay") |}]; + test (error "no fst") (error "no snd"); + [%expect {| (Error ("no fst" "no snd")) |}] + ;; + + let map = A.map + + let%expect_test _ = + let test x = print_s [%sexp (map x ~f:String.capitalize : string Or_error.t)] in + test (Ok "okay"); + [%expect {| (Ok Okay) |}]; + test (error "not okay"); + [%expect {| (Error "not okay") |}] + ;; + + let ( >>| ) = A.( >>| ) + + let%expect_test _ = + let test x = print_s [%sexp (x >>| String.capitalize : string Or_error.t)] in + test (Ok "okay"); + [%expect {| (Ok Okay) |}]; + test (error "not okay"); + [%expect {| (Error "not okay") |}] + ;; + + let map2 = A.map2 + + let%expect_test _ = + let test x y = print_s [%sexp (map2 x y ~f:( ^ ) : string Or_error.t)] in + test (Ok "o") (Ok "kay"); + [%expect {| (Ok okay) |}]; + test (error "not okay") (Ok "kay"); + [%expect {| (Error "not okay") |}]; + test (Ok "o") (error "not okay"); + [%expect {| (Error "not okay") |}]; + test (error "no fst") (error "no snd"); + [%expect {| (Error ("no fst" "no snd")) |}] + ;; + + let map3 = A.map3 + + let%expect_test _ = + let test x y z = + print_s [%sexp (map3 x y z ~f:(fun a b c -> a ^ b ^ c) : string Or_error.t)] + in + test (Ok "o") (Ok "k") (Ok "ay"); + [%expect {| (Ok okay) |}]; + test (error "not okay") (Ok "k") (Ok "ay"); + [%expect {| (Error "not okay") |}]; + test (Ok "o") (error "not okay") (Ok "ay"); + [%expect {| (Error "not okay") |}]; + test (Ok "o") (Ok "k") (error "not okay"); + [%expect {| (Error "not okay") |}]; + test (error "no 1st") (error "no 2nd") (error "no 3rd"); + [%expect {| (Error ("no 1st" "no 2nd" "no 3rd")) |}] + ;; + + let all = A.all + + let%expect_test _ = + let test list = print_s [%sexp (all list : string list Or_error.t)] in + test []; + [%expect {| (Ok ()) |}]; + test [ Ok "okay" ]; + [%expect {| (Ok (okay)) |}]; + test [ Ok "o"; Ok "kay" ]; + [%expect {| (Ok (o kay)) |}]; + test [ Ok "o"; Ok "k"; Ok "ay" ]; + [%expect {| (Ok (o k ay)) |}]; + test [ error "oh no!" ]; + [%expect {| (Error "oh no!") |}]; + test [ error "oh no!"; Ok "okay" ]; + [%expect {| (Error "oh no!") |}]; + test [ Ok "okay"; error "oh no!" ]; + [%expect {| (Error "oh no!") |}]; + test [ error "oh no!"; Ok "o"; Ok "kay" ]; + [%expect {| (Error "oh no!") |}]; + test [ Ok "o"; error "oh no!"; Ok "aay" ]; + [%expect {| (Error "oh no!") |}]; + test [ Ok "o"; Ok "kay"; error "oh no!" ]; + [%expect {| (Error "oh no!") |}]; + test [ error "oh"; error "no"; error "!" ]; + [%expect {| (Error (oh no !)) |}] + ;; + + let all_unit = A.all_unit + + let%expect_test _ = + let test list = print_s [%sexp (all_unit list : unit Or_error.t)] in + test []; + [%expect {| (Ok ()) |}]; + test [ Ok () ]; + [%expect {| (Ok ()) |}]; + test [ Ok (); Ok () ]; + [%expect {| (Ok ()) |}]; + test [ Ok (); Ok (); Ok () ]; + [%expect {| (Ok ()) |}]; + test [ error "oh no!" ]; + [%expect {| (Error "oh no!") |}]; + test [ error "oh no!"; Ok () ]; + [%expect {| (Error "oh no!") |}]; + test [ Ok (); error "oh no!" ]; + [%expect {| (Error "oh no!") |}]; + test [ error "oh no!"; Ok (); Ok () ]; + [%expect {| (Error "oh no!") |}]; + test [ Ok (); error "oh no!"; Ok () ]; + [%expect {| (Error "oh no!") |}]; + test [ Ok (); Ok (); error "oh no!" ]; + [%expect {| (Error "oh no!") |}]; + test [ error "oh"; error "no"; error "!" ]; + [%expect {| (Error (oh no !)) |}] + ;; + + module Applicative_infix = A.Applicative_infix +end + +let%test_module "Make" = + (module Test_applicative_s (Applicative.Make (struct + type 'a t = 'a Or_error.t + + let return = Or_error.return + let apply = Or_error.apply + let map = `Define_using_apply + end))) +;; + +let%test_module "Make" = + (module Test_applicative_s (Applicative.Make_using_map2 (struct + type 'a t = 'a Or_error.t + + let return = Or_error.return + let map2 = Or_error.map2 + let map = `Define_using_map2 + end))) +;; + +let%test_module "Make" = + (module Test_applicative_s (Applicative.Make_using_map2_local (struct + type 'a t = 'a Or_error.t + + let return x = Ok x + let map2 = Or_error.map2 + let map = `Define_using_map2 + end))) +;; + +(* While law-abiding applicatives shouldn't be relying functions being called + the minimal number of times, it is good for performance that things be this + way. For many applicatives this will not matter very much, but for others, + like Bonsai, it is a little more significant, since extra calls construct + more Incremental nodes, yielding more strain on the Incremental stabilizer. + + The point is that we should not assume that the input applicative instance + can be frivolous in creating nodes in the applicative call-tree. +*) +let%expect_test _ = + let module A = struct + type 'a t = + | Other of string + | Return : 'a -> 'a t + | Map : ('a -> 'b) * 'a t -> 'b t + | Map2 : ('a -> 'b -> 'c) * 'a t * 'b t -> 'c t + + include Applicative.Make_using_map2 (struct + type nonrec 'a t = 'a t + + let return x = Return x + let map2 a b ~f = Map2 (f, a, b) + let map = `Custom (fun a ~f -> Map (f, a)) + end) + + let rec sexp_of_t : type a. a t -> Sexp.t = function + | Other x -> Atom x + | Return _ -> Atom "Return" + | Map (_, a) -> List [ Atom "Map"; sexp_of_t a ] + | Map2 (_, a, b) -> List [ Atom "Map2"; sexp_of_t a; sexp_of_t b ] + ;; + end + in + let open A in + let test x = print_s [%sexp (x : A.t)] in + let a, b, c, d = Other "A", Other "B", Other "C", Other "D" in + test (map2 a b ~f:(fun a b -> a, b)); + [%expect {| (Map2 A B) |}]; + test (both a b); + [%expect {| (Map2 A B) |}]; + test (all_unit [ a; b; c; d ]); + [%expect {| (Map2 (Map2 (Map2 (Map2 Return A) B) C) D) |}]; + test (a *> b); + [%expect {| (Map2 A B) |}] +;; + +(* These functors serve only to check that the signatures for various Foo and Foo2 module + types don't drift apart over time. *) +module _ = struct + open Applicative + + (* Applicative_infix to Applicative_infix2 *) + + module _ (X : Applicative_infix) : Applicative_infix2 with type ('a, 'e) t = 'a X.t = + struct + include X + + type ('a, 'e) t = 'a X.t + end + + (* Applicative_infix2 to Applicative_infix *) + module _ (X : Applicative_infix2) : Applicative_infix with type 'a t = ('a, unit) X.t = + struct + include X + + type 'a t = ('a, unit) X.t + end + + (* Applicative_infix2 to Applicative_infix3 *) + module _ (X : Applicative_infix2) : + Applicative_infix3 with type ('a, 'd, 'e) t = ('a, 'd) X.t = struct + include X + + type ('a, 'd, 'e) t = ('a, 'd) X.t + end + + (* Applicative_infix3 to Applicative_infix2 *) + module _ (X : Applicative_infix3) : + Applicative_infix2 with type ('a, 'd) t = ('a, 'd, unit) X.t = struct + include X + + type ('a, 'd) t = ('a, 'd, unit) X.t + end + + (* Let_syntax to Let_syntax2 *) + module _ (X : Let_syntax) : Let_syntax2 with type ('a, 'e) t = 'a X.t = struct + include X + + type ('a, 'e) t = 'a X.t + end + + (* Let_syntax2 to Let_syntax *) + module _ (X : Let_syntax2) : Let_syntax with type 'a t = ('a, unit) X.t = struct + include X + + type 'a t = ('a, unit) X.t + end + + (* Let_syntax2 to Let_syntax3 *) + module _ (X : Let_syntax2) : Let_syntax3 with type ('a, 'd, 'e) t = ('a, 'd) X.t = + struct + include X + + type ('a, 'd, 'e) t = ('a, 'd) X.t + end + + (* Let_syntax3 to Let_syntax2 *) + module _ (X : Let_syntax3) : Let_syntax2 with type ('a, 'd) t = ('a, 'd, unit) X.t = + struct + include X + + type ('a, 'd) t = ('a, 'd, unit) X.t + end +end diff --git a/unikernel/duniverse/base/test/test_applicative.mli b/unikernel/duniverse/base/test/test_applicative.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_applicative.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_applicative.mlt b/unikernel/duniverse/base/test/test_applicative.mlt new file mode 100644 index 00000000..a0eaa884 --- /dev/null +++ b/unikernel/duniverse/base/test/test_applicative.mlt @@ -0,0 +1,14 @@ +open Base +open Expect_test_helpers_base + +let () = + let z = 3 in + let local_ f x y = x + y + z in + let r = Option.map2 (Some 3) (Some 4) ~f in + print_s [%sexp (r : int option)] +;; + +[%%expect + {| +(10) +|}] diff --git a/unikernel/duniverse/base/test/test_array.ml b/unikernel/duniverse/base/test/test_array.ml new file mode 100644 index 00000000..741cccce --- /dev/null +++ b/unikernel/duniverse/base/test/test_array.ml @@ -0,0 +1,682 @@ +open! Import +open Base_quickcheck +open Expect_test_helpers_base +open Array + +let%test_module "Binary_searchable" = + (module Test_binary_searchable.Test1 (struct + include Array + + module For_test = struct + let of_array = Fn.id + end + end)) +;; + +let%test_module "Blit" = + (module Test_blit.Test1 + (struct + type 'a z = 'a + + include Array + + let create_bool ~len = create ~len false + end) + (Array)) +;; + +module List_helpers = struct + let rec sprinkle x xs = + (x :: xs) + :: + (match xs with + | [] -> [] + | x' :: xs' -> List.map (sprinkle x xs') ~f:(fun sprinkled -> x' :: sprinkled)) + ;; + + let rec permutations = function + | [] -> [ [] ] + | x :: xs -> List.concat_map (permutations xs) ~f:(fun perms -> sprinkle x perms) + ;; +end + +let%test_module "Sort" = + (module struct + open Private.Sort + + let%test_module "Intro_sort.five_element_sort" = + (module struct + (* run [five_element_sort] on all permutations of an array of five elements *) + + let all_perms = List_helpers.permutations [ 1; 2; 3; 4; 5 ] + let%test _ = List.length all_perms = 120 + let%test _ = not (List.contains_dup ~compare:[%compare: int list] all_perms) + + let%test _ = + List.for_all all_perms ~f:(fun l -> + let arr = Array.of_list l in + Intro_sort.five_element_sort arr ~compare:[%compare: int] 0 1 2 3 4; + [%compare.equal: int t] arr [| 1; 2; 3; 4; 5 |]) + ;; + end) + ;; + + module Test (M : Private.Sort.Sort) = struct + let random_data ~length ~range = + let arr = Array.create ~len:length 0 in + for i = 0 to length - 1 do + arr.(i) <- Random.int range + done; + arr + ;; + + let assert_sorted arr = + M.sort arr ~left:0 ~right:(Array.length arr - 1) ~compare:[%compare: int]; + let len = Array.length arr in + let rec loop i prev = + if i = len then true else if arr.(i) < prev then false else loop (i + 1) arr.(i) + in + loop 0 (-1) + ;; + + let%test _ = assert_sorted (random_data ~length:0 ~range:100) + let%test _ = assert_sorted (random_data ~length:1 ~range:100) + let%test _ = assert_sorted (random_data ~length:100 ~range:1_000) + let%test _ = assert_sorted (random_data ~length:1_000 ~range:1) + let%test _ = assert_sorted (random_data ~length:1_000 ~range:10) + let%test _ = assert_sorted (random_data ~length:1_000 ~range:1_000_000) + end + + let%test_module _ = (module Test (Insertion_sort)) + let%test_module _ = (module Test (Heap_sort)) + let%test_module _ = (module Test (Intro_sort)) + end) +;; + +let%test _ = is_sorted [||] ~compare:[%compare: int] +let%test _ = is_sorted [| 0 |] ~compare:[%compare: int] +let%test _ = is_sorted [| 0; 1; 2; 2; 4 |] ~compare:[%compare: int] +let%test _ = not (is_sorted [| 0; 1; 2; 3; 2 |] ~compare:[%compare: int]) + +let%test_unit _ = + List.iter + ~f:(fun (t, expect) -> + assert (Bool.equal expect (is_sorted_strictly (of_list t) ~compare:[%compare: int]))) + [ [], true + ; [ 1 ], true + ; [ 1; 2 ], true + ; [ 1; 1 ], false + ; [ 2; 1 ], false + ; [ 1; 2; 3 ], true + ; [ 1; 1; 3 ], false + ; [ 1; 2; 2 ], false + ] +;; + +let%expect_test "merge" = + let test a1 a2 = + let res = merge a1 a2 ~compare:Int.compare in + print_s ([%sexp_of: int array] res); + require_equal + [%here] + (module struct + type t = int list [@@deriving equal, sexp_of] + end) + (to_list res) + (List.merge (to_list a1) (to_list a2) ~compare:Int.compare) + in + test [||] [||]; + [%expect {| () |}]; + test [| 1; 2; 3 |] [||]; + [%expect {| (1 2 3) |}]; + test [||] [| 1; 2; 3 |]; + [%expect {| (1 2 3) |}]; + test [| 1; 2; 3 |] [| 1; 2; 3 |]; + [%expect {| (1 1 2 2 3 3) |}]; + test [| 1; 2; 3 |] [| 4; 5; 6 |]; + [%expect {| (1 2 3 4 5 6) |}]; + test [| 4; 5; 6 |] [| 1; 2; 3 |]; + [%expect {| (1 2 3 4 5 6) |}]; + test [| 3; 5 |] [| 1; 2; 4; 6 |]; + [%expect {| (1 2 3 4 5 6) |}]; + test [| 1; 3; 7; 8; 9 |] [| 2; 4; 5; 6 |]; + [%expect {| (1 2 3 4 5 6 7 8 9) |}]; + test [| 1; 2; 2; 3 |] [| 2; 2; 3; 4 |]; + [%expect {| (1 2 2 2 2 3 3 4) |}] +;; + +let%expect_test "merge with duplicates" = + (* Testing that equal elements from a1 come before equal elements from a2 *) + let test a1 a2 = + let compare a b = Comparable.lift Int.compare ~f:fst a b in + let res = merge a1 a2 ~compare in + print_s ([%sexp_of: (int * string) array] res); + require_equal + [%here] + (module struct + type t = (int * string) list [@@deriving equal, sexp_of] + end) + (to_list res) + (List.merge (to_list a1) (to_list a2) ~compare) + in + test [| 1, "a1" |] [| 1, "a2" |]; + [%expect {| + ((1 a1) + (1 a2)) + |}]; + test [| 1, "a1"; 2, "a1"; 3, "a1" |] [| 3, "a2"; 4, "a2"; 5, "a2" |]; + [%expect + {| + ((1 a1) + (2 a1) + (3 a1) + (3 a2) + (4 a2) + (5 a2)) + |}]; + test [| 3, "a1"; 4, "a1"; 5, "a1" |] [| 1, "a2"; 2, "a2"; 3, "a2" |]; + [%expect + {| + ((1 a2) + (2 a2) + (3 a1) + (3 a2) + (4 a1) + (5 a1)) + |}]; + test [| 1, "a1"; 3, "a1"; 3, "a1"; 5, "a1" |] [| 2, "a2"; 3, "a2"; 3, "a2"; 4, "a2" |]; + [%expect + {| + ((1 a1) + (2 a2) + (3 a1) + (3 a1) + (3 a2) + (3 a2) + (4 a2) + (5 a1)) + |}] +;; + +let%test _ = foldi [||] ~init:13 ~f:(fun _ _ _ -> failwith "bad") = 13 +let%test _ = foldi [| 13 |] ~init:17 ~f:(fun i ac x -> ac + i + x) = 30 +let%test _ = foldi [| 13; 17 |] ~init:19 ~f:(fun i ac x -> ac + i + x) = 50 + +let%test_module "count{,i}" = + (module struct + let%expect_test "[Array.count{,i} = List.count{,i}]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal + [%here] + (module Int) + (list |> List.count ~f) + (list |> of_list |> count ~f)); + quickcheck_m + [%here] + (module struct + type t = int list * (int -> int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal + [%here] + (module Int) + (list |> List.counti ~f) + (list |> of_list |> counti ~f)) + ;; + + let%test _ = counti [| 0; 1; 2; 3; 4 |] ~f:(fun idx x -> idx = x) = 5 + let%test _ = counti [| 0; 1; 2; 3; 4 |] ~f:(fun idx x -> idx = 4 - x) = 1 + end) +;; + +let%test_module "{min,max}_elt" = + (module struct + let test_opt_selector arr_fun list_fun = + quickcheck_m + [%here] + (module struct + type t = int list [@@deriving sexp_of, quickcheck] + end) + ~f:(fun list -> + let arr = of_list list in + require_equal + [%here] + (module struct + type t = int option [@@deriving sexp_of, equal] + end) + (arr_fun arr ~compare:(fun x y -> Int.compare x y)) + (list_fun list ~compare:(fun x y -> Int.compare x y))) + ;; + + let%expect_test "min_elt" = test_opt_selector min_elt List.min_elt + let%expect_test "max_elt" = test_opt_selector max_elt List.max_elt + end) +;; + +let%test_unit _ = + for i = 0 to 5 do + let l1 = List.init i ~f:Fn.id in + let l2 = List.rev (to_list (of_list_rev l1)) in + assert ([%compare.equal: int list] l1 l2) + done +;; + +let%test_unit _ = + [%test_result: int array] + (filter_opt [| Some 1; None; Some 2; None; Some 3 |]) + ~expect:[| 1; 2; 3 |] +;; + +let%test_unit _ = + [%test_result: int array] (filter_opt [| Some 1; None; Some 2 |]) ~expect:[| 1; 2 |] +;; + +let%test_unit _ = [%test_result: int array] (filter_opt [| Some 1 |]) ~expect:[| 1 |] +let%test_unit _ = [%test_result: int array] (filter_opt [| None |]) ~expect:[||] +let%test_unit _ = [%test_result: int array] (filter_opt [||]) ~expect:[||] + +let%expect_test _ = + print_s ([%sexp_of: int array] (map2_exn [| 1; 2; 3 |] [| 2; 3; 4 |] ~f:( + ))); + [%expect {| (3 5 7) |}] +;; + +let%expect_test "map2_exn raise" = + require_does_raise [%here] (fun () -> map2_exn [| 1; 2; 3 |] [| 2; 3; 4; 5 |] ~f:( + )); + [%expect {| (Invalid_argument "length mismatch in Array.map2_exn: 3 <> 4") |}] +;; + +let%test_unit _ = + [%test_result: int] + (fold2_exn [||] [||] ~init:13 ~f:(fun _ -> failwith "fail")) + ~expect:13 +;; + +let%test_unit _ = + [%test_result: (int * string) list] + (fold2_exn [| 1 |] [| "1" |] ~init:[] ~f:(fun ac a b -> (a, b) :: ac)) + ~expect:[ 1, "1" ] +;; + +let%test_unit _ = + [%test_result: int array] (filter [| 0; 1 |] ~f:(fun n -> n < 2)) ~expect:[| 0; 1 |] +;; + +let%test_unit _ = + [%test_result: int array] (filter [| 0; 1 |] ~f:(fun n -> n < 1)) ~expect:[| 0 |] +;; + +let%test_unit _ = + [%test_result: int array] (filter [| 0; 1 |] ~f:(fun n -> n < 0)) ~expect:[||] +;; + +let%test_unit _ = [%test_result: bool] (exists [||] ~f:(fun _ -> true)) ~expect:false + +let%test_unit _ = + [%test_result: bool] (exists [| 0; 1; 2; 3 |] ~f:(fun x -> 4 = x)) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (exists [| 0; 1; 2; 3 |] ~f:(fun x -> 2 = x)) ~expect:true +;; + +let%test_unit _ = [%test_result: bool] (existsi [||] ~f:(fun _ _ -> true)) ~expect:false + +let%test_unit _ = + [%test_result: bool] (existsi [| 0; 1; 2; 3 |] ~f:(fun i x -> i <> x)) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (existsi [| 0; 1; 3; 3 |] ~f:(fun i x -> i <> x)) ~expect:true +;; + +let%test_unit _ = [%test_result: bool] (for_all [||] ~f:(fun _ -> false)) ~expect:true + +let%test_unit _ = + [%test_result: bool] (for_all [| 1; 2; 3 |] ~f:Int.is_positive) ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] (for_all [| 0; 1; 3; 3 |] ~f:Int.is_positive) ~expect:false +;; + +let%test_unit _ = [%test_result: bool] (for_alli [||] ~f:(fun _ _ -> false)) ~expect:true + +let%test_unit _ = + [%test_result: bool] (for_alli [| 0; 1; 2; 3 |] ~f:(fun i x -> i = x)) ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] (for_alli [| 0; 1; 3; 3 |] ~f:(fun i x -> i = x)) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (exists2_exn [||] [||] ~f:(fun _ _ -> true)) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] + (exists2_exn [| 0; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x <> y)) + ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] + (exists2_exn [| 0; 2; 4; 8 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x <> y)) + ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] + (exists2_exn [| 2; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x <> y)) + ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] (for_all2_exn [||] [||] ~f:(fun _ _ -> false)) ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] + (for_all2_exn [| 0; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x = y)) + ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] + (for_all2_exn [| 0; 2; 4; 8 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x = y)) + ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] + (for_all2_exn [| 2; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x = y)) + ~expect:false +;; + +let%test_unit _ = [%test_result: bool] (equal ( = ) [||] [||]) ~expect:true +let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1 |] [| 1 |]) ~expect:true +let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1; 2 |] [| 1; 2 |]) ~expect:true +let%test_unit _ = [%test_result: bool] (equal ( = ) [||] [| 1 |]) ~expect:false +let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1 |] [||]) ~expect:false +let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1 |] [| 1; 2 |]) ~expect:false +let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1; 2 |] [| 1; 3 |]) ~expect:false + +let%test_unit _ = + [%test_result: (int * int) option] + (findi [| 1; 2; 3; 4 |] ~f:(fun i x -> i = 2 * x)) + ~expect:None +;; + +let%test_unit _ = + [%test_result: (int * int) option] + (findi [| 1; 2; 1; 4 |] ~f:(fun i x -> i = 2 * x)) + ~expect:(Some (2, 1)) +;; + +let%test_unit _ = + [%test_result: int option] + (find_mapi [| 0; 5; 2; 1; 4 |] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:(Some 0) +;; + +let%test_unit _ = + [%test_result: int option] + (find_mapi [| 3; 5; 2; 1; 4 |] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:(Some 4) +;; + +let%test_unit _ = + [%test_result: int option] + (find_mapi [| 3; 5; 1; 1; 4 |] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:(Some 8) +;; + +let%test_unit _ = + [%test_result: int option] + (find_mapi [| 3; 5; 1; 1; 2 |] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:None +;; + +let%test_unit _ = + List.iter + ~f:(fun (l, expect) -> + let t = of_list l in + assert (Poly.equal expect (find_consecutive_duplicate t ~equal:Poly.equal))) + [ [], None + ; [ 1 ], None + ; [ 1; 1 ], Some (1, 1) + ; [ 1; 2 ], None + ; [ 1; 2; 1 ], None + ; [ 1; 2; 2 ], Some (2, 2) + ; [ 1; 1; 2; 2 ], Some (1, 1) + ] +;; + +let%test_unit _ = [%test_result: int option] (random_element [||]) ~expect:None +let%test_unit _ = [%test_result: int option] (random_element [| 0 |]) ~expect:(Some 0) + +let%test_unit _ = + List.iter + [ [||]; [| 1 |]; [| 1; 2; 3; 4; 5 |] ] + ~f:(fun t -> [%test_result: int array] (Sequence.to_array (to_sequence t)) ~expect:t) +;; + +let test_fold_map array ~init ~f ~expect = + [%test_result: int array] (folding_map array ~init ~f) ~expect:(snd expect); + [%test_result: int * int array] (fold_map array ~init ~f) ~expect +;; + +let test_fold_mapi array ~init ~f ~expect = + [%test_result: int array] (folding_mapi array ~init ~f) ~expect:(snd expect); + [%test_result: int * int array] (fold_mapi array ~init ~f) ~expect +;; + +let%test_unit _ = + test_fold_map + [| 1; 2; 3; 4 |] + ~init:0 + ~f:(fun acc x -> + let y = acc + x in + y, y) + ~expect:(10, [| 1; 3; 6; 10 |]) +;; + +let%test_unit _ = + test_fold_map + [||] + ~init:0 + ~f:(fun acc x -> + let y = acc + x in + y, y) + ~expect:(0, [||]) +;; + +let%test_unit _ = + test_fold_mapi + [| 1; 2; 3; 4 |] + ~init:0 + ~f:(fun i acc x -> + let y = acc + (i * x) in + y, y) + ~expect:(20, [| 0; 2; 8; 20 |]) +;; + +let%test_unit _ = + test_fold_mapi + [||] + ~init:0 + ~f:(fun i acc x -> + let y = acc + (i * x) in + y, y) + ~expect:(0, [||]) +;; + +let%test_module "permute" = + (module struct + module Int_list = struct + type t = int list [@@deriving compare, sexp_of] + + include (val Comparator.make ~compare ~sexp_of_t) + end + + let test_permute initial_contents ~pos ~len = + let all_permutations = + let pos, len = + Ordered_collection_common.get_pos_len_exn + ?pos + ?len + ~total_length:(List.length initial_contents) + () + in + let left = List.take initial_contents pos in + let middle = List.sub initial_contents ~pos ~len in + let right = List.drop initial_contents (pos + len) in + Set.of_list + (module Int_list) + (List_helpers.permutations middle + |> List.map ~f:(fun middle -> left @ middle @ right)) + in + let not_yet_seen = ref all_permutations in + while not (Set.is_empty !not_yet_seen) do + let array = of_list initial_contents in + permute ?pos ?len array; + let permutation = to_list array in + if not (Set.mem all_permutations permutation) + then + raise_s + [%sexp + "invalid permutation" + , { array_length = (List.length initial_contents : int) + ; permutation : int list + ; pos : int option + ; len : int option + }]; + not_yet_seen := Set.remove !not_yet_seen permutation + done + ;; + + let%expect_test "permute different array lengths and subranges" = + let indices = None :: List.map [ 0; 1; 2; 3; 4 ] ~f:Option.some in + for array_length = 0 to 4 do + let initial_contents = List.init array_length ~f:Int.succ in + List.iter indices ~f:(fun pos -> + List.iter indices ~f:(fun len -> + match + Ordered_collection_common.get_pos_len + ?pos + ?len + ~total_length:array_length + () + with + | Ok _ -> test_permute initial_contents ~pos ~len + | Error _ -> + require + [%here] + (Exn.does_raise (fun () -> + permute ?pos ?len (Array.of_list initial_contents))))) + done; + [%expect {| |}] + ;; + end) +;; + +let%expect_test "create_float_uninitialized" = + let array = create_float_uninitialized ~len:10 in + (* make sure reading/writing the array is safe *) + Array.permute array; + (* sanity check without depending on specific contents *) + print_s [%sexp (Array.length array : int)]; + [%expect {| 10 |}] +;; + +module Int_array = struct + type t = int array [@@deriving equal, sexp_of] +end + +module Int_list = struct + type t = int list [@@deriving equal, sexp_of] +end + +let%expect_test "swap" = + let array = [| 0; 1; 2; 3 |] in + print_s [%sexp (array : int array)]; + [%expect {| (0 1 2 3) |}]; + swap array 0 0; + print_s [%sexp (array : int array)]; + [%expect {| (0 1 2 3) |}]; + swap array 0 3; + print_s [%sexp (array : int array)]; + [%expect {| (3 1 2 0) |}] +;; + +let%expect_test "rev and rev_inplace" = + let test ordered_list = + let ordered_array = of_list ordered_list in + let reversed_array = + let array = copy ordered_array in + rev_inplace array; + array + in + require_equal + [%here] + (module Int_list) + (to_list reversed_array) + (List.rev ordered_list); + require_equal [%here] (module Int_array) reversed_array (rev ordered_array); + print_s [%sexp (reversed_array : int array)] + in + test []; + [%expect {| () |}]; + test [ 0 ]; + [%expect {| (0) |}]; + test (List.init 10 ~f:Fn.id); + [%expect {| (9 8 7 6 5 4 3 2 1 0) |}] +;; + +let%expect_test "map_inplace" = + let test list = + let f x = x * x in + let array = of_list list in + map_inplace array ~f; + require_equal [%here] (module Int_list) (to_list array) (List.map list ~f); + print_s [%sexp (array : int array)] + in + test []; + [%expect {| () |}]; + test [ 0 ]; + [%expect {| (0) |}]; + test (List.init 10 ~f:Fn.id); + [%expect {| (0 1 4 9 16 25 36 49 64 81) |}] +;; + +let%expect_test "cartesian_product" = + require [%here] (is_empty (cartesian_product [||] [||])); + require [%here] (is_empty (cartesian_product [||] [| 13 |])); + require [%here] (is_empty (cartesian_product [| 13 |] [||])); + print_s [%sexp (cartesian_product [| 1; 2; 3 |] [| "a"; "b" |] : (int * string) array)]; + [%expect {| + ((1 a) + (1 b) + (2 a) + (2 b) + (3 a) + (3 b)) + |}] +;; + +let%expect_test "create_local" = + let len = 10 in + let array = create_local ~len (-1) in + for i = 0 to len - 1 do + assert (get array i = -1); + set array i i + done; + let array = init len ~f:(fun i -> get array i) in + print_s (sexp_of_t sexp_of_int array); + [%expect {| (0 1 2 3 4 5 6 7 8 9) |}] +;; diff --git a/unikernel/duniverse/base/test/test_array.mli b/unikernel/duniverse/base/test/test_array.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_array.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_array_local.mlt b/unikernel/duniverse/base/test/test_array_local.mlt new file mode 100644 index 00000000..587cc34e --- /dev/null +++ b/unikernel/duniverse/base/test/test_array_local.mlt @@ -0,0 +1,24 @@ +open! Base + +(* first test that we only allow global elements *) +let local_id (local_ x) = x;; + +let k = local_id 42 in +Array.create_local ~len:10 k + +[%%expect + {| +Line _, characters _-_: +Error: This value escapes its region +|}] +;; + +(* then check that the array is indeed local *) +let arr = Array.create_local ~len:10 42 in +ref arr + +[%%expect + {| +Line _, characters _-_: +Error: This value escapes its region +|}] diff --git a/unikernel/duniverse/base/test/test_backtrace.ml b/unikernel/duniverse/base/test/test_backtrace.ml new file mode 100644 index 00000000..5a0cd3dc --- /dev/null +++ b/unikernel/duniverse/base/test/test_backtrace.ml @@ -0,0 +1,14 @@ +open! Import +open! Backtrace + +let%test_unit (_ [@tags "no-js"]) = + let t = get () in + assert (String.length (to_string t) > 0) +;; + +let%expect_test _ = + Backtrace.elide := true; + Stdio.Out_channel.(output_string stdout) + (Sexp.to_string (sexp_of_t (Exn.with_recording false ~f:Exn.most_recent))); + [%expect {| ("") |}] +;; diff --git a/unikernel/duniverse/base/test/test_backtrace.mli b/unikernel/duniverse/base/test/test_backtrace.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_backtrace.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_base.ml b/unikernel/duniverse/base/test/test_base.ml new file mode 100644 index 00000000..c354a848 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base.ml @@ -0,0 +1,17 @@ +open! Import + +let%expect_test _ = + let f x = x * 2 in + let g x = x + 3 in + print_s [%sexp (f @@ 5 : int)]; + [%expect {| 10 |}]; + print_s [%sexp (g @@ f @@ 5 : int)]; + [%expect {| 13 |}]; + print_s [%sexp (f @@ g @@ 5 : int)]; + [%expect {| 16 |}] +;; + +let%expect_test "exp is present at the toplevel" = + print_s [%sexp (2 ** 8 : int)]; + [%expect {| 256 |}] +;; diff --git a/unikernel/duniverse/base/test/test_base.mli b/unikernel/duniverse/base/test/test_base.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_base_containers_mono.ml b/unikernel/duniverse/base/test/test_base_containers_mono.ml new file mode 100644 index 00000000..c750fae0 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base_containers_mono.ml @@ -0,0 +1,142 @@ +open! Import +open Test_container + +(* Tests of containers that are not polymorphic (i.e. have a fixed element type). *) + +include ( + Test_S0 (struct + include String + + let mem t c = mem t c + + module Elt = struct + type t = char [@@deriving sexp] + + let of_int = Char.of_int_exn + let to_int = Char.to_int + end + + let of_list = of_char_list + end) : + sig end) + +let%expect_test "Hash_set" = + Base_container_tests.test_container_s0 + (module struct + open Base_quickcheck + + module Elt = struct + include Int + + type t = (int[@generator Generator.small_strictly_positive_int]) + [@@deriving compare, equal, quickcheck, sexp_of] + end + + include Hash_set + + type t = Hash_set.M(Int).t [@@deriving sexp_of] + + let quickcheck_generator = + Generator.map [%generator: Elt.t list] ~f:(Hash_set.of_list (module Int)) + ;; + + let quickcheck_observer = Observer.unmap [%observer: Elt.t list] ~f:Hash_set.to_list + + let quickcheck_shrinker = + Shrinker.map + [%shrinker: Elt.t list] + ~f:(Hash_set.of_list (module Int)) + ~f_inverse:Hash_set.to_list + ;; + + (* [to_list] and [to_array] proceed in the opposite order as everything else. This + is likely a performance hack to reuse [fold] without adding a [List.rev]. It is + not particularly problematic, since hash table order is already unpredictable due + to hash functions. *) + let to_list t = List.rev (to_list t) + let to_array t = Array.rev (to_array t) + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + |}] +;; + +let%expect_test "String" = + Base_container_tests.test_indexed_container_s0_with_creators + (module struct + include String + + module Elt = struct + type t = char [@@deriving compare, equal, quickcheck, sexp_of] + end + + type t = string [@@deriving quickcheck] + + (* eta-expand due to [local_] types *) + let mem t c = mem t c + + (* leave off the [?sep] argument *) + let concat list = concat list + let concat_map list = concat_map list + let concat_mapi list = concat_mapi list + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + Container: testing [of_list] + Container: testing [of_array] + Container: testing [append] + Container: testing [concat] + Container: testing [map] + Container: testing [filter] + Container: testing [filter_map] + Container: testing [concat_map] + Container: testing [partition_tf] + Container: testing [partition_map] + Container: testing [foldi] + Container: testing [iteri] + Container: testing [existsi] + Container: testing [for_alli] + Container: testing [counti] + Container: testing [findi] + Container: testing [find_mapi] + Container: testing [init] + Container: testing [mapi] + Container: testing [filteri] + Container: testing [filter_mapi] + Container: testing [concat_mapi] + |}] +;; diff --git a/unikernel/duniverse/base/test/test_base_containers_mono.mli b/unikernel/duniverse/base/test/test_base_containers_mono.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base_containers_mono.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_base_containers_poly.ml b/unikernel/duniverse/base/test/test_base_containers_poly.ml new file mode 100644 index 00000000..77b007e7 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base_containers_poly.ml @@ -0,0 +1,227 @@ +open! Import +open Test_container + +(* Tests of containers that are polymorphic over their element type. *) + +include (Test_S1 (Array) : sig end) +include (Test_S1 (List) : sig end) +include (Test_S1 (Queue) : sig end) + +(* Quickcheck-based expect tests *) + +let%expect_test "Array" = + Base_container_tests.test_indexed_container_s1_with_creators + (module struct + include Array + + type 'a t = 'a array [@@deriving quickcheck] + + (* [Array.concat] has a slightly different type than S1 expects *) + let concat array = concat (Array.to_list array) + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + Container: testing [of_list] + Container: testing [of_array] + Container: testing [append] + Container: testing [concat] + Container: testing [map] + Container: testing [filter] + Container: testing [filter_map] + Container: testing [concat_map] + Container: testing [partition_tf] + Container: testing [partition_map] + Container: testing [foldi] + Container: testing [iteri] + Container: testing [existsi] + Container: testing [for_alli] + Container: testing [counti] + Container: testing [findi] + Container: testing [find_mapi] + Container: testing [init] + Container: testing [mapi] + Container: testing [filteri] + Container: testing [filter_mapi] + Container: testing [concat_mapi] + |}] +;; + +let%expect_test "List" = + Base_container_tests.test_indexed_container_s1_with_creators + (module struct + include List + + type 'a t = 'a list [@@deriving quickcheck] + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + Container: testing [of_list] + Container: testing [of_array] + Container: testing [append] + Container: testing [concat] + Container: testing [map] + Container: testing [filter] + Container: testing [filter_map] + Container: testing [concat_map] + Container: testing [partition_tf] + Container: testing [partition_map] + Container: testing [foldi] + Container: testing [iteri] + Container: testing [existsi] + Container: testing [for_alli] + Container: testing [counti] + Container: testing [findi] + Container: testing [find_mapi] + Container: testing [init] + Container: testing [mapi] + Container: testing [filteri] + Container: testing [filter_mapi] + Container: testing [concat_mapi] + |}] +;; + +let%expect_test "Set" = + Base_container_tests.test_container_s0 + (module struct + open Base_quickcheck + + module Elt = struct + include Int + + type t = (int[@generator Generator.small_strictly_positive_int]) + [@@deriving compare, equal, quickcheck, sexp_of] + end + + include Set + + type t = Set.M(Int).t [@@deriving sexp_of] + + let quickcheck_generator = Generator.set_t_m (module Elt) Elt.quickcheck_generator + let quickcheck_observer = Observer.set_t Elt.quickcheck_observer + let quickcheck_shrinker = Shrinker.set_t Elt.quickcheck_shrinker + let min_elt t ~compare:_ = min_elt t + let max_elt t ~compare:_ = max_elt t + + (* [find] and [find_map] use pre-order traversals (root -> left -> right), while all + the other traversals are in-order (left -> root -> right). We patch them up here + to behave like pre-order, while still using [Set.find] and [Set.find_map] for the + searching so we're actually testing those functions. *) + + let rec find t ~f = + match Set.find t ~f with + | None -> None + | Some elt as some -> + let lt, _ = Set.split_lt_ge t elt in + Option.first_some (find lt ~f) some + ;; + + let rec find_map t ~f = + match Set.find_map t ~f:(fun elt -> Option.map (f elt) ~f:(fun x -> elt, x)) with + | None -> None + | Some (elt, x) -> + let lt, _ = Set.split_lt_ge t elt in + Option.first_some (find_map lt ~f) (Some x) + ;; + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + |}] +;; + +let%expect_test "Queue" = + Base_container_tests.test_indexed_container_s1 + (module struct + include Queue + open Base_quickcheck + + let quickcheck_generator quickcheck_generator_elt = + [%generator: elt list] |> Generator.map ~f:Queue.of_list + ;; + + let quickcheck_observer quickcheck_observer_elt = + [%observer: elt list] |> Observer.unmap ~f:Queue.to_list + ;; + + let quickcheck_shrinker quickcheck_shrinker_elt = + [%shrinker: elt list] |> Shrinker.map ~f:Queue.of_list ~f_inverse:Queue.to_list + ;; + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + Container: testing [foldi] + Container: testing [iteri] + Container: testing [existsi] + Container: testing [for_alli] + Container: testing [counti] + Container: testing [findi] + Container: testing [find_mapi] + |}] +;; diff --git a/unikernel/duniverse/base/test/test_base_containers_poly.mli b/unikernel/duniverse/base/test/test_base_containers_poly.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base_containers_poly.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_base_stack.ml b/unikernel/duniverse/base/test/test_base_stack.ml new file mode 100644 index 00000000..a9dc43b3 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base_stack.ml @@ -0,0 +1,22 @@ +open! Import +open Stack +include Test_container.Test_S1 (Stack) +include Test_stack.Test (Test_stack.Debug (Stack)) + +let capacity = capacity +let set_capacity = set_capacity + +let%test_unit _ = + let t = create () in + [%test_result: int] (capacity t) ~expect:0; + set_capacity t (-1); + [%test_result: int] (capacity t) ~expect:0; + set_capacity t 10; + [%test_result: int] (capacity t) ~expect:10; + set_capacity t 0; + [%test_result: int] (capacity t) ~expect:0; + push t (); + set_capacity t 0; + [%test_result: int] (length t) ~expect:1; + [%test_pred: int] (fun c -> c >= 1) (capacity t) +;; diff --git a/unikernel/duniverse/base/test/test_base_stack.mli b/unikernel/duniverse/base/test/test_base_stack.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_base_stack.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_blit.ml b/unikernel/duniverse/base/test/test_blit.ml new file mode 100644 index 00000000..10540751 --- /dev/null +++ b/unikernel/duniverse/base/test/test_blit.ml @@ -0,0 +1,89 @@ +open! Import +open! Blit + +(* This unit test checks that when [blit] calls [unsafe_blit], the slices are valid. + It also checks that [blit] doesn't call [unsafe_blit] when there is a range error. *) +let%test_module _ = + (module struct + let blit_was_called = ref false + let slices_are_valid = ref (Ok ()) + + module B = Make (struct + type t = bool array + + let create ~len = Array.create false ~len + let length = Array.length + + let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len = + blit_was_called := true; + slices_are_valid + := Or_error.try_with (fun () -> + assert (len >= 0); + assert (src_pos >= 0); + assert (src_pos + len <= Array.length src); + assert (dst_pos >= 0); + assert (dst_pos + len <= Array.length dst)); + Array.blit ~src ~src_pos ~dst ~dst_pos ~len + ;; + end) + + let%test_module "Bool" = + (module Test_blit.Test + (struct + type t = bool + + let equal = Bool.equal + let of_bool = Fn.id + end) + (struct + type t = bool array [@@deriving sexp_of] + + let create ~len = Array.create false ~len + let length = Array.length + let get = Array.get + let set = Array.set + end) + (B)) + ;; + + let%test_unit _ = + let opts = [ None; Some (-1); Some 0; Some 1; Some 2 ] in + List.iter [ 0; 1; 2 ] ~f:(fun src -> + List.iter [ 0; 1; 2 ] ~f:(fun dst -> + List.iter opts ~f:(fun src_pos -> + List.iter opts ~f:(fun src_len -> + List.iter opts ~f:(fun dst_pos -> + try + let check f = + blit_was_called := false; + slices_are_valid := Ok (); + match Or_error.try_with f with + | Error _ -> assert (not !blit_was_called) + | Ok () -> ok_exn !slices_are_valid + in + check (fun () -> + B.blito + ~src:(Array.create ~len:src false) + ?src_pos + ?src_len + ~dst:(Array.create ~len:dst false) + ?dst_pos + ()); + check (fun () -> + ignore + (B.subo (Array.create ~len:src false) ?pos:src_pos ?len:src_len + : bool array)) + with + | exn -> + raise_s + [%message + "failure" + (exn : exn) + (src : int) + (src_pos : int option) + (src_len : int option) + (dst : int) + (dst_pos : int option)]))))) + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_blit.mli b/unikernel/duniverse/base/test/test_blit.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_blit.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_bool.ml b/unikernel/duniverse/base/test/test_bool.ml new file mode 100644 index 00000000..3ff43ecf --- /dev/null +++ b/unikernel/duniverse/base/test/test_bool.ml @@ -0,0 +1,47 @@ +open! Import + +let%expect_test "hash coherence" = + check_hash_coherence [%here] (module Bool) [ false; true ]; + [%expect {| |}] +;; + +let%expect_test "Bool.Non_short_circuiting.(||)" = + let ( || ) = Bool.Non_short_circuiting.( || ) in + assert (true || true); + assert (true || false); + assert (false || true); + assert (not (false || false)); + assert ( + true + || + (print_endline "rhs"; + true)); + [%expect {| rhs |}]; + assert ( + false + || + (print_endline "rhs"; + true)); + [%expect {| rhs |}] +;; + +let%expect_test "Bool.Non_short_circuiting.(&&)" = + let ( && ) = Bool.Non_short_circuiting.( && ) in + assert (true && true); + assert (not (true && false)); + assert (not (false && true)); + assert (not (false && false)); + assert ( + true + && + (print_endline "rhs"; + true)); + [%expect {| rhs |}]; + assert ( + not + (false + && + (print_endline "rhs"; + true))); + [%expect {| rhs |}] +;; diff --git a/unikernel/duniverse/base/test/test_bool.mli b/unikernel/duniverse/base/test/test_bool.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_bool.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_bytes.ml b/unikernel/duniverse/base/test/test_bytes.ml new file mode 100644 index 00000000..e6cf1775 --- /dev/null +++ b/unikernel/duniverse/base/test/test_bytes.ml @@ -0,0 +1,106 @@ +open! Import +open! Bytes + +let%test_module "Blit" = + (module Test_blit.Test + (struct + include Char + + let of_bool b = if b then 'a' else 'b' + end) + (struct + include Bytes + + let create ~len = create len + end) + (Bytes)) +;; + +let%expect_test "local" = + let bytes = Bytes.create_local 10 in + printf "%d\n" (Bytes.length bytes); + [%expect {| 10 |}]; + for i = 0 to 9 do + Bytes.set bytes i (Int.to_string i).[0] + done; + let string = Bytes.unsafe_to_string ~no_mutation_while_string_reachable:bytes in + for i = 0 to 9 do + printf "%c" string.[i] + done; + [%expect {| 0123456789 |}]; + Expect_test_helpers_base.require_does_raise [%here] (fun () -> + ignore (Bytes.create_local (Sys.max_string_length + 1) : Bytes.t)); + [%expect {| (Invalid_argument Bytes.create_local) |}] +;; + +let%test_module "Unsafe primitives" = + (module struct + let%expect_test "16-bit primitives" = + let buffer = create 10 in + (* Ensure that writing the biggest possible 16-bit value works. *) + Bytes.unsafe_set_int16 buffer 2 0xFFFF; + printf "0x%04x" (Bytes.unsafe_get_int16 buffer 2); + [%expect {| 0xffff |}]; + (* Ensure that [16-bit] operations are indeed 16-bit, meaning it doesn't affect + anything other than x[pos] and x[pos + 1]. *) + Bytes.unsafe_set_int16 buffer 4 0; + Bytes.unsafe_set_int16 buffer 2 ((1 lsl 16) + 1); + printf "0x%04x" (Bytes.unsafe_get_int16 buffer 2); + [%expect {| 0x0001 |}]; + printf "0x%04x" (Bytes.unsafe_get_int16 buffer 4); + [%expect {| 0x0000 |}] + ;; + + let%expect_test "32-bit primitives" = + let buffer = create 10 in + Bytes.unsafe_set_int32 buffer 0 0xdeadbeefl; + printf "%lx" (Bytes.unsafe_get_int32 buffer 0); + [%expect {| deadbeef |}]; + (* Ensure that Bytes.get will retrieve the individual positions byte values as + written by Bytes.unsafe_set_int32. *) + for i = 0 to 3 do + let chr = Bytes.get buffer i in + printf "buffer[%d] = 0x%02x\n" i (Char.to_int chr) + done; + [%expect + {| + buffer[0] = 0xef + buffer[1] = 0xbe + buffer[2] = 0xad + buffer[3] = 0xde + |}]; + (* Ensure that 32-bit writes works on non-word-aligned positions. *) + Bytes.unsafe_set_int32 buffer 1 178293l; + printf "%ld" (Bytes.unsafe_get_int32 buffer 1); + [%expect {| 178293 |}] + ;; + + let%expect_test "64-bit primitives" = + let buffer = create 10 in + Bytes.unsafe_set_int64 buffer 0 0x12345678_deadbeefL; + printf "%Lx" (Bytes.unsafe_get_int64 buffer 0); + [%expect {| 12345678deadbeef |}]; + (* Ensure that Bytes.get will retrieve the individual positions byte values as + written by Bytes.unsafe_set_int64. *) + for i = 0 to 7 do + let chr = Bytes.get buffer i in + printf "buffer[%d] = 0x%02x\n" i (Char.to_int chr) + done; + [%expect + {| + buffer[0] = 0xef + buffer[1] = 0xbe + buffer[2] = 0xad + buffer[3] = 0xde + buffer[4] = 0x78 + buffer[5] = 0x56 + buffer[6] = 0x34 + buffer[7] = 0x12 + |}]; + (* Ensure that 64-bit writes works on non-word-aligned positions. *) + Bytes.unsafe_set_int64 buffer 1 0x12345678_deadbeefL; + printf "%Lx" (Bytes.unsafe_get_int64 buffer 1); + [%expect {| 12345678deadbeef |}] + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_bytes.mli b/unikernel/duniverse/base/test/test_bytes.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_bytes.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_char.ml b/unikernel/duniverse/base/test/test_char.ml new file mode 100644 index 00000000..3c993390 --- /dev/null +++ b/unikernel/duniverse/base/test/test_char.ml @@ -0,0 +1,160 @@ +open! Import +open! Char + +let%test _ = not (is_whitespace '\008') + +(* backspace *) +let%test _ = is_whitespace '\009' + +(* '\t': horizontal tab *) +let%test _ = is_whitespace '\010' + +(* '\n': line feed *) +let%test _ = is_whitespace '\011' + +(* '\v': vertical tab *) +let%test _ = is_whitespace '\012' + +(* '\f': form feed *) +let%test _ = is_whitespace '\013' + +(* '\r': carriage return *) +let%test _ = not (is_whitespace '\014') + +(* shift out *) +let%test _ = is_whitespace '\032' + +(* space *) + +let%expect_test "hash coherence" = + check_hash_coherence [%here] (module Char) [ min_value; 'a'; max_value ]; + [%expect {| |}] +;; + +let%test_module "int to char conversion" = + (module struct + let%test_unit "of_int bounds" = + let bounds_check i = + [%test_result: t option] (of_int i) ~expect:None ~message:(Int.to_string i) + in + for i = 1 to 100 do + bounds_check (-i); + bounds_check (255 + i) + done + ;; + + let%test_unit "of_int_exn vs of_int" = + for i = -100 to 300 do + [%test_eq: t option] + (of_int i) + (Option.try_with (fun () -> of_int_exn i)) + ~message:(Int.to_string i) + done + ;; + + let%test_unit "unsafe_of_int vs of_int_exn" = + for i = 0 to 255 do + [%test_eq: t] (unsafe_of_int i) (of_int_exn i) ~message:(Int.to_string i) + done + ;; + end) +;; + +let%expect_test "all" = + Ref.set_temporarily sexp_style To_string_hum ~f:(fun () -> + print_s [%sexp (all : t list)]); + [%expect + {| + ("\000" "\001" "\002" "\003" "\004" "\005" "\006" "\007" "\b" "\t" "\n" + "\011" "\012" "\r" "\014" "\015" "\016" "\017" "\018" "\019" "\020" "\021" + "\022" "\023" "\024" "\025" "\026" "\027" "\028" "\029" "\030" "\031" " " ! + "\"" # $ % & ' "(" ")" * + , - . / 0 1 2 3 4 5 6 7 8 9 : ";" < = > ? @ A B C + D E F G H I J K L M N O P Q R S T U V W X Y Z [ "\\" ] ^ _ ` a b c d e f g h + i j k l m n o p q r s t u v w x y z { | } ~ "\127" "\128" "\129" "\130" + "\131" "\132" "\133" "\134" "\135" "\136" "\137" "\138" "\139" "\140" "\141" + "\142" "\143" "\144" "\145" "\146" "\147" "\148" "\149" "\150" "\151" "\152" + "\153" "\154" "\155" "\156" "\157" "\158" "\159" "\160" "\161" "\162" "\163" + "\164" "\165" "\166" "\167" "\168" "\169" "\170" "\171" "\172" "\173" "\174" + "\175" "\176" "\177" "\178" "\179" "\180" "\181" "\182" "\183" "\184" "\185" + "\186" "\187" "\188" "\189" "\190" "\191" "\192" "\193" "\194" "\195" "\196" + "\197" "\198" "\199" "\200" "\201" "\202" "\203" "\204" "\205" "\206" "\207" + "\208" "\209" "\210" "\211" "\212" "\213" "\214" "\215" "\216" "\217" "\218" + "\219" "\220" "\221" "\222" "\223" "\224" "\225" "\226" "\227" "\228" "\229" + "\230" "\231" "\232" "\233" "\234" "\235" "\236" "\237" "\238" "\239" "\240" + "\241" "\242" "\243" "\244" "\245" "\246" "\247" "\248" "\249" "\250" "\251" + "\252" "\253" "\254" "\255") + |}] +;; + +let%expect_test "predicates" = + Ref.set_temporarily sexp_style To_string_hum ~f:(fun () -> + print_s [%sexp (List.filter all ~f:is_digit : t list)]; + [%expect {| (0 1 2 3 4 5 6 7 8 9) |}]; + print_s [%sexp (List.filter all ~f:is_lowercase : t list)]; + [%expect {| (a b c d e f g h i j k l m n o p q r s t u v w x y z) |}]; + print_s [%sexp (List.filter all ~f:is_uppercase : t list)]; + [%expect {| (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) |}]; + print_s [%sexp (List.filter all ~f:is_alpha : t list)]; + [%expect + {| + (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l + m n o p q r s t u v w x y z) + |}]; + print_s [%sexp (List.filter all ~f:is_alphanum : t list)]; + [%expect + {| + (0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b + c d e f g h i j k l m n o p q r s t u v w x y z) + |}]; + print_s [%sexp (List.filter all ~f:is_print : t list)]; + [%expect + {| + (" " ! "\"" # $ % & ' "(" ")" * + , - . / 0 1 2 3 4 5 6 7 8 9 : ";" < = > ? @ + A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ "\\" ] ^ _ ` a b c d e + f g h i j k l m n o p q r s t u v w x y z { | } ~) + |}]; + print_s [%sexp (List.filter all ~f:is_whitespace : t list)]; + [%expect {| ("\t" "\n" "\011" "\012" "\r" " ") |}]; + print_s [%sexp (List.filter all ~f:is_hex_digit : t list)]; + [%expect {| (0 1 2 3 4 5 6 7 8 9 A B C D E F a b c d e f) |}]; + print_s [%sexp (List.filter all ~f:is_hex_digit_lower : t list)]; + [%expect {| (0 1 2 3 4 5 6 7 8 9 a b c d e f) |}]; + print_s [%sexp (List.filter all ~f:is_hex_digit_upper : t list)]; + [%expect {| (0 1 2 3 4 5 6 7 8 9 A B C D E F) |}]) +;; + +let%expect_test "get_hex_digit" = + Ref.set_temporarily sexp_style To_string_hum ~f:(fun () -> + let hex_digit_alist = + List.filter_map Char.all ~f:(fun char -> + Option.map (get_hex_digit char) ~f:(fun digit -> char, digit)) + in + print_s [%sexp (hex_digit_alist : (char * int) list)]; + [%expect + {| + ((0 0) (1 1) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (A 10) (B 11) + (C 12) (D 13) (E 14) (F 15) (a 10) (b 11) (c 12) (d 13) (e 14) (f 15)) + |}]; + require_equal + [%here] + (module struct + type t = (char * int) list [@@deriving equal, sexp_of] + end) + (Char.all + |> List.filter ~f:is_hex_digit + |> List.map ~f:(fun char -> char, get_hex_digit_exn char)) + hex_digit_alist; + [%expect {| |}]; + require_does_raise [%here] (fun () -> get_hex_digit_exn Char.min_value); + [%expect {| ("Char.get_hex_digit_exn: not a hexadecimal digit" (char "\000")) |}]) +;; + +let%test_module "Caseless Comparable" = + (module struct + (* examples from docs *) + let%test _ = Caseless.equal 'A' 'a' + let%test _ = Caseless.('a' < 'B') + let%test _ = Int.( <> ) (Caseless.compare 'a' 'B') (compare 'a' 'B') + let%test _ = List.is_sorted ~compare:Caseless.compare [ 'A'; 'b'; 'C' ] + end) +;; diff --git a/unikernel/duniverse/base/test/test_char.mli b/unikernel/duniverse/base/test/test_char.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_char.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_clz_ctz.ml b/unikernel/duniverse/base/test/test_clz_ctz.ml new file mode 100644 index 00000000..3d88ddd2 --- /dev/null +++ b/unikernel/duniverse/base/test/test_clz_ctz.ml @@ -0,0 +1,112 @@ +open! Import + +module E = struct + type t = + { clz : int + ; ctz : int + } + [@@deriving compare, sexp_of] +end + +module type T = sig + type t [@@deriving sexp_of] + + val one : t + val ( lsl ) : t -> int -> t + val clz : t -> int + val ctz : t -> int + val num_bits : int +end + +module Make (Int : T) = struct + let%expect_test "one-hot" = + let clz_and_ctz int = { E.clz = Int.clz int; ctz = Int.ctz int } in + for i = 0 to Int.num_bits - 1 do + [%test_result: E.t] + ~expect:{ E.clz = Int.num_bits - 1 - i; ctz = i } + (clz_and_ctz Int.(one lsl i)) + done + ;; +end + +include Make (Nativeint) +include Make (Int63) +include Make (Int63.Private.Emul) + +include Make (struct + include Int + + let%expect_test "zero" = + (* [clz 0] is guaranteed to be num_bits for int. We compute clz on the tagged + representation of int's, and the binary representation of the int [0] is + num_bits 0's followed by a 1 (the tag bit). *) + [%test_result: int] ~expect:num_bits (clz 0) + ;; + + (* [ctz 0] is unspecified. On linux it seems to be stable and equal to the system + word size (which is num_bits + 1). + ran 2019-02-11 on linux: + {v + [%test_result: int] ~expect:(num_bits + 1) (ctz 0) + v} + + in javascript, it is 32 (which is num_bits): + ran 2019-02-11 on javascript: + {v + [%test_result: int] ~expect:(num_bits) (ctz 0) + v} + *) +end) + +include Make (struct + include Int32 + + let clz_and_ctz i32 = { E.clz = clz i32; ctz = ctz i32 } + + let%expect_test "extra examples" = + [%test_result: E.t] ~expect:{ clz = 31; ctz = 0 } (clz_and_ctz 0b1l); + [%test_result: E.t] ~expect:{ clz = 30; ctz = 1 } (clz_and_ctz 0b10l); + [%test_result: E.t] ~expect:{ clz = 30; ctz = 0 } (clz_and_ctz 0b11l); + [%test_result: E.t] ~expect:{ clz = 25; ctz = 1 } (clz_and_ctz 0b1000010l); + [%test_result: E.t] + ~expect:{ clz = 8; ctz = 6 } + (clz_and_ctz 0b100000010000001001000000l); + [%test_result: E.t] + ~expect:{ clz = 0; ctz = 31 } + (clz_and_ctz 0b10000000000000000000000000000000l); + [%test_result: E.t] + ~expect:{ clz = 9; ctz = 6 } + (clz_and_ctz 0b00000000010000000100000001000000l); + [%test_result: E.t] + ~expect:{ clz = 0; ctz = 6 } + (clz_and_ctz 0b10000000010000000100000001000000l) + ;; +end) + +include Make (struct + include Int64 + + let clz_and_ctz i64 = { E.clz = clz i64; ctz = ctz i64 } + + let%expect_test "extra examples" = + [%test_result: E.t] ~expect:{ clz = 63; ctz = 0 } (clz_and_ctz 0b1L); + [%test_result: E.t] ~expect:{ clz = 62; ctz = 1 } (clz_and_ctz 0b10L); + [%test_result: E.t] ~expect:{ clz = 62; ctz = 0 } (clz_and_ctz 0b11L); + [%test_result: E.t] ~expect:{ clz = 57; ctz = 1 } (clz_and_ctz 0b1000010L); + [%test_result: E.t] + ~expect:{ clz = 40; ctz = 6 } + (clz_and_ctz 0b100000010000001001000000L); + [%test_result: E.t] + ~expect:{ clz = 0; ctz = 63 } + (clz_and_ctz 0b1000000000000000000000000000000000000000000000000000000000000000L); + [%test_result: E.t] + ~expect:{ clz = 32; ctz = 31 } + (clz_and_ctz 0b0000000000000000000000000000000010000000000000000000000000000000L); + [%test_result: E.t] + ~expect:{ clz = 32; ctz = 6 } + (clz_and_ctz 0b0000000000000000000000000000000010000000010000000100000001000000L); + [%test_result: E.t] + ~expect:{ clz = 33; ctz = 6 } + (clz_and_ctz 0b0000000000000000000000000000000001000000010000000100000001000000L) + ;; +end) diff --git a/unikernel/duniverse/base/test/test_clz_ctz.mli b/unikernel/duniverse/base/test/test_clz_ctz.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_clz_ctz.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_compare.ml b/unikernel/duniverse/base/test/test_compare.ml new file mode 100644 index 00000000..1a2b3fbd --- /dev/null +++ b/unikernel/duniverse/base/test/test_compare.ml @@ -0,0 +1,176 @@ +open! Base +open Expect_test_helpers_base + +module type S = sig + type t [@@deriving sexp_of] + + include Comparable.Comparisons with type t := t +end + +(* Test the consistency of derived comparison operators with [compare] because many of + them are hand-optimized in [Base]. *) +let test (type a) here (module T : S with type t = a) list = + let op (type b) (module Result : S with type t = b) operator ~actual ~expect = + With_return.with_return (fun failed -> + List.iter list ~f:(fun arg1 -> + List.iter list ~f:(fun arg2 -> + let actual = actual arg1 arg2 in + let expect = expect arg1 arg2 in + if not (Result.compare actual expect = 0) + then ( + print_cr + here + [%message + "comparison failed" + (operator : string) + (arg1 : T.t) + (arg2 : T.t) + (actual : Result.t) + (expect : Result.t)]; + failed.return ())))) + in + let module C = Comparable.Make (T) in + op (module Bool) "equal" ~actual:T.equal ~expect:C.equal; + op (module T) "min" ~actual:T.min ~expect:C.min; + op (module T) "max" ~actual:T.max ~expect:C.max; + op (module Bool) "(=)" ~actual:T.( = ) ~expect:C.( = ); + op (module Bool) "(<)" ~actual:T.( < ) ~expect:C.( < ); + op (module Bool) "(>)" ~actual:T.( > ) ~expect:C.( > ); + op (module Bool) "(<>)" ~actual:T.( <> ) ~expect:C.( <> ); + op (module Bool) "(<=)" ~actual:T.( <= ) ~expect:C.( <= ); + op (module Bool) "(>=)" ~actual:T.( >= ) ~expect:C.( >= ); + op + (module Bool) + "Comparable.equal" + ~actual:(fun a b -> Comparable.equal T.compare a b) + ~expect:C.equal; + op + (module T) + "Comparable.min" + ~actual:(fun a b -> Comparable.min T.compare a b) + ~expect:C.min; + op + (module T) + "Comparable.max" + ~actual:(fun a b -> Comparable.max T.compare a b) + ~expect:C.max +;; + +let%expect_test "Base" = + test + [%here] + (module struct + include Base + + type t = int [@@deriving sexp_of] + end) + Int.[ min_value; minus_one; zero; one; max_value ]; + [%expect {| |}] +;; + +let%expect_test "Unit" = + test [%here] (module Unit) Unit.all; + [%expect {| |}] +;; + +let%expect_test "Bool" = + test [%here] (module Bool) Bool.all; + [%expect {| |}] +;; + +let%expect_test "Char" = + test [%here] (module Char) Char.all; + [%expect {| |}] +;; + +let%expect_test "Float" = + test [%here] (module Float) Float.[ min_value; minus_one; zero; one; max_value ]; + [%expect {| |}] +;; + +let%expect_test "Int" = + test [%here] (module Int) Int.[ min_value; minus_one; zero; one; max_value ]; + [%expect {| |}] +;; + +let%expect_test "Int32" = + test [%here] (module Int32) Int32.[ min_value; minus_one; zero; one; max_value ]; + [%expect {| |}] +;; + +let%expect_test "Int64" = + test [%here] (module Int64) Int64.[ min_value; minus_one; zero; one; max_value ]; + [%expect {| |}] +;; + +let%expect_test "Nativeint" = + test [%here] (module Nativeint) Nativeint.[ min_value; minus_one; zero; one; max_value ]; + [%expect {| |}] +;; + +let%expect_test "Int63" = + test [%here] (module Int63) Int63.[ min_value; minus_one; zero; one; max_value ]; + [%expect {| |}] +;; + +let%test_module "lexicographic" = + (module struct + let%expect_test "single" = + Ref.set_temporarily sexp_style To_string_hum ~f:(fun () -> + List.iter + [ 1, 2; 1, 1; 2, 1 ] + ~f:(fun (a, b) -> + let ordering = Ordering.of_int (compare a b) in + print_s [%message (a : int) (b : int) (ordering : Ordering.t)]; + require_equal + [%here] + (module Ordering) + (Ordering.of_int (compare a b)) + (Ordering.of_int (Comparable.lexicographic [ compare ] a b))); + [%expect + {| + ((a 1) (b 2) (ordering Less)) + ((a 1) (b 1) (ordering Equal)) + ((a 2) (b 1) (ordering Greater)) + |}]) + ;; + + let%expect_test "three comparisons" = + Ref.set_temporarily sexp_style To_string_hum ~f:(fun () -> + let compare_first_three_elts a_1 b_1 = + Comparable.lexicographic + (List.init 3 ~f:(fun i a b -> compare a.(i) b.(i))) + a_1 + b_1 + in + let test a b = + let a = Array.of_list a in + let b = Array.of_list b in + let ordering = Ordering.of_int (compare_first_three_elts a b) in + print_s [%message (a : int array) (b : int array) (ordering : Ordering.t)] + in + test [ 1; 2; 3; 4 ] [ 1; 2; 4; 9 ]; + [%expect {| ((a (1 2 3 4)) (b (1 2 4 9)) (ordering Less)) |}]; + test [ 1; 2; 3; 4 ] [ 1; 2; 3; 9 ]; + [%expect {| ((a (1 2 3 4)) (b (1 2 3 9)) (ordering Equal)) |}]; + test [ 1; 2; 3; 4 ] [ 1; 1; 4; 9 ]; + [%expect {| ((a (1 2 3 4)) (b (1 1 4 9)) (ordering Greater)) |}]) + ;; + end) +;; + +let%expect_test "reversed" = + let list = [ 3; 1; 4; 1; 5; 9; 2; 6; 5; 3; 5; 9 ] in + let sort_asc1 = List.sort ~compare:[%compare: int] list in + let sort_desc = List.sort ~compare:[%compare: int Comparable.reversed] list in + let sort_asc2 = + List.sort ~compare:[%compare: int Comparable.reversed Comparable.reversed] list + in + print_s [%message (sort_asc1 : int list) (sort_desc : int list) (sort_asc2 : int list)]; + [%expect + {| + ((sort_asc1 (1 1 2 3 3 4 5 5 5 6 9 9)) + (sort_desc (9 9 6 5 5 5 4 3 3 2 1 1)) + (sort_asc2 (1 1 2 3 3 4 5 5 5 6 9 9))) + |}] +;; diff --git a/unikernel/duniverse/base/test/test_compare.mli b/unikernel/duniverse/base/test/test_compare.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_compare.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_container_module_types.ml b/unikernel/duniverse/base/test/test_container_module_types.ml new file mode 100644 index 00000000..771dea26 --- /dev/null +++ b/unikernel/duniverse/base/test/test_container_module_types.ml @@ -0,0 +1,227 @@ +(** This file tests the consistency of [Container] and [Indexed_container] module types. + + We compare each module type S to the most generic version G that exports the same set + of values. We create a module type I by instantiating G to mimic S, such as by + dropping a type parameter. We then test that S = I by writing two identity functors, + one from S to I and one from I to S. *) + +open! Base + +module _ : module type of Container = struct + (* The most generic interface that everything else implements. *) + module type Generic = Container.Generic + + (* The generic interface with creator functions. Ensure it implements Generic. *) + module type Generic_with_creators = Container.Generic_with_creators + + module _ (M : Container.Generic_with_creators) : Container.Generic = M + + (* Ensure that S0 is Generic with no type arguments. *) + module type S0 = Container.S0 + + open struct + module type Generic0 = sig + type elt + type t + + include Generic with type _ elt := elt and type (_, _, _) t := t + + val mem : t -> elt -> bool + end + end + + module _ (M : S0) : Generic0 = M + module _ (M : Generic0) : S0 = M + + (* Ensure that S0_phantom is Generic with a fixed element type. *) + module type S0_phantom = Container.S0_phantom + + open struct + module type Generic0_phantom = sig + type elt + type _ t + + include Container.Generic with type _ elt := elt and type (_, 'p, _) t := 'p t + + val mem : _ t -> elt -> bool + end + end + + module _ (M : S0_phantom) : Generic0_phantom = M + module _ (M : Generic0_phantom) : S0_phantom = M + + (* Ensure that S0_with_creators is Generic_with_creators with no type arguments. *) + module type S0_with_creators = Container.S0_with_creators + + open struct + module type Generic0_with_creators = sig + type elt + type t + + include + Generic_with_creators + with type _ elt := elt + and type (_, _, _) t := t + and type ('a, _, _) concat := 'a list + + val mem : t -> elt -> bool + end + end + + module _ (M : S0_with_creators) : Generic0_with_creators = M + module _ (M : Generic0_with_creators) : S0_with_creators = M + + (* Ensure that S1 is Generic with no phantom type. *) + module type S1 = Container.S1 + + open struct + module type Generic1 = sig + type _ t + + include Container.Generic with type 'a elt := 'a and type ('a, _, _) t := 'a t + end + end + + module _ (M : S1) : Generic1 = M + module _ (M : Generic1) : S1 = M + + (* Ensure that S1_phantom is Generic with a covariant phantom type. *) + module type S1_phantom = Container.S1_phantom + + open struct + module type Generic1_phantom = sig + type (_, _) t + + include Generic with type 'a elt := 'a and type ('a, 'p, _) t := ('a, 'p) t + end + end + + module _ (M : S1_phantom) : Generic1_phantom = M + module _ (M : Generic1_phantom) : S1_phantom = M + + (* Ensure that S1_with_creators is Generic_with_creators with no phantom type. *) + module type S1_with_creators = Container.S1_with_creators + + open struct + module type Generic1_with_creators = sig + type 'a t + + include + Generic_with_creators + with type 'a elt := 'a + and type ('a, _, _) t := 'a t + and type ('a, _, _) concat := 'a t + end + end + + module _ (M : S1_with_creators) : Generic1_with_creators = M + module _ (M : Generic1_with_creators) : S1_with_creators = M + + (* Other definitions that we are not testing: *) + + module Continue_or_stop = Container.Continue_or_stop + module Make = Container.Make + module Make0 = Container.Make0 + module Make_gen = Container.Make_gen + module Make_with_creators = Container.Make_with_creators + module Make0_with_creators = Container.Make0_with_creators + module Make_gen_with_creators = Container.Make_gen_with_creators + + module type Derived = Container.Derived + module type Summable = Container.Summable + + include (Container : Derived) +end + +module _ : module type of Indexed_container = struct + (* The generic interface everything else implements. *) + module type Generic = Indexed_container.Generic + + (* Ensure that S0 is Generic without type parameters. *) + module type S0 = Indexed_container.S0 + + open struct + module type Generic0 = sig + type elt + type t + + include Generic with type _ elt := elt and type (_, _, _) t := t + + val mem : t -> elt -> bool + end + end + + module _ (M : S0) : Generic0 = M + module _ (M : Generic0) : S0 = M + + (* Ensure that S1 is Generic without an abstract element type. *) + module type S1 = Indexed_container.S1 + + open struct + module type Generic1 = sig + type 'a t + + include Generic with type 'a elt := 'a and type ('a, _, _) t := 'a t + end + end + + module _ (M : S1) : Generic1 = M + module _ (M : Generic1) : S1 = M + + (* Ensure that Generic_with_creators includes Generic. *) + module type Generic_with_creators = Indexed_container.Generic_with_creators + + module _ (M : Indexed_container.Generic_with_creators) : Indexed_container.Generic = M + + (* Ensure that S0_with_creators is Generic_with_creators with no type arguments. *) + module type S0_with_creators = Indexed_container.S0_with_creators + + open struct + module type Generic0_with_creators = sig + type elt + type t + + include + Generic_with_creators + with type _ elt := elt + and type (_, _, _) t := t + and type ('a, _, _) concat := 'a list + + val mem : t -> elt -> bool + end + end + + module _ (M : S0_with_creators) : Generic0_with_creators = M + module _ (M : Generic0_with_creators) : S0_with_creators = M + + (* Ensure that S1_with_creators is Generic_with_creators with no phantom type. *) + module type S1_with_creators = Indexed_container.S1_with_creators + + open struct + module type Generic1_with_creators = sig + type 'a t + + include + Generic_with_creators + with type 'a elt := 'a + and type ('a, _, _) t := 'a t + and type ('a, _, _) concat := 'a t + end + end + + module _ (M : S1_with_creators) : Generic1_with_creators = M + module _ (M : Generic1_with_creators) : S1_with_creators = M + + (* Other definitions that we are not testing: *) + + module Make = Indexed_container.Make + module Make0 = Indexed_container.Make0 + module Make_gen = Indexed_container.Make_gen + module Make_with_creators = Indexed_container.Make_with_creators + module Make0_with_creators = Indexed_container.Make0_with_creators + module Make_gen_with_creators = Indexed_container.Make_gen_with_creators + + module type Derived = Indexed_container.Derived + + include (Indexed_container : Derived) +end diff --git a/unikernel/duniverse/base/test/test_container_module_types.mli b/unikernel/duniverse/base/test/test_container_module_types.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_container_module_types.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_dictionary_module_types.ml b/unikernel/duniverse/base/test/test_dictionary_module_types.ml new file mode 100644 index 00000000..934601d2 --- /dev/null +++ b/unikernel/duniverse/base/test/test_dictionary_module_types.ml @@ -0,0 +1,225 @@ +(** This file tests the consistency of [Dictionary_immutable] module types. + + We compare each module type S to the most generic version G that exports the same set + of values. We create a module type I by instantiating G to mimic S, such as by + dropping a type parameter. We then test that S = I by writing two identity functors, + one from S to I and one from I to S. *) + +open! Base + +module _ : module type of Dictionary_immutable = struct + (* The generic interface for accessors. *) + module type Accessors = Dictionary_immutable.Accessors + + (* Ensure that Accessors1 is Accessors with only a data type argument. *) + module type Accessors1 = Dictionary_immutable.Accessors1 + + open struct + module type Accessors_instance1 = sig + type key + type 'data t + + include + Accessors + with type _ key := key + and type (_, 'data, _) t := 'data t + and type ('fn, _, _, _) accessor := 'fn + end + end + + module _ (M : Accessors1) : Accessors_instance1 = M + module _ (M : Accessors_instance1) : Accessors1 = M + + (* Ensure that Accessors2 is Accessors with no phantom type argument. *) + module type Accessors2 = Dictionary_immutable.Accessors2 + + open struct + module type Accessors_instance2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) accessor + + include + Accessors + with type 'key key := 'key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + end + end + + module _ (M : Accessors2) : Accessors_instance2 = M + module _ (M : Accessors_instance2) : Accessors2 = M + + (* Ensure that Accessors3 is Accessors with no [key] type. *) + module type Accessors3 = Dictionary_immutable.Accessors3 + + open struct + module type Accessors_instance3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + + include + Accessors + with type 'key key := 'key + and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + end + end + + module _ (M : Accessors3) : Accessors_instance3 = M + module _ (M : Accessors_instance3) : Accessors3 = M + + (* The generic interface for creators. *) + module type Creators = Dictionary_immutable.Creators + + (* Ensure that Creators1 is Creators with only a data type argument. *) + module type Creators1 = Dictionary_immutable.Creators1 + + open struct + module type Creators_instance1 = sig + type key + type 'data t + + include + Creators + with type _ key := key + and type (_, 'data, _) t := 'data t + and type ('fn, _, _, _) creator := 'fn + end + end + + module _ (M : Creators1) : Creators_instance1 = M + module _ (M : Creators_instance1) : Creators1 = M + + (* Ensure that Creators2 is Creators with no phantom type argument. *) + module type Creators2 = Dictionary_immutable.Creators2 + + open struct + module type Creators_instance2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) creator + + include + Creators + with type 'key key := 'key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + end + end + + module _ (M : Creators2) : Creators_instance2 = M + module _ (M : Creators_instance2) : Creators2 = M + + (* Ensure that Creators3 is Creators with no [key] type. *) + module type Creators3 = Dictionary_immutable.Creators3 + + open struct + module type Creators_instance3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) creator + + include + Creators + with type 'key key := 'key + and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end + end + + module _ (M : Creators3) : Creators_instance3 = M + module _ (M : Creators_instance3) : Creators3 = M + + (* The generic type for creators + accessors. *) + module type S = Dictionary_immutable.S + + open struct + module type Creators_and_accessors = sig + type 'key key + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + type ('fn, 'key, 'data, 'phantom) creator + + include + Accessors + with type 'key key := 'key key + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + with type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + + include + Creators + with type 'key key := 'key key + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + with type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end + end + + module _ (M : S) : Creators_and_accessors = M + module _ (M : Creators_and_accessors) : S = M + + (* Ensure that S1 is S with only a data type argument. *) + module type S1 = Dictionary_immutable.S1 + + open struct + module type S_instance1 = sig + type key + type 'data t + + include + S + with type _ key := key + and type (_, 'data, _) t := 'data t + and type ('fn, _, _, _) accessor := 'fn + and type ('fn, _, _, _) creator := 'fn + end + end + + module _ (M : S1) : S_instance1 = M + module _ (M : S_instance1) : S1 = M + + (* Ensure that S2 is S with no phantom type argument. *) + module type S2 = Dictionary_immutable.S2 + + open struct + module type S_instance2 = sig + type ('key, 'data) t + type ('fn, 'key, 'data) accessor + type ('fn, 'key, 'data) creator + + include + S + with type 'key key := 'key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + end + end + + module _ (M : S2) : S_instance2 = M + module _ (M : S_instance2) : S2 = M + + (* Ensure that S3 is S with no [key] type. *) + module type S3 = Dictionary_immutable.S3 + + open struct + module type S_instance3 = sig + type ('key, 'data, 'phantom) t + type ('fn, 'key, 'data, 'phantom) accessor + type ('fn, 'key, 'data, 'phantom) creator + + include + S + with type 'key key := 'key + and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator + end + end + + module _ (M : S3) : S_instance3 = M + module _ (M : S_instance3) : S3 = M +end diff --git a/unikernel/duniverse/base/test/test_dictionary_module_types.mli b/unikernel/duniverse/base/test/test_dictionary_module_types.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_dictionary_module_types.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_either.ml b/unikernel/duniverse/base/test/test_either.ml new file mode 100644 index 00000000..6257db5d --- /dev/null +++ b/unikernel/duniverse/base/test/test_either.ml @@ -0,0 +1,100 @@ +open! Import + +type t = (int, string) Either.t [@@deriving sexp_of] + +let f : t = First 0 +let s : t = Second "str" + +let%expect_test "First.Monad.map" = + let open Either.First.Let_syntax in + let inc x = + let%map v = x in + v + 1 + in + let f' = inc f in + let s' = inc s in + print_s [%message (f' : t) (s' : t)]; + [%expect {| + ((f' (First 1)) + (s' (Second str))) + |}] +;; + +let%expect_test "Second.Monad.map" = + let open Either.Second.Let_syntax in + let add x = + let%map v = x in + String.concat [ v; "1" ] + in + let f' = add f in + let s' = add s in + print_s [%message (f' : t) (s' : t)]; + [%expect {| + ((f' (First 0)) + (s' (Second str1))) + |}] +;; + +let%expect_test "First.Monad.bind" = + let open Either.First.Let_syntax in + let inc x = + let%bind v = x in + return (v + 1) + in + let f' = inc f in + let s' = inc s in + print_s [%message (f' : t) (s' : t)]; + [%expect {| + ((f' (First 1)) + (s' (Second str))) + |}] +;; + +let%expect_test "Second.Monad.bind" = + let open Either.Second.Let_syntax in + let add x = + let%bind v = x in + return (String.concat [ v; "1" ]) + in + let f' = add f in + let s' = add s in + print_s [%message (f' : t) (s' : t)]; + [%expect {| + ((f' (First 0)) + (s' (Second str1))) + |}] +;; + +let%expect_test "First.map2" = + let m t1 t2 = + let result = Either.First.map2 ~f:(fun x y -> x + y) t1 t2 in + print_s [%sexp (result : (int, string) Either.t)] + in + let foo = "foo" in + let bar = "bar" in + m (Second foo) (Second bar); + [%expect {| (Second foo) |}]; + m (First 1) (First 2); + [%expect {| (First 3) |}]; + m (Second foo) (First 1); + [%expect {| (Second foo) |}]; + m (First 1) (Second bar); + [%expect {| (Second bar) |}] +;; + +let%expect_test "Second.map2" = + let m t1 t2 = + let result = Either.Second.map2 ~f:(fun x y -> x + y) t1 t2 in + print_s [%sexp (result : (string, int) Either.t)] + in + let foo = "foo" in + let bar = "bar" in + m (First foo) (First bar); + [%expect {| (First foo) |}]; + m (Second 1) (Second 2); + [%expect {| (Second 3) |}]; + m (First foo) (Second 1); + [%expect {| (First foo) |}]; + m (Second 1) (First bar); + [%expect {| (First bar) |}] +;; diff --git a/unikernel/duniverse/base/test/test_either.mli b/unikernel/duniverse/base/test/test_either.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_either.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_error.ml b/unikernel/duniverse/base/test/test_error.ml new file mode 100644 index 00000000..ca7afee2 --- /dev/null +++ b/unikernel/duniverse/base/test/test_error.ml @@ -0,0 +1,28 @@ +open! Base +open! Import + +let errors = + [ Error.of_string "ABC" + ; Error.tag ~tag:"DEF" (Error.of_thunk (fun () -> "GHI")) + ; Error.create_s [%message "foo" ~bar:(31 : int)] + ] +;; + +let%expect_test _ = + List.iter errors ~f:(fun error -> show_raise (fun () -> Error.raise error)); + [%expect {| + (raised ABC) + (raised (DEF GHI)) + (raised (foo (bar 31))) + |}] +;; + +let%expect_test _ = + List.iter errors ~f:(fun error -> + show_raise (fun () -> Error.raise_s [%sexp (error : Error.t)])); + [%expect {| + (raised ABC) + (raised (DEF GHI)) + (raised (foo (bar 31))) + |}] +;; diff --git a/unikernel/duniverse/base/test/test_error.mli b/unikernel/duniverse/base/test/test_error.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_error.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_exn.ml b/unikernel/duniverse/base/test/test_exn.ml new file mode 100644 index 00000000..8e01d81e --- /dev/null +++ b/unikernel/duniverse/base/test/test_exn.ml @@ -0,0 +1,15 @@ +open! Import +open! Exn + +let%expect_test "[create_s]" = + print_s [%sexp (create_s [%message "foo"] : t)]; + [%expect {| foo |}]; + print_s [%sexp (create_s [%message "foo" "bar"] : t)]; + [%expect {| (foo bar) |}]; + let sexp = [%message "foo"] in + print_s [%sexp (phys_equal sexp (sexp_of_t (create_s sexp)) : bool)]; + [%expect {| true |}] +;; + +let%test _ = not (does_raise Fn.ignore) +let%test _ = does_raise (fun () -> failwith "foo") diff --git a/unikernel/duniverse/base/test/test_exn.mli b/unikernel/duniverse/base/test/test_exn.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_exn.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_exn_reraise.ml b/unikernel/duniverse/base/test/test_exn_reraise.ml new file mode 100644 index 00000000..fd10adb6 --- /dev/null +++ b/unikernel/duniverse/base/test/test_exn_reraise.ml @@ -0,0 +1,200 @@ +open! Import + +(* These methods miss part of the backtrace. *) + +let clobber_most_recent_backtrace () = + try failwith "clobbering" with + | _ -> () +;; + +let _Base_Exn_reraise exn = Exn.reraise exn "reraised" + +let _Base_Exn_reraise_after_clobbering_most_recent_backtrace exn = + clobber_most_recent_backtrace (); + Exn.reraise exn "reraised" +;; + +external reraiser_raw : exn -> 'a = "%reraise" + +let external_reraise_unequal exn = reraiser_raw (Exn.Reraised ("reraised", exn)) +let vanilla_raise_unequal exn = raise (Exn.Reraised ("reraised", exn)) + +(* These methods produce the full, desired backtrace. *) + +let vanilla_raise exn = raise exn + +let raise_with_original_backtrace exn = + let backtrace = Backtrace.Exn.most_recent () in + Exn.raise_with_original_backtrace (Exn.Reraised ("reraised", exn)) backtrace +;; + +(* This ref causes [check_value] to appear in the backtrace, because the [raise_s] call is + no longer in tail position. *) +let setter = ref 0 + +let check_value x = + if x < 0 then raise_s [%message "bad value" (x : int)]; + setter := x +;; + +(* This function duplicates the functionality of [Exn.reraise_uncaught] with a custom + [reraiser] *) +let reraise_uncaught reraiser f = + try f () with + | exn -> reraiser exn +;; + +let callstacker ~reraise_uncaught = + let rec loop reraise_uncaught x = + reraise_uncaught (fun () -> check_value x); + loop reraise_uncaught (x - 1); + reraise_uncaught (fun () -> check_value x) + in + loop reraise_uncaught 1 +;; + +let with_backtraces_enabled f = + Backtrace.Exn.with_recording true ~f:(fun () -> + Ref.set_temporarily Backtrace.elide false ~f) +;; + +let test_reraise_uncaught ~reraise_uncaught = + with_backtraces_enabled (fun () -> + Exn.handle_uncaught ~exit:false (fun () -> callstacker ~reraise_uncaught)) +;; + +let test_reraiser reraiser = + test_reraise_uncaught ~reraise_uncaught:(reraise_uncaught reraiser) +;; + +(* If you want to see what the underlying backtraces look like, set this to true. + Otherwise, these tests extract small snippets from the backtraces so that they are + robust to compiler changes. *) +let just_print = false + +let really_show_backtrace s = + if just_print + then print_endline s + else + printf + "Before re-raise: %b\nAfter re-raise: %b" + (String.is_substring s ~substring:"check_value") + (String.is_substring s ~substring:"handle_uncaught") +;; + +let%test_module ("Show native backtraces" [@tags "no-js"]) = + (module struct + (* good *) + let%expect_test "Base.Exn.reraise" = + test_reraiser _Base_Exn_reraise; + really_show_backtrace [%expect.output]; + [%expect {| + Before re-raise: true + After re-raise: true + |}] + ;; + + (* bad, because the backtrace was clobbered *) + let%expect_test "Base.Exn.reraise" = + test_reraiser _Base_Exn_reraise_after_clobbering_most_recent_backtrace; + really_show_backtrace [%expect.output]; + [%expect {| + Before re-raise: false + After re-raise: true + |}] + ;; + + (* bad, missing the backtrace before the reraise *) + let%expect_test "%reraise unequal" = + test_reraiser external_reraise_unequal; + really_show_backtrace [%expect.output]; + [%expect {| + Before re-raise: false + After re-raise: true + |}] + ;; + + (* bad, missing the backtrace before the reraise *) + let%expect_test "raise unequal" = + test_reraiser vanilla_raise_unequal; + really_show_backtrace [%expect.output]; + [%expect {| + Before re-raise: false + After re-raise: true + |}] + ;; + + (* good, but no additional info attached *) + let%expect_test "raise equal" = + test_reraiser vanilla_raise; + really_show_backtrace [%expect.output]; + [%expect {| + Before re-raise: true + After re-raise: true + |}] + ;; + + (* good *) + let%expect_test "Caml.Printexc.raise_with_backtrace" = + test_reraiser raise_with_original_backtrace; + really_show_backtrace [%expect.output]; + [%expect {| + Before re-raise: true + After re-raise: true + |}] + ;; + + (* good *) + let%expect_test "Exn.reraise_uncaught" = + test_reraise_uncaught ~reraise_uncaught:(Exn.reraise_uncaught "reraised"); + really_show_backtrace [%expect.output]; + [%expect {| + Before re-raise: true + After re-raise: true + |}] + ;; + end) +;; + +(* An example bad backtrace: + {v + Uncaught exception: + + (exn.ml.Reraised reraised ("bad value" (x -1))) + + Raised at Base_test__Test_exn_reraise.vanilla_raise_unequal in file "test_exn_reraise.ml" (inlined), line 10, characters 32-70 + Called from Base_test__Test_exn_reraise.reraise_uncaught in file "test_exn_reraise.ml" (inlined), line 34, characters 11-23 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml", line 39, characters 4-55 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 38, characters 15-167 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 38, characters 15-167 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25 + Called from Base_test__Test_exn_reraise.callstacker in file "test_exn_reraise.ml" (inlined), line 43, characters 2-17 + Called from Base__Exn.handle_uncaught_aux in file "exn.ml" (inlined), line 113, characters 6-10 + Called from Base__Exn.handle_uncaught in file "exn.ml" (inlined), line 139, characters 2-88 + Called from Base_test__Test_exn_reraise.test.(fun) in file "test_exn_reraise.ml", line 53, characters 4-68 + v} +*) + +(* An example good backtrace: + {v + Uncaught exception: + + (exn.ml.Reraised reraised ("bad value" (x -1))) + + Raised at Base__Error.raise in file "error.ml" (inlined), line 9, characters 14-30 + Called from Base__Error.raise_s in file "error.ml" (inlined), line 10, characters 19-40 + Called from Base_test__Test_exn_reraise.check_value in file "test_exn_reraise.ml", line 26, characters 16-56 + Called from Base_test__Test_exn_reraise.callstacker.loop.(fun) in file "test_exn_reraise.ml" (inlined), line 39, characters 41-54 + Called from Base_test__Test_exn_reraise.reraise_uncaught in file "test_exn_reraise.ml" (inlined), line 33, characters 6-10 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml", line 39, characters 4-55 + Re-raised at Base_test__Test_exn_reraise._Caml_Printexc_raise_with_backtrace in file "test_exn_reraise.ml", line 18, characters 2-79 + Called from Base_test__Test_exn_reraise.reraise_uncaught in file "test_exn_reraise.ml" (inlined), line 34, characters 11-23 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml", line 39, characters 4-55 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25 + Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25 + Called from Base_test__Test_exn_reraise.callstacker in file "test_exn_reraise.ml" (inlined), line 43, characters 2-17 + Called from Base__Exn.handle_uncaught_aux in file "exn.ml" (inlined), line 113, characters 6-10 + Called from Base__Exn.handle_uncaught in file "exn.ml" (inlined), line 139, characters 2-88 + Called from Base_test__Test_exn_reraise.test.(fun) in file "test_exn_reraise.ml", line 53, characters 4-68 + v}*) diff --git a/unikernel/duniverse/base/test/test_exn_reraise.mli b/unikernel/duniverse/base/test/test_exn_reraise.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_exn_reraise.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_exported_int_conversions.ml b/unikernel/duniverse/base/test/test_exported_int_conversions.ml new file mode 100644 index 00000000..49f062af --- /dev/null +++ b/unikernel/duniverse/base/test/test_exported_int_conversions.ml @@ -0,0 +1,297 @@ +open! Import + +module type S = sig + type t [@@deriving compare, sexp_of] + + val num_bits : int + val min_value : t + val minus_one : t + val zero : t + val one : t + val max_value : t + val to_int64 : t -> int64 + val shift_right : t -> int -> t + val random : Random.State.t -> t -> t -> t +end + +module I : S with type t = int = struct + include Int + + let random = Random.State.int_incl +end + +module Native : S with type t = nativeint = struct + include Nativeint + + let random = Random.State.nativeint_incl +end + +module I32 : S with type t = int32 = struct + include Int32 + + let random = Random.State.int32_incl +end + +module I64 : S with type t = int64 = struct + include Int64 + + let random = Random.State.int64_incl +end + +module I63 : S with type t = Int63.t = struct + include Int63 + + let random state lo hi = Int63.random_incl ~state lo hi +end + +let iter (type a) (module M : S with type t = a) ~f = + let state = Random.State.make [| 0; 1; 2; 3; 4; 5 |] in + List.iter ~f [ M.min_value; M.minus_one; M.zero; M.one; M.max_value ]; + for _ = 1 to 10_000 do + (* skew toward low numbers of bits so that, e.g., choosing a random int64 does + frequently find a value that can be converted to int32. *) + let strip_bits = Random.State.int_incl state 0 (M.num_bits - 1) in + let lo = M.shift_right M.min_value strip_bits in + let hi = M.shift_right M.max_value strip_bits in + f (M.random state lo hi) + done +;; + +let try_with f x = Option.try_with (fun () -> f x) + +(* Checks that a conversion from [A.t] to [B.t] is total using [of] and [to]. *) +let test_total + (type a b) + (module A : S with type t = a) + (module B : S with type t = b) + ~of_:b_of_a + ~to_:a_to_b + = + iter + (module A) + ~f:(fun a -> + require_compare_equal [%here] (module B) (b_of_a a) (a_to_b a); + require_compare_equal [%here] (module Int64) (A.to_int64 a) (B.to_int64 (b_of_a a))) +;; + +let truncate int64 ~num_bits = + Int64.shift_right (Int64.shift_left int64 (64 - num_bits)) (64 - num_bits) +;; + +(* Checks that a conversion from [A.t] to [B.t] is partial using [of] and [to], and the + [_exn] equivalents. In the case where the conversion fails, ensure that the value, + converted to an [Int64.t] is outside the representable range of [B.t] converted to an + [Int64.t] as well. *) +let test_partial + (type a b) + (module A : S with type t = a) + (module B : S with type t = b) + ~of_:b_of_a + ~of_exn:b_of_a_exn + ~of_trunc:b_of_a_trunc + ~to_:a_to_b + ~to_exn:a_to_b_exn + ~to_trunc:a_to_b_trunc + = + let module B_option = struct + type t = B.t option [@@deriving compare, sexp_of] + end + in + let convertible_count = ref 0 in + iter + (module A) + ~f:(fun a -> + require_compare_equal [%here] (module B_option) (b_of_a a) (a_to_b a); + require_compare_equal [%here] (module B_option) (b_of_a a) (try_with b_of_a_exn a); + require_compare_equal [%here] (module B_option) (a_to_b a) (try_with a_to_b_exn a); + match b_of_a a with + | Some b -> + Int.incr convertible_count; + require_compare_equal [%here] (module B) b (b_of_a_trunc a); + require_compare_equal [%here] (module B) b (a_to_b_trunc a); + require_compare_equal [%here] (module Int64) (A.to_int64 a) (B.to_int64 b) + | None -> + let trunc = truncate (A.to_int64 a) ~num_bits:B.num_bits in + require_compare_equal [%here] (module Int64) trunc (B.to_int64 (b_of_a_trunc a)); + require_compare_equal [%here] (module Int64) trunc (B.to_int64 (a_to_b_trunc a)); + require + [%here] + (Int64.( > ) (A.to_int64 a) (B.to_int64 B.max_value) + || Int64.( < ) (A.to_int64 a) (B.to_int64 B.min_value)) + ~if_false_then_print_s:(lazy [%message "failed to convert" ~_:(a : A.t)])); + (* Make sure we stress the conversion a nontrivial number of times. This makes sure the + random generation is useful and we aren't just testing the hard-coded examples. *) + require + [%here] + (!convertible_count > 100) + ~if_false_then_print_s: + (lazy + [%message + "did not test successful conversion often enough" (convertible_count : int ref)]) +;; + +let%expect_test "int <-> nativeint" = + test_total (module I) (module Native) ~of_:Nativeint.of_int ~to_:Int.to_nativeint; + [%expect {| |}]; + test_partial + (module Native) + (module I) + ~of_:Int.of_nativeint + ~of_exn:Int.of_nativeint_exn + ~of_trunc:Int.of_nativeint_trunc + ~to_:Nativeint.to_int + ~to_exn:Nativeint.to_int_exn + ~to_trunc:Nativeint.to_int_trunc; + [%expect {| |}] +;; + +let%expect_test "int <-> int32" = + test_partial + (module I) + (module I32) + ~of_:Int32.of_int + ~of_exn:Int32.of_int_exn + ~of_trunc:Int32.of_int_trunc + ~to_:Int.to_int32 + ~to_exn:Int.to_int32_exn + ~to_trunc:Int.to_int32_trunc; + [%expect {| |}]; + test_partial + (module I32) + (module I) + ~of_:Int.of_int32 + ~of_exn:Int.of_int32_exn + ~of_trunc:Int.of_int32_trunc + ~to_:Int32.to_int + ~to_exn:Int32.to_int_exn + ~to_trunc:Int32.to_int_trunc; + [%expect {| |}] +;; + +let%expect_test "nativeint <-> int32" = + test_partial + (module Native) + (module I32) + ~of_:Int32.of_nativeint + ~of_exn:Int32.of_nativeint_exn + ~of_trunc:Int32.of_nativeint_trunc + ~to_:Nativeint.to_int32 + ~to_exn:Nativeint.to_int32_exn + ~to_trunc:Nativeint.to_int32_trunc; + [%expect {| |}]; + test_total (module I32) (module Native) ~of_:Nativeint.of_int32 ~to_:Int32.to_nativeint; + [%expect {| |}] +;; + +let%expect_test "int <-> int64" = + test_total (module I) (module I64) ~of_:Int64.of_int ~to_:Int.to_int64; + [%expect {| |}]; + test_partial + (module I64) + (module I) + ~of_:Int.of_int64 + ~of_exn:Int.of_int64_exn + ~of_trunc:Int.of_int64_trunc + ~to_:Int64.to_int + ~to_exn:Int64.to_int_exn + ~to_trunc:Int64.to_int_trunc; + [%expect {| |}] +;; + +let%expect_test "nativeint <-> int64" = + test_total (module Native) (module I64) ~of_:Int64.of_nativeint ~to_:Nativeint.to_int64; + [%expect {| |}]; + test_partial + (module I64) + (module Native) + ~of_:Nativeint.of_int64 + ~of_exn:Nativeint.of_int64_exn + ~of_trunc:Nativeint.of_int64_trunc + ~to_:Int64.to_nativeint + ~to_exn:Int64.to_nativeint_exn + ~to_trunc:Int64.to_nativeint_trunc; + [%expect {| |}] +;; + +let%expect_test "int32 <-> int64" = + test_total (module I32) (module I64) ~of_:Int64.of_int32 ~to_:Int32.to_int64; + [%expect {| |}]; + test_partial + (module I64) + (module I32) + ~of_:Int32.of_int64 + ~of_exn:Int32.of_int64_exn + ~of_trunc:Int32.of_int64_trunc + ~to_:Int64.to_int32 + ~to_exn:Int64.to_int32_exn + ~to_trunc:Int64.to_int32_trunc; + [%expect {| |}] +;; + +let%expect_test "int <-> int63" = + test_total (module I) (module I63) ~of_:Int63.of_int ~to_:Int63.of_int; + [%expect {| |}]; + test_partial + (module I63) + (module I) + ~of_:Int63.to_int + ~of_exn:Int63.to_int_exn + ~of_trunc:Int63.to_int_trunc + ~to_:Int63.to_int + ~to_exn:Int63.to_int_exn + ~to_trunc:Int63.to_int_trunc; + [%expect {| |}] +;; + +let%expect_test "nativeint <-> int63" = + test_partial + (module Native) + (module I63) + ~of_:Int63.of_nativeint + ~of_exn:Int63.of_nativeint_exn + ~of_trunc:Int63.of_nativeint_trunc + ~to_:Int63.of_nativeint + ~to_exn:Int63.of_nativeint_exn + ~to_trunc:Int63.of_nativeint_trunc; + [%expect {| |}]; + test_partial + (module I63) + (module Native) + ~of_:Int63.to_nativeint + ~of_exn:Int63.to_nativeint_exn + ~of_trunc:Int63.to_nativeint_trunc + ~to_:Int63.to_nativeint + ~to_exn:Int63.to_nativeint_exn + ~to_trunc:Int63.to_nativeint_trunc; + [%expect {| |}] +;; + +let%expect_test "int32 <-> int63" = + test_total (module I32) (module I63) ~of_:Int63.of_int32 ~to_:Int63.of_int32; + [%expect {| |}]; + test_partial + (module I63) + (module I32) + ~of_:Int63.to_int32 + ~of_exn:Int63.to_int32_exn + ~of_trunc:Int63.to_int32_trunc + ~to_:Int63.to_int32 + ~to_exn:Int63.to_int32_exn + ~to_trunc:Int63.to_int32_trunc; + [%expect {| |}] +;; + +let%expect_test "int64 <-> int63" = + test_partial + (module I64) + (module I63) + ~of_:Int63.of_int64 + ~of_exn:Int63.of_int64_exn + ~of_trunc:Int63.of_int64_trunc + ~to_:Int63.of_int64 + ~to_exn:Int63.of_int64_exn + ~to_trunc:Int63.of_int64_trunc; + [%expect {| |}]; + test_total (module I63) (module I64) ~of_:Int63.to_int64 ~to_:Int63.to_int64; + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/test_exported_int_conversions.mli b/unikernel/duniverse/base/test/test_exported_int_conversions.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_exported_int_conversions.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_float.ml b/unikernel/duniverse/base/test/test_float.ml new file mode 100644 index 00000000..03c93f5f --- /dev/null +++ b/unikernel/duniverse/base/test/test_float.ml @@ -0,0 +1,1307 @@ +open! Import +open! Float +open! Float.Private + +let%expect_test ("hash coherence" [@tags "64-bits-only"]) = + check_hash_coherence [%here] (module Float) [ min_value; 0.; 37.; max_value ]; + [%expect {| |}] +;; + +let%expect_test "of_string_opt" = + print_s [%sexp (of_string_opt "1." : float option)]; + [%expect "(1)"]; + print_s [%sexp (of_string_opt "1.a" : float option)]; + [%expect "()"]; + print_s [%sexp (of_string_opt "1e10000" : float option)]; + [%expect "(INF)"] +;; + +let exponent_bits = 11 +let mantissa_bits = 52 +let exponent_mask64 = Int64.(shift_left one exponent_bits - one) +let exponent_mask = Int64.to_int_exn exponent_mask64 +let mantissa_mask = Int63.(shift_left one mantissa_bits - one) +let _mantissa_mask64 = Int63.to_int64 mantissa_mask + +let%test_unit "upper/lower_bound_for_int" = + assert ( + [%compare.equal: (int * t * t) list] + ([ 8; 16; 31; 32; 52; 53; 54; 62; 63; 64 ] + |> List.map ~f:(fun x -> x, lower_bound_for_int x, upper_bound_for_int x)) + [ 8, -128.99999999999997, 127.99999999999999 + ; 16, -32768.999999999993, 32767.999999999996 + ; 31, -1073741824.9999998, 1073741823.9999999 + ; 32, -2147483648.9999995, 2147483647.9999998 + ; 52, -2251799813685248.5, 2251799813685247.8 + ; 53, -4503599627370496., 4503599627370495.5 + ; 54, -9007199254740992., 9007199254740991. + ; 62, -2305843009213693952., 2305843009213693696. + ; 63, -4611686018427387904., 4611686018427387392. + ; 64, -9223372036854775808., 9223372036854774784. + ]) +;; + +let%test_unit _ = + (* on 64-bit platform ppx_hash hashes floats exactly the same as polymorphic hash *) + match Word_size.word_size with + | W32 -> () + | W64 -> + List.iter + ~f:(fun float -> + let hash1 = Stdlib.Hashtbl.hash float in + let hash2 = [%hash: float] float in + let hash3 = specialized_hash float in + if not Int.(hash1 = hash2 && hash1 = hash3) + then + raise_s + [%message "bad" (hash1 : Int.Hex.t) (hash2 : Int.Hex.t) (hash3 : Int.Hex.t)]) + [ 0.926038888360971146; 34.1638588598232076 ] +;; + +let test_both_ways (a : t) (b : int64) = + Int64.( = ) (to_int64_preserve_order_exn a) b + && Float.( = ) (of_int64_preserve_order b) a +;; + +let%test _ = test_both_ways 0. 0L +let%test _ = test_both_ways (-0.) 0L +let%test _ = test_both_ways 1. Int64.(shift_left 1023L 52) +let%test _ = test_both_ways (-2.) Int64.(neg (shift_left 1024L 52)) +let%test _ = test_both_ways infinity Int64.(shift_left 2047L 52) +let%test _ = test_both_ways neg_infinity Int64.(neg (shift_left 2047L 52)) +let%test _ = one_ulp `Down infinity = max_finite_value +let%test _ = is_nan (one_ulp `Up infinity) +let%test _ = is_nan (one_ulp `Down neg_infinity) +let%test _ = one_ulp `Up neg_infinity = ~-.max_finite_value + +(* Some tests to make sure that the compiler is generating code for handling subnormal + numbers at runtime accurately. *) +let x () = min_positive_subnormal_value +let y () = min_positive_normal_value +let%test _ = test_both_ways (x ()) 1L +let%test _ = test_both_ways (y ()) Int64.(shift_left 1L 52) +let%test _ = x () > 0. +let%test_unit _ = [%test_result: float] (x () /. 2.) ~expect:0. +let%test _ = one_ulp `Up 0. = x () +let%test _ = one_ulp `Down 0. = ~-.(x ()) +let are_one_ulp_apart a b = one_ulp `Up a = b +let%test _ = are_one_ulp_apart (x ()) (2. *. x ()) +let%test _ = are_one_ulp_apart (2. *. x ()) (3. *. x ()) +let one_ulp_below_y () = y () -. x () +let%test _ = one_ulp_below_y () < y () +let%test _ = y () -. one_ulp_below_y () = x () +let%test _ = are_one_ulp_apart (one_ulp_below_y ()) (y ()) +let one_ulp_above_y () = y () +. x () +let%test _ = y () < one_ulp_above_y () +let%test _ = one_ulp_above_y () -. y () = x () +let%test _ = are_one_ulp_apart (y ()) (one_ulp_above_y ()) +let%test _ = not (are_one_ulp_apart (one_ulp_below_y ()) (one_ulp_above_y ())) + +(* [2 * min_positive_normal_value] is where the ulp increases for the first time. *) +let z () = 2. *. y () +let one_ulp_below_z () = z () -. x () +let%test _ = one_ulp_below_z () < z () +let%test _ = z () -. one_ulp_below_z () = x () +let%test _ = are_one_ulp_apart (one_ulp_below_z ()) (z ()) +let one_ulp_above_z () = z () +. (2. *. x ()) +let%test _ = z () < one_ulp_above_z () +let%test _ = one_ulp_above_z () -. z () = 2. *. x () +let%test _ = are_one_ulp_apart (z ()) (one_ulp_above_z ()) + +let%test_module "clamp" = + (module struct + let%test _ = clamp_exn 1.0 ~min:2. ~max:3. = 2. + let%test _ = clamp_exn 2.5 ~min:2. ~max:3. = 2.5 + let%test _ = clamp_exn 3.5 ~min:2. ~max:3. = 3. + + let%test_unit "clamp" = + [%test_result: float Or_error.t] (clamp 3.5 ~min:2. ~max:3.) ~expect:(Ok 3.) + ;; + + let%test_unit "clamp nan" = + [%test_result: float Or_error.t] (clamp nan ~min:2. ~max:3.) ~expect:(Ok nan) + ;; + + let%test "clamp bad" = Or_error.is_error (clamp 2.5 ~min:3. ~max:2.) + let%test "clamp also bad" = Or_error.is_error (clamp 2.5 ~min:nan ~max:3.) + let%test "clamp also bad 2" = Or_error.is_error (clamp 2.5 ~min:2. ~max:nan) + let%test "clamp also bad 3" = Or_error.is_error (clamp 2.5 ~min:nan ~max:nan) + let%test "clamp also bad 4" = Or_error.is_error (clamp nan ~min:nan ~max:nan) + + let%test_unit "clamp_exn bad" = + Expect_test_helpers_base.require_does_raise [%here] (fun () -> + clamp_exn 2.5 ~min:3. ~max:2.) + ;; + + let%test_unit "clamp_exn also bad" = + Expect_test_helpers_base.require_does_raise [%here] (fun () -> + clamp_exn 2.5 ~min:nan ~max:3.) + ;; + + let%test_unit "clamp_exn also bad 2" = + Expect_test_helpers_base.require_does_raise [%here] (fun () -> + clamp_exn 2.5 ~min:2. ~max:nan) + ;; + + let%test_unit "clamp_exn also bad 3" = + Expect_test_helpers_base.require_does_raise [%here] (fun () -> + clamp_exn 2.5 ~min:nan ~max:nan) + ;; + + let%test_unit "clamp_exn also bad 4" = + Expect_test_helpers_base.require_does_raise [%here] (fun () -> + clamp_exn nan ~min:nan ~max:nan) + ;; + end) +;; + +let%test_unit _ = + [%test_result: Int64.t] + (Int64.bits_of_float 1.1235582092889474E+307) + ~expect:0x7fb0000000000000L +;; + +let%test_module "IEEE" = + (module struct + (* Note: IEEE 754 defines NaN values to be those where the exponent is all 1s and the + mantissa is nonzero. test_result sees nan values as equal because it is based + on [compare] rather than [=]. (If [x] and [x'] are nan, [compare x x'] returns 0, + whereas [x = x'] returns [false]. This is the case regardless of whether or not + [x] and [x'] are bit-identical values of nan.) *) + let f (t : t) (negative : bool) (exponent : int) (mantissa : Int63.t) : unit = + let str = to_string t in + let is_nan = is_nan t in + (* the sign doesn't matter when nan *) + if not is_nan + then + [%test_result: bool] + ~message:("ieee_negative " ^ str) + (ieee_negative t) + ~expect:negative; + [%test_result: int] + ~message:("ieee_exponent " ^ str) + (ieee_exponent t) + ~expect:exponent; + if is_nan + then assert (Int63.(zero <> ieee_mantissa t)) + else + [%test_result: Int63.t] + ~message:("ieee_mantissa " ^ str) + (ieee_mantissa t) + ~expect:mantissa; + [%test_result: t] + ~message: + (Printf.sprintf + !"create_ieee ~negative:%B ~exponent:%d ~mantissa:%{Int63}" + negative + exponent + mantissa) + (create_ieee_exn ~negative ~exponent ~mantissa) + ~expect:t + ;; + + let%test_unit _ = + let ( !! ) x = Int63.of_int x in + f zero false 0 !!0; + f min_positive_subnormal_value false 0 !!1; + f min_positive_normal_value false 1 !!0; + f epsilon_float false Int.(1023 - mantissa_bits) !!0; + f one false 1023 !!0; + f minus_one true 1023 !!0; + f max_finite_value false Int.(exponent_mask - 1) mantissa_mask; + f infinity false exponent_mask !!0; + f neg_infinity true exponent_mask !!0; + f nan false exponent_mask !!1 + ;; + + (* test the normalized case, that is, 1 <= exponent <= 2046 *) + let%test_unit _ = + let g ~negative ~exponent ~mantissa = + assert ( + create_ieee_exn ~negative ~exponent ~mantissa:(Int63.of_int64_exn mantissa) + = (if negative then -1. else 1.) + * (2. **. (Float.of_int exponent - 1023.)) + * (1. + ((2. **. -52.) * Int64.to_float mantissa))) + in + g ~negative:false ~exponent:1 ~mantissa:147L; + g ~negative:true ~exponent:137 ~mantissa:13L; + g ~negative:false ~exponent:1015 ~mantissa:1370001L; + g ~negative:true ~exponent:2046 ~mantissa:137000100945L + ;; + end) +;; + +let%test_module _ = + (module struct + let test f expect = + let actual = to_padded_compact_string f in + if String.(actual <> expect) + then raise_s [%message "failure" (f : t) (expect : string) (actual : string)] + ;; + + let both f expect = + assert (f > 0.); + test f expect; + test ~-.f ("-" ^ expect) + ;; + + let decr = one_ulp `Down + let incr = one_ulp `Up + + let boundary f ~closer_to_zero ~at = + assert (f > 0.); + (* If [f] looks like an odd multiple of 0.05, it might be slightly under-represented + as a float, e.g. + + 1. -. 0.95 = 0.0500000000000000444 + + In such case, sadly, the right way for [to_padded_compact_string], just as for + [sprintf "%.1f"], is to round it down. However, the next representable number + should be rounded up: + + # let x = 0.95 in sprintf "%.0f / %.1f / %.2f / %.3f / %.20f" x x x x x;; + - : string = "1 / 0.9 / 0.95 / 0.950 / 0.94999999999999995559" + + # let x = incr 0.95 in sprintf "%.0f / %.1f / %.2f / %.3f / %.20f" x x x x x ;; + - : string = "1 / 1.0 / 0.95 / 0.950 / 0.95000000000000006661" + *) + let f = + if f >= 1000. + then f + else ( + let x = Printf.sprintf "%.20f" f in + let spot = String.index_exn x '.' in + (* the following condition is only meant to work for small multiples of 0.05 *) + let ( + ) = Int.( + ) in + let ( = ) = Char.( = ) in + if x.[spot + 2] = '4' && x.[spot + 3] = '9' && x.[spot + 4] = '9' + then (* something like 0.94999999999999995559 *) + incr f + else f) + in + both (decr f) closer_to_zero; + both f at + ;; + + let%test_unit _ = test nan "nan " + let%test_unit _ = test 0.0 "0 " + let%test_unit _ = both min_positive_subnormal_value "0 " + let%test_unit _ = both infinity "inf " + let%test_unit _ = boundary 0.05 ~closer_to_zero:"0 " ~at:"0.1" + let%test_unit _ = boundary 0.15 ~closer_to_zero:"0.1" ~at:"0.2" + + (* glibc printf resolves ties to even, cf. + http://www.exploringbinary.com/inconsistent-rounding-of-printed-floating-point-numbers/ + Ties are resolved differently in JavaScript - mark some tests as no running with JavaScript. + *) + let%test_unit (_ [@tags "no-js"]) = + boundary (* tie *) 0.25 ~closer_to_zero:"0.2" ~at:"0.2" + ;; + + let%test_unit (_ [@tags "no-js"]) = + boundary (incr 0.25) ~closer_to_zero:"0.2" ~at:"0.3" + ;; + + let%test_unit _ = boundary 0.35 ~closer_to_zero:"0.3" ~at:"0.4" + let%test_unit _ = boundary 0.45 ~closer_to_zero:"0.4" ~at:"0.5" + let%test_unit _ = both 0.50 "0.5" + let%test_unit _ = boundary 0.55 ~closer_to_zero:"0.5" ~at:"0.6" + let%test_unit _ = boundary 0.65 ~closer_to_zero:"0.6" ~at:"0.7" + + (* this time tie-to-even means round away from 0 *) + let%test_unit _ = boundary (* tie *) 0.75 ~closer_to_zero:"0.7" ~at:"0.8" + let%test_unit _ = boundary 0.85 ~closer_to_zero:"0.8" ~at:"0.9" + let%test_unit _ = boundary 0.95 ~closer_to_zero:"0.9" ~at:"1 " + let%test_unit _ = boundary 1.05 ~closer_to_zero:"1 " ~at:"1.1" + let%test_unit (_ [@tags "no-js"]) = boundary 3.25 ~closer_to_zero:"3.2" ~at:"3.2" + + let%test_unit (_ [@tags "no-js"]) = + boundary (incr 3.25) ~closer_to_zero:"3.2" ~at:"3.3" + ;; + + let%test_unit _ = boundary 3.75 ~closer_to_zero:"3.7" ~at:"3.8" + let%test_unit _ = boundary 9.95 ~closer_to_zero:"9.9" ~at:"10 " + let%test_unit _ = boundary 10.05 ~closer_to_zero:"10 " ~at:"10.1" + let%test_unit _ = boundary 100.05 ~closer_to_zero:"100 " ~at:"100.1" + + let%test_unit (_ [@tags "no-js"]) = + boundary (* tie *) 999.25 ~closer_to_zero:"999.2" ~at:"999.2" + ;; + + let%test_unit (_ [@tags "no-js"]) = + boundary (incr 999.25) ~closer_to_zero:"999.2" ~at:"999.3" + ;; + + let%test_unit _ = boundary 999.75 ~closer_to_zero:"999.7" ~at:"999.8" + let%test_unit _ = boundary 999.95 ~closer_to_zero:"999.9" ~at:"1k " + let%test_unit _ = both 1000. "1k " + + (* some ties which we resolve manually in [iround_ratio_exn] *) + let%test_unit _ = boundary 1050. ~closer_to_zero:"1k " ~at:"1k " + let%test_unit _ = boundary (incr 1050.) ~closer_to_zero:"1k " ~at:"1k1" + let%test_unit _ = boundary 1950. ~closer_to_zero:"1k9" ~at:"2k " + let%test_unit _ = boundary 3250. ~closer_to_zero:"3k2" ~at:"3k2" + let%test_unit _ = boundary (incr 3250.) ~closer_to_zero:"3k2" ~at:"3k3" + let%test_unit _ = boundary 9950. ~closer_to_zero:"9k9" ~at:"10k " + let%test_unit _ = boundary 33_250. ~closer_to_zero:"33k2" ~at:"33k2" + let%test_unit _ = boundary (incr 33_250.) ~closer_to_zero:"33k2" ~at:"33k3" + let%test_unit _ = boundary 33_350. ~closer_to_zero:"33k3" ~at:"33k4" + let%test_unit _ = boundary 33_750. ~closer_to_zero:"33k7" ~at:"33k8" + let%test_unit _ = boundary 333_250. ~closer_to_zero:"333k2" ~at:"333k2" + let%test_unit _ = boundary (incr 333_250.) ~closer_to_zero:"333k2" ~at:"333k3" + let%test_unit _ = boundary 333_750. ~closer_to_zero:"333k7" ~at:"333k8" + let%test_unit _ = boundary 999_850. ~closer_to_zero:"999k8" ~at:"999k8" + let%test_unit _ = boundary (incr 999_850.) ~closer_to_zero:"999k8" ~at:"999k9" + let%test_unit _ = boundary 999_950. ~closer_to_zero:"999k9" ~at:"1m " + let%test_unit _ = boundary 1_050_000. ~closer_to_zero:"1m " ~at:"1m " + let%test_unit _ = boundary (incr 1_050_000.) ~closer_to_zero:"1m " ~at:"1m1" + let%test_unit _ = boundary 999_950_000. ~closer_to_zero:"999m9" ~at:"1g " + let%test_unit _ = boundary 999_950_000_000. ~closer_to_zero:"999g9" ~at:"1t " + let%test_unit _ = boundary 999_950_000_000_000. ~closer_to_zero:"999t9" ~at:"1p " + + let%test_unit _ = + boundary 999_950_000_000_000_000. ~closer_to_zero:"999p9" ~at:"1.0e+18" + ;; + + (* Test the boundary between the subnormals and the normals. *) + let%test_unit _ = boundary min_positive_normal_value ~closer_to_zero:"0 " ~at:"0 " + end) +;; + +let%test "int_pow" = + let tol = 1e-15 in + let test (x, n) = + let reference_value = x **. of_int n in + let relative_error = (int_pow x n -. reference_value) /. reference_value in + abs relative_error < tol + in + List.for_all + ~f:test + [ 1.5, 17 + ; 1.5, 42 + ; 0.99, 64 + ; 2., -5 + ; 2., -1 + ; -1.3, 2 + ; -1.3, -1 + ; -1.3, -2 + ; 5., 0 + ; nan, 0 + ; 0., 0 + ; infinity, 0 + ] +;; + +let%test "int_pow misc" = + int_pow 0. (-1) = infinity + && int_pow (-0.) (-1) = neg_infinity + && int_pow (-0.) (-2) = infinity + && int_pow 1.5 5000 = infinity + && int_pow 1.5 (-5000) = 0. + && int_pow (-1.) Int.max_value = -1. + && int_pow (-1.) Int.min_value = 1. +;; + +(* some ugly corner cases with extremely large exponents and some serious precision loss *) +let%test ("int_pow bad cases" [@tags "64-bits-only"]) = + let a = one_ulp `Down 1. in + let b = one_ulp `Up 1. in + let large = 1 lsl 61 in + let small = Int.neg large in + (* this huge discrepancy comes from the fact that [1 / a = b] but this is a very poor + approximation, and in particular [1 / b = one_ulp `Down a = a * a]. *) + a **. of_int small = 1.5114276650041252e+111 + && int_pow a small = 2.2844048619719663e+222 + && int_pow b large = 2.2844048619719663e+222 + && b **. of_int large = 2.2844135865396268e+222 +;; + +let%test_unit "sign_exn" = + List.iter + ~f:(fun (input, expect) -> assert (Sign.equal (sign_exn input) expect)) + [ 1e-30, Sign.Pos; -0., Zero; 0., Zero; neg_infinity, Neg ] +;; + +let%test _ = + match sign_exn nan with + | Neg | Zero | Pos -> false + | exception _ -> true +;; + +let%test_unit "sign_or_nan" = + List.iter + ~f:(fun (input, expect) -> assert (Sign_or_nan.equal (sign_or_nan input) expect)) + [ 1e-30, Sign_or_nan.Pos; -0., Zero; 0., Zero; neg_infinity, Neg; nan, Nan ] +;; + +let%test_module _ = + (module struct + (* Some of the following tests used to live in lib_test/core_float_test.ml. *) + + let () = Random.init 137 + + (* round: + ... <-)[-><-)[-><-)[-><-)[-><-)[-><-)[-> ... + ... -+-----+-----+-----+-----+-----+-----+- ... + ... -3 -2 -1 0 1 2 3 ... + so round x -. x should be in (-0.5,0.5] + *) + let round_test x = + let y = round x in + -0.5 < y -. x && y -. x <= 0.5 + ;; + + let iround_up_vs_down_test x = + let expected_difference = if Parts.fractional (modf x) = 0. then 0 else 1 in + match iround_up x, iround_down x with + | Some x, Some y -> Int.(x - y = expected_difference) + | _, _ -> true + ;; + + let test_all_six + x + ~specialized_iround + ~specialized_iround_exn + ~float_rounding + ~dir + ~validate + = + let result1 = iround x ~dir in + let result2 = Option.try_with (fun () -> iround_exn x ~dir) in + let result3 = specialized_iround x in + let result4 = Option.try_with (fun () -> specialized_iround_exn x) in + let result5 = Option.try_with (fun () -> Int.of_float (float_rounding x)) in + let result6 = Option.try_with (fun () -> Int.of_float (round ~dir x)) in + let ( = ) = Stdlib.( = ) in + if result1 = result2 + && result2 = result3 + && result3 = result4 + && result4 = result5 + && result5 = result6 + then validate result1 + else false + ;; + + (* iround ~dir:`Nearest built so this should always be true *) + let iround_nearest_test x = + test_all_six + x + ~specialized_iround:iround_nearest + ~specialized_iround_exn:iround_nearest_exn + ~float_rounding:round_nearest + ~dir:`Nearest + ~validate:(function + | None -> true + | Some y -> + let y = of_int y in + -0.5 < y -. x && y -. x <= 0.5) + ;; + + (* iround_down: + ... )[<---)[<---)[<---)[<---)[<---)[<---)[ ... + ... -+-----+-----+-----+-----+-----+-----+- ... + ... -3 -2 -1 0 1 2 3 ... + so x -. iround_down x should be in [0,1) + *) + let iround_down_test x = + test_all_six + x + ~specialized_iround:iround_down + ~specialized_iround_exn:iround_down_exn + ~float_rounding:round_down + ~dir:`Down + ~validate:(function + | None -> true + | Some y -> + let y = of_int y in + 0. <= x -. y && x -. y < 1.) + ;; + + (* iround_up: + ... ](--->](--->](--->](--->](--->](--->]( ... + ... -+-----+-----+-----+-----+-----+-----+- ... + ... -3 -2 -1 0 1 2 3 ... + so iround_up x -. x should be in [0,1) + *) + let iround_up_test x = + test_all_six + x + ~specialized_iround:iround_up + ~specialized_iround_exn:iround_up_exn + ~float_rounding:round_up + ~dir:`Up + ~validate:(function + | None -> true + | Some y -> + let y = of_int y in + 0. <= y -. x && y -. x < 1.) + ;; + + (* iround_towards_zero: + ... ](--->](--->](---><--->)[<---)[<---)[ ... + ... -+-----+-----+-----+-----+-----+-----+- ... + ... -3 -2 -1 0 1 2 3 ... + so abs x -. abs (iround_towards_zero x) should be in [0,1) + *) + let iround_towards_zero_test x = + test_all_six + x + ~specialized_iround:iround_towards_zero + ~specialized_iround_exn:iround_towards_zero_exn + ~float_rounding:round_towards_zero + ~dir:`Zero + ~validate:(function + | None -> true + | Some y -> + let x = abs x in + let y = abs (of_int y) in + 0. <= x -. y && x -. y < 1. && (Sign.(sign_exn x = sign_exn y) || y = 0.0)) + ;; + + (* Easy cases that used to live inline with the code above. *) + let%test_unit _ = [%test_result: int option] (iround_up (-3.4)) ~expect:(Some (-3)) + let%test_unit _ = [%test_result: int option] (iround_up 0.0) ~expect:(Some 0) + let%test_unit _ = [%test_result: int option] (iround_up 3.4) ~expect:(Some 4) + let%test_unit _ = [%test_result: int] (iround_up_exn (-3.4)) ~expect:(-3) + let%test_unit _ = [%test_result: int] (iround_up_exn 0.0) ~expect:0 + let%test_unit _ = [%test_result: int] (iround_up_exn 3.4) ~expect:4 + let%test_unit _ = [%test_result: int option] (iround_down (-3.4)) ~expect:(Some (-4)) + let%test_unit _ = [%test_result: int option] (iround_down 0.0) ~expect:(Some 0) + let%test_unit _ = [%test_result: int option] (iround_down 3.4) ~expect:(Some 3) + let%test_unit _ = [%test_result: int] (iround_down_exn (-3.4)) ~expect:(-4) + let%test_unit _ = [%test_result: int] (iround_down_exn 0.0) ~expect:0 + let%test_unit _ = [%test_result: int] (iround_down_exn 3.4) ~expect:3 + + let%test_unit _ = + [%test_result: int option] (iround_towards_zero (-3.4)) ~expect:(Some (-3)) + ;; + + let%test_unit _ = + [%test_result: int option] (iround_towards_zero 0.0) ~expect:(Some 0) + ;; + + let%test_unit _ = + [%test_result: int option] (iround_towards_zero 3.4) ~expect:(Some 3) + ;; + + let%test_unit _ = [%test_result: int] (iround_towards_zero_exn (-3.4)) ~expect:(-3) + let%test_unit _ = [%test_result: int] (iround_towards_zero_exn 0.0) ~expect:0 + let%test_unit _ = [%test_result: int] (iround_towards_zero_exn 3.4) ~expect:3 + + let%test_unit _ = + [%test_result: int option] (iround_nearest (-3.6)) ~expect:(Some (-4)) + ;; + + let%test_unit _ = + [%test_result: int option] (iround_nearest (-3.5)) ~expect:(Some (-3)) + ;; + + let%test_unit _ = + [%test_result: int option] (iround_nearest (-3.4)) ~expect:(Some (-3)) + ;; + + let%test_unit _ = [%test_result: int option] (iround_nearest 0.0) ~expect:(Some 0) + let%test_unit _ = [%test_result: int option] (iround_nearest 3.4) ~expect:(Some 3) + let%test_unit _ = [%test_result: int option] (iround_nearest 3.5) ~expect:(Some 4) + let%test_unit _ = [%test_result: int option] (iround_nearest 3.6) ~expect:(Some 4) + let%test_unit _ = [%test_result: int] (iround_nearest_exn (-3.6)) ~expect:(-4) + let%test_unit _ = [%test_result: int] (iround_nearest_exn (-3.5)) ~expect:(-3) + let%test_unit _ = [%test_result: int] (iround_nearest_exn (-3.4)) ~expect:(-3) + let%test_unit _ = [%test_result: int] (iround_nearest_exn 0.0) ~expect:0 + let%test_unit _ = [%test_result: int] (iround_nearest_exn 3.4) ~expect:3 + let%test_unit _ = [%test_result: int] (iround_nearest_exn 3.5) ~expect:4 + let%test_unit _ = [%test_result: int] (iround_nearest_exn 3.6) ~expect:4 + + let special_values_test () = + [%test_result: float] (round (-1.50001)) ~expect:(-2.); + [%test_result: float] (round (-1.5)) ~expect:(-1.); + [%test_result: float] (round (-0.50001)) ~expect:(-1.); + [%test_result: float] (round (-0.5)) ~expect:0.; + [%test_result: float] (round 0.49999) ~expect:0.; + [%test_result: float] (round 0.5) ~expect:1.; + [%test_result: float] (round 1.49999) ~expect:1.; + [%test_result: float] (round 1.5) ~expect:2.; + [%test_result: int] (iround_exn ~dir:`Up (-2.)) ~expect:(-2); + [%test_result: int] (iround_exn ~dir:`Up (-1.9999)) ~expect:(-1); + [%test_result: int] (iround_exn ~dir:`Up (-1.)) ~expect:(-1); + [%test_result: int] (iround_exn ~dir:`Up (-0.9999)) ~expect:0; + [%test_result: int] (iround_exn ~dir:`Up 0.) ~expect:0; + [%test_result: int] (iround_exn ~dir:`Up 0.00001) ~expect:1; + [%test_result: int] (iround_exn ~dir:`Up 1.) ~expect:1; + [%test_result: int] (iround_exn ~dir:`Up 1.00001) ~expect:2; + [%test_result: int] (iround_up_exn (-2.)) ~expect:(-2); + [%test_result: int] (iround_up_exn (-1.9999)) ~expect:(-1); + [%test_result: int] (iround_up_exn (-1.)) ~expect:(-1); + [%test_result: int] (iround_up_exn (-0.9999)) ~expect:0; + [%test_result: int] (iround_up_exn 0.) ~expect:0; + [%test_result: int] (iround_up_exn 0.00001) ~expect:1; + [%test_result: int] (iround_up_exn 1.) ~expect:1; + [%test_result: int] (iround_up_exn 1.00001) ~expect:2; + [%test_result: int] (iround_exn ~dir:`Down (-1.00001)) ~expect:(-2); + [%test_result: int] (iround_exn ~dir:`Down (-1.)) ~expect:(-1); + [%test_result: int] (iround_exn ~dir:`Down (-0.00001)) ~expect:(-1); + [%test_result: int] (iround_exn ~dir:`Down 0.) ~expect:0; + [%test_result: int] (iround_exn ~dir:`Down 0.99999) ~expect:0; + [%test_result: int] (iround_exn ~dir:`Down 1.) ~expect:1; + [%test_result: int] (iround_exn ~dir:`Down 1.99999) ~expect:1; + [%test_result: int] (iround_exn ~dir:`Down 2.) ~expect:2; + [%test_result: int] (iround_down_exn (-1.00001)) ~expect:(-2); + [%test_result: int] (iround_down_exn (-1.)) ~expect:(-1); + [%test_result: int] (iround_down_exn (-0.00001)) ~expect:(-1); + [%test_result: int] (iround_down_exn 0.) ~expect:0; + [%test_result: int] (iround_down_exn 0.99999) ~expect:0; + [%test_result: int] (iround_down_exn 1.) ~expect:1; + [%test_result: int] (iround_down_exn 1.99999) ~expect:1; + [%test_result: int] (iround_down_exn 2.) ~expect:2; + [%test_result: int] (iround_exn ~dir:`Zero (-2.)) ~expect:(-2); + [%test_result: int] (iround_exn ~dir:`Zero (-1.99999)) ~expect:(-1); + [%test_result: int] (iround_exn ~dir:`Zero (-1.)) ~expect:(-1); + [%test_result: int] (iround_exn ~dir:`Zero (-0.99999)) ~expect:0; + [%test_result: int] (iround_exn ~dir:`Zero 0.99999) ~expect:0; + [%test_result: int] (iround_exn ~dir:`Zero 1.) ~expect:1; + [%test_result: int] (iround_exn ~dir:`Zero 1.99999) ~expect:1; + [%test_result: int] (iround_exn ~dir:`Zero 2.) ~expect:2 + ;; + + let is_64_bit_platform = of_int Int.max_value >= 2. **. 60. + + (* Tests for values close to [iround_lbound] and [iround_ubound]. *) + let extremities_test ~round = + let ( + ) = Int.( + ) in + let ( - ) = Int.( - ) in + if is_64_bit_platform + then ( + (* 64 bits *) + [%test_result: int option] + (round ((2.0 **. 62.) -. 512.)) + ~expect:(Some (Int.max_value - 511)); + [%test_result: int option] + (round ((2.0 **. 62.) -. 1024.)) + ~expect:(Some (Int.max_value - 1023)); + [%test_result: int option] (round (-.(2.0 **. 62.))) ~expect:(Some Int.min_value); + [%test_result: int option] + (round (-.((2.0 **. 62.) -. 512.))) + ~expect:(Some (Int.min_value + 512)); + [%test_result: int option] (round (2.0 **. 62.)) ~expect:None; + [%test_result: int option] (round (-.((2.0 **. 62.) +. 1024.))) ~expect:None) + else ( + let int_size_minus_one = of_int (Int.num_bits - 1) in + (* 32 bits *) + [%test_result: int option] + (round ((2.0 **. int_size_minus_one) -. 1.)) + ~expect:(Some Int.max_value); + [%test_result: int option] + (round ((2.0 **. int_size_minus_one) -. 2.)) + ~expect:(Some (Int.max_value - 1)); + [%test_result: int option] + (round (-.(2.0 **. int_size_minus_one))) + ~expect:(Some Int.min_value); + [%test_result: int option] + (round (-.((2.0 **. int_size_minus_one) -. 1.))) + ~expect:(Some (Int.min_value + 1)); + [%test_result: int option] (round (2.0 **. int_size_minus_one)) ~expect:None; + [%test_result: int option] + (round (-.((2.0 **. int_size_minus_one) +. 1.))) + ~expect:None) + ;; + + let%test_unit _ = extremities_test ~round:iround_down + let%test_unit _ = extremities_test ~round:iround_up + let%test_unit _ = extremities_test ~round:iround_nearest + let%test_unit _ = extremities_test ~round:iround_towards_zero + + (* test values beyond the integers range *) + let large_value_test x = + [%test_result: int option] (iround_down x) ~expect:None; + [%test_result: int option] (iround ~dir:`Down x) ~expect:None; + [%test_result: int option] (iround_up x) ~expect:None; + [%test_result: int option] (iround ~dir:`Up x) ~expect:None; + [%test_result: int option] (iround_towards_zero x) ~expect:None; + [%test_result: int option] (iround ~dir:`Zero x) ~expect:None; + [%test_result: int option] (iround_nearest x) ~expect:None; + [%test_result: int option] (iround ~dir:`Nearest x) ~expect:None; + assert (Exn.does_raise (fun () -> iround_down_exn x)); + assert (Exn.does_raise (fun () -> iround_exn ~dir:`Down x)); + assert (Exn.does_raise (fun () -> iround_up_exn x)); + assert (Exn.does_raise (fun () -> iround_exn ~dir:`Up x)); + assert (Exn.does_raise (fun () -> iround_towards_zero_exn x)); + assert (Exn.does_raise (fun () -> iround_exn ~dir:`Zero x)); + assert (Exn.does_raise (fun () -> iround_nearest_exn x)); + assert (Exn.does_raise (fun () -> iround_exn ~dir:`Nearest x)); + [%test_result: float] (round_down x) ~expect:x; + [%test_result: float] (round ~dir:`Down x) ~expect:x; + [%test_result: float] (round_up x) ~expect:x; + [%test_result: float] (round ~dir:`Up x) ~expect:x; + [%test_result: float] (round_towards_zero x) ~expect:x; + [%test_result: float] (round ~dir:`Zero x) ~expect:x; + [%test_result: float] (round_nearest x) ~expect:x; + [%test_result: float] (round ~dir:`Nearest x) ~expect:x + ;; + + let large_numbers = + let ( + ) = Int.( + ) in + let ( - ) = Int.( - ) in + List.concat + (List.init (1024 - 64) ~f:(fun x -> + let x = of_int (x + 64) in + let y = + [ 2. **. x + ; (2. **. x) -. (2. **. (x -. 53.)) + ; (* one ulp down *) + (2. **. x) +. (2. **. (x -. 52.)) + ] + (* one ulp up *) + in + y @ List.map y ~f:neg)) + @ [ infinity; neg_infinity ] + ;; + + let%test_unit _ = List.iter large_numbers ~f:large_value_test + + let numbers_near_powers_of_two = + List.concat + (List.init 64 ~f:(fun i -> + let pow2 = 2. **. of_int i in + let x = + [ pow2 + ; one_ulp `Down (pow2 +. 0.5) + ; pow2 +. 0.5 + ; one_ulp `Down (pow2 +. 1.0) + ; pow2 +. 1.0 + ; one_ulp `Down (pow2 +. 1.5) + ; pow2 +. 1.5 + ; one_ulp `Down (pow2 +. 2.0) + ; pow2 +. 2.0 + ; one_ulp `Down ((pow2 *. 2.0) -. 1.0) + ; one_ulp `Down pow2 + ; one_ulp `Up pow2 + ] + in + x @ List.map x ~f:neg)) + ;; + + let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_up_vs_down_test + let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_nearest_test + let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_down_test + let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_up_test + let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_towards_zero_test + let%test _ = List.for_all numbers_near_powers_of_two ~f:round_test + + (* code for generating random floats on which to test functions *) + let rec absirand () = + let open Int.O in + let rec aux acc cnt = + if cnt = 0 + then acc + else ( + let bit = if Random.bool () then 1 else 0 in + aux ((2 * acc) + bit) (cnt - 1)) + in + let result = aux 0 (if is_64_bit_platform then 62 else 30) in + if result >= Int.max_value - 255 + then + (* On a 64-bit box, [float x > Int.max_value] when [x >= Int.max_value - 255], so + [iround (float x)] would be out of bounds. So we try again. This branch of code + runs with probability 6e-17 :-) As such, we have some fixed tests in + [extremities_test] above, to ensure that we do always check some examples in + that range. *) + absirand () + else result + ;; + + (* -Int.max_value <= frand () <= Int.max_value *) + let frand () = + let x = of_int (absirand ()) +. Random.float 1.0 in + if Random.bool () then -1.0 *. x else x + ;; + + let randoms = List.init ~f:(fun _ -> frand ()) 10_000 + let%test _ = List.for_all randoms ~f:iround_up_vs_down_test + let%test _ = List.for_all randoms ~f:iround_nearest_test + let%test _ = List.for_all randoms ~f:iround_down_test + let%test _ = List.for_all randoms ~f:iround_up_test + let%test _ = List.for_all randoms ~f:iround_towards_zero_test + let%test _ = List.for_all randoms ~f:round_test + let%test_unit _ = special_values_test () + let%test _ = iround_nearest_test (of_int Int.max_value) + let%test _ = iround_nearest_test (of_int Int.min_value) + end) +;; + +module Test_bounds (I : sig + type t + + val num_bits : int + val of_float : float -> t + val to_int64 : t -> Int64.t + val max_value : t + val min_value : t +end) = +struct + open I + + let float_lower_bound = lower_bound_for_int num_bits + let float_upper_bound = upper_bound_for_int num_bits + let%test_unit "lower bound is valid" = ignore (of_float float_lower_bound : t) + let%test_unit "upper bound is valid" = ignore (of_float float_upper_bound : t) + + let%test "smaller than lower bound is not valid" = + Exn.does_raise (fun () -> of_float (one_ulp `Down float_lower_bound)) + ;; + + let%test "bigger than upper bound is not valid" = + Exn.does_raise (fun () -> of_float (one_ulp `Up float_upper_bound)) + ;; + + (* We use [Caml.Int64.of_float] in the next two tests because [Int64.of_float] rejects + out-of-range inputs, whereas [Caml.Int.of_float] simply overflows (returns + [Int64.min_int]). *) + + let%test "smaller than lower bound overflows" = + let lower_bound = Int64.of_float float_lower_bound in + let lower_bound_minus_epsilon = + Stdlib.Int64.of_float (one_ulp `Down float_lower_bound) + in + let min_value = to_int64 min_value in + if Int.( = ) num_bits 64 + (* We cannot detect overflow because on Intel overflow results in min_value. *) + then true + else ( + assert (Int64.( <= ) lower_bound_minus_epsilon lower_bound); + (* a value smaller than min_value would overflow if converted to [t] *) + Int64.( < ) lower_bound_minus_epsilon min_value) + ;; + + let%test "bigger than upper bound overflows" = + let upper_bound = Int64.of_float float_upper_bound in + let upper_bound_plus_epsilon = + Stdlib.Int64.of_float (one_ulp `Up float_upper_bound) + in + let max_value = to_int64 max_value in + if Int.( = ) num_bits 64 + (* upper_bound_plus_epsilon is not representable as a Int64.t, it has overflowed *) + then Int64.( < ) upper_bound_plus_epsilon upper_bound + else ( + assert (Int64.( >= ) upper_bound_plus_epsilon upper_bound); + (* a value greater than max_value would overflow if converted to [t] *) + Int64.( > ) upper_bound_plus_epsilon max_value) + ;; +end + +let%test_module "Int" = (module Test_bounds (Int)) +let%test_module "Int32" = (module Test_bounds (Int32)) +let%test_module "Int63" = (module Test_bounds (Int63)) +let%test_module "Int63_emul" = (module Test_bounds (Base.Int63.Private.Emul)) +let%test_module "Int64" = (module Test_bounds (Int64)) +let%test_module "Nativeint" = (module Test_bounds (Nativeint)) +let%test_unit _ = [%test_result: string] (to_string 3.14) ~expect:"3.14" +let%test_unit _ = [%test_result: string] (to_string 3.1400000000000001) ~expect:"3.14" + +let%test_unit _ = + [%test_result: string] (to_string 3.1400000000000004) ~expect:"3.1400000000000006" +;; + +let%test_unit _ = + [%test_result: string] (to_string 8.000000000000002) ~expect:"8.0000000000000018" +;; + +let%test_unit _ = [%test_result: string] (to_string 9.992) ~expect:"9.992" + +let%test_unit _ = + [%test_result: string] + (to_string ((2. **. 63.) *. (1. +. (2. **. -52.)))) + ~expect:"9.2233720368547779e+18" +;; + +let%test_unit _ = [%test_result: string] (to_string (-3.)) ~expect:"-3." +let%test_unit _ = [%test_result: string] (to_string nan) ~expect:"nan" +let%test_unit _ = [%test_result: string] (to_string infinity) ~expect:"inf" +let%test_unit _ = [%test_result: string] (to_string neg_infinity) ~expect:"-inf" +let%test_unit _ = [%test_result: string] (to_string 3e100) ~expect:"3e+100" + +let%test_unit _ = + [%test_result: string] (to_string max_finite_value) ~expect:"1.7976931348623157e+308" +;; + +let%test_unit _ = + [%test_result: string] + (to_string min_positive_subnormal_value) + ~expect:"4.94065645841247e-324" +;; + +let%test _ = epsilon_float = one_ulp `Up 1. -. 1. +let%test _ = one_ulp_less_than_half = 0.49999999999999994 +let%test _ = round_down 3.6 = 3. && round_down (-3.6) = -4. +let%test _ = round_up 3.6 = 4. && round_up (-3.6) = -3. +let%test _ = round_towards_zero 3.6 = 3. && round_towards_zero (-3.6) = -3. +let%test _ = round_nearest_half_to_even 0. = 0. +let%test _ = round_nearest_half_to_even 0.5 = 0. +let%test _ = round_nearest_half_to_even (-0.5) = 0. +let%test _ = round_nearest_half_to_even (one_ulp `Up 0.5) = 1. +let%test _ = round_nearest_half_to_even (one_ulp `Down 0.5) = 0. +let%test _ = round_nearest_half_to_even (one_ulp `Up (-0.5)) = 0. +let%test _ = round_nearest_half_to_even (one_ulp `Down (-0.5)) = -1. +let%test _ = round_nearest_half_to_even 3.5 = 4. +let%test _ = round_nearest_half_to_even 4.5 = 4. +let%test _ = round_nearest_half_to_even (one_ulp `Up (-5.5)) = -5. +let%test _ = round_nearest_half_to_even 5.5 = 6. +let%test _ = round_nearest_half_to_even 6.5 = 6. +let%test _ = round_nearest_half_to_even (one_ulp `Up (-.(2. **. 52.))) = -.(2. **. 52.) +let%test _ = round_nearest (one_ulp `Up (-.(2. **. 52.))) = 1. -. (2. **. 52.) +let%test _ = is_integer 1. +let%test _ = is_integer 0. +let%test _ = is_integer (-0.) +let%test _ = is_integer (-1.) +let%test _ = is_integer 8.98e307 +let%test _ = is_integer ((2. ** 53.) -. 0.5) +let%test _ = not (is_integer ((2. ** 52.) -. 0.5)) +let%test _ = not (is_integer 0.0000000000000001) +let%test _ = not (is_integer (-0.0000000000000001)) +let%test _ = not (is_integer 0.9999999999999999) +let%test _ = not (is_integer nan) +let%test _ = not (is_integer infinity) +let%test _ = not (is_integer neg_infinity) + +let%test_module _ = + (module struct + (* check we raise on invalid input *) + let must_fail f x = Exn.does_raise (fun () -> f x) + + let must_succeed f x = + ignore (f x : _); + true + ;; + + let%test _ = must_fail int63_round_nearest_portable_alloc_exn nan + let%test _ = must_fail int63_round_nearest_portable_alloc_exn max_value + let%test _ = must_fail int63_round_nearest_portable_alloc_exn min_value + let%test _ = must_fail int63_round_nearest_portable_alloc_exn (2. **. 63.) + let%test _ = must_fail int63_round_nearest_portable_alloc_exn ~-.(2. **. 63.) + let%test _ = must_succeed int63_round_nearest_portable_alloc_exn ((2. **. 62.) -. 512.) + let%test _ = must_fail int63_round_nearest_portable_alloc_exn (2. **. 62.) + + let%test _ = + must_fail int63_round_nearest_portable_alloc_exn (~-.(2. **. 62.) -. 1024.) + ;; + + let%test _ = must_succeed int63_round_nearest_portable_alloc_exn ~-.(2. **. 62.) + end) +;; + +let%test _ = round_nearest 3.6 = 4. && round_nearest (-3.6) = -4. + +(* The redefinition of [sexp_of_t] in float.ml assumes sexp conversion uses E rather than + e. *) +let%test_unit "e vs E" = + [%test_result: Sexp.t] [%sexp (1.4e100 : t)] ~expect:(Atom "1.4E+100") +;; + +let%test_module _ = + (module struct + let test ?delimiter ~decimals f s s_strip_zero = + let s' = to_string_hum ?delimiter ~decimals ~strip_zero:false f in + if String.(s' <> s) + then + raise_s + [%message + "to_string_hum ~strip_zero:false" + ~input:(f : float) + (decimals : int) + ~got:(s' : string) + ~expected:(s : string)]; + let s_strip_zero' = to_string_hum ?delimiter ~decimals ~strip_zero:true f in + if String.(s_strip_zero' <> s_strip_zero) + then + raise_s + [%message + "to_string_hum ~strip_zero:true" + ~input:(f : float) + (decimals : int) + ~got:(s_strip_zero : string) + ~expected:(s_strip_zero' : string)] + ;; + + let%test_unit _ = test ~decimals:3 0.99999 "1.000" "1" + let%test_unit _ = test ~decimals:3 0.00001 "0.000" "0" + let%test_unit _ = test ~decimals:3 ~-.12345.1 "-12_345.100" "-12_345.1" + let%test_unit _ = test ~delimiter:',' ~decimals:3 ~-.12345.1 "-12,345.100" "-12,345.1" + let%test_unit _ = test ~decimals:0 0.99999 "1" "1" + let%test_unit _ = test ~decimals:0 0.00001 "0" "0" + let%test_unit _ = test ~decimals:0 ~-.12345.1 "-12_345" "-12_345" + let%test_unit _ = test ~decimals:0 (5.0 /. 0.0) "inf" "inf" + let%test_unit _ = test ~decimals:0 (-5.0 /. 0.0) "-inf" "-inf" + let%test_unit _ = test ~decimals:0 (0.0 /. 0.0) "nan" "nan" + let%test_unit _ = test ~decimals:2 (5.0 /. 0.0) "inf" "inf" + let%test_unit _ = test ~decimals:2 (-5.0 /. 0.0) "-inf" "-inf" + let%test_unit _ = test ~decimals:2 (0.0 /. 0.0) "nan" "nan" + let%test_unit _ = test ~decimals:5 (10_000.0 /. 3.0) "3_333.33333" "3_333.33333" + let%test_unit _ = test ~decimals:2 ~-.0.00001 "-0.00" "-0" + + let rand_test n = + let go () = + let f = Random.float 1_000_000.0 -. 500_000.0 in + let repeatable to_str = + let s = to_str f in + if String.( <> ) + (String.split s ~on:',' |> String.concat |> of_string |> to_str) + s + then raise_s [%message "failed" (f : t)] + in + repeatable (to_string_hum ~decimals:3 ~strip_zero:false) + in + try + for _ = 0 to Int.( - ) n 1 do + go () + done; + true + with + | e -> + eprintf "%s\n%!" (Exn.to_string e); + false + ;; + + let%test _ = rand_test 10_000 + end) +;; + +let%test_module "Hexadecimal syntax" = + (module struct + let should_fail str = Exn.does_raise (fun () -> Stdlib.float_of_string str) + let test_equal str g = Stdlib.float_of_string str = g + let%test _ = should_fail "0x" + let%test _ = should_fail "0x.p0" + let%test _ = test_equal "0x0" 0. + let%test _ = test_equal "0x1.b7p-1" 0.857421875 + let%test _ = test_equal "0x1.999999999999ap-4" 0.1 + end) +;; + +let%expect_test "square" = + printf "%f\n" (square 1.5); + printf "%f\n" (square (-2.5)); + [%expect {| + 2.250000 + 6.250000 + |}] +;; + +let%expect_test "mathematical constants" = + (* Compare to the from-string conversion of numbers from Wolfram Alpha *) + let eq x s = assert (x = of_string s) in + eq pi "3.141592653589793238462643383279502884197169399375105820974"; + eq sqrt_pi "1.772453850905516027298167483341145182797549456122387128213"; + eq sqrt_2pi "2.506628274631000502415765284811045253006986740609938316629"; + eq euler "0.577215664901532860606512090082402431042159335939923598805"; + (* Check size of diff from ordinary computation. *) + printf "sqrt pi diff : %.20f\n" (sqrt_pi - sqrt pi); + printf "sqrt 2pi diff : %.20f\n" (sqrt_2pi - sqrt (2. * pi)); + [%expect + {| + sqrt pi diff : 0.00000000000000022204 + sqrt 2pi diff : 0.00000000000000044409 + |}] +;; + +let%test _ = not (is_negative Float.nan) +let%test _ = not (is_non_positive Float.nan) +let%test _ = is_non_negative (-0.) + +let%test_unit "int to float conversion consistency" = + let test_int63 x = + [%test_result: float] (Float.of_int63 x) ~expect:(Float.of_int64 (Int63.to_int64 x)) + in + let test_int x = + [%test_result: float] (Float.of_int x) ~expect:(Float.of_int63 (Int63.of_int x)); + test_int63 (Int63.of_int x) + in + test_int 0; + test_int 35; + test_int (-1); + test_int Int.max_value; + test_int Int.min_value; + test_int63 Int63.zero; + test_int63 Int63.min_value; + test_int63 Int63.max_value; + let rand = Random.State.make [| Hashtbl.hash "int to float conversion consistency" |] in + for _i = 0 to 100 do + let x = Random.State.int rand Int.max_value in + test_int x + done; + () +;; + +let%expect_test "min and max" = + let nan = Float.nan in + let inf = Float.infinity in + let ninf = Float.neg_infinity in + List.iter + [ 0.1, 0.3; 71., -7.; nan, 0.3; nan, ninf; nan, inf; nan, nan; ninf, inf; 0., -0. ] + ~f:(fun (a, b) -> + printf + "%5g%5g%5g%5g%5g%5g\n" + a + b + (Float.min a b) + (Float.min b a) + (Float.max a b) + (Float.max b a)); + [%expect + {| + 0.1 0.3 0.1 0.1 0.3 0.3 + 71 -7 -7 -7 71 71 + nan 0.3 nan nan nan nan + nan -inf nan nan nan nan + nan inf nan nan nan nan + nan nan nan nan nan nan + -inf inf -inf -inf inf inf + 0 -0 -0 0 -0 0 + |}] +;; + +let%expect_test "is_nan, is_inf, and is_finite" = + List.iter + ~f:(fun x -> + printf + !"%24s %5s %5s %5s\n" + (to_string x) + (Bool.to_string (is_nan x)) + (Bool.to_string (is_inf x)) + (Bool.to_string (is_finite x))) + [ nan + ; neg_infinity + ; -.max_finite_value + ; -1. + ; -.min_positive_subnormal_value + ; -0. + ; 0. + ; min_positive_subnormal_value + ; 1. + ; max_finite_value + ; infinity + ]; + [%expect + {| + nan true false false + -inf false true false + -1.7976931348623157e+308 false false true + -1. false false true + -4.94065645841247e-324 false false true + -0. false false true + 0. false false true + 4.94065645841247e-324 false false true + 1. false false true + 1.7976931348623157e+308 false false true + inf false true false + |}] +;; + +let%expect_test "nan" = + require [%here] (Float.is_nan (Float.min 1. Float.nan)); + require [%here] (Float.is_nan (Float.min Float.nan 0.)); + require [%here] (Float.is_nan (Float.min Float.nan Float.nan)); + require [%here] (Float.is_nan (Float.max 1. Float.nan)); + require [%here] (Float.is_nan (Float.max Float.nan 0.)); + require [%here] (Float.is_nan (Float.max Float.nan Float.nan)); + require_equal [%here] (module Float) 1. (Float.min_inan 1. Float.nan); + require_equal [%here] (module Float) 0. (Float.min_inan Float.nan 0.); + require [%here] (Float.is_nan (Float.min_inan Float.nan Float.nan)); + require_equal [%here] (module Float) 1. (Float.max_inan 1. Float.nan); + require_equal [%here] (module Float) 0. (Float.max_inan Float.nan 0.); + require [%here] (Float.is_nan (Float.max_inan Float.nan Float.nan)) +;; + +let%expect_test "iround_exn" = + require_equal [%here] (module Int) 0 (Float.iround_exn ~dir:`Nearest 0.2); + require_equal [%here] (module Int) 0 (Float.iround_exn ~dir:`Nearest (-0.2)); + require_equal [%here] (module Int) 3 (Float.iround_exn ~dir:`Nearest 3.4); + require_equal [%here] (module Int) (-3) (Float.iround_exn ~dir:`Nearest (-3.4)) +;; + +let%expect_test "log" = + let test float = + let log2 = Float.log2 float in + let log10 = Float.log10 float in + let ratio = log2 /. log10 in + let ratio = + (* NAN behavior differs in js_of_ocaml *) + if Float.is_nan ratio + then Float.nan + else ( + assert (Float.(abs ratio - (1. / log10 2.) < 1e-15)); + ratio) + in + print_s [%sexp { log2 : float; log10 : float; ratio : float }] + in + test (-1.); + [%expect {| + ((log2 NAN) + (log10 NAN) + (ratio NAN)) + |}]; + test 0.; + [%expect {| + ((log2 -INF) + (log10 -INF) + (ratio NAN)) + |}]; + test 1.; + [%expect {| + ((log2 0) + (log10 0) + (ratio NAN)) + |}]; + test 2.; + [%expect + {| + ((log2 1) + (log10 0.3010299956639812) + (ratio 3.3219280948873622)) + |}]; + test 10.; + [%expect + {| + ((log2 3.3219280948873622) + (log10 1) + (ratio 3.3219280948873622)) + |}]; + test Float.min_positive_subnormal_value; + [%expect + {| + ((log2 -1074) + (log10 -323.30621534311581) + (ratio 3.3219280948873622)) + |}]; + test Float.epsilon_float; + [%expect + {| + ((log2 -52) + (log10 -15.653559774527022) + (ratio 3.3219280948873626)) + |}]; + test Float.pi; + [%expect + {| + ((log2 1.6514961294723187) + (log10 0.4971498726941338) + (ratio 3.3219280948873626)) + |}]; + test Float.max_finite_value; + [%expect + {| + ((log2 1024) + (log10 308.25471555991675) + (ratio 3.3219280948873622)) + |}]; + test Float.infinity; + [%expect {| + ((log2 INF) + (log10 INF) + (ratio NAN)) + |}] +;; + +let%expect_test "float comparisons permit both local and global arguments" = + let (_ : float -> float -> bool) = Float.( < ) in + let (_ : float -> float -> bool) = Float.( < ) in + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/test_float.mli b/unikernel/duniverse/base/test/test_float.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_float.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_fn.ml b/unikernel/duniverse/base/test/test_fn.ml new file mode 100644 index 00000000..8a92161d --- /dev/null +++ b/unikernel/duniverse/base/test/test_fn.ml @@ -0,0 +1,10 @@ +open! Import +open! Fn + +(* enforce that we're testing [Fn.(|>)] and not ppx_pipebang. *) +let (_ : 'a -> ('a -> 'b) -> 'b) = ( |> ) +let%test _ = 1 |> fun x -> x = 1 +let%test _ = 1 |> fun x -> x + 1 |> fun y -> y = 2 +let%test _ = 0 = apply_n_times ~n:0 (fun _ -> assert false) 0 +let%test _ = 0 = apply_n_times ~n:(-3) (fun _ -> assert false) 0 +let%test _ = 10 = apply_n_times ~n:10 (( + ) 1) 0 diff --git a/unikernel/duniverse/base/test/test_fn.mli b/unikernel/duniverse/base/test/test_fn.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_fn.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_fn_local.mlt b/unikernel/duniverse/base/test/test_fn_local.mlt new file mode 100644 index 00000000..031cbd35 --- /dev/null +++ b/unikernel/duniverse/base/test/test_fn_local.mlt @@ -0,0 +1,37 @@ +open Base + +(* [id] can operate on global arguments *) + +let f : 'a. 'a -> 'a = Fn.id + +[%%expect {| |}] + +(* [id] can operate on local arguments *) + +let f : 'a. local_ 'a -> local_ 'a = Fn.id + +[%%expect {| |}] + +(* [id] cannot make a local argument global; this would be unsound *) + +let f : 'a. local_ 'a -> 'a = Fn.id + +[%%expect + {| +Line _, characters _-_: +Error: This expression has type local_ 'b -> local_ 'b + but an expression was expected of type local_ 'a -> 'a +|}] + +(* [id] cannot make a global argument local; this is unexpected. + If this following code gets accepted, it means that the meaning of + [@local_opt] may have changed. However, the [f] below is not unsound. *) + +let f : 'a. 'a -> local_ 'a = Fn.id + +[%%expect + {| +Line _, characters _-_: +Error: This expression has type 'b -> 'b + but an expression was expected of type 'a -> local_ 'a +|}] diff --git a/unikernel/duniverse/base/test/test_globalize_lib.ml b/unikernel/duniverse/base/test/test_globalize_lib.ml new file mode 100644 index 00000000..f2d41270 --- /dev/null +++ b/unikernel/duniverse/base/test/test_globalize_lib.ml @@ -0,0 +1,128 @@ +open! Core +open! Import + +let%expect_test "bool_true" = + printf "%b" (globalize_bool true); + [%expect {| true |}] +;; + +let%expect_test "bool_false" = + printf "%b" (globalize_bool false); + [%expect {| false |}] +;; + +let%expect_test "char" = + let c = 'A' in + let c' = globalize_char c in + printf "%s" (Char.to_string c'); + [%expect {| A |}] +;; + +let%expect_test "float" = + let f = 5.5 in + let f' = globalize_float f in + printf "%f" f'; + [%expect {| 5.500000 |}] +;; + +let%expect_test "int" = + printf "%d" (globalize_int 42); + [%expect {| 42 |}] +;; + +let%expect_test "int32" = + let i = 42l in + let i' = globalize_int32 i in + printf "%ld" i'; + [%expect {| 42 |}] +;; + +let%expect_test "int64" = + let i = 42L in + let i' = globalize_int64 i in + printf "%Ld" i'; + [%expect {| 42 |}] +;; + +let%expect_test "nativeint" = + let i = 42n in + let i' = globalize_nativeint i in + printf "%nd" i'; + [%expect {| 42 |}] +;; + +let%expect_test "string" = + let s = "hello" in + let s' = globalize_string s in + printf "%s" s'; + [%expect {| hello |}] +;; + +let%expect_test "array" = + let a = [| "one"; "two"; "three" |] in + let a' = globalize_array globalize_string a in + Array.iter ~f:print_endline a'; + [%expect {| + one + two + three + |}] +;; + +let%expect_test "list" = + let l = [ "one"; "two"; "three" ] in + let l' = globalize_list globalize_string l in + List.iter ~f:print_endline l'; + [%expect {| + one + two + three + |}] +;; + +let%expect_test "option" = + let o = Some "hello" in + let o' = globalize_option globalize_string o in + Option.iter ~f:print_endline o'; + [%expect {| hello |}] +;; + +let%expect_test "ref" = + let r = ref "hello" in + let r' = globalize_ref globalize_string r in + print_endline !r'; + [%expect {| hello |}] +;; + +let%expect_test "no sharing between globalized refs" = + let r = ref "initial" in + let r' = globalize_ref (fun _ -> assert false) r in + print_endline !r; + [%expect {| initial |}]; + print_endline !r'; + [%expect {| initial |}]; + r := "local"; + r' := "global"; + print_endline !r; + [%expect {| local |}]; + print_endline !r'; + [%expect {| global |}] +;; + +external get : 'a array -> int -> 'a = "%array_safe_get" +external set : 'a array -> int -> 'a -> unit = "%array_safe_set" + +let%expect_test "no sharing between globalized arrays" = + let a = [| "initial" |] in + let a' = globalize_array (fun _ -> assert false) a in + print_endline (get a 0); + [%expect {| initial |}]; + print_endline (get a' 0); + [%expect {| initial |}]; + set a 0 "local"; + set a' 0 "global"; + print_endline (get a 0); + [%expect {| local |}]; + print_endline (get a' 0); + [%expect {| global |}] +;; diff --git a/unikernel/duniverse/base/test/test_globalize_lib.mli b/unikernel/duniverse/base/test/test_globalize_lib.mli new file mode 100644 index 00000000..26fdb693 --- /dev/null +++ b/unikernel/duniverse/base/test/test_globalize_lib.mli @@ -0,0 +1 @@ +(*_ Intentionally blank *) diff --git a/unikernel/duniverse/base/test/test_hash_set.ml b/unikernel/duniverse/base/test/test_hash_set.ml new file mode 100644 index 00000000..f678a236 --- /dev/null +++ b/unikernel/duniverse/base/test/test_hash_set.ml @@ -0,0 +1,100 @@ +open! Import +open! Hash_set + +let%test_module "Set Intersection" = + (module struct + let run_test first_contents second_contents ~expect = + let of_list lst = + let s = create (module String) in + List.iter lst ~f:(add s); + s + in + let s1 = of_list first_contents in + let s2 = of_list second_contents in + let expect = of_list expect in + let result = inter s1 s2 in + iter result ~f:(fun x -> assert (mem expect x)); + iter expect ~f:(fun x -> assert (mem result x)); + let equal x y = 0 = String.compare x y in + assert (List.equal equal (to_list result) (to_list expect)); + assert (length result = length expect); + (* Make sure the sets are unmodified by the inter *) + assert (List.length first_contents = length s1); + assert (List.length second_contents = length s2) + ;; + + let%test_unit "First smaller" = + run_test [ "0"; "3"; "99" ] [ "0"; "1"; "2"; "3" ] ~expect:[ "0"; "3" ] + ;; + + let%test_unit "Second smaller" = + run_test [ "a"; "b"; "c"; "d" ] [ "b"; "d" ] ~expect:[ "b"; "d" ] + ;; + + let%test_unit "No intersection" = + run_test ~expect:[] [ "a"; "b"; "c"; "d" ] [ "1"; "2"; "3"; "4" ] + ;; + end) +;; + +let%expect_test "sexp" = + let ints = List.init 20 ~f:(fun x -> x * x) in + let int_hash_set = Hash_set.of_list (module Int) ints in + print_s [%sexp (int_hash_set : int Hash_set.t)]; + [%expect {| (0 1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361) |}]; + let strs = List.init 20 ~f:(fun x -> Int.to_string x) in + let str_hash_set = Hash_set.of_list (module String) strs in + print_s [%sexp (str_hash_set : string Hash_set.t)]; + [%expect {| (0 1 10 11 12 13 14 15 16 17 18 19 2 3 4 5 6 7 8 9) |}] +;; + +let%expect_test "to_array" = + let empty_array = to_array (Hash_set.of_list (module Int) []) in + print_s [%sexp (empty_array : int Array.t)]; + [%expect {| () |}]; + let array_from_to_array = to_array (Hash_set.of_list (module Int) [ 1; 2; 3; 4; 5 ]) in + print_s [%sexp (array_from_to_array : int Array.t)]; + [%expect {| (1 3 2 4 5) |}]; + let array_via_to_list = + to_list (Hash_set.of_list (module Int) [ 1; 2; 3; 4; 5 ]) |> Array.of_list + in + print_s [%sexp (array_via_to_list : int Array.t)]; + [%expect {| (1 3 2 4 5) |}] +;; + +let%expect_test "union" = + let print_union s1 s2 = + let s1 = Hash_set.of_list (module Int) s1 in + let s2 = Hash_set.of_list (module Int) s2 in + print_s [%sexp (Hash_set.union s1 s2 : int Hash_set.t)] + in + print_union [ 0; 1; 2 ] [ 3; 4; 5 ]; + [%expect {| (0 1 2 3 4 5) |}]; + print_union [ 0; 1; 2 ] [ 1; 2; 3 ]; + [%expect {| (0 1 2 3) |}] +;; + +let%expect_test "deriving equal" = + let module Hs = struct + type t = { hs : Hash_set.M(Int).t } [@@deriving equal] + + let of_list lst = { hs = Hash_set.of_list (module Int) lst } + end + in + require [%here] (Hs.equal (Hs.of_list []) (Hs.of_list [])); + require [%here] (not (Hs.equal (Hs.of_list [ 1 ]) (Hs.of_list []))); + require [%here] (not (Hs.equal (Hs.of_list [ 1 ]) (Hs.of_list [ 2 ]))); + require [%here] (Hs.equal (Hs.of_list [ 1 ]) (Hs.of_list [ 1 ])) +;; + +(* This module exists to check, at compile-time, that [Creators] is a subset of + [Creators_generic]. *) +module _ (M : Creators) : + Creators_generic + with type 'a t := 'a M.t + with type 'a elt := 'a + with type ('a, 'z) create_options := ('a, 'z) create_options = struct + include M + + let create ?growth_allowed ?size m () = create ?growth_allowed ?size m +end diff --git a/unikernel/duniverse/base/test/test_hash_set.mli b/unikernel/duniverse/base/test/test_hash_set.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_hash_set.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_hashtbl.ml b/unikernel/duniverse/base/test/test_hashtbl.ml new file mode 100644 index 00000000..28f8e1c0 --- /dev/null +++ b/unikernel/duniverse/base/test/test_hashtbl.ml @@ -0,0 +1,150 @@ +open! Base +open Expect_test_helpers_base + +type int_hashtbl = int Hashtbl.M(Int).t [@@deriving sexp] + +let%test "Hashtbl.merge succeeds with first-class-module interface" = + let t1 = Hashtbl.create (module Int) in + let t2 = Hashtbl.create (module Int) in + let result = + Hashtbl.merge t1 t2 ~f:(fun ~key:_ -> function + | `Left x -> x + | `Right x -> x + | `Both _ -> assert false) + |> Hashtbl.to_alist + in + List.equal Poly.equal result [] +;; + +let%test_module _ = + (module Hashtbl_tests.Make (struct + include Hashtbl + + let create_poly ?size () = Poly.create ?size () + let of_alist_poly_exn l = Poly.of_alist_exn l + let of_alist_poly_or_error l = Poly.of_alist_or_error l + end)) +;; + +let%expect_test "Hashtbl.find_exn" = + let table = Hashtbl.of_alist_exn (module String) [ "one", 1; "two", 2; "three", 3 ] in + let test_success key = + require_does_not_raise [%here] (fun () -> + print_s [%sexp (Hashtbl.find_exn table key : int)]) + in + test_success "one"; + [%expect {| 1 |}]; + test_success "two"; + [%expect {| 2 |}]; + test_success "three"; + [%expect {| 3 |}]; + let test_failure key = + require_does_raise [%here] (fun () -> Hashtbl.find_exn table key) + in + test_failure "zero"; + [%expect {| (Not_found_s ("Hashtbl.find_exn: not found" zero)) |}]; + test_failure "four"; + [%expect {| (Not_found_s ("Hashtbl.find_exn: not found" four)) |}] +;; + +let%expect_test "[t_of_sexp] error on duplicate" = + let sexp = Sexplib.Sexp.of_string "((0 a)(1 b)(2 c)(1 d))" in + (match [%of_sexp: string Hashtbl.M(String).t] sexp with + | t -> print_cr [%here] [%message "did not raise" (t : string Hashtbl.M(String).t)] + | exception (Sexp.Of_sexp_error _ as exn) -> print_s (sexp_of_exn exn) + | exception exn -> print_cr [%here] [%message "wrong kind of exception" (exn : exn)]); + [%expect {| (Of_sexp_error "Hashtbl.t_of_sexp: duplicate key" (invalid_sexp 1)) |}] +;; + +let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn]" = + let test ?size l = + let t = l |> List.map ~f:(fun i -> i, i) |> Hashtbl.of_alist_exn ?size (module Int) in + print_s + [%message + "" + ~input:(t : int_hashtbl) + ~choose:(Hashtbl.choose t : (_ * _) option) + ~choose_exn: + (Or_error.try_with (fun () -> Hashtbl.choose_exn t) : (_ * _) Or_error.t) + ~choose_randomly:(Hashtbl.choose_randomly t : (_ * _) option) + ~choose_randomly_exn: + (Or_error.try_with (fun () -> Hashtbl.choose_randomly_exn t) + : (_ * _) Or_error.t)] + in + test []; + [%expect + {| + ((input ()) + (choose ()) + (choose_exn (Error ("[Hashtbl.choose_exn] of empty hashtbl"))) + (choose_randomly ()) + (choose_randomly_exn ( + Error ("[Hashtbl.choose_randomly_exn] of empty hashtbl")))) + |}]; + test [] ~size:100; + [%expect + {| + ((input ()) + (choose ()) + (choose_exn (Error ("[Hashtbl.choose_exn] of empty hashtbl"))) + (choose_randomly ()) + (choose_randomly_exn ( + Error ("[Hashtbl.choose_randomly_exn] of empty hashtbl")))) + |}]; + test [ 1 ]; + [%expect + {| + ((input ((1 1))) + (choose ((_ _))) + (choose_exn (Ok (_ _))) + (choose_randomly ((_ _))) + (choose_randomly_exn (Ok (_ _)))) + |}]; + test [ 1 ] ~size:100; + [%expect + {| + ((input ((1 1))) + (choose ((_ _))) + (choose_exn (Ok (_ _))) + (choose_randomly ((_ _))) + (choose_randomly_exn (Ok (_ _)))) + |}]; + test [ 1; 2 ]; + [%expect + {| + ((input ( + (1 1) + (2 2))) + (choose ((_ _))) + (choose_exn (Ok (_ _))) + (choose_randomly ((_ _))) + (choose_randomly_exn (Ok (_ _)))) + |}]; + test [ 1; 2 ] ~size:100; + [%expect + {| + ((input ( + (1 1) + (2 2))) + (choose ((_ _))) + (choose_exn (Ok (_ _))) + (choose_randomly ((_ _))) + (choose_randomly_exn (Ok (_ _)))) + |}] +;; + +let%expect_test "update_and_return" = + let t = Hashtbl.create (module String) in + let update_and_return str ~f = + let x = Hashtbl.update_and_return t str ~f in + print_s [%message (t : (string, int) Hashtbl.t) (x : int)] + in + update_and_return "foo" ~f:(function + | None -> 1 + | Some _ -> failwith "no"); + [%expect {| ((t ((foo 1))) (x 1)) |}]; + update_and_return "foo" ~f:(function + | Some 1 -> 2 + | _ -> failwith "no"); + [%expect {| ((t ((foo 2))) (x 2)) |}] +;; diff --git a/unikernel/duniverse/base/test/test_hashtbl.mli b/unikernel/duniverse/base/test/test_hashtbl.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_hashtbl.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_identifiable.ml b/unikernel/duniverse/base/test/test_identifiable.ml new file mode 100644 index 00000000..d65af34b --- /dev/null +++ b/unikernel/duniverse/base/test/test_identifiable.ml @@ -0,0 +1,17 @@ +open! Import +open! Identifiable + +module T = struct + type t = string + + include Make (struct + let module_name = "test" + + include String + end) +end + +let%expect_test ("hash coherence" [@tags "64-bits-only"]) = + check_hash_coherence [%here] (module T) ([ ""; "a"; "foo" ] |> List.map ~f:T.of_string); + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/test_identifiable.mli b/unikernel/duniverse/base/test/test_identifiable.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_identifiable.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_indexed_container.ml b/unikernel/duniverse/base/test/test_indexed_container.ml new file mode 100644 index 00000000..e7257223 --- /dev/null +++ b/unikernel/duniverse/base/test/test_indexed_container.ml @@ -0,0 +1,199 @@ +open! Import + +module type S = Indexed_container.S1 with type 'a t = 'a list + +module This_list : S = struct + include List + + include Indexed_container.Make (struct + type 'a t = 'a list + + let fold = List.fold + let iter = `Custom List.iter + let length = `Custom List.length + let foldi = `Define_using_fold + let iteri = `Define_using_fold + end) +end + +module That_list : S = List + +let examples = [ []; [ 1 ]; [ 2; 3 ]; [ 4; 5; 1 ]; List.init 8 ~f:(fun i -> i * i) ] + +module type Output = sig + type t [@@deriving compare, sexp_of] +end + +module Int_list = struct + type t = int list [@@deriving compare, sexp_of] +end + +module Int_pair_option = struct + type t = (int * int) option [@@deriving compare, sexp_of] +end + +module Int_option = struct + type t = int option [@@deriving compare, sexp_of] +end + +let check (type a) here examples ~actual ~expect (module Output : Output with type t = a) = + List.iter examples ~f:(fun example -> + let actual = actual example in + let expect = expect example in + require + here + (Output.compare actual expect = 0) + ~if_false_then_print_s:(lazy [%message (expect : Output.t)]); + print_s [%sexp (actual : Output.t)]) +;; + +let%expect_test "foldi" = + let f i acc elt = if i % 2 = 0 then elt :: acc else acc in + check + [%here] + examples + (module Int_list) + ~actual:(fun list -> This_list.foldi list ~init:[] ~f) + ~expect:(fun list -> That_list.foldi list ~init:[] ~f); + [%expect {| + () + (1) + (2) + (1 4) + (36 16 4 0) + |}] +;; + +let%expect_test "findi" = + let check f = + check + [%here] + examples + (module Int_pair_option) + ~actual:(fun list -> This_list.findi list ~f) + ~expect:(fun list -> That_list.findi list ~f) + in + check (fun i _elt -> i = 0); + [%expect {| + () + ((0 1)) + ((0 2)) + ((0 4)) + ((0 0)) + |}]; + check (fun _i elt -> elt = 1); + [%expect {| + () + ((0 1)) + () + ((2 1)) + ((1 1)) + |}] +;; + +let%expect_test "find_mapi" = + let f i elt = if elt = 1 then Some ((i * 100) + elt) else None in + check + [%here] + examples + (module Int_option) + ~actual:(fun list -> This_list.find_mapi list ~f) + ~expect:(fun list -> That_list.find_mapi list ~f); + [%expect {| + () + (1) + () + (201) + (101) + |}] +;; + +let%expect_test "iteri" = + let go iteri = + let acc = ref [] in + iteri ~f:(fun i elt -> acc := i :: elt :: !acc); + !acc + in + check + [%here] + examples + (module Int_list) + ~actual:(fun list -> go (This_list.iteri list)) + ~expect:(fun list -> go (That_list.iteri list)); + [%expect + {| + () + (0 1) + (1 3 0 2) + (2 1 1 5 0 4) + (7 49 6 36 5 25 4 16 3 9 2 4 1 1 0 0) + |}] +;; + +let bool_examples = + [ [] + ; [ true ] + ; [ false ] + ; [ false; false ] + ; [ true; false ] + ; [ false; true ] + ; [ true; true ] + ] +;; + +let%expect_test "for_alli" = + let f _i elt = elt in + check + [%here] + bool_examples + (module Bool) + ~actual:(fun list -> This_list.for_alli list ~f) + ~expect:(fun list -> That_list.for_alli list ~f); + [%expect {| + true + true + false + false + false + false + true + |}] +;; + +let%expect_test "existsi" = + let f _i elt = elt in + check + [%here] + bool_examples + (module Bool) + ~actual:(fun list -> This_list.existsi list ~f) + ~expect:(fun list -> That_list.existsi list ~f); + [%expect {| + false + true + false + false + true + true + true + |}] +;; + +let%expect_test "counti" = + let f _i elt = elt in + check + [%here] + bool_examples + (module Int) + ~actual:(fun list -> This_list.counti list ~f) + ~expect:(fun list -> That_list.counti list ~f); + [%expect {| + 0 + 1 + 0 + 0 + 1 + 1 + 2 + |}] +;; diff --git a/unikernel/duniverse/base/test/test_indexed_container.mli b/unikernel/duniverse/base/test/test_indexed_container.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_indexed_container.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_info.ml b/unikernel/duniverse/base/test/test_info.ml new file mode 100644 index 00000000..c6d353e3 --- /dev/null +++ b/unikernel/duniverse/base/test/test_info.ml @@ -0,0 +1,154 @@ +open! Import +open! Info + +let%expect_test _ = + print_endline (to_string_hum (of_exn (Failure "foo"))); + [%expect {| (Failure foo) |}] +;; + +let%expect_test _ = + print_endline (to_string_hum (tag (of_string "b") ~tag:"a")); + [%expect {| (a b) |}] +;; + +let%expect_test _ = + print_endline (to_string_hum (of_list (List.map ~f:of_string [ "a"; "b"; "c" ]))); + [%expect {| (a b c) |}] +;; + +let%expect_test _ = + print_endline (to_string_hum (tag_s ~tag:[%message "tag"] (create_s [%message "info"]))); + [%expect {| (tag info) |}] +;; + +let of_strings strings = of_list (List.map ~f:of_string strings) + +let nested = + of_list + (List.map ~f:of_strings [ [ "a"; "b"; "c" ]; [ "d"; "e"; "f" ]; [ "g"; "h"; "i" ] ]) +;; + +let%expect_test _ = + print_endline (to_string_hum nested); + [%expect {| (a b c d e f g h i) |}] +;; + +let%expect_test _ = + require_equal + [%here] + (module Sexp) + (sexp_of_t nested) + (sexp_of_t (of_strings [ "a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"; "i" ])); + [%expect {| |}] +;; + +let%expect_test _ = + match to_exn (of_exn (Failure "foo")) with + | Failure "foo" -> () + | exn -> raise_s [%sexp { got = (exn : exn); expected = Failure "foo" }] +;; + +let round t = + let sexp = sexp_of_t t in + require [%here] (Sexp.( = ) sexp (sexp_of_t (t_of_sexp sexp))) +;; + +let%expect_test "non-empty tag" = + tag_arg (of_string "hello") "tag" 13 [%sexp_of: int] |> sexp_of_t |> print_s; + [%expect {| (tag 13 hello) |}] +;; + +let%expect_test "empty tag" = + tag_arg (of_string "hello") "" 13 [%sexp_of: int] |> sexp_of_t |> print_s; + [%expect {| (13 hello) |}] +;; + +let%expect_test _ = round (of_string "hello") +let%expect_test _ = round (of_thunk (fun () -> "hello")) +let%expect_test _ = round (create "tag" 13 [%sexp_of: int]) +let%expect_test _ = round (tag (of_string "hello") ~tag:"tag") +let%expect_test _ = round (tag_arg (of_string "hello") "tag" 13 [%sexp_of: int]) +let%expect_test _ = round (tag_arg (of_string "hello") "" 13 [%sexp_of: int]) +let%expect_test _ = round (of_list [ of_string "hello"; of_string "goodbye" ]) + +let%expect_test _ = + round (t_of_sexp (Sexplib.Sexp.of_string "((random sexp 1)(b 2)((c (1 2 3))))")) +;; + +let%expect_test _ = + require_equal [%here] (module String) (to_string_hum (of_string "a\nb")) "a\nb"; + [%expect {| |}] +;; + +let%expect_test "stack overflow" = + (* [Info.of_list [info]] and [Info.of_lazy_t (lazy info)] produce an [Info.t] with the + same sexp as the original. Ideally, deep nesting of these should not yield a stack + overflow just to produce a small value. *) + let depth = + match Word_size.word_size with + | W64 -> 1_000_000 + | W32 -> 100_000 + in + let test f = + let info = ref (Info.of_string "info") in + for _ = 1 to depth do + info := f !info + done; + print_s (Info.sexp_of_t !info) + in + test (fun info -> Info.of_list [ info ]); + [%expect {| info |}]; + test (fun info -> Info.of_lazy_t (lazy info)); + [%expect {| info |}]; + test (fun info -> Info.of_lazy_t (lazy (Info.of_list [ info ]))); + [%expect {| info |}] +;; + +let%expect_test "cyclic info computation" = + let info = + let rec lazy_info = lazy (Info.of_lazy_t lazy_info) in + Info.of_lazy_t lazy_info + in + print_s (Info.sexp_of_t info); + [%expect {| (Could_not_construct "cycle while computing message") |}] +;; + +let%expect_test "show how backtraces are printed" = + (* This is a real backtrace from some random OCaml program. + + The words [Raised] and [Called] have been lowercased to fool the expect test + collector and prevent it from complaining about the presence of a backtrace. This is + fine for this test because we are using a static string as the source for the + backtrace, rather than actually raising (which might change output between compiler + versions). *) + let backtrace = + "raised at Base__Error.raise in file \"error.ml\" (inlined), line 9, characters 14-30\n\ + called from Base__Error.raise_s in file \"error.ml\", line 10, characters 19-40\n\ + called from Floops_interfaces__Registrant.register_exn in file \"registrant.ml\", \ + line 18, characters 4-241\n\ + called from Floops_interfaces_test__Registrant_test.Test_brick.create_exn.(fun) in \ + file \"registrant_test.ml\", line 25, characters 6-67\n\ + called from Base__Or_error.try_with in file \"or_error.ml\", line 84, characters 9-15\n" + in + let exn = of_exn ~backtrace:(`This backtrace) (Failure "foo") in + print_s [%sexp (exn : t)]; + [%expect + {| + ((Failure foo) + ("raised at Base__Error.raise in file \"error.ml\" (inlined), line 9, characters 14-30" + "called from Base__Error.raise_s in file \"error.ml\", line 10, characters 19-40" + "called from Floops_interfaces__Registrant.register_exn in file \"registrant.ml\", line 18, characters 4-241" + "called from Floops_interfaces_test__Registrant_test.Test_brick.create_exn.(fun) in file \"registrant_test.ml\", line 25, characters 6-67" + "called from Base__Or_error.try_with in file \"or_error.ml\", line 84, characters 9-15")) + |}]; + print_endline (Info.to_string_hum exn); + [%expect + {| + ((Failure foo) + ("raised at Base__Error.raise in file \"error.ml\" (inlined), line 9, characters 14-30" + "called from Base__Error.raise_s in file \"error.ml\", line 10, characters 19-40" + "called from Floops_interfaces__Registrant.register_exn in file \"registrant.ml\", line 18, characters 4-241" + "called from Floops_interfaces_test__Registrant_test.Test_brick.create_exn.(fun) in file \"registrant_test.ml\", line 25, characters 6-67" + "called from Base__Or_error.try_with in file \"or_error.ml\", line 84, characters 9-15")) + |}] +;; diff --git a/unikernel/duniverse/base/test/test_info.mli b/unikernel/duniverse/base/test/test_info.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_info.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int.ml b/unikernel/duniverse/base/test/test_int.ml new file mode 100644 index 00000000..9a7ca862 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int.ml @@ -0,0 +1,300 @@ +open! Import +open! Int + +let%expect_test ("hash coherence" [@tags "64-bits-only"]) = + check_int_hash_coherence [%here] (module Int); + [%expect {| |}] +;; + +let%expect_test "[max_value_30_bits]" = + print_s [%sexp (max_value_30_bits : t)]; + [%expect {| 1_073_741_823 |}] +;; + +let%expect_test "of_string_opt" = + print_s [%sexp (of_string_opt "1" : int option)]; + [%expect "(1)"]; + print_s [%sexp (of_string_opt "1a" : int option)]; + [%expect "()"]; + print_s [%sexp (of_string_opt "99999999999999999999999999999" : int option)]; + [%expect "()"] +;; + +let%expect_test "to_string_hum" = + let test_roundtrip int = + require_equal [%here] (module Int) (of_string (to_string_hum int)) int + in + quickcheck_m + [%here] + (module struct + type t = int [@@deriving quickcheck, sexp_of] + end) + ~examples:[ Int.min_value; Int.max_value ] + ~f:test_roundtrip +;; + +let%expect_test "hex" = + let test x = + let n = Or_error.try_with (fun () -> Int.Hex.of_string x) in + print_s [%message (n : int Or_error.t)] + in + test "0x1c5f"; + [%expect {| (n (Ok 7_263)) |}]; + test "0x1c5f NON-HEX-GARBAGE"; + [%expect + {| + (n ( + Error ( + Failure + "Base.Int.Hex.of_string: invalid input \"0x1c5f NON-HEX-GARBAGE\""))) + |}] +;; + +let%test_module "Hex" = + (module struct + let f (i, s_hum) = + let s = String.filter s_hum ~f:(fun c -> not (Char.equal c '_')) in + let sexp_hum = Sexp.Atom s_hum in + let sexp = Sexp.Atom s in + [%test_result: Sexp.t] ~message:"sexp_of_t" ~expect:sexp (Hex.sexp_of_t i); + [%test_result: int] ~message:"t_of_sexp" ~expect:i (Hex.t_of_sexp sexp); + [%test_result: int] ~message:"t_of_sexp[human]" ~expect:i (Hex.t_of_sexp sexp_hum); + [%test_result: string] ~message:"to_string" ~expect:s (Hex.to_string i); + [%test_result: string] ~message:"to_string_hum" ~expect:s_hum (Hex.to_string_hum i); + [%test_result: int] ~message:"of_string" ~expect:i (Hex.of_string s); + [%test_result: int] ~message:"of_string[human]" ~expect:i (Hex.of_string s_hum) + ;; + + let%test_unit _ = + List.iter + ~f + [ 0, "0x0" + ; 1, "0x1" + ; 2, "0x2" + ; 5, "0x5" + ; 10, "0xa" + ; 16, "0x10" + ; 254, "0xfe" + ; 65_535, "0xffff" + ; 65_536, "0x1_0000" + ; 1_000_000, "0xf_4240" + ; -1, "-0x1" + ; -2, "-0x2" + ; -1_000_000, "-0xf_4240" + ; ( max_value + , match num_bits with + | 31 -> "0x3fff_ffff" + | 32 -> "0x7fff_ffff" + | 63 -> "0x3fff_ffff_ffff_ffff" + | _ -> assert false ) + ; ( min_value + , match num_bits with + | 31 -> "-0x4000_0000" + | 32 -> "-0x8000_0000" + | 63 -> "-0x4000_0000_0000_0000" + | _ -> assert false ) + ] + ;; + + let%test_unit _ = [%test_result: int] (Hex.of_string "0XA") ~expect:10 + + let%test_unit _ = + match Option.try_with (fun () -> Hex.of_string "0") with + | None -> () + | Some _ -> failwith "Hex must always have a 0x prefix." + ;; + + let%test_unit _ = + match Option.try_with (fun () -> Hex.of_string "0x_0") with + | None -> () + | Some _ -> failwith "Hex may not have '_' before the first digit." + ;; + end) +;; + +let%expect_test "binary" = + quickcheck_m + [%here] + (module struct + type t = int [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t : t) -> ignore (Binary.to_string t : string)) +;; + +let test_binary i = + Binary.to_string_hum i |> print_endline; + Binary.to_string i |> print_endline; + print_s [%sexp (i : Binary.t)] +;; + +let%expect_test "binary" = + test_binary 0b0; + [%expect {| + 0b0 + 0b0 + 0b0 + |}]; + test_binary 0b01; + [%expect {| + 0b1 + 0b1 + 0b1 + |}]; + test_binary 0b100; + [%expect {| + 0b100 + 0b100 + 0b100 + |}]; + test_binary 0b101; + [%expect {| + 0b101 + 0b101 + 0b101 + |}]; + test_binary 0b10_1010_1010_1010; + [%expect {| + 0b10_1010_1010_1010 + 0b10101010101010 + 0b10_1010_1010_1010 + |}]; + test_binary 0b11_1111_0000_0000; + [%expect {| + 0b11_1111_0000_0000 + 0b11111100000000 + 0b11_1111_0000_0000 + |}]; + test_binary 19; + [%expect {| + 0b1_0011 + 0b10011 + 0b1_0011 + |}]; + test_binary 0; + [%expect {| + 0b0 + 0b0 + 0b0 + |}] +;; + +let%expect_test ("63-bit cases" [@tags "64-bits-only"]) = + test_binary (-1); + [%expect + {| + 0b111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 + 0b111111111111111111111111111111111111111111111111111111111111111 + 0b111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 + |}]; + test_binary max_value; + [%expect + {| + 0b11_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 + 0b11111111111111111111111111111111111111111111111111111111111111 + 0b11_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 + |}]; + test_binary min_value; + [%expect + {| + 0b100_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000 + 0b100000000000000000000000000000000000000000000000000000000000000 + 0b100_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000 + |}] +;; + +let%expect_test ("32-bit cases" [@tags "js-only"]) = + test_binary (-1); + [%expect + {| + 0b1111_1111_1111_1111_1111_1111_1111_1111 + 0b11111111111111111111111111111111 + 0b1111_1111_1111_1111_1111_1111_1111_1111 + |}]; + test_binary max_value; + [%expect + {| + 0b111_1111_1111_1111_1111_1111_1111_1111 + 0b1111111111111111111111111111111 + 0b111_1111_1111_1111_1111_1111_1111_1111 + |}]; + test_binary min_value; + [%expect + {| + 0b1000_0000_0000_0000_0000_0000_0000_0000 + 0b10000000000000000000000000000000 + 0b1000_0000_0000_0000_0000_0000_0000_0000 + |}] +;; + +let%test _ = neg 5 + 5 = 0 +let%test _ = pow min_value 1 = min_value +let%test _ = pow max_value 1 = max_value + +let%test "comparisons" = + let original_compare (x : int) y = Stdlib.compare x y in + let valid_compare x y = + let result = compare x y in + let expect = original_compare x y in + assert (Bool.( = ) (result < 0) (expect < 0)); + assert (Bool.( = ) (result > 0) (expect > 0)); + assert (Bool.( = ) (result = 0) (expect = 0)); + assert (result = expect) + in + valid_compare min_value min_value; + valid_compare min_value (-1); + valid_compare (-1) min_value; + valid_compare min_value 0; + valid_compare 0 min_value; + valid_compare max_value (-1); + valid_compare (-1) max_value; + valid_compare max_value min_value; + valid_compare max_value max_value; + true +;; + +let test f x = test_conversion ~to_string:Int.Hex.to_string_hum f x +let numbers = [ 0x10_20; 0x11_22_33; 0x11_22_33_1F; 0x11_22_33_44 ] + +let%expect_test "bswap16" = + List.iter numbers ~f:(test bswap16); + [%expect + {| + 0x1020 --> 0x2010 + 0x11_2233 --> 0x3322 + 0x1122_331f --> 0x1f33 + 0x1122_3344 --> 0x4433 + |}] +;; + +let%expect_test "% and /%" = + quickcheck_m + [%here] + (module struct + type t = + int + * (int + [@quickcheck.generator Base_quickcheck.Generator.small_strictly_positive_int]) + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (a, b) -> + let r = a % b in + let q = a /% b in + require [%here] (r >= 0); + require_equal [%here] (module Int) a ((q * b) + r)) +;; + +include ( + struct + (** Various functors whose type-correctness ensures desired relationships between + interfaces. *) + + (* O contained in S *) + module _ (M : S) : module type of M.O = M + + (* O contained in S_unbounded *) + module _ (M : S_unbounded) : module type of M.O = M + + (* S_unbounded in S *) + module _ (M : S) : S_unbounded = M + end : + sig end) diff --git a/unikernel/duniverse/base/test/test_int.mli b/unikernel/duniverse/base/test/test_int.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int32.ml b/unikernel/duniverse/base/test/test_int32.ml new file mode 100644 index 00000000..45f37f0c --- /dev/null +++ b/unikernel/duniverse/base/test/test_int32.ml @@ -0,0 +1,81 @@ +open! Import +open! Int32 + +let%expect_test "hash coherence" = + check_int_hash_coherence [%here] (module Int32); + [%expect {| |}] +;; + +let numbers = [ 0x10_20l; 0x11_22_33l; 0x11_22_33_1Fl; 0x11_22_33_44l ] +let test = test_conversion ~to_string:(fun x -> Int32.Hex.to_string_hum x) + +let%expect_test "bswap16" = + List.iter numbers ~f:(test bswap16); + [%expect + {| + 0x1020 --> 0x2010 + 0x11_2233 --> 0x3322 + 0x1122_331f --> 0x1f33 + 0x1122_3344 --> 0x4433 + |}] +;; + +let%expect_test "bswap32" = + List.iter numbers ~f:(test bswap32); + [%expect + {| + 0x1020 --> 0x2010_0000 + 0x11_2233 --> 0x3322_1100 + 0x1122_331f --> 0x1f33_2211 + 0x1122_3344 --> 0x4433_2211 + |}] +;; + +let%expect_test "binary" = + quickcheck_m + [%here] + (module struct + type t = int32 [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t : t) -> ignore (Binary.to_string t : string)); + [%expect {| |}] +;; + +let test_binary i = + Binary.to_string_hum i |> print_endline; + Binary.to_string i |> print_endline; + print_s [%sexp (i : Binary.t)] +;; + +let%expect_test "binary" = + test_binary 0b01l; + [%expect {| + 0b1 + 0b1 + 0b1 + |}]; + test_binary 0b100l; + [%expect {| + 0b100 + 0b100 + 0b100 + |}]; + test_binary 0b101l; + [%expect {| + 0b101 + 0b101 + 0b101 + |}]; + test_binary 0b10_1010_1010_1010l; + [%expect {| + 0b10_1010_1010_1010 + 0b10101010101010 + 0b10_1010_1010_1010 + |}]; + test_binary 0b11_1111_0000_0000l; + [%expect {| + 0b11_1111_0000_0000 + 0b11111100000000 + 0b11_1111_0000_0000 + |}] +;; diff --git a/unikernel/duniverse/base/test/test_int32.mli b/unikernel/duniverse/base/test/test_int32.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int32.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int32_pow2.ml b/unikernel/duniverse/base/test/test_int32_pow2.ml new file mode 100644 index 00000000..413f9c5c --- /dev/null +++ b/unikernel/duniverse/base/test/test_int32_pow2.ml @@ -0,0 +1,101 @@ +open! Import +open! Int32 + +let of_ints = List.map ~f:of_int_exn +let examples = of_ints [ -1; 0; 1; 2; 3; 4; 5; 7; 8; 9; 63; 64; 65 ] +let examples_64_bit = [ min_value; succ min_value; pred max_value; max_value ] + +let print_for ints f = + List.iter ints ~f:(fun i -> + print_s + [%message "" ~_:(i : int32) ~_:(Or_error.try_with (fun () -> f i) : int Or_error.t)]) +;; + +let%expect_test "[floor_log2]" = + print_for examples floor_log2; + [%expect + {| + (-1 (Error ("[Int32.floor_log2] got invalid input" -1))) + (0 (Error ("[Int32.floor_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 1)) + (4 (Ok 2)) + (5 (Ok 2)) + (7 (Ok 2)) + (8 (Ok 3)) + (9 (Ok 3)) + (63 (Ok 5)) + (64 (Ok 6)) + (65 (Ok 6)) + |}] +;; + +let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit floor_log2; + [%expect + {| + (-2_147_483_648 (Error ("[Int32.floor_log2] got invalid input" -2147483648))) + (-2_147_483_647 (Error ("[Int32.floor_log2] got invalid input" -2147483647))) + (2_147_483_646 (Ok 30)) + (2_147_483_647 (Ok 30)) + |}] +;; + +let%expect_test "[ceil_log2]" = + print_for examples ceil_log2; + [%expect + {| + (-1 (Error ("[Int32.ceil_log2] got invalid input" -1))) + (0 (Error ("[Int32.ceil_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 2)) + (4 (Ok 2)) + (5 (Ok 3)) + (7 (Ok 3)) + (8 (Ok 3)) + (9 (Ok 4)) + (63 (Ok 6)) + (64 (Ok 6)) + (65 (Ok 7)) + |}] +;; + +let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit ceil_log2; + [%expect + {| + (-2_147_483_648 (Error ("[Int32.ceil_log2] got invalid input" -2147483648))) + (-2_147_483_647 (Error ("[Int32.ceil_log2] got invalid input" -2147483647))) + (2_147_483_646 (Ok 31)) + (2_147_483_647 (Ok 31)) + |}] +;; + +let%test_module "int_math" = + (module struct + let test_cases () = + of_ints + [ 0b10101010 + ; 0b1010101010101010 + ; 0b101010101010101010101010 + ; 0b10000000 + ; 0b1000000000001000 + ; 0b100000000000000000001000 + ] + ;; + + let%test_unit "ceil_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = ceil_pow2 x in + assert (is_pow2 p2 && p2 >= x && x >= p2 / of_int_exn 2)) + ;; + + let%test_unit "floor_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = floor_pow2 x in + assert (is_pow2 p2 && of_int_exn 2 * p2 >= x && x >= p2)) + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_int32_pow2.mli b/unikernel/duniverse/base/test/test_int32_pow2.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int32_pow2.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int63.ml b/unikernel/duniverse/base/test/test_int63.ml new file mode 100644 index 00000000..94ae29e7 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int63.ml @@ -0,0 +1,184 @@ +open! Import +open! Int63 + +let%expect_test ("hash coherence" [@tags "64-bits-only"]) = + check_int_hash_coherence [%here] (module Int63); + [%expect {| |}] +;; + +let%test_unit _ = [%test_result: t] max_value ~expect:(of_int64_exn 4611686018427387903L) + +let%test_unit _ = + [%test_result: t] min_value ~expect:(of_int64_exn (-4611686018427387904L)) +;; + +let%test_unit _ = + [%test_result: t] (of_int32_exn Int32.min_value) ~expect:(of_int32 Int32.min_value) +;; + +let%test_unit _ = + [%test_result: t] (of_int32_exn Int32.max_value) ~expect:(of_int32 Int32.max_value) +;; + +let%test "typical random 0" = Exn.does_raise (fun () -> random zero) + +let%test_module "Overflow_exn" = + (module struct + open Overflow_exn + + let%test_module "( + )" = + (module struct + let test t = Exn.does_raise (fun () -> t + t) + let%test "max_value / 2 + 1" = test (succ (max_value / of_int 2)) + let%test "min_value / 2 - 1" = test (pred (min_value / of_int 2)) + let%test "min_value + min_value" = test min_value + let%test "max_value + max_value" = test max_value + end) + ;; + + let%test_module "( - )" = + (module struct + let%test "min_value - 1" = Exn.does_raise (fun () -> min_value - one) + let%test "max_value - -1" = Exn.does_raise (fun () -> max_value - neg one) + + let%test "min_value / 2 - max_value / 2 - 2" = + Exn.does_raise (fun () -> + (min_value / of_int 2) - (max_value / of_int 2) - of_int 2) + ;; + + let%test "min_value - max_value" = + Exn.does_raise (fun () -> min_value - max_value) + ;; + + let%test "max_value - min_value" = + Exn.does_raise (fun () -> max_value - min_value) + ;; + + let%test "max_value - -max_value" = + Exn.does_raise (fun () -> max_value - neg max_value) + ;; + end) + ;; + + let is_overflow = Exn.does_raise + + let%test_module "( * )" = + (module struct + let%test "1 * 1" = one * one = one + let%test "1 * 0" = one * zero = zero + let%test "0 * 1" = zero * one = zero + let%test "min_value * -1" = is_overflow (fun () -> min_value * neg one) + let%test "-1 * min_value" = is_overflow (fun () -> neg one * min_value) + + let%test "46116860184273879 * 100" = + of_int64_exn 46116860184273879L * of_int 100 = of_int64_exn 4611686018427387900L + ;; + + let%test "46116860184273879 * 101" = + is_overflow (fun () -> of_int64_exn 46116860184273879L * of_int 101) + ;; + end) + ;; + + let%test_module "( / )" = + (module struct + let%test "1 / 1" = one / one = one + let%test "min_value / -1" = is_overflow (fun () -> min_value / neg one) + let%test "min_value / 1" = min_value / one = min_value + let%test "max_value / -1" = max_value / neg one = min_value + one + end) + ;; + end) +;; + +let%expect_test "[floor_log2]" = + let floor_log2 t = print_s [%sexp (floor_log2 t : int)] in + show_raise (fun () -> floor_log2 zero); + [%expect {| (raised ("[Int.floor_log2] got invalid input" 0)) |}]; + floor_log2 one; + [%expect {| 0 |}]; + for i = 1 to 8 do + floor_log2 (i |> of_int) + done; + [%expect {| + 0 + 1 + 1 + 2 + 2 + 2 + 2 + 3 + |}]; + floor_log2 ((one lsl 61) - one); + [%expect {| 60 |}]; + floor_log2 (one lsl 61); + [%expect {| 61 |}]; + floor_log2 max_value; + [%expect {| 61 |}] +;; + +let%expect_test "binary" = + quickcheck_m + [%here] + (module struct + type t = int64 [@@deriving quickcheck, sexp_of] + end) + ~f:(fun int64 -> ignore (Binary.to_string (of_int64_trunc int64) : string)); + [%expect {| |}] +;; + +let test_binary i = + let i = of_int64_exn i in + Binary.to_string_hum i |> print_endline; + Binary.to_string i |> print_endline; + print_s [%sexp (i : Binary.t)] +;; + +let%expect_test ("binary emulation" [@tags "js-only"]) = + test_binary 0b1L; + [%expect {| + 0b1 + 0b1 + 0b1 + |}]; + test_binary 0b0L; + [%expect {| + 0b0 + 0b0 + 0b0 + |}] +;; + +let%expect_test "binary" = + test_binary 0b01L; + [%expect {| + 0b1 + 0b1 + 0b1 + |}]; + test_binary 0b100L; + [%expect {| + 0b100 + 0b100 + 0b100 + |}]; + test_binary 0b101L; + [%expect {| + 0b101 + 0b101 + 0b101 + |}]; + test_binary 0b10_1010_1010_1010L; + [%expect {| + 0b10_1010_1010_1010 + 0b10101010101010 + 0b10_1010_1010_1010 + |}]; + test_binary 0b11_1111_0000_0000L; + [%expect {| + 0b11_1111_0000_0000 + 0b11111100000000 + 0b11_1111_0000_0000 + |}] +;; diff --git a/unikernel/duniverse/base/test/test_int63.mli b/unikernel/duniverse/base/test/test_int63.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int63.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int63_emul.ml b/unikernel/duniverse/base/test/test_int63_emul.ml new file mode 100644 index 00000000..7579cc40 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int63_emul.ml @@ -0,0 +1,14 @@ +open! Import +module Int63_emul = Base.Int63.Private.Emul + +let%expect_test _ = + let s63 = Int63.(Hex.to_string min_value) in + let s63_emul = Int63_emul.(Hex.to_string min_value) in + print_s [%message (s63 : string) (s63_emul : string)]; + require [%here] (String.equal s63 s63_emul); + [%expect + {| + ((s63 -0x4000000000000000) + (s63_emul -0x4000000000000000)) + |}] +;; diff --git a/unikernel/duniverse/base/test/test_int63_emul.mli b/unikernel/duniverse/base/test/test_int63_emul.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int63_emul.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int64.ml b/unikernel/duniverse/base/test/test_int64.ml new file mode 100644 index 00000000..500a660f --- /dev/null +++ b/unikernel/duniverse/base/test/test_int64.ml @@ -0,0 +1,125 @@ +open! Import +open! Int64 + +let%expect_test "hash coherence" = + check_int_hash_coherence [%here] (module Int64); + [%expect {| |}] +;; + +let numbers = + [ 0x0000_0000_0000_1020L + ; 0x0000_0000_0011_2233L + ; 0x0000_0000_1122_3344L + ; 0x0000_0011_2233_4455L + ; 0x0000_1122_3344_5566L + ; 0x0011_2233_4455_6677L + ; 0x1122_3344_5566_7788L + ] +;; + +let test = test_conversion ~to_string:Int64.Hex.to_string_hum + +let%expect_test "bswap16" = + List.iter numbers ~f:(test bswap16); + [%expect + {| + 0x1020 --> 0x2010 + 0x11_2233 --> 0x3322 + 0x1122_3344 --> 0x4433 + 0x11_2233_4455 --> 0x5544 + 0x1122_3344_5566 --> 0x6655 + 0x11_2233_4455_6677 --> 0x7766 + 0x1122_3344_5566_7788 --> 0x8877 + |}] +;; + +let%expect_test "bswap32" = + List.iter numbers ~f:(test bswap32); + [%expect + {| + 0x1020 --> 0x2010_0000 + 0x11_2233 --> 0x3322_1100 + 0x1122_3344 --> 0x4433_2211 + 0x11_2233_4455 --> 0x5544_3322 + 0x1122_3344_5566 --> 0x6655_4433 + 0x11_2233_4455_6677 --> 0x7766_5544 + 0x1122_3344_5566_7788 --> 0x8877_6655 + |}] +;; + +let%expect_test "bswap48" = + List.iter numbers ~f:(test bswap48); + [%expect + {| + 0x1020 --> 0x2010_0000_0000 + 0x11_2233 --> 0x3322_1100_0000 + 0x1122_3344 --> 0x4433_2211_0000 + 0x11_2233_4455 --> 0x5544_3322_1100 + 0x1122_3344_5566 --> 0x6655_4433_2211 + 0x11_2233_4455_6677 --> 0x7766_5544_3322 + 0x1122_3344_5566_7788 --> 0x8877_6655_4433 + |}] +;; + +let%expect_test "bswap64" = + List.iter numbers ~f:(test bswap64); + [%expect + {| + 0x1020 --> 0x2010_0000_0000_0000 + 0x11_2233 --> 0x3322_1100_0000_0000 + 0x1122_3344 --> 0x4433_2211_0000_0000 + 0x11_2233_4455 --> 0x5544_3322_1100_0000 + 0x1122_3344_5566 --> 0x6655_4433_2211_0000 + 0x11_2233_4455_6677 --> 0x7766_5544_3322_1100 + 0x1122_3344_5566_7788 --> -0x7788_99aa_bbcc_ddef + |}] +;; + +let%expect_test "binary" = + quickcheck_m + [%here] + (module struct + type t = int64 [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t : t) -> ignore (Binary.to_string t : string)); + [%expect {| |}] +;; + +let test_binary i = + Binary.to_string_hum i |> print_endline; + Binary.to_string i |> print_endline; + print_s [%sexp (i : Binary.t)] +;; + +let%expect_test "binary" = + test_binary 0b01L; + [%expect {| + 0b1 + 0b1 + 0b1 + |}]; + test_binary 0b100L; + [%expect {| + 0b100 + 0b100 + 0b100 + |}]; + test_binary 0b101L; + [%expect {| + 0b101 + 0b101 + 0b101 + |}]; + test_binary 0b10_1010_1010_1010L; + [%expect {| + 0b10_1010_1010_1010 + 0b10101010101010 + 0b10_1010_1010_1010 + |}]; + test_binary 0b11_1111_0000_0000L; + [%expect {| + 0b11_1111_0000_0000 + 0b11111100000000 + 0b11_1111_0000_0000 + |}] +;; diff --git a/unikernel/duniverse/base/test/test_int64.mli b/unikernel/duniverse/base/test/test_int64.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int64.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int64_pow2.ml b/unikernel/duniverse/base/test/test_int64_pow2.ml new file mode 100644 index 00000000..961d7877 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int64_pow2.ml @@ -0,0 +1,113 @@ +open! Import +open! Int64 + +let examples = [ -1L; 0L; 1L; 2L; 3L; 4L; 5L; 7L; 8L; 9L; 63L; 64L; 65L ] +let examples_64_bit = [ min_value; succ min_value; pred max_value; max_value ] + +let print_for ints f = + List.iter ints ~f:(fun i -> + print_s + [%message "" ~_:(i : int64) ~_:(Or_error.try_with (fun () -> f i) : int Or_error.t)]) +;; + +let%expect_test "[floor_log2]" = + print_for examples floor_log2; + [%expect + {| + (-1 (Error ("[Int64.floor_log2] got invalid input" -1))) + (0 (Error ("[Int64.floor_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 1)) + (4 (Ok 2)) + (5 (Ok 2)) + (7 (Ok 2)) + (8 (Ok 3)) + (9 (Ok 3)) + (63 (Ok 5)) + (64 (Ok 6)) + (65 (Ok 6)) + |}] +;; + +let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit floor_log2; + [%expect + {| + (-9_223_372_036_854_775_808 ( + Error ("[Int64.floor_log2] got invalid input" -9223372036854775808))) + (-9_223_372_036_854_775_807 ( + Error ("[Int64.floor_log2] got invalid input" -9223372036854775807))) + (9_223_372_036_854_775_806 (Ok 62)) + (9_223_372_036_854_775_807 (Ok 62)) + |}] +;; + +let%expect_test "[ceil_log2]" = + print_for examples ceil_log2; + [%expect + {| + (-1 (Error ("[Int64.ceil_log2] got invalid input" -1))) + (0 (Error ("[Int64.ceil_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 2)) + (4 (Ok 2)) + (5 (Ok 3)) + (7 (Ok 3)) + (8 (Ok 3)) + (9 (Ok 4)) + (63 (Ok 6)) + (64 (Ok 6)) + (65 (Ok 7)) + |}] +;; + +let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit ceil_log2; + [%expect + {| + (-9_223_372_036_854_775_808 ( + Error ("[Int64.ceil_log2] got invalid input" -9223372036854775808))) + (-9_223_372_036_854_775_807 ( + Error ("[Int64.ceil_log2] got invalid input" -9223372036854775807))) + (9_223_372_036_854_775_806 (Ok 63)) + (9_223_372_036_854_775_807 (Ok 63)) + |}] +;; + +let%test_module "int64_math" = + (module struct + let test_cases () = + let cases = + [ 0b10101010L + ; 0b1010101010101010L + ; 0b101010101010101010101010L + ; 0b10000000L + ; 0b1000000000001000L + ; 0b100000000000000000001000L + ] + in + let cases = + cases + @ [ (0b1010101010101010L lsl 16) lor 0b1010101010101010L + ; (0b1000000000000000L lsl 16) lor 0b0000000000001000L + ] + in + let added_cases = List.map cases ~f:(fun x -> x lsl 16) in + List.concat [ cases; added_cases ] + ;; + + let%test_unit "ceil_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = ceil_pow2 x in + assert (is_pow2 p2 && p2 >= x && x >= p2 / 2L)) + ;; + + let%test_unit "floor_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = floor_pow2 x in + assert (is_pow2 p2 && 2L * p2 >= x && x >= p2)) + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_int64_pow2.mli b/unikernel/duniverse/base/test/test_int64_pow2.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int64_pow2.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int_conversions.ml b/unikernel/duniverse/base/test/test_int_conversions.ml new file mode 100644 index 00000000..908dbeb3 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_conversions.ml @@ -0,0 +1,255 @@ +open! Import +open! Int_conversions + +let%test_module "pretty" = + (module struct + let check input output = + List.for_all [ ""; "+"; "-" ] ~f:(fun prefix -> + let input = prefix ^ input in + let output = prefix ^ output in + [%compare.equal: string] output (insert_underscores input)) + ;; + + let%test _ = check "1" "1" + let%test _ = check "12" "12" + let%test _ = check "123" "123" + let%test _ = check "1234" "1_234" + let%test _ = check "12345" "12_345" + let%test _ = check "123456" "123_456" + let%test _ = check "1234567" "1_234_567" + let%test _ = check "12345678" "12_345_678" + let%test _ = check "123456789" "123_456_789" + let%test _ = check "1234567890" "1_234_567_890" + end) +;; + +let%test_module "conversions" = + (module struct + module type S = sig + include Int.S + + val module_name : string + end + + let test_conversion (type a b) loc ma mb a_to_b_or_error a_to_b_trunc b_to_a_trunc = + let (module A : S with type t = a) = ma in + let (module B : S with type t = b) = mb in + let examples = + [ A.min_value + ; A.minus_one + ; A.zero + ; A.one + ; A.max_value + ; B.min_value |> b_to_a_trunc + ; B.max_value |> b_to_a_trunc + ] + |> List.concat_map ~f:(fun a -> [ A.pred a; a; A.succ a ]) + |> List.dedup_and_sort ~compare:A.compare + |> List.sort ~compare:A.compare + in + List.iter examples ~f:(fun a -> + let b' = a_to_b_trunc a in + let a' = b_to_a_trunc b' in + match a_to_b_or_error a with + | Ok b -> + require + loc + (B.equal b b') + ~if_false_then_print_s: + (lazy + [%message + "conversion produced wrong value" + ~from:(A.module_name : string) + ~to_:(B.module_name : string) + ~input:(a : A.t) + ~output:(b : B.t) + ~expected:(b' : B.t)]); + require + loc + (A.equal a a') + ~if_false_then_print_s: + (lazy + [%message + "conversion does not round-trip" + ~from:(A.module_name : string) + ~to_:(B.module_name : string) + ~input:(a : A.t) + ~output:(b : B.t) + ~round_trip:(a' : A.t)]) + | Error error -> + require + loc + (not (A.equal a a')) + ~if_false_then_print_s: + (lazy + [%message + "conversion failed" + ~from:(A.module_name : string) + ~to_:(B.module_name : string) + ~input:(a : A.t) + ~expected_output:(b' : B.t) + ~error:(error : Error.t)])) + ;; + + let test loc ma mb (a_to_b_trunc, a_to_b_or_error) (b_to_a_trunc, b_to_a_or_error) = + test_conversion loc ma mb a_to_b_or_error a_to_b_trunc b_to_a_trunc; + test_conversion loc mb ma b_to_a_or_error b_to_a_trunc a_to_b_trunc + ;; + + module Int = struct + include Int + + let module_name = "Int" + end + + module Int32 = struct + include Int32 + + let module_name = "Int32" + end + + module Int64 = struct + include Int64 + + let module_name = "Int64" + end + + module Nativeint = struct + include Nativeint + + let module_name = "Nativeint" + end + + let with_exn f x = Or_error.try_with (fun () -> f x) + let optional f x = Or_error.try_with (fun () -> Option.value_exn (f x)) + let alwaysok f x = Ok (f x) + + let%expect_test "int <-> int32" = + test + [%here] + (module Int) + (module Int32) + (Stdlib.Int32.of_int, with_exn int_to_int32_exn) + (Stdlib.Int32.to_int, with_exn int32_to_int_exn); + [%expect {| |}]; + test + [%here] + (module Int) + (module Int32) + (Stdlib.Int32.of_int, optional int_to_int32) + (Stdlib.Int32.to_int, optional int32_to_int); + [%expect {| |}] + ;; + + let%expect_test "int <-> int64" = + test + [%here] + (module Int) + (module Int64) + (Stdlib.Int64.of_int, alwaysok int_to_int64) + (Stdlib.Int64.to_int, with_exn int64_to_int_exn); + [%expect {| |}]; + test + [%here] + (module Int) + (module Int64) + (Stdlib.Int64.of_int, alwaysok int_to_int64) + (Stdlib.Int64.to_int, optional int64_to_int); + [%expect {| |}] + ;; + + let%expect_test "int <-> nativeint" = + test + [%here] + (module Int) + (module Nativeint) + (Stdlib.Nativeint.of_int, alwaysok int_to_nativeint) + (Stdlib.Nativeint.to_int, with_exn nativeint_to_int_exn); + [%expect {| |}]; + test + [%here] + (module Int) + (module Nativeint) + (Stdlib.Nativeint.of_int, alwaysok int_to_nativeint) + (Stdlib.Nativeint.to_int, optional nativeint_to_int); + [%expect {| |}] + ;; + + let%expect_test "int32 <-> int64" = + test + [%here] + (module Int32) + (module Int64) + (Stdlib.Int64.of_int32, alwaysok int32_to_int64) + (Stdlib.Int64.to_int32, with_exn int64_to_int32_exn); + [%expect {| |}]; + test + [%here] + (module Int32) + (module Int64) + (Stdlib.Int64.of_int32, alwaysok int32_to_int64) + (Stdlib.Int64.to_int32, optional int64_to_int32); + [%expect {| |}] + ;; + + let%expect_test "int32 <-> nativeint" = + test + [%here] + (module Int32) + (module Nativeint) + (Stdlib.Nativeint.of_int32, alwaysok int32_to_nativeint) + (Stdlib.Nativeint.to_int32, with_exn nativeint_to_int32_exn); + [%expect {| |}]; + test + [%here] + (module Int32) + (module Nativeint) + (Stdlib.Nativeint.of_int32, alwaysok int32_to_nativeint) + (Stdlib.Nativeint.to_int32, optional nativeint_to_int32); + [%expect {| |}] + ;; + + let%expect_test "int64 <-> nativeint" = + test + [%here] + (module Int64) + (module Nativeint) + (Stdlib.Int64.to_nativeint, with_exn int64_to_nativeint_exn) + (Stdlib.Int64.of_nativeint, alwaysok nativeint_to_int64); + [%expect {| |}]; + test + [%here] + (module Int64) + (module Nativeint) + (Stdlib.Int64.to_nativeint, optional int64_to_nativeint) + (Stdlib.Int64.of_nativeint, alwaysok nativeint_to_int64); + [%expect {| |}] + ;; + end) +;; + +let%test_module "Make_hex" = + (module struct + module Hex_int = struct + type t = int [@@deriving quickcheck] + + module M = Make_hex (struct + type nonrec t = int [@@deriving sexp, compare ~localize, hash, quickcheck] + + let to_string = Int.Hex.to_string + let of_string = Int.Hex.of_string + let zero = 0 + let ( < ) = ( < ) + let neg = Int.neg + let module_name = "Hex_int" + end) + + include (M.Hex : module type of M.Hex with type t := t) + end + + let%expect_test "validate sexp grammar" = + require_ok [%here] (Sexp_grammar_validation.validate_grammar (module Hex_int)); + [%expect {| String |}] + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_int_conversions.mli b/unikernel/duniverse/base/test/test_int_conversions.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_conversions.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int_hash.ml b/unikernel/duniverse/base/test/test_int_hash.ml new file mode 100644 index 00000000..eaccd447 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_hash.ml @@ -0,0 +1,7 @@ +open! Base +open! Import + +let%expect_test ("int hash is not ident" [@tags "64-bits-only"]) = + print_s [%message "hash of 10" (Int.hash 10 : int)]; + [%expect {| ("hash of 10" ("Int.hash 10" 1_579_120_067_278_557_813)) |}] +;; diff --git a/unikernel/duniverse/base/test/test_int_hash.mli b/unikernel/duniverse/base/test/test_int_hash.mli new file mode 100644 index 00000000..1b568381 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_hash.mli @@ -0,0 +1 @@ +(* this interface is deliberately empty *) diff --git a/unikernel/duniverse/base/test/test_int_math.ml b/unikernel/duniverse/base/test/test_int_math.ml new file mode 100644 index 00000000..dedcf847 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_math.ml @@ -0,0 +1,487 @@ +open! Import +open! Base.Int_math +open! Base.Int_math.Private + +let%test_unit _ = + let x = + match Word_size.word_size with + | W32 -> 9 + | W64 -> 10 + in + for i = 0 to x do + for j = 0 to x do + assert (int_pow i j = Stdlib.(int_of_float (float_of_int i ** float_of_int j))) + done + done +;; + +module Test (X : Make_arg) : sig end = struct + open X + include Make (X) + + let%test_module "integer-rounding" = + (module struct + let check dir ~range:(lower, upper) ~modulus expected = + let modulus = of_int_exn modulus in + let expected = of_int_exn expected in + for i = lower to upper do + let observed = round ~dir ~to_multiple_of:modulus (of_int_exn i) in + if observed <> expected then raise_s [%message "invalid result" (i : int)] + done + ;; + + let%test_unit _ = check ~modulus:10 `Down ~range:(10, 19) 10 + let%test_unit _ = check ~modulus:10 `Down ~range:(0, 9) 0 + let%test_unit _ = check ~modulus:10 `Down ~range:(-10, -1) (-10) + let%test_unit _ = check ~modulus:10 `Down ~range:(-20, -11) (-20) + let%test_unit _ = check ~modulus:10 `Up ~range:(11, 20) 20 + let%test_unit _ = check ~modulus:10 `Up ~range:(1, 10) 10 + let%test_unit _ = check ~modulus:10 `Up ~range:(-9, 0) 0 + let%test_unit _ = check ~modulus:10 `Up ~range:(-19, -10) (-10) + let%test_unit _ = check ~modulus:10 `Zero ~range:(10, 19) 10 + let%test_unit _ = check ~modulus:10 `Zero ~range:(-9, 9) 0 + let%test_unit _ = check ~modulus:10 `Zero ~range:(-19, -10) (-10) + let%test_unit _ = check ~modulus:10 `Nearest ~range:(15, 24) 20 + let%test_unit _ = check ~modulus:10 `Nearest ~range:(5, 14) 10 + let%test_unit _ = check ~modulus:10 `Nearest ~range:(-5, 4) 0 + let%test_unit _ = check ~modulus:10 `Nearest ~range:(-15, -6) (-10) + let%test_unit _ = check ~modulus:10 `Nearest ~range:(-25, -16) (-20) + let%test_unit _ = check ~modulus:5 `Nearest ~range:(8, 12) 10 + let%test_unit _ = check ~modulus:5 `Nearest ~range:(3, 7) 5 + let%test_unit _ = check ~modulus:5 `Nearest ~range:(-2, 2) 0 + let%test_unit _ = check ~modulus:5 `Nearest ~range:(-7, -3) (-5) + let%test_unit _ = check ~modulus:5 `Nearest ~range:(-12, -8) (-10) + end) + ;; + + let%test_module "remainder-and-modulus" = + (module struct + let one = of_int_exn 1 + + let check_integers x y = + let sexp_of_t t = sexp_of_string (to_string t) in + let check_raises f what = + match f () with + | exception _ -> () + | z -> + raise_s + [%message + "produced result instead of raising" + (what : string) + (x : t) + (y : t) + (z : t)] + in + let check_true cond what = + if not cond then raise_s [%message "failed" (what : string) (x : t) (y : t)] + in + if y = zero + then ( + check_raises (fun () -> x / y) "division by zero"; + check_raises (fun () -> rem x y) "rem _ zero"; + check_raises (fun () -> x % y) "_ % zero"; + check_raises (fun () -> x /% y) "_ /% zero") + else ( + if x < zero + then check_true (rem x y <= zero) "non-positive remainder" + else check_true (rem x y >= zero) "non-negative remainder"; + check_true (abs (rem x y) <= abs y - one) "range of remainder"; + if y < zero + then ( + check_raises (fun () -> x % y) "_ % negative"; + check_raises (fun () -> x /% y) "_ /% negative") + else ( + check_true (x = (x /% y * y) + (x % y)) "(/%) and (%) identity"; + check_true (x = (x / y * y) + rem x y) "(/) and rem identity"; + check_true (x % y >= zero) "non-negative (%)"; + check_true (x % y <= y - one) "range of (%)"; + if x > zero && y > zero + then ( + check_true (x /% y = x / y) "(/%) and (/) identity"; + check_true (x % y = rem x y) "(%) and rem identity"))) + ;; + + let check_natural_numbers x y = + List.iter + [ x; -x; x + one; -(x + one) ] + ~f:(fun x -> + List.iter [ y; -y; y + one; -(y + one) ] ~f:(fun y -> check_integers x y)) + ;; + + let%test_unit "deterministic" = + let big1 = of_int_exn 118_310_344 in + let big2 = of_int_exn 828_172_408 in + (* Important to test the case where one value is a multiple of the other. Note that + the [x + one] and [y + one] cases in [check_natural_numbers] ensure that we also + test non-multiple cases. *) + assert (big2 = big1 * of_int_exn 7); + let values = [ zero; one; big1; big2 ] in + List.iter values ~f:(fun x -> + List.iter values ~f:(fun y -> check_natural_numbers x y)) + ;; + + let%test_unit "random" = + let rand = Random.State.make [| 8; 67; -5_309 |] in + for _ = 0 to 1_000 do + let max_value = 1_000_000_000 in + let x = of_int_exn (Random.State.int rand max_value) in + let y = of_int_exn (Random.State.int rand max_value) in + check_natural_numbers x y + done + ;; + end) + ;; +end + +include Test (Int) +include Test (Int32) +include Test (Int63) +include Test (Int64) +include Test (Nativeint) + +let%test_module "int rounding quickcheck tests" = + (module struct + module type With_quickcheck = sig + type t [@@deriving sexp_of] + + include Make_arg with type t := t + + val min_value : t + val max_value : t + val quickcheck_generator_incl : t -> t -> t Base_quickcheck.Generator.t + val quickcheck_generator_log_incl : t -> t -> t Base_quickcheck.Generator.t + end + + module Rounding_direction = struct + type t = + [ `Up + | `Down + | `Zero + | `Nearest + ] + [@@deriving enumerate, sexp_of] + end + + module Rounding_pair (Integer : With_quickcheck) = struct + type t = + { number : Integer.t + ; factor : Integer.t + } + [@@deriving sexp_of] + + let quickcheck_generator = + (* This generator should frequently generate "interesting" numbers for rounding. *) + let open Base_quickcheck.Generator.Let_syntax in + (* First we choose a factor to round to. *) + let%bind factor = + Integer.quickcheck_generator_log_incl (Integer.of_int_exn 1) Integer.max_value + in + (* Then we choose a multiplier for that factor. *) + let%map multiplier = + Integer.quickcheck_generator_incl + (Integer.( / ) Integer.min_value factor) + (Integer.( / ) Integer.max_value factor) + (* Then we choose an offset such that [multiplier * factor] is the nearest value + to round to. [quickcheck_generator_incl] puts extra weight on the [-factor/2, + factor/2] bounds, and we also weight 0 heavily. *) + and offset = + let half_factor = Integer.( / ) factor (Integer.of_int_exn 2) in + Base_quickcheck.Generator.weighted_union + [ 9., Integer.quickcheck_generator_incl (Integer.neg half_factor) half_factor + ; 1., Base_quickcheck.Generator.return Integer.zero + ] + in + let number = Integer.( + ) offset (Integer.( * ) factor multiplier) in + { number; factor } + ;; + + let quickcheck_shrinker = Base_quickcheck.Shrinker.atomic + end + + let test_direction (module Integer : With_quickcheck) ~dir = + let open Integer in + (* Criterion for correct rounding: must be a multiple of the factor *) + let is_multiple_of number ~factor = factor * (number / factor) = number in + (* Criterion for correct rounding: must not reverse sign *) + let is_compatible_sign number ~rounded = + if number > zero + then rounded >= zero + else if number < zero + then rounded <= zero + else rounded = zero + in + (* Criterion for correct rounding: must be less than factor away from original *) + let is_close_enough x y ~factor = + if x > y + then x - y > zero && x - y < factor + else if x < y + then y - x > zero && y - x < factor + else true + in + (* Criterion for correct rounding: rounding direction must be respected *) + let is_in_correct_direction number ~dir ~rounded ~factor = + match dir with + | `Down -> rounded <= number + | `Up -> rounded >= number + | `Zero -> + if number < zero + then rounded >= number + else if number > zero + then rounded <= number + else rounded = zero + | `Nearest -> + if rounded > number + then rounded - number <= number - (rounded - factor) + else if rounded < number + then number - rounded < rounded + factor - number + else true + in + (* Correct rounding obeys all four criteria *) + let is_rounded_correctly number ~dir ~factor ~rounded = + is_multiple_of rounded ~factor + && is_compatible_sign number ~rounded + && is_close_enough number rounded ~factor + && is_in_correct_direction number ~dir ~rounded ~factor + in + (* Round correctly by finding a multiple of the factor, and trying +/-factor away + from that. If this returns [None], there should be no correct representable + result. *) + let round_correctly number ~dir ~factor = + let rounded0 = factor * (number / factor) in + match + List.filter + [ rounded0 - factor; rounded0; rounded0 + factor ] + ~f:(fun rounded -> is_rounded_correctly number ~dir ~factor ~rounded) + with + | [] -> None + | [ rounded ] -> Some rounded + | multiple -> + raise_s + [%sexp + "test bug: multiple correctly rounded values", (multiple : Integer.t list)] + in + let module Math = Make (Integer) in + let module Pair = Rounding_pair (Integer) in + require_does_not_raise [%here] (fun () -> + Base_quickcheck.Test.run_exn + (module Pair) + ~f:(fun ({ number; factor } : Pair.t) -> + let rounded = Math.round number ~dir ~to_multiple_of:factor in + (* Test that if it is possible to round correctly, then we do. *) + match round_correctly number ~dir ~factor with + | None -> + if is_rounded_correctly number ~dir ~factor ~rounded + then + raise_s + [%sexp + "test bug: did not find correctly rounded value" + , { rounded : Integer.t }] + | Some rounded_correctly -> + if rounded <> rounded_correctly + then + raise_s + [%sexp + "rounding failed" + , { rounded : Integer.t; rounded_correctly : Integer.t }])) + ;; + + let test m = + List.iter Rounding_direction.all ~f:(fun dir -> + print_s [%sexp "testing", (dir : Rounding_direction.t)]; + test_direction m ~dir) + ;; + + let%expect_test ("int" [@tags "no-js", "64-bits-only"]) = + test + (module struct + include Int + + let quickcheck_generator_incl = Base_quickcheck.Generator.int_inclusive + let quickcheck_generator_log_incl = Base_quickcheck.Generator.int_log_inclusive + end); + [%expect + {| + (testing Up) + (testing Down) + (testing Zero) + (testing Nearest) + |}] + ;; + + let%expect_test "int32" = + test + (module struct + include Int32 + + let quickcheck_generator_incl = Base_quickcheck.Generator.int32_inclusive + + let quickcheck_generator_log_incl = + Base_quickcheck.Generator.int32_log_inclusive + ;; + end); + [%expect + {| + (testing Up) + (testing Down) + (testing Zero) + (testing Nearest) + |}] + ;; + + let%expect_test "int63" = + test + (module struct + include Int63 + + let quickcheck_generator_incl = Base_quickcheck.Generator.int63_inclusive + + let quickcheck_generator_log_incl = + Base_quickcheck.Generator.int63_log_inclusive + ;; + end); + [%expect + {| + (testing Up) + (testing Down) + (testing Zero) + (testing Nearest) + |}] + ;; + + let%expect_test "int64" = + test + (module struct + include Int64 + + let quickcheck_generator_incl = Base_quickcheck.Generator.int64_inclusive + + let quickcheck_generator_log_incl = + Base_quickcheck.Generator.int64_log_inclusive + ;; + end); + [%expect + {| + (testing Up) + (testing Down) + (testing Zero) + (testing Nearest) + |}] + ;; + + let%expect_test ("nativeint" [@tags "no-js", "64-bits-only"]) = + test + (module struct + include Nativeint + + let quickcheck_generator_incl = Base_quickcheck.Generator.nativeint_inclusive + + let quickcheck_generator_log_incl = + Base_quickcheck.Generator.nativeint_log_inclusive + ;; + end); + [%expect + {| + (testing Up) + (testing Down) + (testing Zero) + (testing Nearest) + |}] + ;; + end) +;; + +let%test_module "pow" = + (module struct + let%test _ = int_pow 0 0 = 1 + let%test _ = int_pow 0 1 = 0 + let%test _ = int_pow 10 1 = 10 + let%test _ = int_pow 10 2 = 100 + let%test _ = int_pow 10 3 = 1_000 + let%test _ = int_pow 10 4 = 10_000 + let%test _ = int_pow 10 5 = 100_000 + let%test _ = int_pow 2 10 = 1024 + let%test _ = int_pow 0 1_000_000 = 0 + let%test _ = int_pow 1 1_000_000 = 1 + let%test _ = int_pow (-1) 1_000_000 = 1 + let%test _ = int_pow (-1) 1_000_001 = -1 + let ( = ) = Int64.( = ) + let%test _ = int64_pow 0L 0L = 1L + let%test _ = int64_pow 0L 1_000_000L = 0L + let%test _ = int64_pow 1L 1_000_000L = 1L + let%test _ = int64_pow (-1L) 1_000_000L = 1L + let%test _ = int64_pow (-1L) 1_000_001L = -1L + let%test _ = int64_pow 10L 1L = 10L + let%test _ = int64_pow 10L 2L = 100L + let%test _ = int64_pow 10L 3L = 1_000L + let%test _ = int64_pow 10L 4L = 10_000L + let%test _ = int64_pow 10L 5L = 100_000L + let%test _ = int64_pow 2L 10L = 1_024L + let%test _ = int64_pow 5L 27L = 7450580596923828125L + let exception_thrown pow b e = Exn.does_raise (fun () -> pow b e) + let%test _ = exception_thrown int_pow 10 60 + let%test _ = exception_thrown int64_pow 10L 60L + let%test _ = exception_thrown int_pow 10 (-1) + let%test _ = exception_thrown int64_pow 10L (-1L) + let%test _ = exception_thrown int64_pow 2L 63L + let%test _ = not (exception_thrown int64_pow 2L 62L) + let%test _ = exception_thrown int64_pow (-2L) 63L + let%test _ = not (exception_thrown int64_pow (-2L) 62L) + end) +;; + +let%test_module "overflow_bounds" = + (module struct + module Pow_overflow_bounds = Pow_overflow_bounds + + let%test _ = Int.equal Pow_overflow_bounds.overflow_bound_max_int_value Int.max_value + + let%test _ = + Int64.equal Pow_overflow_bounds.overflow_bound_max_int64_value Int64.max_value + ;; + + module Big_int = struct + include Big_int + + let ( > ) = gt_big_int + let ( = ) = eq_big_int + let ( ^ ) = power_big_int_positive_int + let ( + ) = add_big_int + let one = unit_big_int + let to_string = string_of_big_int + end + + let test_overflow_table tbl conv max_val = + assert (Array.length tbl = 64); + let max_val = conv max_val in + Array.iteri tbl ~f:(fun i max_base -> + let max_base = conv max_base in + let overflows b = Big_int.(b ^ i > max_val) in + let is_ok = + if i = 0 + then Big_int.(max_base = max_val) + else (not (overflows max_base)) && overflows Big_int.(max_base + one) + in + if not is_ok + then + Printf.failwithf + "overflow table check failed for %s (index %d)" + (Big_int.to_string max_base) + i + ()) + ;; + + let%test_unit _ = + test_overflow_table + Pow_overflow_bounds.int_positive_overflow_bounds + Big_int.big_int_of_int + Int.max_value + ;; + + let%test_unit _ = + test_overflow_table + Pow_overflow_bounds.int64_positive_overflow_bounds + Big_int.big_int_of_int64 + Int64.max_value + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_int_math.mli b/unikernel/duniverse/base/test/test_int_math.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_math.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_int_pow2.ml b/unikernel/duniverse/base/test/test_int_pow2.ml new file mode 100644 index 00000000..ac909718 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_pow2.ml @@ -0,0 +1,121 @@ +open! Import +open! Int + +let examples = [ -1; 0; 1; 2; 3; 4; 5; 7; 8; 9; 63; 64; 65 ] + +let examples_64_bit = + [ Int.min_value; Int.min_value + 1; Int.max_value - 1; Int.max_value ] +;; + +let print_for ints f = + List.iter ints ~f:(fun i -> + print_s + [%message "" ~_:(i : int) ~_:(Or_error.try_with (fun () -> f i) : int Or_error.t)]) +;; + +let%expect_test "[floor_log2]" = + print_for examples floor_log2; + [%expect + {| + (-1 (Error ("[Int.floor_log2] got invalid input" -1))) + (0 (Error ("[Int.floor_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 1)) + (4 (Ok 2)) + (5 (Ok 2)) + (7 (Ok 2)) + (8 (Ok 3)) + (9 (Ok 3)) + (63 (Ok 5)) + (64 (Ok 6)) + (65 (Ok 6)) + |}] +;; + +let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit floor_log2; + [%expect + {| + (-4_611_686_018_427_387_904 ( + Error ("[Int.floor_log2] got invalid input" -4611686018427387904))) + (-4_611_686_018_427_387_903 ( + Error ("[Int.floor_log2] got invalid input" -4611686018427387903))) + (4_611_686_018_427_387_902 (Ok 61)) + (4_611_686_018_427_387_903 (Ok 61)) + |}] +;; + +let%expect_test "[ceil_log2]" = + print_for examples ceil_log2; + [%expect + {| + (-1 (Error ("[Int.ceil_log2] got invalid input" -1))) + (0 (Error ("[Int.ceil_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 2)) + (4 (Ok 2)) + (5 (Ok 3)) + (7 (Ok 3)) + (8 (Ok 3)) + (9 (Ok 4)) + (63 (Ok 6)) + (64 (Ok 6)) + (65 (Ok 7)) + |}] +;; + +let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit ceil_log2; + [%expect + {| + (-4_611_686_018_427_387_904 ( + Error ("[Int.ceil_log2] got invalid input" -4611686018427387904))) + (-4_611_686_018_427_387_903 ( + Error ("[Int.ceil_log2] got invalid input" -4611686018427387903))) + (4_611_686_018_427_387_902 (Ok 62)) + (4_611_686_018_427_387_903 (Ok 62)) + |}] +;; + +let%test_module "int_math" = + (module struct + let test_cases () = + let cases = + [ 0b10101010 + ; 0b1010101010101010 + ; 0b101010101010101010101010 + ; 0b10000000 + ; 0b1000000000001000 + ; 0b100000000000000000001000 + ] + in + match Word_size.word_size with + | W64 -> + (* create some >32 bit values... *) + (* We can't use literals directly because the compiler complains on 32 bits. *) + let cases = + cases + @ [ (0b1010101010101010 lsl 16) lor 0b1010101010101010 + ; (0b1000000000000000 lsl 16) lor 0b0000000000001000 + ] + in + let added_cases = List.map cases ~f:(fun x -> x lsl 16) in + List.concat [ cases; added_cases ] + | W32 -> cases + ;; + + let%test_unit "ceil_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = ceil_pow2 x in + assert (is_pow2 p2 && p2 >= x && x >= p2 / 2)) + ;; + + let%test_unit "floor_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = floor_pow2 x in + assert (is_pow2 p2 && 2 * p2 >= x && x >= p2)) + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_int_pow2.mli b/unikernel/duniverse/base/test/test_int_pow2.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_int_pow2.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_lazy.ml b/unikernel/duniverse/base/test/test_lazy.ml new file mode 100644 index 00000000..86215f1b --- /dev/null +++ b/unikernel/duniverse/base/test/test_lazy.ml @@ -0,0 +1,108 @@ +open! Import +open! Lazy + +let%test_unit _ = + let r = ref 0 in + let t = + return () + >>= fun () -> + Int.incr r; + return () + in + assert (!r = 0); + force t; + assert (!r = 1); + force t; + assert (!r = 1) +;; + +let%test_unit _ = + let r = ref 0 in + let t = return () >>= fun () -> lazy (Int.incr r) in + assert (!r = 0); + force t; + assert (!r = 1); + force t; + assert (!r = 1) +;; + +let%expect_test "peek" = + let t = + lazy + (print_endline "force t"; + "forced") + in + print_s [%sexp (peek t : string option)]; + [%expect {| () |}]; + ignore (force t : string); + [%expect {| force t |}]; + print_s [%sexp (peek t : string option)]; + [%expect {| (forced) |}] +;; + +let%test_module _ = + (module struct + module M1 = struct + type nonrec t = { x : int t } [@@deriving sexp_of] + end + + module M2 = struct + type t = { x : int T_unforcing.t } [@@deriving sexp_of] + end + + let%test_unit _ = + let v = lazy 42 in + let (_ : int) = + (* no needed, but the purpose of this test is not to test this compiler + optimization *) + force v + in + assert (is_val v); + let t1 = { M1.x = v } in + let t2 = { M2.x = v } in + assert (Sexp.equal (M1.sexp_of_t t1) (M2.sexp_of_t t2)) + ;; + + let%test_unit _ = + let t1 = { M1.x = lazy (40 + 2) } in + let t2 = { M2.x = lazy (40 + 2) } in + assert (not (Sexp.equal (M1.sexp_of_t t1) (M2.sexp_of_t t2))); + assert (is_val t1.x); + assert (not (is_val t2.x)) + ;; + end) +;; + +let%expect_test "equal" = + let lazy_a = + lazy + (print_endline "force lazy_a"; + 1) + in + let lazy_b = + lazy + (print_endline "force lazy_b"; + 1) + in + let lazy_c = + lazy + (print_endline "force lazy_c"; + 2) + in + (* [phys_equal] short-circuiting without [force] *) + print_s [%sexp (equal Int.equal lazy_a lazy_a : bool)]; + [%expect {| true |}]; + (* [force], resulting in [true] *) + print_s [%sexp (equal Int.equal lazy_a lazy_b : bool)]; + [%expect {| + force lazy_b + force lazy_a + true + |}]; + (* [force], resulting in [false] *) + print_s [%sexp (equal Int.equal lazy_b lazy_c : bool)]; + [%expect {| + force lazy_c + false + |}] +;; diff --git a/unikernel/duniverse/base/test/test_lazy.mli b/unikernel/duniverse/base/test/test_lazy.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_lazy.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_list.ml b/unikernel/duniverse/base/test/test_list.ml new file mode 100644 index 00000000..4d10cb47 --- /dev/null +++ b/unikernel/duniverse/base/test/test_list.ml @@ -0,0 +1,1946 @@ +open! Import +open! List + +let%expect_test "find_exn" = + let show f sexp_of_ok = print_s [%sexp (Result.try_with f : (ok, exn) Result.t)] in + let test list = + show (fun () -> List.find_exn list ~f:Int.is_negative) [%sexp_of: int] + in + test []; + [%expect {| (Error (Not_found_s "List.find_exn: not found")) |}]; + test [ 1; 2; 3 ]; + [%expect {| (Error (Not_found_s "List.find_exn: not found")) |}]; + test [ -1; -2; -3 ]; + [%expect {| (Ok -1) |}]; + test [ 1; -2; -3 ]; + [%expect {| (Ok -2) |}] +;; + +let%test_module "reduce_balanced" = + (module struct + let test expect list = + [%test_result: string option] + ~expect + (reduce_balanced ~f:(fun a b -> "(" ^ a ^ "+" ^ b ^ ")") list) + ;; + + let%test_unit "length 0" = test None [] + let%test_unit "length 1" = test (Some "a") [ "a" ] + let%test_unit "length 2" = test (Some "(a+b)") [ "a"; "b" ] + + let%test_unit "length 6" = + test (Some "(((a+b)+(c+d))+(e+f))") [ "a"; "b"; "c"; "d"; "e"; "f" ] + ;; + + let%test_unit "longer" = + (* pairs (index, number of times f called on me) to check: + 1. f called on results in index order + 2. total number of calls on any element is low + called on 2^n + 1 to demonstrate lack of balance (most elements are distance 7 from + the tree root, but one is distance 1) *) + let data = map (range 0 65) ~f:(fun i -> [ i, 0 ]) in + let f x y = map (x @ y) ~f:(fun (ix, cx) -> ix, cx + 1) in + match reduce_balanced data ~f with + | None -> failwith "None" + | Some l -> + [%test_result: int] ~expect:65 (List.length l); + iteri l ~f:(fun actual_index (computed_index, num_f) -> + let expected_num_f = if actual_index = 64 then 1 else 7 in + [%test_result: int * int] + ~expect:(actual_index, expected_num_f) + (computed_index, num_f)) + ;; + end) +;; + +let%test_module "range symmetries" = + (module struct + let basic ~stride ~start ~stop ~start_n ~stop_n ~result = + [%compare.equal: int t] (range ~stride ~start ~stop start_n stop_n) result + ;; + + let test stride (start_n, start) (stop_n, stop) result = + basic ~stride ~start ~stop ~start_n ~stop_n ~result + && (* works for negative [start] and [stop] *) + basic + ~stride:(-stride) + ~start_n:(-start_n) + ~stop_n:(-stop_n) + ~start + ~stop + ~result:(List.map result ~f:(fun x -> -x)) + ;; + + let%test _ = test 1 (3, `inclusive) (1, `exclusive) [] + let%test _ = test 1 (3, `inclusive) (3, `exclusive) [] + let%test _ = test 1 (3, `inclusive) (4, `exclusive) [ 3 ] + let%test _ = test 1 (3, `inclusive) (8, `exclusive) [ 3; 4; 5; 6; 7 ] + let%test _ = test 3 (4, `inclusive) (10, `exclusive) [ 4; 7 ] + let%test _ = test 3 (4, `inclusive) (11, `exclusive) [ 4; 7; 10 ] + let%test _ = test 3 (4, `inclusive) (12, `exclusive) [ 4; 7; 10 ] + let%test _ = test 3 (4, `inclusive) (13, `exclusive) [ 4; 7; 10 ] + let%test _ = test 3 (4, `inclusive) (14, `exclusive) [ 4; 7; 10; 13 ] + let%test _ = test (-1) (1, `inclusive) (3, `exclusive) [] + let%test _ = test (-1) (3, `inclusive) (3, `exclusive) [] + let%test _ = test (-1) (4, `inclusive) (3, `exclusive) [ 4 ] + let%test _ = test (-1) (8, `inclusive) (3, `exclusive) [ 8; 7; 6; 5; 4 ] + let%test _ = test (-3) (10, `inclusive) (4, `exclusive) [ 10; 7 ] + let%test _ = test (-3) (10, `inclusive) (3, `exclusive) [ 10; 7; 4 ] + let%test _ = test (-3) (10, `inclusive) (2, `exclusive) [ 10; 7; 4 ] + let%test _ = test (-3) (10, `inclusive) (1, `exclusive) [ 10; 7; 4 ] + let%test _ = test (-3) (10, `inclusive) (0, `exclusive) [ 10; 7; 4; 1 ] + let%test _ = test 1 (3, `exclusive) (1, `exclusive) [] + let%test _ = test 1 (3, `exclusive) (3, `exclusive) [] + let%test _ = test 1 (3, `exclusive) (4, `exclusive) [] + let%test _ = test 1 (3, `exclusive) (8, `exclusive) [ 4; 5; 6; 7 ] + let%test _ = test 3 (4, `exclusive) (10, `exclusive) [ 7 ] + let%test _ = test 3 (4, `exclusive) (11, `exclusive) [ 7; 10 ] + let%test _ = test 3 (4, `exclusive) (12, `exclusive) [ 7; 10 ] + let%test _ = test 3 (4, `exclusive) (13, `exclusive) [ 7; 10 ] + let%test _ = test 3 (4, `exclusive) (14, `exclusive) [ 7; 10; 13 ] + let%test _ = test (-1) (1, `exclusive) (3, `exclusive) [] + let%test _ = test (-1) (3, `exclusive) (3, `exclusive) [] + let%test _ = test (-1) (4, `exclusive) (3, `exclusive) [] + let%test _ = test (-1) (8, `exclusive) (3, `exclusive) [ 7; 6; 5; 4 ] + let%test _ = test (-3) (10, `exclusive) (4, `exclusive) [ 7 ] + let%test _ = test (-3) (10, `exclusive) (3, `exclusive) [ 7; 4 ] + let%test _ = test (-3) (10, `exclusive) (2, `exclusive) [ 7; 4 ] + let%test _ = test (-3) (10, `exclusive) (1, `exclusive) [ 7; 4 ] + let%test _ = test (-3) (10, `exclusive) (0, `exclusive) [ 7; 4; 1 ] + let%test _ = test 1 (3, `inclusive) (1, `inclusive) [] + let%test _ = test 1 (3, `inclusive) (3, `inclusive) [ 3 ] + let%test _ = test 1 (3, `inclusive) (4, `inclusive) [ 3; 4 ] + let%test _ = test 1 (3, `inclusive) (8, `inclusive) [ 3; 4; 5; 6; 7; 8 ] + let%test _ = test 3 (4, `inclusive) (10, `inclusive) [ 4; 7; 10 ] + let%test _ = test 3 (4, `inclusive) (11, `inclusive) [ 4; 7; 10 ] + let%test _ = test 3 (4, `inclusive) (12, `inclusive) [ 4; 7; 10 ] + let%test _ = test 3 (4, `inclusive) (13, `inclusive) [ 4; 7; 10; 13 ] + let%test _ = test 3 (4, `inclusive) (14, `inclusive) [ 4; 7; 10; 13 ] + let%test _ = test (-1) (1, `inclusive) (3, `inclusive) [] + let%test _ = test (-1) (3, `inclusive) (3, `inclusive) [ 3 ] + let%test _ = test (-1) (4, `inclusive) (3, `inclusive) [ 4; 3 ] + let%test _ = test (-1) (8, `inclusive) (3, `inclusive) [ 8; 7; 6; 5; 4; 3 ] + let%test _ = test (-3) (10, `inclusive) (4, `inclusive) [ 10; 7; 4 ] + let%test _ = test (-3) (10, `inclusive) (3, `inclusive) [ 10; 7; 4 ] + let%test _ = test (-3) (10, `inclusive) (2, `inclusive) [ 10; 7; 4 ] + let%test _ = test (-3) (10, `inclusive) (1, `inclusive) [ 10; 7; 4; 1 ] + let%test _ = test (-3) (10, `inclusive) (0, `inclusive) [ 10; 7; 4; 1 ] + let%test _ = test 1 (3, `exclusive) (1, `inclusive) [] + let%test _ = test 1 (3, `exclusive) (3, `inclusive) [] + let%test _ = test 1 (3, `exclusive) (4, `inclusive) [ 4 ] + let%test _ = test 1 (3, `exclusive) (8, `inclusive) [ 4; 5; 6; 7; 8 ] + let%test _ = test 3 (4, `exclusive) (10, `inclusive) [ 7; 10 ] + let%test _ = test 3 (4, `exclusive) (11, `inclusive) [ 7; 10 ] + let%test _ = test 3 (4, `exclusive) (12, `inclusive) [ 7; 10 ] + let%test _ = test 3 (4, `exclusive) (13, `inclusive) [ 7; 10; 13 ] + let%test _ = test 3 (4, `exclusive) (14, `inclusive) [ 7; 10; 13 ] + let%test _ = test (-1) (1, `exclusive) (3, `inclusive) [] + let%test _ = test (-1) (3, `exclusive) (3, `inclusive) [] + let%test _ = test (-1) (4, `exclusive) (3, `inclusive) [ 3 ] + let%test _ = test (-1) (8, `exclusive) (3, `inclusive) [ 7; 6; 5; 4; 3 ] + let%test _ = test (-3) (10, `exclusive) (4, `inclusive) [ 7; 4 ] + let%test _ = test (-3) (10, `exclusive) (3, `inclusive) [ 7; 4 ] + let%test _ = test (-3) (10, `exclusive) (2, `inclusive) [ 7; 4 ] + let%test _ = test (-3) (10, `exclusive) (1, `inclusive) [ 7; 4; 1 ] + let%test _ = test (-3) (10, `exclusive) (0, `inclusive) [ 7; 4; 1 ] + + let test_start_inc_exc stride start (stop, stop_inc_exc) result = + test stride (start, `inclusive) (stop, stop_inc_exc) result + && + match result with + | [] -> true + | head :: tail -> + head = start && test stride (start, `exclusive) (stop, stop_inc_exc) tail + ;; + + let test_inc_exc stride start stop result = + test_start_inc_exc stride start (stop, `inclusive) result + && + match List.rev result with + | [] -> true + | last :: all_but_last -> + let all_but_last = List.rev all_but_last in + if last = stop + then test_start_inc_exc stride start (stop, `exclusive) all_but_last + else true + ;; + + let%test _ = test_inc_exc 1 4 10 [ 4; 5; 6; 7; 8; 9; 10 ] + let%test _ = test_inc_exc 3 4 10 [ 4; 7; 10 ] + let%test _ = test_inc_exc 3 4 11 [ 4; 7; 10 ] + let%test _ = test_inc_exc 3 4 12 [ 4; 7; 10 ] + let%test _ = test_inc_exc 3 4 13 [ 4; 7; 10; 13 ] + let%test _ = test_inc_exc 3 4 14 [ 4; 7; 10; 13 ] + end) +;; + +module Test_values = struct + let long1 = + let v = lazy (range 1 100_000) in + fun () -> Lazy.force v + ;; + + let long2 = + let v = lazy (range 2 100_001) in + fun () -> Lazy.force v + ;; + + let l1 = [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ] +end + +let%test_unit _ = + [%test_result: int list] + (rev_append [ 1; 2; 3 ] [ 4; 5; 6 ]) + ~expect:[ 3; 2; 1; 4; 5; 6 ] +;; + +let%test_unit _ = [%test_result: int list] (rev_append [] [ 4; 5; 6 ]) ~expect:[ 4; 5; 6 ] +let%test_unit _ = [%test_result: int list] (rev_append [ 1; 2; 3 ] []) ~expect:[ 3; 2; 1 ] +let%test_unit _ = [%test_result: int list] (rev_append [ 1 ] [ 2; 3 ]) ~expect:[ 1; 2; 3 ] +let%test_unit _ = [%test_result: int list] (rev_append [ 1; 2 ] [ 3 ]) ~expect:[ 2; 1; 3 ] + +let%test_unit _ = + let long = Test_values.long1 () in + ignore (rev_append long long : int list) +;; + +let%test_unit _ = + let long1 = Test_values.long1 () in + let long2 = Test_values.long2 () in + [%test_result: int list] (map long1 ~f:(fun x -> x + 1)) ~expect:long2 +;; + +let test_ordering n = + let l = List.range 0 n in + let r = ref [] in + let (_ : unit list) = List.map l ~f:(fun x -> r := x :: !r) in + [%test_eq: int list] l (List.rev !r) +;; + +let%test_unit _ = test_ordering 10 +let%test_unit _ = test_ordering 1000 +let%test_unit _ = test_ordering 1_000_000 +let%test _ = for_all2_exn [] [] ~f:(fun _ _ -> assert false) + +let%test_unit _ = + [%test_result: int option] + (find_mapi [ 0; 5; 2; 1; 4 ] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:(Some 0) +;; + +let%test_unit _ = + [%test_result: int option] + (find_mapi [ 3; 5; 2; 1; 4 ] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:(Some 4) +;; + +let%test_unit _ = + [%test_result: int option] + (find_mapi [ 3; 5; 1; 1; 4 ] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:(Some 8) +;; + +let%test_unit _ = + [%test_result: int option] + (find_mapi [ 3; 5; 1; 1; 2 ] ~f:(fun i x -> if i = x then Some (i + x) else None)) + ~expect:None +;; + +let%test_unit _ = [%test_result: bool] (for_alli [] ~f:(fun _ _ -> false)) ~expect:true + +let%test_unit _ = + [%test_result: bool] (for_alli [ 0; 1; 2; 3 ] ~f:(fun i x -> i = x)) ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] (for_alli [ 0; 1; 3; 3 ] ~f:(fun i x -> i = x)) ~expect:false +;; + +let%test_unit _ = [%test_result: bool] (existsi [] ~f:(fun _ _ -> true)) ~expect:false + +let%test_unit _ = + [%test_result: bool] (existsi [ 0; 1; 2; 3 ] ~f:(fun i x -> i <> x)) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (existsi [ 0; 1; 3; 3 ] ~f:(fun i x -> i <> x)) ~expect:true +;; + +let%test_unit _ = + [%test_result: int list] (append [ 1; 2; 3 ] [ 4; 5; 6 ]) ~expect:[ 1; 2; 3; 4; 5; 6 ] +;; + +let%test_unit _ = [%test_result: int list] (append [] [ 4; 5; 6 ]) ~expect:[ 4; 5; 6 ] +let%test_unit _ = [%test_result: int list] (append [ 1; 2; 3 ] []) ~expect:[ 1; 2; 3 ] +let%test_unit _ = [%test_result: int list] (append [ 1 ] [ 2; 3 ]) ~expect:[ 1; 2; 3 ] +let%test_unit _ = [%test_result: int list] (append [ 1; 2 ] [ 3 ]) ~expect:[ 1; 2; 3 ] + +let%test_unit _ = + let long = Test_values.long1 () in + ignore (append long long : int list) +;; + +let%test_unit _ = + [%test_result: int list] (map ~f:Fn.id Test_values.l1) ~expect:Test_values.l1 +;; + +let%test_unit _ = [%test_result: int list] (map ~f:Fn.id []) ~expect:[] + +let%test_unit _ = + [%test_result: float list] + (map ~f:(fun x -> x +. 5.) [ 1.; 2.; 3. ]) + ~expect:[ 6.; 7.; 8. ] +;; + +let%test_unit _ = ignore (map ~f:Fn.id (Test_values.long1 ()) : int list) + +let%test_unit _ = + [%test_result: (int * char) list] + (map2_exn ~f:(fun a b -> a, b) [ 1; 2; 3 ] [ 'a'; 'b'; 'c' ]) + ~expect:[ 1, 'a'; 2, 'b'; 3, 'c' ] +;; + +let%test_unit _ = [%test_result: _ list] (map2_exn ~f:(fun _ _ -> ()) [] []) ~expect:[] + +let%test_unit _ = + let long = Test_values.long1 () in + ignore (map2_exn ~f:(fun _ _ -> ()) long long : unit list) +;; + +let%test_unit _ = + [%test_result: int list] + (rev_map_append [ 1; 2; 3; 4; 5 ] [ 6 ] ~f:Fn.id) + ~expect:[ 5; 4; 3; 2; 1; 6 ] +;; + +let%test_unit _ = + [%test_result: int list] + (rev_map_append [ 1; 2; 3; 4; 5 ] [ 6 ] ~f:(fun x -> 2 * x)) + ~expect:[ 10; 8; 6; 4; 2; 6 ] +;; + +let%test_unit _ = + [%test_result: int list] + (rev_map_append [] [ 6 ] ~f:(fun _ -> failwith "bug!")) + ~expect:[ 6 ] +;; + +let%test_unit _ = + [%test_result: int list] + (fold_right ~f:(fun e acc -> e :: acc) Test_values.l1 ~init:[]) + ~expect:Test_values.l1 +;; + +let%test_unit _ = + [%test_result: string] + (fold_right ~f:(fun e acc -> e ^ acc) [ "1"; "2" ] ~init:"3") + ~expect:"123" +;; + +let%test_unit _ = + [%test_result: unit] (fold_right ~f:(fun _ _ -> ()) [] ~init:()) ~expect:() +;; + +let%test_unit _ = + let long = Test_values.long1 () in + ignore (fold_right ~f:(fun e acc -> e :: acc) long ~init:[] : int list) +;; + +let%test_unit _ = + [%test_result: string] + (fold_right2_exn + ~f:(fun e1 e2 acc -> e1 ^ e2 ^ acc) + [ "1"; "2" ] + [ "a"; "b" ] + ~init:"3c") + ~expect:"1a2b3c" +;; + +let%test_unit _ = + [%test_result: string Or_unequal_lengths.t] + (fold_right2 + ~f:(fun e1 e2 acc -> e1 ^ e2 ^ acc) + [ "1"; "2" ] + [ "a"; "b"; "c" ] + ~init:"#") + ~expect:Or_unequal_lengths.Unequal_lengths +;; + +let%test_unit _ = + let l1 = Test_values.l1 in + [%test_result: int list * int list] + (unzip (zip_exn l1 (List.rev l1))) + ~expect:(l1, List.rev l1) +;; + +let%test_unit _ = + let long = Test_values.long1 () in + ignore (unzip (zip_exn long long) : int list * int list) +;; + +let%test_unit _ = + [%test_result: int list * int list] (unzip [ 1, 2; 4, 5 ]) ~expect:([ 1; 4 ], [ 2; 5 ]) +;; + +let%test_unit _ = + [%test_result: int list * int list * int list] + (unzip3 [ 1, 2, 3; 4, 5, 6 ]) + ~expect:([ 1; 4 ], [ 2; 5 ], [ 3; 6 ]) +;; + +let%test_unit _ = + [%test_result: (int * int) list Or_unequal_lengths.t] + (zip [ 1; 2; 3 ] [ 4; 5; 6 ]) + ~expect:(Ok [ 1, 4; 2, 5; 3, 6 ]) +;; + +let%test_unit _ = + [%test_result: (int * int) list Or_unequal_lengths.t] + (zip [ 1 ] [ 4; 5; 6 ]) + ~expect:Unequal_lengths +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (zip_exn [ 1; 2; 3 ] [ 4; 5; 6 ]) + ~expect:[ 1, 4; 2, 5; 3, 6 ] +;; + +let%expect_test _ = + show_raise (fun () -> zip_exn [ 1 ] [ 4; 5; 6 ]); + [%expect {| (raised (Invalid_argument "length mismatch in zip_exn: 1 <> 3")) |}] +;; + +let%expect_test _ = + show_raise (fun () -> + rev_map3_exn [ 1 ] [ 4; 5; 6 ] [ 2; 3 ] ~f:(fun a b c -> a + b + c)); + [%expect + {| (raised (Invalid_argument "length mismatch in rev_map3_exn: 1 <> 3 || 3 <> 2")) |}] +;; + +let%test_unit _ = + [%test_result: (int * string) list] + (mapi ~f:(fun i x -> i, x) [ "one"; "two"; "three"; "four" ]) + ~expect:[ 0, "one"; 1, "two"; 2, "three"; 3, "four" ] +;; + +let%test_unit _ = [%test_result: (int * _) list] (mapi ~f:(fun i x -> i, x) []) ~expect:[] + +let%test_module "group" = + (module struct + let%test_unit _ = + [%test_result: int list list] + (group [ 1; 2; 3; 4 ] ~break:(fun _ x -> x = 3)) + ~expect:[ [ 1; 2 ]; [ 3; 4 ] ] + ;; + + let%test_unit _ = + [%test_result: int list list] (group [] ~break:(fun _ -> assert false)) ~expect:[] + ;; + + let mis = [ 'M'; 'i'; 's'; 's'; 'i'; 's'; 's'; 'i'; 'p'; 'p'; 'i' ] + + let equal_letters = + [ [ 'M' ] + ; [ 'i' ] + ; [ 's'; 's' ] + ; [ 'i' ] + ; [ 's'; 's' ] + ; [ 'i' ] + ; [ 'p'; 'p' ] + ; [ 'i' ] + ] + ;; + + let single_letters = [ [ 'M'; 'i'; 's'; 's'; 'i'; 's'; 's'; 'i'; 'p'; 'p'; 'i' ] ] + + let every_three = + [ [ 'M'; 'i'; 's' ]; [ 's'; 'i'; 's' ]; [ 's'; 'i'; 'p' ]; [ 'p'; 'i' ] ] + ;; + + let%test_unit _ = + [%test_result: char list list] (group ~break:Char.( <> ) mis) ~expect:equal_letters + ;; + + let%test_unit _ = + [%test_result: char list list] + (group ~break:(fun _ _ -> false) mis) + ~expect:single_letters + ;; + + let%test_unit _ = + [%test_result: char list list] + (groupi ~break:(fun i _ _ -> i % 3 = 0) mis) + ~expect:every_three + ;; + end) +;; + +let%test_module "sort_and_group" = + (module struct + let%expect_test _ = + let compare a b = + Comparable.lift + String.compare + ~f:(fun s -> String.rstrip ~drop:Char.is_digit s) + a + b + in + [%test_result: string list list] + (sort_and_group [ "b1"; "c1"; "a1"; "a2"; "b2"; "a3" ] ~compare) + ~expect:[ [ "a1"; "a2"; "a3" ]; [ "b1"; "b2" ]; [ "c1" ] ] + ;; + end) +;; + +let%test_module "Assoc.group" = + (module struct + let%expect_test _ = + let test alist = + let multi = Assoc.group alist ~equal:String.Caseless.equal in + print_s [%sexp (multi : (string * int list) list)]; + let round_trip = + List.concat_map multi ~f:(fun (key, data) -> + List.map data ~f:(fun datum -> key, datum)) + in + require_equal + [%here] + (module struct + type t = (String.Caseless.t * int) list [@@deriving equal, sexp_of] + end) + alist + round_trip + in + test []; + [%expect {| () |}]; + test [ "a", 1; "A", 2 ]; + [%expect {| ((a (1 2))) |}]; + test [ "a", 1; "b", 2 ]; + [%expect {| + ((a (1)) + (b (2))) + |}]; + test [ "odd", 1; "even", 2; "Odd", 3; "Even", 4; "ODD", 5; "EVEN", 6 ]; + [%expect + {| + ((odd (1)) + (even (2)) + (Odd (3)) + (Even (4)) + (ODD (5)) + (EVEN (6))) + |}]; + test [ "odd", 1; "Odd", 3; "ODD", 5; "even", 2; "Even", 4; "EVEN", 6 ]; + [%expect {| + ((odd (1 3 5)) + (even (2 4 6))) + |}] + ;; + end) +;; + +let%test_module "Assoc.sort_and_group" = + (module struct + let%expect_test _ = + let test alist = + let multi = Assoc.sort_and_group alist ~compare:String.Caseless.compare in + print_s [%sexp (multi : (string * int list) list)]; + require_equal + [%here] + (module struct + type t = (string * int list) list [@@deriving equal, sexp_of] + end) + multi + (Map.to_alist (Map.of_alist_multi (module String.Caseless) alist)) + in + test []; + [%expect {| () |}]; + test [ "a", 1; "A", 2 ]; + [%expect {| ((a (1 2))) |}]; + test [ "a", 1; "b", 2 ]; + [%expect {| + ((a (1)) + (b (2))) + |}]; + test [ "odd", 1; "even", 2; "Odd", 3; "Even", 4; "ODD", 5; "EVEN", 6 ]; + [%expect {| + ((even (2 4 6)) + (odd (1 3 5))) + |}] + ;; + end) +;; + +let%test_module "chunks_of" = + (module struct + let test length break_every = + let l = List.init length ~f:Fn.id in + let b = chunks_of l ~length:break_every in + [%test_eq: int list] (List.concat b) l; + List.iter + b + ~f:([%test_pred: int list] (fun batch -> List.length batch <= break_every)) + ;; + + let expect_exn length break_every = + match test length break_every with + | exception _ -> () + | () -> raise_s [%message "Didn't raise." (length : int) (break_every : int)] + ;; + + let%test_unit _ = + for n = 0 to 10 do + for k = n + 2 downto 1 do + test n k + done + done; + expect_exn 1 0; + expect_exn 1 (-1) + ;; + + let%test_unit _ = [%test_result: _ list list] (chunks_of [] ~length:1) ~expect:[] + end) +;; + +let%test _ = last_exn [ 1; 2; 3 ] = 3 +let%test _ = last_exn [ 1 ] = 1 +let%test _ = last_exn (Test_values.long1 ()) = 99_999 +let%test _ = is_prefix [] ~prefix:[] ~equal:( = ) +let%test _ = is_prefix [ 1 ] ~prefix:[] ~equal:( = ) +let%test _ = is_prefix [ 1 ] ~prefix:[ 1 ] ~equal:( = ) +let%test _ = not (is_prefix [ 1 ] ~prefix:[ 1; 2 ] ~equal:( = )) +let%test _ = not (is_prefix [ 1; 3 ] ~prefix:[ 1; 2 ] ~equal:( = )) +let%test _ = is_prefix [ 1; 2; 3 ] ~prefix:[ 1; 2 ] ~equal:( = ) +let%test _ = is_suffix [] ~suffix:[] ~equal:( = ) +let%test _ = is_suffix [ 1 ] ~suffix:[] ~equal:( = ) +let%test _ = is_suffix [ 1 ] ~suffix:[ 1 ] ~equal:( = ) +let%test _ = not (is_suffix [ 1 ] ~suffix:[ 1; 2 ] ~equal:( = )) +let%test _ = not (is_suffix [ 1; 3 ] ~suffix:[ 1; 2 ] ~equal:( = )) +let%test _ = is_suffix [ 1; 2; 3 ] ~suffix:[ 2; 3 ] ~equal:( = ) + +let%test_unit _ = + List.iter + ~f:(fun (t, expect) -> + assert (Poly.equal expect (find_consecutive_duplicate t ~equal:Poly.equal))) + [ [], None + ; [ 1 ], None + ; [ 1; 1 ], Some (1, 1) + ; [ 1; 2 ], None + ; [ 1; 2; 1 ], None + ; [ 1; 2; 2 ], Some (2, 2) + ; [ 1; 1; 2; 2 ], Some (1, 1) + ] +;; + +let%test_unit _ = + [%test_result: ((int * char) * (int * char)) option] + (find_consecutive_duplicate + [ 0, 'a'; 1, 'b'; 2, 'b' ] + ~equal:(fun (_, a) (_, b) -> Char.( = ) a b)) + ~expect:(Some ((1, 'b'), (2, 'b'))) +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates ~which_to_keep:`Last [] ~equal:Int.( = )) + ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates + ~which_to_keep:`Last + [ 5; 5; 5; 5; 5 ] + ~equal:Int.( = )) + ~expect:[ 5 ] +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates + ~which_to_keep:`Last + [ 5; 6; 5; 6; 5; 6 ] + ~equal:Int.( = )) + ~expect:[ 5; 6; 5; 6; 5; 6 ] +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates + ~which_to_keep:`Last + [ 5; 5; 6; 6; 5; 5; 8; 8 ] + ~equal:Int.( = )) + ~expect:[ 5; 6; 5; 8 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`Last + [ 0, 1; 0, 2; 2, 2; 4, 1 ] + ~equal:(fun (a, _) (b, _) -> Int.( = ) a b)) + ~expect:[ 0, 2; 2, 2; 4, 1 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`Last + [ 0, 1; 2, 2; 0, 2; 4, 1 ] + ~equal:(fun (a, _) (b, _) -> Int.( = ) a b)) + ~expect:[ 0, 1; 2, 2; 0, 2; 4, 1 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`Last + [ 0, 1; 2, 1; 0, 2; 4, 2 ] + ~equal:(fun (_, a) (_, b) -> Int.( = ) a b)) + ~expect:[ 2, 1; 4, 2 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`Last + [ 0, 1; 2, 2; 0, 2; 4, 1 ] + ~equal:(fun (_, a) (_, b) -> Int.( = ) a b)) + ~expect:[ 0, 1; 0, 2; 4, 1 ] +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates ~which_to_keep:`First [] ~equal:Int.( = )) + ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates + ~which_to_keep:`First + [ 5; 5; 5; 5; 5 ] + ~equal:Int.( = )) + ~expect:[ 5 ] +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates + ~which_to_keep:`First + [ 5; 6; 5; 6; 5; 6 ] + ~equal:Int.( = )) + ~expect:[ 5; 6; 5; 6; 5; 6 ] +;; + +let%test_unit _ = + [%test_result: int list] + (remove_consecutive_duplicates + ~which_to_keep:`First + [ 5; 5; 6; 6; 5; 5; 8; 8 ] + ~equal:Int.( = )) + ~expect:[ 5; 6; 5; 8 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`First + [ 0, 1; 0, 2; 2, 2; 4, 1 ] + ~equal:(fun (a, _) (b, _) -> Int.( = ) a b)) + ~expect:[ 0, 1; 2, 2; 4, 1 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`First + [ 0, 1; 2, 2; 0, 2; 4, 1 ] + ~equal:(fun (a, _) (b, _) -> Int.( = ) a b)) + ~expect:[ 0, 1; 2, 2; 0, 2; 4, 1 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`First + [ 0, 1; 2, 1; 0, 2; 4, 2 ] + ~equal:(fun (_, a) (_, b) -> Int.( = ) a b)) + ~expect:[ 0, 1; 0, 2 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (remove_consecutive_duplicates + ~which_to_keep:`First + [ 0, 1; 2, 2; 0, 2; 4, 1 ] + ~equal:(fun (_, a) (_, b) -> Int.( = ) a b)) + ~expect:[ 0, 1; 2, 2; 4, 1 ] +;; + +let%test_unit _ = + [%test_result: int list] (dedup_and_sort ~compare:Int.compare []) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (dedup_and_sort ~compare:Int.compare [ 5; 5; 5; 5; 5 ]) + ~expect:[ 5 ] +;; + +let%test_unit _ = + [%test_result: int] + (length (dedup_and_sort ~compare:Int.compare [ 2; 1; 5; 3; 4 ])) + ~expect:5 +;; + +let%test_unit _ = + [%test_result: int] + (length (dedup_and_sort ~compare:Int.compare [ 2; 3; 5; 3; 4 ])) + ~expect:4 +;; + +let%test_unit _ = + [%test_result: int] + (length + (dedup_and_sort + [ 0, 1; 2, 2; 0, 2; 4, 1 ] + ~compare:(fun (a, _) (b, _) -> Int.compare a b))) + ~expect:3 +;; + +let%test_unit _ = + [%test_result: int] + (length + (dedup_and_sort + [ 0, 1; 2, 2; 0, 2; 4, 1 ] + ~compare:(fun (_, a) (_, b) -> Int.compare a b))) + ~expect:2 +;; + +let%test_unit _ = + [%test_result: int option] (find_a_dup ~compare:Int.compare []) ~expect:None +;; + +let%test_unit _ = + [%test_result: int option] (find_a_dup ~compare:Int.compare [ 3 ]) ~expect:None +;; + +let%test_unit _ = + [%test_result: int option] (find_a_dup ~compare:Int.compare [ 3; 4 ]) ~expect:None +;; + +let%test_unit _ = + [%test_result: int option] (find_a_dup ~compare:Int.compare [ 3; 3 ]) ~expect:(Some 3) +;; + +let%test_unit _ = + [%test_result: int option] + (find_a_dup ~compare:Int.compare [ 3; 5; 4; 6; 12 ]) + ~expect:None +;; + +let%test_unit _ = + [%test_result: int option] + (find_a_dup ~compare:Int.compare [ 3; 5; 4; 5; 12 ]) + ~expect:(Some 5) +;; + +let%test_unit _ = + [%test_result: int option] + (find_a_dup ~compare:Int.compare [ 3; 5; 12; 5; 12 ]) + ~expect:(Some 5) +;; + +let%test_unit _ = + [%test_result: (int * int) option] + (find_a_dup ~compare:[%compare: int * int] [ 0, 1; 2, 2; 0, 2; 4, 1 ]) + ~expect:None +;; + +let%test _ = + find_a_dup [ 0, 1; 2, 2; 0, 2; 4, 1 ] ~compare:(fun (_, a) (_, b) -> Int.compare a b) + |> Option.is_some +;; + +let%test _ = + let dup = + find_a_dup [ 0, 1; 2, 2; 0, 2; 4, 1 ] ~compare:(fun (a, _) (b, _) -> Int.compare a b) + in + match dup with + | Some (0, _) -> true + | _ -> false +;; + +let%test_unit _ = + [%test_result: bool] (contains_dup ~compare:Int.compare []) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (contains_dup ~compare:Int.compare [ 3 ]) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (contains_dup ~compare:Int.compare [ 3; 4 ]) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (contains_dup ~compare:Int.compare [ 3; 3 ]) ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] + (contains_dup ~compare:Int.compare [ 3; 5; 4; 6; 12 ]) + ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (contains_dup ~compare:Int.compare [ 3; 5; 4; 5; 12 ]) ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] + (contains_dup ~compare:Int.compare [ 3; 5; 12; 5; 12 ]) + ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] + (contains_dup ~compare:[%compare: int * int] [ 0, 1; 2, 2; 0, 2; 4, 1 ]) + ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] + (contains_dup + [ 0, 1; 2, 2; 0, 2; 4, 1 ] + ~compare:(fun (_, a) (_, b) -> Int.compare a b)) + ~expect:true +;; + +let%test_unit _ = + [%test_result: int list] (find_all_dups ~compare:Int.compare []) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] (find_all_dups ~compare:Int.compare [ 3 ]) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] (find_all_dups ~compare:Int.compare [ 3; 4 ]) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] (find_all_dups ~compare:Int.compare [ 3; 3 ]) ~expect:[ 3 ] +;; + +let%test_unit _ = + [%test_result: int list] + (find_all_dups ~compare:Int.compare [ 3; 5; 4; 6; 12 ]) + ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (find_all_dups ~compare:Int.compare [ 3; 5; 4; 5; 12 ]) + ~expect:[ 5 ] +;; + +let%test_unit _ = + [%test_result: int list] + (find_all_dups ~compare:Int.compare [ 3; 5; 12; 5; 12 ]) + ~expect:[ 5; 12 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (find_all_dups ~compare:[%compare: int * int] [ 0, 1; 2, 2; 0, 2; 4, 1 ]) + ~expect:[] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (find_all_dups [ 0, 1; 2, 2; 0, 2; 4, 1 ] ~compare:[%compare: _ * int]) + ~expect:[ 4, 1; 0, 2 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (find_all_dups [ 0, 1; 2, 2; 0, 2; 4, 1 ] ~compare:[%compare: int * _]) + ~expect:[ 0, 2 ] +;; + +let%test_unit _ = + [%test_result: int list] + (filter_map ~f:(fun x -> Some x) Test_values.l1) + ~expect:Test_values.l1 +;; + +let%test_unit _ = [%test_result: int list] (filter_map ~f:(fun x -> Some x) []) ~expect:[] + +let%test_unit _ = + [%test_result: int list] (filter_map ~f:(fun _x -> None) [ 1.; 2.; 3. ]) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (filter_map ~f:(fun x -> if x > 0 then Some x else None) [ 1; -1; 3 ]) + ~expect:[ 1; 3 ] +;; + +let%test_unit _ = + [%test_result: int list] + (filter_mapi ~f:(fun _i x -> Some x) Test_values.l1) + ~expect:Test_values.l1 +;; + +let%test_unit _ = + [%test_result: int list] (filter_mapi ~f:(fun _i x -> Some x) []) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] (filter_mapi ~f:(fun _i _x -> None) [ 1.; 2.; 3. ]) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (filter_mapi ~f:(fun _i x -> if x > 0 then Some x else None) [ 1; -1; 3 ]) + ~expect:[ 1; 3 ] +;; + +let%test_unit _ = + [%test_result: int list] + (filter_mapi ~f:(fun i x -> if i % 2 = 0 then Some x else None) [ 1; -1; 3 ]) + ~expect:[ 1; 3 ] +;; + +let%test_unit _ = + [%test_result: int list * int list] + (split_n [ 1; 2; 3; 4; 5; 6 ] 3) + ~expect:([ 1; 2; 3 ], [ 4; 5; 6 ]) +;; + +let%test_unit _ = + [%test_result: int list * int list] + (split_n [ 1; 2; 3; 4; 5; 6 ] 100) + ~expect:([ 1; 2; 3; 4; 5; 6 ], []) +;; + +let%test_unit _ = + [%test_result: int list * int list] + (split_n [ 1; 2; 3; 4; 5; 6 ] 0) + ~expect:([], [ 1; 2; 3; 4; 5; 6 ]) +;; + +let%test_unit _ = + [%test_result: int list * int list] + (split_n [ 1; 2; 3; 4; 5; 6 ] (-5)) + ~expect:([], [ 1; 2; 3; 4; 5; 6 ]) +;; + +let%test_unit _ = + [%test_result: int list] (take [ 1; 2; 3; 4; 5; 6 ] 3) ~expect:[ 1; 2; 3 ] +;; + +let%test_unit _ = + [%test_result: int list] (take [ 1; 2; 3; 4; 5; 6 ] 100) ~expect:[ 1; 2; 3; 4; 5; 6 ] +;; + +let%test_unit _ = [%test_result: int list] (take [ 1; 2; 3; 4; 5; 6 ] 0) ~expect:[] +let%test_unit _ = [%test_result: int list] (take [ 1; 2; 3; 4; 5; 6 ] (-5)) ~expect:[] + +let%test_unit _ = + [%test_result: int list] (drop [ 1; 2; 3; 4; 5; 6 ] 3) ~expect:[ 4; 5; 6 ] +;; + +let%test_unit _ = [%test_result: int list] (drop [ 1; 2; 3; 4; 5; 6 ] 100) ~expect:[] + +let%test_unit _ = + [%test_result: int list] (drop [ 1; 2; 3; 4; 5; 6 ] 0) ~expect:[ 1; 2; 3; 4; 5; 6 ] +;; + +let%test_unit _ = + [%test_result: int list] (drop [ 1; 2; 3; 4; 5; 6 ] (-5)) ~expect:[ 1; 2; 3; 4; 5; 6 ] +;; + +let%test_module "{take,drop,split}_while" = + (module struct + let pred = function + | '0' .. '9' -> true + | _ -> false + ;; + + let test xs prefix suffix = + let prefix1, suffix1 = split_while ~f:pred xs in + let prefix2 = take_while xs ~f:pred in + let suffix2 = drop_while xs ~f:pred in + [%test_eq: char list] xs (prefix @ suffix); + [%test_result: char list] ~expect:prefix prefix1; + [%test_result: char list] ~expect:prefix prefix2; + [%test_result: char list] ~expect:suffix suffix1; + [%test_result: char list] ~expect:suffix suffix2 + ;; + + let%test_unit _ = + test [ '1'; '2'; '3'; 'a'; 'b'; 'c' ] [ '1'; '2'; '3' ] [ 'a'; 'b'; 'c' ] + ;; + + let%test_unit _ = test [ '1'; '2'; 'a'; 'b'; 'c' ] [ '1'; '2' ] [ 'a'; 'b'; 'c' ] + let%test_unit _ = test [ '1'; 'a'; 'b'; 'c' ] [ '1' ] [ 'a'; 'b'; 'c' ] + let%test_unit _ = test [ 'a'; 'b'; 'c' ] [] [ 'a'; 'b'; 'c' ] + let%test_unit _ = test [ '1'; '2'; '3' ] [ '1'; '2'; '3' ] [] + let%test_unit _ = test [] [] [] + end) +;; + +let%test_unit _ = [%test_result: int list] (concat []) ~expect:[] +let%test_unit _ = [%test_result: int list] (concat [ [] ]) ~expect:[] +let%test_unit _ = [%test_result: int list] (concat [ [ 3 ] ]) ~expect:[ 3 ] + +let%test_unit _ = + [%test_result: int list] (concat [ [ 1; 2; 3; 4 ] ]) ~expect:[ 1; 2; 3; 4 ] +;; + +let%test_unit _ = + [%test_result: int list] + (concat [ [ 1; 2; 3; 4 ]; [ 5; 6; 7 ]; [ 8; 9; 10 ]; []; [ 11; 12 ] ]) + ~expect:[ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12 ] +;; + +let%test_unit _ = [%test_result: bool] (is_sorted [] ~compare:Int.compare) ~expect:true +let%test_unit _ = [%test_result: bool] (is_sorted [ 1 ] ~compare:Int.compare) ~expect:true + +let%test_unit _ = + [%test_result: bool] (is_sorted [ 1; 2; 3; 4 ] ~compare:Int.compare) ~expect:true +;; + +let%test_unit _ = + [%test_result: bool] (is_sorted [ 2; 1 ] ~compare:Int.compare) ~expect:false +;; + +let%test_unit _ = + [%test_result: bool] (is_sorted [ 1; 3; 2 ] ~compare:Int.compare) ~expect:false +;; + +let%test_unit _ = + List.iter + ~f:(fun (t, expect) -> + [%test_result: bool] ~expect (is_sorted_strictly t ~compare:Int.compare)) + [ [], true + ; [ 1 ], true + ; [ 1; 2 ], true + ; [ 1; 1 ], false + ; [ 2; 1 ], false + ; [ 1; 2; 3 ], true + ; [ 1; 1; 3 ], false + ; [ 1; 2; 2 ], false + ] +;; + +let%test_unit _ = [%test_result: int option] (random_element []) ~expect:None +let%test_unit _ = [%test_result: int option] (random_element [ 0 ]) ~expect:(Some 0) + +let%test_module "transpose" = + (module struct + let round_trip a b = + [%test_result: int list list option] (transpose a) ~expect:(Some b); + [%test_result: int list list option] (transpose b) ~expect:(Some a) + ;; + + let%test_unit _ = round_trip [] [] + + let%test_unit _ = + [%test_result: int list list option] (transpose [ [] ]) ~expect:(Some []) + ;; + + let%test_unit _ = + [%test_result: int list list option] (transpose [ []; [] ]) ~expect:(Some []) + ;; + + let%test_unit _ = + [%test_result: int list list option] (transpose [ []; []; [] ]) ~expect:(Some []) + ;; + + let%test_unit _ = round_trip [ [ 1 ] ] [ [ 1 ] ] + let%test_unit _ = round_trip [ [ 1 ]; [ 2 ] ] [ [ 1; 2 ] ] + let%test_unit _ = round_trip [ [ 1 ]; [ 2 ]; [ 3 ] ] [ [ 1; 2; 3 ] ] + let%test_unit _ = round_trip [ [ 1; 2 ]; [ 3; 4 ] ] [ [ 1; 3 ]; [ 2; 4 ] ] + + let%test_unit _ = + round_trip [ [ 1; 2; 3 ]; [ 4; 5; 6 ] ] [ [ 1; 4 ]; [ 2; 5 ]; [ 3; 6 ] ] + ;; + + let%test_unit _ = + round_trip + [ [ 1; 2; 3 ]; [ 4; 5; 6 ]; [ 7; 8; 9 ] ] + [ [ 1; 4; 7 ]; [ 2; 5; 8 ]; [ 3; 6; 9 ] ] + ;; + + let%test_unit _ = + round_trip + [ [ 1; 2; 3; 4 ]; [ 5; 6; 7; 8 ]; [ 9; 10; 11; 12 ] ] + [ [ 1; 5; 9 ]; [ 2; 6; 10 ]; [ 3; 7; 11 ]; [ 4; 8; 12 ] ] + ;; + + let%test_unit _ = + round_trip + [ [ 1; 2; 3; 4 ]; [ 5; 6; 7; 8 ]; [ 9; 10; 11; 12 ]; [ 13; 14; 15; 16 ] ] + [ [ 1; 5; 9; 13 ]; [ 2; 6; 10; 14 ]; [ 3; 7; 11; 15 ]; [ 4; 8; 12; 16 ] ] + ;; + + let%test_unit _ = + round_trip + [ [ 1; 2; 3 ]; [ 4; 5; 6 ]; [ 7; 8; 9 ]; [ 10; 11; 12 ] ] + [ [ 1; 4; 7; 10 ]; [ 2; 5; 8; 11 ]; [ 3; 6; 9; 12 ] ] + ;; + + let%test_unit _ = + [%test_result: int list list option] (transpose [ []; [ 1 ] ]) ~expect:None + ;; + + let%test_unit _ = + [%test_result: int list list option] (transpose [ [ 1; 2 ]; [ 3 ] ]) ~expect:None + ;; + end) +;; + +let%test_unit _ = + [%test_result: int list] (intersperse [ 1; 2; 3 ] ~sep:0) ~expect:[ 1; 0; 2; 0; 3 ] +;; + +let%test_unit _ = + [%test_result: int list] (intersperse [ 1; 2 ] ~sep:0) ~expect:[ 1; 0; 2 ] +;; + +let%test_unit _ = [%test_result: int list] (intersperse [ 1 ] ~sep:0) ~expect:[ 1 ] +let%test_unit _ = [%test_result: int list] (intersperse [] ~sep:0) ~expect:[] + +let test_fold_map list ~init ~f ~expect = + [%test_result: int list] (folding_map list ~init ~f) ~expect:(snd expect); + [%test_result: _ * int list] (fold_map list ~init ~f) ~expect +;; + +let test_fold_mapi list ~init ~f ~expect = + [%test_result: int list] (folding_mapi list ~init ~f) ~expect:(snd expect); + [%test_result: _ * int list] (fold_mapi list ~init ~f) ~expect +;; + +let%test_unit _ = + test_fold_map + [ 1; 2; 3; 4 ] + ~init:0 + ~f:(fun acc x -> + let y = acc + x in + y, y) + ~expect:(10, [ 1; 3; 6; 10 ]) +;; + +let%test_unit _ = + test_fold_map + [] + ~init:0 + ~f:(fun acc x -> + let y = acc + x in + y, y) + ~expect:(0, []) +;; + +let%test_unit _ = + test_fold_mapi + [ 1; 2; 3; 4 ] + ~init:0 + ~f:(fun i acc x -> + let y = acc + (i * x) in + y, y) + ~expect:(20, [ 0; 2; 8; 20 ]) +;; + +let%test_unit _ = + test_fold_mapi + [] + ~init:0 + ~f:(fun i acc x -> + let y = acc + (i * x) in + y, y) + ~expect:(0, []) +;; + +let%expect_test "drop_last" = + let print_drop_last x = print_s [%sexp (List.drop_last x : int list option)] in + print_drop_last []; + [%expect {| () |}]; + print_drop_last [ 1 ]; + [%expect {| (()) |}]; + print_drop_last [ 1; 2; 3 ]; + [%expect {| ((1 2)) |}] +;; + +let%expect_test "drop_last_exn" = + let print_drop_last_exn x = print_s [%sexp (List.drop_last_exn x : int list)] in + require_does_raise [%here] (fun () -> print_drop_last_exn []); + [%expect {| (Failure "List.drop_last_exn: empty list") |}]; + require_does_not_raise [%here] (fun () -> print_drop_last_exn [ 1 ]); + [%expect {| () |}] +;; + +let%expect_test "[all_equal]" = + let test list = + print_s [%sexp (all_equal list ~equal:Char.Caseless.equal : char option)] + in + (* empty list *) + test []; + [%expect {| () |}]; + (* singleton *) + test [ 'a' ]; + [%expect {| (a) |}]; + (* homogenous pairs (up to [equal]) *) + test [ 'a'; 'a' ]; + [%expect {| (a) |}]; + test [ 'a'; 'A' ]; + [%expect {| (a) |}]; + test [ 'A'; 'a' ]; + [%expect {| (A) |}]; + (* heterogenous pairs *) + test [ 'a'; 'b' ]; + [%expect {| () |}]; + test [ 'b'; 'a' ]; + [%expect {| () |}]; + (* heterogenous lists *) + test [ 'a'; 'b'; 'a'; 'b'; 'a'; 'b' ]; + [%expect {| () |}]; + test [ 'a'; 'b'; 'c'; 'd'; 'e'; 'f' ]; + [%expect {| () |}]; + (* homogenous lists (up to [equal]) *) + test [ 'a'; 'a'; 'a'; 'a'; 'a'; 'a' ]; + [%expect {| (a) |}]; + test [ 'A'; 'a'; 'A'; 'a'; 'A'; 'a' ]; + [%expect {| (A) |}] +;; + +let%expect_test "[Cartesian_product.apply] identity" = + let test list = + require_equal + [%here] + (module struct + type t = char list [@@deriving equal, sexp_of] + end) + list + (List.Cartesian_product.apply (return Fn.id) list) + in + test []; + test [ 'a'; 'b'; 'c' ]; + test [ 'a'; 'z'; 'd'; 'b' ] +;; + +let%expect_test "[Cartesian_product]" = + (let%map.List.Cartesian_product letter = [ 'a'; 'b'; 'c' ] + and number = [ 1; 2; 3 ] + and solfege = [ "do"; "re"; "mi" ] in + [%sexp (letter : char), (number : int), (solfege : string)]) + |> List.iter ~f:print_s; + [%expect + {| + (a 1 do) + (a 1 re) + (a 1 mi) + (a 2 do) + (a 2 re) + (a 2 mi) + (a 3 do) + (a 3 re) + (a 3 mi) + (b 1 do) + (b 1 re) + (b 1 mi) + (b 2 do) + (b 2 re) + (b 2 mi) + (b 3 do) + (b 3 re) + (b 3 mi) + (c 1 do) + (c 1 re) + (c 1 mi) + (c 2 do) + (c 2 re) + (c 2 mi) + (c 3 do) + (c 3 re) + (c 3 mi) + |}] +;; + +let%expect_test "[compare__local] is the same as [compare]" = + Base_quickcheck.Test.run_exn + (module struct + type t = int list * int list [@@deriving sexp_of, quickcheck] + end) + ~f:(fun (l1, l2) -> + require_equal + [%here] + (module Int) + (compare Int.compare l1 l2) + (compare__local Int.compare__local l1 l2)); + [%expect {| |}] +;; + +let%expect_test "[equal__local] is the same as [equal]" = + Base_quickcheck.Test.run_exn + (module struct + type t = int list * int list [@@deriving sexp_of, quickcheck] + end) + ~f:(fun (l1, l2) -> + require_equal + [%here] + (module Bool) + (equal Int.equal l1 l2) + (equal__local Int.equal__local l1 l2)); + [%expect {| |}] +;; + +let%expect_test "list sort, dedup" = + let slow_stable_sort list ~compare = + let rec insert elt list = + match list with + | [] -> [ elt ] + | head :: tail -> + (match compare elt head with + | c when c <= 0 -> elt :: list + | _ -> head :: insert elt tail) + in + List.fold_right list ~init:[] ~f:insert + in + let slow_sort list ~compare = + (* sort happens to behave the same as stable_sort *) + let rec insert elt list = + match list with + | [] -> [ elt ] + | head :: tail -> + (match compare elt head with + | c when c <= 0 -> elt :: list + | _ -> head :: insert elt tail) + in + List.fold_right list ~init:[] ~f:insert + in + let slow_dedup_and_sort list ~compare = + (* dedup_and_sort keeps the last element among duplicates *) + let rec insert elt list = + match list with + | [] -> [ elt ] + | head :: tail -> + (match compare elt head with + | 0 -> list + | c when c < 0 -> elt :: list + | _ -> head :: insert elt tail) + in + List.fold_right list ~init:[] ~f:insert + in + let slow_stable_dedup list ~compare = + (* stable_dedup keeps the first element among duplicates *) + let insert elt list = + elt :: List.filter list ~f:(fun other -> compare elt other <> 0) + in + List.fold_right list ~init:[] ~f:insert + in + let module Char_list = struct + open Base_quickcheck + + type t = char list [@@deriving equal, sexp_of] + + let quickcheck_generator = Generator.list_non_empty Generator.char_alpha + + let quickcheck_shrinker = + let prev char = Char.of_int_exn (Int.pred (Char.to_int char)) in + Shrinker.list + (Shrinker.create (function + | 'a' -> Sequence.empty + | 'b' .. 'z' as char -> Sequence.singleton (prev char) + | 'A' -> Sequence.singleton 'a' + | 'B' .. 'Z' as char -> Sequence.of_list [ Char.lowercase char; prev char ] + | _ -> Sequence.empty)) + ;; + end + in + let compare = Char.Caseless.compare in + quickcheck_m + [%here] + ~examples:[ []; [ 'a'; 'a' ]; [ 'a'; 'A' ]; [ 'A'; 'a' ]; [ 'A'; 'A' ] ] + (module Char_list) + ~f:(fun list -> + require_equal + [%here] + (module Char_list) + ~message:"sort mismatch" + (List.sort list ~compare) + (slow_sort list ~compare); + require_equal + [%here] + (module Char_list) + ~message:"stable_sort mismatch" + (List.stable_sort list ~compare) + (slow_stable_sort list ~compare); + require_equal + [%here] + (module Char_list) + ~message:"dedup_and_sort mismatch" + (List.dedup_and_sort list ~compare) + (slow_dedup_and_sort list ~compare); + require_equal + [%here] + (module Char_list) + ~message:"stable_dedup mismatch" + (List.stable_dedup list ~compare) + (slow_stable_dedup list ~compare)) +;; + +let%expect_test "[take], [drop], and [split]" = + for whole_len = 0 to 3 do + let whole = List.init whole_len ~f:Fn.id in + let test name kind requested_length list = + let expected_length = Int.clamp_exn requested_length ~min:0 ~max:whole_len in + let phys_equal_whole = phys_equal list whole in + let check problem bool = + require + [%here] + bool + ~if_false_then_print_s: + [%lazy_message + name + ~problem + (whole : int list) + (requested_length : int) + (expected_length : int) + (phys_equal_whole : bool) + (list : int list)] + in + check "wrong length" (List.length list = expected_length); + if expected_length = whole_len then check "not phys_equal" phys_equal_whole; + match kind with + | `prefix -> + check "is not a prefix" (List.is_prefix whole ~prefix:list ~equal:( = )) + | `suffix -> + check "is not a suffix" (List.is_suffix whole ~suffix:list ~equal:( = )) + in + for prefix_len = -1 to 2 do + let suffix_len = whole_len - prefix_len in + test "take" `prefix prefix_len (List.take whole prefix_len); + test "drop" `suffix suffix_len (List.drop whole prefix_len); + let prefix, suffix = List.split_n whole prefix_len in + test "split prefix" `prefix prefix_len prefix; + test "split suffix" `suffix suffix_len suffix + done + done; + [%expect {| |}] +;; + +let print_s sexp = + Ref.set_temporarily sexp_style Sexp_style.simple_pretty ~f:(fun () -> print_s sexp) +;; + +let%expect_test "[cartesian_product]" = + let test xs ys = print_s [%sexp (cartesian_product xs ys : (int * int) list)] in + test [] []; + [%expect {| () |}]; + test [ 1; 2; 3 ] []; + [%expect {| () |}]; + test [] [ 1; 2; 3 ]; + [%expect {| () |}]; + test [ 1 ] [ 2; 3; 4 ]; + [%expect {| ((1 2) (1 3) (1 4)) |}]; + test [ 1; 2; 3 ] [ 4 ]; + [%expect {| ((1 4) (2 4) (3 4)) |}]; + test [ 1; 2 ] [ 3; 4; 5 ]; + [%expect {| ((1 3) (1 4) (1 5) (2 3) (2 4) (2 5)) |}]; + test [ 1; 2; 3 ] [ 4; 5 ]; + [%expect {| ((1 4) (1 5) (2 4) (2 5) (3 4) (3 5)) |}]; + test [ 1; 2; 3 ] [ 4; 5; 6 ]; + [%expect {| ((1 4) (1 5) (1 6) (2 4) (2 5) (2 6) (3 4) (3 5) (3 6)) |}] +;; + +let%expect_test "[concat_map]" = + let test list = + List.concat_map list ~f:(fun n -> List.init n ~f:Int.succ) + |> [%sexp_of: int list] + |> print_s + in + test []; + [%expect {| () |}]; + test [ 1 ]; + [%expect {| (1) |}]; + test [ 1; 2 ]; + [%expect {| (1 1 2) |}]; + test [ 1; 2; 3 ]; + [%expect {| (1 1 2 1 2 3) |}]; + test [ 1; 2; 3; 4 ]; + [%expect {| (1 1 2 1 2 3 1 2 3 4) |}]; + test [ 4; 5; 6 ]; + [%expect {| (1 2 3 4 1 2 3 4 5 1 2 3 4 5 6) |}] +;; + +let%expect_test "[concat_mapi]" = + let test list = + List.concat_mapi list ~f:(fun i n -> List.init n ~f:(( + ) i)) + |> [%sexp_of: int list] + |> print_s + in + test []; + [%expect {| () |}]; + test [ 1 ]; + [%expect {| (0) |}]; + test [ 1; 2 ]; + [%expect {| (0 1 2) |}]; + test [ 1; 2; 3 ]; + [%expect {| (0 1 2 2 3 4) |}]; + test [ 1; 2; 3; 4 ]; + [%expect {| (0 1 2 2 3 4 3 4 5 6) |}]; + test [ 4; 5; 6 ]; + [%expect {| (0 1 2 3 1 2 3 4 5 2 3 4 5 6 7) |}] +;; + +let%test_module "filter{,i}" = + (module struct + open Base_quickcheck + + module Int_list = struct + type t = int list [@@deriving equal, sexp_of] + end + + let%expect_test "[filter]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + (* test [f] *) + let pos = List.filter list ~f in + require [%here] (List.for_all pos ~f); + (* test [~f] *) + let not_f = Fn.non f in + let neg = List.filter list ~f:not_f in + require [%here] (List.for_all neg ~f:not_f); + (* test [f \/ ~f] *) + let sort = sort ~compare:Int.compare in + require_equal [%here] (module Int_list) (sort list) (sort (pos @ neg))) + ;; + + let%expect_test "[filteri]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + let pos, neg = + (* stash the original indices, so that we can retrieve them after filtering *) + let list = mapi list ~f:(fun i x -> i, x) in + let ignore_stash f : _ = fun i (_, x) -> f i x in + let use_orig_index f : _ = fun (i, x) -> f i x in + (* test [f] *) + let pos = List.filteri list ~f:(ignore_stash f) in + require [%here] (List.for_all pos ~f:(use_orig_index f)); + (* test [~f] *) + let not_f i x = not (f i x) in + let neg = List.filteri list ~f:(ignore_stash not_f) in + require [%here] (List.for_all neg ~f:(use_orig_index not_f)); + pos, neg + in + (* test [f \/ ~f] *) + let sort = sort ~compare:[%compare: int * _] in + require_equal [%here] (module Int_list) list (sort (pos @ neg) |> map ~f:snd)) + ;; + + let%expect_test "[filteri ~f:(Fn.const f) = filter ~f]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal + [%here] + (module Int_list) + (filteri list ~f:(fun _ x -> f x)) + (filter list ~f)) + ;; + + let%expect_test "[filter]" = + let test list = + List.filter list ~f:(fun n -> n % 3 > 0) |> [%sexp_of: int list] |> print_s + in + test []; + [%expect {| () |}]; + test [ 1 ]; + [%expect {| (1) |}]; + test [ 1; 2 ]; + [%expect {| (1 2) |}]; + test [ 1; 2; 3 ]; + [%expect {| (1 2) |}]; + test [ 1; 2; 3; 4 ]; + [%expect {| (1 2 4) |}]; + test [ 4; 5; 6 ]; + [%expect {| (4 5) |}] + ;; + + let%expect_test "[filteri]" = + let test list = + List.filteri list ~f:(fun i n -> n > i) |> [%sexp_of: int list] |> print_s + in + test []; + [%expect {| () |}]; + test [ 0 ]; + [%expect {| () |}]; + test [ 0; 1 ]; + [%expect {| () |}]; + test [ 0; 1; 2 ]; + [%expect {| () |}]; + test [ 1 ]; + [%expect {| (1) |}]; + test [ 1; 2 ]; + [%expect {| (1 2) |}]; + test [ 1; 2; 3 ]; + [%expect {| (1 2 3) |}]; + test [ 1; 0 ]; + [%expect {| (1) |}]; + test [ 2; 1; 0 ]; + [%expect {| (2) |}]; + test [ 3; 2; 1; 0 ]; + [%expect {| (3 2) |}] + ;; + end) +;; + +let%test_module "count{,i}" = + (module struct + let%expect_test "[count{,i} list ~f = List.length (filter{,i} list ~f)]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal [%here] (module Int) (count list ~f) (length (filter list ~f))); + quickcheck_m + [%here] + (module struct + type t = int list * (int -> int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal [%here] (module Int) (counti list ~f) (length (filteri list ~f))) + ;; + + let%test_unit _ = + [%test_result: int] (counti [ 0; 1; 2; 3; 4 ] ~f:(fun idx x -> idx = x)) ~expect:5 + ;; + + let%test_unit _ = + [%test_result: int] + (counti [ 0; 1; 2; 3; 4 ] ~f:(fun idx x -> idx = 4 - x)) + ~expect:1 + ;; + end) +;; + +let%test_module "{min,max}_elt" = + (module struct + let test_in_list_and_forall ~tested_f ~holds_for_res_over_all_elem = + quickcheck_m + [%here] + (module struct + type t = int list [@@deriving quickcheck, sexp_of] + end) + ~f:(fun list -> + let res = tested_f list ~compare:[%compare: int] in + match res with + | None -> require [%here] (is_empty list) + | Some res -> + require [%here] (mem list res ~equal:Int.equal); + iter list ~f:(fun elem -> + require [%here] (holds_for_res_over_all_elem ~res ~elem))) + ;; + + let%expect_test "min_elt" = + test_in_list_and_forall + ~tested_f:min_elt + ~holds_for_res_over_all_elem:(fun ~res ~elem -> res <= elem) + ;; + + let%expect_test "max_elt" = + test_in_list_and_forall + ~tested_f:max_elt + ~holds_for_res_over_all_elem:(fun ~res ~elem -> res >= elem) + ;; + end) +;; + +let%expect_test "[map2]" = + let test xs ys = + map2 xs ys ~f:(fun x y -> x, y) + |> [%sexp_of: (int * int) list Or_unequal_lengths.t] + |> print_s + in + test [] []; + [%expect {| (Ok ()) |}]; + test [ 1 ] [ 2 ]; + [%expect {| (Ok ((1 2))) |}]; + test [ 1; 2 ] [ 3; 4 ]; + [%expect {| (Ok ((1 3) (2 4))) |}]; + test [ 1; 2; 3 ] [ 4; 5; 6 ]; + [%expect {| (Ok ((1 4) (2 5) (3 6))) |}]; + test [] [ 1 ]; + [%expect {| Unequal_lengths |}]; + test [ 1 ] []; + [%expect {| Unequal_lengths |}]; + test [ 1 ] [ 2; 3; 4 ]; + [%expect {| Unequal_lengths |}]; + test [ 1; 2; 3 ] [ 4 ]; + [%expect {| Unequal_lengths |}] +;; + +let%expect_test "[map3]" = + let test xs ys zs = + map3 xs ys zs ~f:(fun x y z -> x, y, z) + |> [%sexp_of: (int * int * int) list Or_unequal_lengths.t] + |> print_s + in + test [] [] []; + [%expect {| (Ok ()) |}]; + test [ 1 ] [ 2 ] [ 3 ]; + [%expect {| (Ok ((1 2 3))) |}]; + test [ 1; 2 ] [ 3; 4 ] [ 5; 6 ]; + [%expect {| (Ok ((1 3 5) (2 4 6))) |}]; + test [ 1; 2; 3 ] [ 4; 5; 6 ] [ 7; 8; 9 ]; + [%expect {| (Ok ((1 4 7) (2 5 8) (3 6 9))) |}]; + test [] [] [ 1 ]; + [%expect {| Unequal_lengths |}]; + test [] [ 1 ] []; + [%expect {| Unequal_lengths |}]; + test [] [] [ 1 ]; + [%expect {| Unequal_lengths |}]; + test [ 1 ] [ 2 ] [ 3; 4; 5 ]; + [%expect {| Unequal_lengths |}]; + test [ 1 ] [ 2; 3; 4 ] [ 5 ]; + [%expect {| Unequal_lengths |}]; + test [ 1; 2; 3 ] [ 4 ] [ 5 ]; + [%expect {| Unequal_lengths |}] +;; + +let%expect_test "[merge]" = + let module Int_list = struct + type t = int list [@@deriving equal, sexp_of] + end + in + let test_int xs ys = + let list1 = merge xs ys ~compare:Int.compare in + print_s [%sexp (list1 : int list)]; + let list2 = merge ys xs ~compare:Int.compare in + require_equal [%here] (module Int_list) list1 list2 + in + test_int [] []; + [%expect {| () |}]; + test_int [] [ 1; 2; 3 ]; + [%expect {| (1 2 3) |}]; + test_int [ 1; 2 ] [ 3; 4; 5 ]; + [%expect {| (1 2 3 4 5) |}]; + test_int [ 1; 3 ] [ 2; 4; 5 ]; + [%expect {| (1 2 3 4 5) |}]; + test_int [ 1; 4 ] [ 2; 3; 5 ]; + [%expect {| (1 2 3 4 5) |}]; + test_int [ 1; 5 ] [ 2; 3; 4 ]; + [%expect {| (1 2 3 4 5) |}]; + test_int [ 1; 3; 5 ] [ 2; 4 ]; + [%expect {| (1 2 3 4 5) |}]; + test_int [ 1; 3; 4 ] [ 1; 2 ]; + [%expect {| (1 1 2 3 4) |}]; + let test_pair xs ys = + let list1 = merge xs ys ~compare:[%compare: int * _] in + print_s [%sexp (list1 : (int * string) list)]; + let list2 = merge ys xs ~compare:[%compare: int * _] in + print_s [%sexp (list2 : (int * string) list)] + in + test_pair [] []; + [%expect {| + () + () + |}]; + test_pair [] [ 1, "a"; 2, "b"; 3, "c" ]; + [%expect {| + ((1 a) (2 b) (3 c)) + ((1 a) (2 b) (3 c)) + |}]; + test_pair [ 1, "z"; 2, "y" ] [ 3, "x"; 4, "w"; 5, "v" ]; + [%expect + {| + ((1 z) (2 y) (3 x) (4 w) (5 v)) + ((1 z) (2 y) (3 x) (4 w) (5 v)) + |}]; + test_pair [ 1, "a"; 2, "b" ] []; + [%expect {| + ((1 a) (2 b)) + ((1 a) (2 b)) + |}]; + test_pair [ 1, "a"; 3, "b" ] [ 1, "b"; 2, "a" ]; + [%expect {| + ((1 a) (1 b) (2 a) (3 b)) + ((1 b) (1 a) (2 a) (3 b)) + |}]; + test_pair [ 0, "!"; 1, "b"; 2, "a" ] [ 1, "a"; 2, "b" ]; + [%expect + {| + ((0 !) (1 b) (1 a) (2 a) (2 b)) + ((0 !) (1 a) (1 b) (2 b) (2 a)) + |}] +;; + +let%expect_test "[sub]" = + let test pos len list = + match sub list ~pos ~len with + | list -> print_s [%sexp (list : int list)] + | exception exn -> print_s [%sexp "raised", (exn : exn)] + in + test 0 0 []; + [%expect {| () |}]; + test 1 0 []; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + test 0 1 []; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + let list = [ 1; 2; 3; 4 ] in + test 0 0 list; + [%expect {| () |}]; + test 0 4 list; + [%expect {| (1 2 3 4) |}]; + test 0 1 list; + [%expect {| (1) |}]; + test 1 1 list; + [%expect {| (2) |}]; + test 2 1 list; + [%expect {| (3) |}]; + test 3 1 list; + [%expect {| (4) |}]; + test 4 1 list; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + test 0 2 list; + [%expect {| (1 2) |}]; + test 1 2 list; + [%expect {| (2 3) |}]; + test 2 2 list; + [%expect {| (3 4) |}]; + test 3 2 list; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + test 0 3 list; + [%expect {| (1 2 3) |}]; + test 1 3 list; + [%expect {| (2 3 4) |}]; + test 2 3 list; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + test 0 4 list; + [%expect {| (1 2 3 4) |}]; + test 1 4 list; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + test 0 5 list; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + test (-1) 0 list; + [%expect {| (raised (Invalid_argument List.sub)) |}]; + test 1 (-1) list; + [%expect {| (raised (Invalid_argument List.sub)) |}] +;; diff --git a/unikernel/duniverse/base/test/test_list.mli b/unikernel/duniverse/base/test/test_list.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_list.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_map.ml b/unikernel/duniverse/base/test/test_map.ml new file mode 100644 index 00000000..c3050dec --- /dev/null +++ b/unikernel/duniverse/base/test/test_map.ml @@ -0,0 +1,434 @@ +open! Import +open! Map + +let%expect_test "Finished_or_unfinished <-> Continue_or_stop" = + (* These functions are implemented using [Caml.Obj.magic]. It is important to test them + comprehensively. *) + List.iter2_exn Continue_or_stop.all Finished_or_unfinished.all ~f:(fun c_or_s f_or_u -> + print_s [%sexp (c_or_s : Continue_or_stop.t), (f_or_u : Finished_or_unfinished.t)]; + require_equal + [%here] + (module Continue_or_stop) + c_or_s + (Finished_or_unfinished.to_continue_or_stop f_or_u); + require_equal + [%here] + (module Finished_or_unfinished) + f_or_u + (Finished_or_unfinished.of_continue_or_stop c_or_s)); + [%expect {| + (Continue Finished) + (Stop Unfinished) + |}] +;; + +let%test _ = + invariants (of_increasing_iterator_unchecked (module Int) ~len:20 ~f:(fun x -> x, x)) +;; + +let%test _ = invariants (Poly.of_increasing_iterator_unchecked ~len:20 ~f:(fun x -> x, x)) +let add12 t = add_exn t ~key:1 ~data:2 + +type int_map = int Map.M(Int).t [@@deriving compare, hash, sexp] + +let%expect_test "[add_exn] success" = + print_s [%sexp (add12 (empty (module Int)) : int_map)]; + [%expect {| ((1 2)) |}] +;; + +let%expect_test "[add_exn] failure" = + show_raise (fun () -> add12 (add12 (empty (module Int)))); + [%expect {| (raised ("[Map.add_exn] got key already present" (key 1))) |}] +;; + +let%expect_test "[add] success" = + print_s [%sexp (add (empty (module Int)) ~key:1 ~data:2 : int_map Or_duplicate.t)]; + [%expect {| (Ok ((1 2))) |}] +;; + +let%expect_test "[add] duplicate" = + print_s + [%sexp (add (add12 (empty (module Int))) ~key:1 ~data:2 : int_map Or_duplicate.t)]; + [%expect {| Duplicate |}] +;; + +let%expect_test "[Map.of_alist_multi] preserves value ordering" = + print_s + [%sexp + (Map.of_alist_multi (module String) [ "a", 1; "a", 2; "b", 1; "b", 3 ] + : int list Map.M(String).t)]; + [%expect {| + ((a (1 2)) + (b (1 3))) + |}] +;; + +let%expect_test "find_exn" = + let map = Map.of_alist_exn (module String) [ "one", 1; "two", 2; "three", 3 ] in + let test_success key = + require_does_not_raise [%here] (fun () -> + print_s [%sexp (Map.find_exn map key : int)]) + in + test_success "one"; + [%expect {| 1 |}]; + test_success "two"; + [%expect {| 2 |}]; + test_success "three"; + [%expect {| 3 |}]; + let test_failure key = require_does_raise [%here] (fun () -> Map.find_exn map key) in + test_failure "zero"; + [%expect {| (Not_found_s ("Map.find_exn: not found" zero)) |}]; + test_failure "four"; + [%expect {| (Not_found_s ("Map.find_exn: not found" four)) |}] +;; + +let%expect_test "[t_of_sexp] error on duplicate" = + let sexp = Sexplib.Sexp.of_string "((0 a)(1 b)(2 c)(1 d))" in + (match [%of_sexp: string Map.M(String).t] sexp with + | t -> print_cr [%here] [%message "did not raise" (t : string Map.M(String).t)] + | exception (Sexp.Of_sexp_error _ as exn) -> print_s (sexp_of_exn exn) + | exception exn -> print_cr [%here] [%message "wrong kind of exception" (exn : exn)]); + [%expect {| (Of_sexp_error "Map.t_of_sexp_direct: duplicate key" (invalid_sexp 1)) |}] +;; + +let%expect_test "combine_errors" = + let test list = + let input = + list + |> List.map ~f:(Result.map_error ~f:Error.of_string) + |> List.mapi ~f:(fun k x -> Int.succ k, x) + |> Map.of_alist_exn (module Int) + in + let output = Map.combine_errors input in + print_s [%sexp (output : string Map.M(Int).t Or_error.t)] + in + (* empty *) + test []; + [%expect {| (Ok ()) |}]; + (* singletons *) + test [ Ok "one" ]; + test [ Error "one" ]; + [%expect {| + (Ok ((1 one))) + (Error ((1 one))) + |}]; + (* multiple ok *) + test [ Ok "one"; Ok "two"; Ok "three" ]; + [%expect {| + (Ok ( + (1 one) + (2 two) + (3 three))) + |}]; + (* multiple errors *) + test [ Error "one"; Error "two"; Error "three" ]; + [%expect {| + (Error ( + (1 one) + (2 two) + (3 three))) + |}]; + (* one error among oks *) + test [ Error "one"; Ok "two"; Ok "three" ]; + test [ Ok "one"; Error "two"; Ok "three" ]; + test [ Ok "one"; Ok "two"; Error "three" ]; + [%expect {| + (Error ((1 one))) + (Error ((2 two))) + (Error ((3 three))) + |}]; + (* one ok among errors *) + test [ Ok "one"; Error "two"; Error "three" ]; + test [ Error "one"; Ok "two"; Error "three" ]; + test [ Error "one"; Error "two"; Ok "three" ]; + [%expect + {| + (Error ( + (2 two) + (3 three))) + (Error ( + (1 one) + (3 three))) + (Error ( + (1 one) + (2 two))) + |}] +;; + +let%test_module "Poly" = + (module struct + let%test _ = length Poly.empty = 0 + + let%test _ = + let a = Poly.of_alist_exn [] in + Poly.equal Base.Poly.equal a Poly.empty + ;; + + let%test _ = + let a = Poly.of_alist_exn [ "a", 1 ] in + let b = Poly.of_alist_exn [ 1, "b" ] in + length a = length b + ;; + end) +;; + +let%test_module "[symmetric_diff]" = + (module struct + let%expect_test "examples" = + let test alist1 alist2 = + Map.symmetric_diff + ~data_equal:Int.equal + (Map.of_alist_exn (module String) alist1) + (Map.of_alist_exn (module String) alist2) + |> Sequence.to_list + |> [%sexp_of: (string, int) Symmetric_diff_element.t list] + |> print_s + in + test [] []; + [%expect {| () |}]; + test [ "one", 1 ] []; + [%expect {| ((one (Left 1))) |}]; + test [] [ "two", 2 ]; + [%expect {| ((two (Right 2))) |}]; + test [ "one", 1; "two", 2 ] [ "one", 1; "two", 2 ]; + [%expect {| () |}]; + test [ "one", 1; "two", 2 ] [ "one", 1; "two", 3 ]; + [%expect {| ((two (Unequal (2 3)))) |}] + ;; + + module String_to_int_map = struct + type t = int Map.M(String).t [@@deriving equal, sexp_of] + + open Base_quickcheck + + let quickcheck_generator = + Generator.map_t_m (module String) Generator.string Generator.int + ;; + + let quickcheck_observer = Observer.map_t Observer.string Observer.int + let quickcheck_shrinker = Shrinker.map_t Shrinker.string Shrinker.int + end + + let apply_diff_left_to_right map (key, elt) = + match elt with + | `Right data | `Unequal (_, data) -> Map.set map ~key ~data + | `Left _ -> Map.remove map key + ;; + + let apply_diff_right_to_left map (key, elt) = + match elt with + | `Left data | `Unequal (data, _) -> Map.set map ~key ~data + | `Right _ -> Map.remove map key + ;; + + (* This is a deterministic benchmark rather than a test, measuring the number of + comparisons made by fold_symmetric_diff. *) + let%expect_test "number of key comparisons" = + let count = ref 0 in + let measure_comparisons f = + let c = !count in + f (); + !count - c + in + let module Key = struct + module T = struct + type t = int [@@deriving sexp_of] + + let compare x y = + Int.incr count; + compare_int x y + ;; + end + + include T + include Comparator.Make (T) + end + in + let (_m : unit Map.M(Key).t), map_pairs = + List.fold + (List.init 1000 ~f:Fn.id) + ~init:(Map.empty (module Key), []) + ~f:(fun (m, acc) i -> + let m' = Map.add_exn m ~key:i ~data:() in + m', (m, m') :: acc) + in + print_s [%sexp (!count : int)]; + [%expect {| 9_966 |}]; + count := 0; + let diffs = ref 0 in + let counts = + List.map map_pairs ~f:(fun (m, m') -> + measure_comparisons (fun () -> + diffs + := !diffs + + Map.fold_symmetric_diff + ~init:0 + ~f:(fun n _ -> n + 1) + ~data_equal:(fun () () -> true) + (m : unit Map.M(Key).t) + m')) + in + let worst_counts = + List.sort counts ~compare:[%compare: int] |> List.rev |> fun l -> List.take l 20 + in + (* The smaller these numbers are, the better. *) + print_s [%sexp (!diffs : int), (!count : int)]; + [%expect {| (1_000 10_955) |}]; + print_s [%sexp (worst_counts : int list)]; + [%expect {| (12 12 12 12 12 12 12 12 12 12 12 12 12 12 12 12 12 12 12 12) |}] + ;; + + let%expect_test "reconstructing in both directions" = + let test (map1, map2) = + let diff = Map.symmetric_diff map1 map2 ~data_equal:Int.equal in + require_equal + [%here] + (module String_to_int_map) + (Sequence.fold diff ~init:map1 ~f:apply_diff_left_to_right) + map2; + require_equal + [%here] + (module String_to_int_map) + map1 + (Sequence.fold diff ~init:map2 ~f:apply_diff_right_to_left) + in + Base_quickcheck.Test.run_exn + ~f:test + (module struct + type t = String_to_int_map.t * String_to_int_map.t + [@@deriving quickcheck, sexp_of] + end) + ;; + + let%expect_test "vs [fold_symmetric_diff]" = + let test (map1, map2) = + require_compare_equal + [%here] + (module struct + type t = (string, int) Symmetric_diff_element.t list + [@@deriving compare, sexp_of] + end) + (Map.symmetric_diff map1 map2 ~data_equal:Int.equal + |> Sequence.fold ~init:[] ~f:(Fn.flip List.cons)) + (Map.fold_symmetric_diff + map1 + map2 + ~data_equal:Int.equal + ~init:[] + ~f:(Fn.flip List.cons)) + in + Base_quickcheck.Test.run_exn + ~f:test + (module struct + type t = String_to_int_map.t * String_to_int_map.t + [@@deriving quickcheck, sexp_of] + end) + ;; + end) +;; + +let%test_module "of_alist_multi key equality" = + (module struct + module Key = struct + module T = struct + type t = string * int [@@deriving sexp_of] + + let compare = [%compare: string * _] + end + + include T + include Comparator.Make (T) + end + + let alist = [ ("a", 1), 1; ("a", 2), 3; ("b", 0), 0; ("a", 3), 2 ] + + let%expect_test "of_alist_multi chooses the first key" = + print_s [%sexp (Map.of_alist_multi (module Key) alist : int list Map.M(Key).t)]; + [%expect {| (((a 1) (1 3 2)) ((b 0) (0))) |}] + ;; + + let%test_unit "of_{alist,sequence}_multi have the same behaviour" = + [%test_result: int list Map.M(Key).t] + ~expect:(Map.of_alist_multi (module Key) alist) + (Map.of_sequence_multi (module Key) (Sequence.of_list alist)) + ;; + end) +;; + +let%expect_test "remove returns the same object if there's nothing to do" = + let map1 = Map.of_alist_exn (module Int) [ 1, "one"; 3, "three" ] in + let map2 = Map.remove map1 2 in + require [%here] (phys_equal map1 map2) +;; + +let%expect_test "[map_keys]" = + let test m c ~f = + print_s + [%sexp + (Map.map_keys c ~f m + : [ `Duplicate_key of string | `Ok of string Map.M(String).t ])] + in + let map = Map.of_alist_exn (module Int) [ 1, "one"; 2, "two"; 3, "three" ] in + test map (module String) ~f:Int.to_string; + [%expect {| + (Ok ( + (1 one) + (2 two) + (3 three))) + |}]; + test map (module String) ~f:(fun x -> Int.to_string (x / 2)); + [%expect {| (Duplicate_key 1) |}] +;; + +let%expect_test "[fold_until]" = + let test t = + print_s + [%sexp + (Map.fold_until + t + ~init:0 + ~f:(fun ~key ~data acc -> if key > 2 then Stop data else Continue (acc + key)) + ~finish:Int.to_string + : string)] + in + let map = Map.of_alist_exn (module Int) [ 1, "one"; 2, "two"; 3, "three" ] in + test map; + [%expect {| three |}]; + let map = Map.of_alist_exn (module Int) [ -1, "minus-one"; 1, "one"; 2, "two" ] in + test map; + [%expect {| 2 |}] +;; + +let%expect_test "[sum]" = + let test t = print_s [%sexp (Map.sum (module Int) t ~f:(( * ) 2) : int)] in + let map = Map.of_alist_exn (module String) [ "A", 1; "B", 2; "C", 3 ] in + test map; + [%expect {| 12 |}] +;; + +let%expect_test "[sumi]" = + let test t = + print_s [%sexp (Map.sumi (module Int) t ~f:(fun ~key ~data -> key * data) : int)] + in + let map = Map.of_alist_exn (module Int) [ 1, 1; 2, 2; 3, 3 ] in + test map; + [%expect {| 14 |}] +;; + +let%expect_test "[merge_disjoint_exn] success" = + let map1 = Map.of_alist_exn (module Int) [ 1, "one"; 2, "two" ] in + let map2 = Map.of_alist_exn (module Int) [ 3, "three" ] in + print_s [%sexp (Map.merge_disjoint_exn map1 map2 : string Map.M(Int).t)]; + [%expect {| + ((1 one) + (2 two) + (3 three)) + |}] +;; + +let%expect_test "[merge_disjoint_exn] failure" = + let map1 = Map.of_alist_exn (module Int) [ 1, "one"; 2, "two" ] in + let map2 = Map.of_alist_exn (module Int) [ 2, "two"; 3, "three" ] in + show_raise (fun () -> Map.merge_disjoint_exn map1 map2); + [%expect {| (raised ("Map.merge_disjoint_exn: duplicate key" 2)) |}] +;; diff --git a/unikernel/duniverse/base/test/test_map.mli b/unikernel/duniverse/base/test/test_map.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_map.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_map.mlt b/unikernel/duniverse/base/test/test_map.mlt new file mode 100644 index 00000000..7261c9a0 --- /dev/null +++ b/unikernel/duniverse/base/test/test_map.mlt @@ -0,0 +1,5 @@ +open Base + +let _ = Map.add + +[%%expect {| |}] diff --git a/unikernel/duniverse/base/test/test_map_interface.ml b/unikernel/duniverse/base/test/test_map_interface.ml new file mode 100644 index 00000000..77974b58 --- /dev/null +++ b/unikernel/duniverse/base/test/test_map_interface.ml @@ -0,0 +1,20 @@ +open! Base + +(* Typechecking this code is a compile-time check that the specific interfaces have not + drifted apart from each other. *) + +module _ : sig + open Map + + type ('a, 'b, 'c) t + + include + Creators_and_accessors_generic + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Map.Using_comparator.Tree.t + with type 'k key := 'k + with type 'c cmp := 'c + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_first_class_module.t +end = + Map diff --git a/unikernel/duniverse/base/test/test_map_interface.mli b/unikernel/duniverse/base/test/test_map_interface.mli new file mode 100644 index 00000000..34976fd8 --- /dev/null +++ b/unikernel/duniverse/base/test/test_map_interface.mli @@ -0,0 +1 @@ +(* This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_map_traversal.ml b/unikernel/duniverse/base/test/test_map_traversal.ml new file mode 100644 index 00000000..90a07d74 --- /dev/null +++ b/unikernel/duniverse/base/test/test_map_traversal.ml @@ -0,0 +1,156 @@ +open! Import +open! Map +open! Int + +module Lazy_apply = struct + module T = struct + type 'a t = { compute : unit -> 'a } [@@unboxed] + + let run t = t.compute () + let return x = { compute = (fun () -> x) } + let map x ~f = { compute = (fun () -> f (run x)) } + let both x y = { compute = (fun () -> run x, run y) } + let map2 a b ~f = map (both a b) ~f:(fun (x, y) -> f x y) + let map = `Custom map + end + + include T + include Applicative.Make_using_map2 (T) + + let of_thunk f = { compute = (fun () -> run (f ())) } +end + +module Lazy_map = Map.Make_applicative_traversals (Lazy_apply) + +let%expect_test "mapi correctness check" = + let map = Map.of_alist_exn (module Int) (List.init 100 ~f:(fun x -> x, x)) in + let f ~key:_ ~data = data + 1 in + let test_output = + Lazy_map.mapi map ~f:(fun ~key ~data -> Lazy_apply.return (f ~key ~data)) + |> Lazy_apply.run + in + let reference_output = Map.mapi map ~f in + require [%here] (Map.equal Int.equal test_output reference_output); + require [%here] (Map.invariants test_output); + [%expect {| |}] +;; + +let%expect_test "filter_mapi correctness check" = + let map = Map.of_alist_exn (module Int) (List.init 1000 ~f:(fun x -> x, x)) in + let f ~key:_ ~data = if data % 50 > 10 then None else Some data in + let test_output = + Lazy_map.filter_mapi map ~f:(fun ~key ~data -> Lazy_apply.return (f ~key ~data)) + |> Lazy_apply.run + in + let reference_output = Map.filter_mapi map ~f in + require [%here] (Map.equal Int.equal test_output reference_output); + require [%here] (Map.invariants test_output); + [%expect {| |}] +;; + +module Step_applicative = struct + module M = struct + type 'a t = { compute : steps:int -> ('a * int, 'a t) Either.t } + + let return x = { compute = (fun ~steps -> First (x, steps)) } + + let step x = + let rec t = + { compute = (fun ~steps -> if steps > 0 then First (x, steps - 1) else Second t) } + in + t + ;; + + let internal_map x ~f = + let rec fn t = + { compute = + (fun ~steps -> + match t.compute ~steps with + | First (x, steps) -> First (f x, steps) + | Second t -> Second (fn t)) + } + in + fn x + ;; + + let map2 a b ~f = + let rec fn a = + { compute = + (fun ~steps -> + match a.compute ~steps with + | First (x, steps) -> (internal_map b ~f:(fun y -> f x y)).compute ~steps + | Second t -> Second (fn t)) + } + in + fn a + ;; + + let map = `Custom internal_map + + let of_thunk f = + { compute = + (fun ~steps -> + let t = f () in + t.compute ~steps) + } + ;; + end + + include M + include Applicative.Make_using_map2 (M) +end + +module Step_map = Map.Make_applicative_traversals (Step_applicative) + +let%expect_test "mapi lazy check" = + let map = Map.of_alist_exn (module Int) (List.init 10 ~f:(fun x -> x, x)) in + let f ~key:_ ~data = data * 2 in + (* transform the map, expect no output yet *) + let step_computation = + Step_map.mapi map ~f:(fun ~key ~data -> + Step_applicative.of_thunk (fun () -> + print_s [%message (key : int) (data : int)]; + Step_applicative.step (f ~key ~data))) + in + [%expect {| |}]; + (* take a few steps, expect some but not all output *) + let more_computation = + match step_computation.compute ~steps:3 with + | First _ -> assert false + | Second c -> c + in + [%expect + {| + ((key 0) + (data 0)) + ((key 1) + (data 1)) + ((key 2) + (data 2)) + ((key 3) + (data 3)) + |}]; + (* take more than enough steps to finish, expect the rest of the output *) + let test_output = + match more_computation.compute ~steps:100 with + | First (r, _) -> r + | Second _ -> assert false + in + let reference_output = Map.mapi map ~f in + require [%here] (Map.equal Int.equal test_output reference_output); + [%expect + {| + ((key 4) + (data 4)) + ((key 5) + (data 5)) + ((key 6) + (data 6)) + ((key 7) + (data 7)) + ((key 8) + (data 8)) + ((key 9) + (data 9)) + |}] +;; diff --git a/unikernel/duniverse/base/test/test_map_traversal.mli b/unikernel/duniverse/base/test/test_map_traversal.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_map_traversal.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_maybe_bound.ml b/unikernel/duniverse/base/test/test_maybe_bound.ml new file mode 100644 index 00000000..531ea9ab --- /dev/null +++ b/unikernel/duniverse/base/test/test_maybe_bound.ml @@ -0,0 +1,123 @@ +open! Import +open! Maybe_bound + +let%test_unit "bounds_crossed" = + let a, b, c, d = Incl 1, Excl 1, Incl 3, Excl 3 in + let cases = + [ a, a, false + ; a, b, false + ; a, c, false + ; a, d, false + ; b, a, false + ; b, b, false + ; b, c, false + ; b, d, false + ; c, a, true + ; c, b, true + ; c, c, false + ; c, d, false + ; d, a, true + ; d, b, true + ; d, c, false + ; d, d, false + ] + in + List.iter cases ~f:(fun (lower, upper, expect) -> + let actual = bounds_crossed ~lower ~upper ~compare in + assert ([%compare.equal: bool] expect actual)) +;; + +let%test_module "is_lower_bound" = + (module struct + let compare = Int.compare + let%test _ = is_lower_bound Unbounded ~of_:Int.min_value ~compare + let%test _ = not (is_lower_bound (Incl 2) ~of_:1 ~compare) + let%test _ = is_lower_bound (Incl 2) ~of_:2 ~compare + let%test _ = is_lower_bound (Incl 2) ~of_:3 ~compare + let%test _ = not (is_lower_bound (Excl 2) ~of_:1 ~compare) + let%test _ = not (is_lower_bound (Excl 2) ~of_:2 ~compare) + let%test _ = is_lower_bound (Excl 2) ~of_:3 ~compare + end) +;; + +let%test_module "is_upper_bound" = + (module struct + let compare = Int.compare + let%test _ = is_upper_bound Unbounded ~of_:Int.max_value ~compare + let%test _ = is_upper_bound (Incl 2) ~of_:1 ~compare + let%test _ = is_upper_bound (Incl 2) ~of_:2 ~compare + let%test _ = not (is_upper_bound (Incl 2) ~of_:3 ~compare) + let%test _ = is_upper_bound (Excl 2) ~of_:1 ~compare + let%test _ = not (is_upper_bound (Excl 2) ~of_:2 ~compare) + let%test _ = not (is_upper_bound (Excl 2) ~of_:3 ~compare) + end) +;; + +let%test_module "check_range" = + (module struct + let compare = Int.compare + + let tests (lower, upper) cases = + List.iter cases ~f:(fun (n, comparison) -> + [%test_result: interval_comparison] + ~expect:comparison + (compare_to_interval_exn n ~lower ~upper ~compare); + [%test_result: bool] + ~expect: + (match comparison with + | In_range -> true + | _ -> false) + (interval_contains_exn n ~lower ~upper ~compare)) + ;; + + let%test_unit _ = + tests + (Unbounded, Unbounded) + [ Int.min_value, In_range; 0, In_range; Int.max_value, In_range ] + ;; + + let%test_unit _ = + tests + (Incl 2, Incl 4) + [ 1, Below_lower_bound + ; 2, In_range + ; 3, In_range + ; 4, In_range + ; 5, Above_upper_bound + ] + ;; + + let%test_unit _ = + tests + (Incl 2, Excl 4) + [ 1, Below_lower_bound + ; 2, In_range + ; 3, In_range + ; 4, Above_upper_bound + ; 5, Above_upper_bound + ] + ;; + + let%test_unit _ = + tests + (Excl 2, Incl 4) + [ 1, Below_lower_bound + ; 2, Below_lower_bound + ; 3, In_range + ; 4, In_range + ; 5, Above_upper_bound + ] + ;; + + let%test_unit _ = + tests + (Excl 2, Excl 4) + [ 1, Below_lower_bound + ; 2, Below_lower_bound + ; 3, In_range + ; 4, Above_upper_bound + ; 5, Above_upper_bound + ] + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_maybe_bound.mli b/unikernel/duniverse/base/test/test_maybe_bound.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_maybe_bound.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_minmax.ml b/unikernel/duniverse/base/test/test_minmax.ml new file mode 100644 index 00000000..7542d638 --- /dev/null +++ b/unikernel/duniverse/base/test/test_minmax.ml @@ -0,0 +1,166 @@ +open Import + +module Size = struct + type t = + | Small + | Large +end + +let[@inline never] test (type t) m size = + let (module T : Int.S with type t = t) = m in + let fwd = + match (size : Size.t) with + | Small -> List.map ~f:T.of_int_exn [ 0; -20; -10; -1; 1; 2; 4; 100 ] + | Large -> [ T.min_value; T.max_value; T.zero ] + in + let rev = List.rev fwd in + List.iter2_exn fwd rev ~f:(fun a b -> + print_s [%message "min" ~_:(a : T.t) ~_:(b : T.t) "=" ~_:(T.min a b : T.t)]; + print_s [%message "max" ~_:(a : T.t) ~_:(b : T.t) "=" ~_:(T.max a b : T.t)]) +;; + +let%expect_test "small values" = + let test (module T : Int.S) = + test (module T) Small; + [%expect + {| + (min 0 100 = 0) + (max 0 100 = 100) + (min -20 4 = -20) + (max -20 4 = 4) + (min -10 2 = -10) + (max -10 2 = 2) + (min -1 1 = -1) + (max -1 1 = 1) + (min 1 -1 = -1) + (max 1 -1 = 1) + (min 2 -10 = -10) + (max 2 -10 = 2) + (min 4 -20 = -20) + (max 4 -20 = 4) + (min 100 0 = 0) + (max 100 0 = 100) + |}] + in + test (module Int); + test (module Int64); + test (module Int32); + test (module Nativeint); + [%expect {| |}] +;; + +let%expect_test "fixed-size types" = + test (module Int64) Large; + [%expect + {| + (min -9_223_372_036_854_775_808 0 = -9_223_372_036_854_775_808) + (max -9_223_372_036_854_775_808 0 = 0) + (min + 9_223_372_036_854_775_807 + 9_223_372_036_854_775_807 + = + 9_223_372_036_854_775_807) + (max + 9_223_372_036_854_775_807 + 9_223_372_036_854_775_807 + = + 9_223_372_036_854_775_807) + (min 0 -9_223_372_036_854_775_808 = -9_223_372_036_854_775_808) + (max 0 -9_223_372_036_854_775_808 = 0) + |}]; + test (module Int32) Large; + [%expect + {| + (min -2_147_483_648 0 = -2_147_483_648) + (max -2_147_483_648 0 = 0) + (min 2_147_483_647 2_147_483_647 = 2_147_483_647) + (max 2_147_483_647 2_147_483_647 = 2_147_483_647) + (min 0 -2_147_483_648 = -2_147_483_648) + (max 0 -2_147_483_648 = 0) + |}] +;; + +let%expect_test ("64-bit platforms" [@tags "no-js", "64-bits-only"]) = + test (module Int) Large; + [%expect + {| + (min -4_611_686_018_427_387_904 0 = -4_611_686_018_427_387_904) + (max -4_611_686_018_427_387_904 0 = 0) + (min + 4_611_686_018_427_387_903 + 4_611_686_018_427_387_903 + = + 4_611_686_018_427_387_903) + (max + 4_611_686_018_427_387_903 + 4_611_686_018_427_387_903 + = + 4_611_686_018_427_387_903) + (min 0 -4_611_686_018_427_387_904 = -4_611_686_018_427_387_904) + (max 0 -4_611_686_018_427_387_904 = 0) + |}]; + test (module Nativeint) Large; + [%expect + {| + (min -9_223_372_036_854_775_808 0 = -9_223_372_036_854_775_808) + (max -9_223_372_036_854_775_808 0 = 0) + (min + 9_223_372_036_854_775_807 + 9_223_372_036_854_775_807 + = + 9_223_372_036_854_775_807) + (max + 9_223_372_036_854_775_807 + 9_223_372_036_854_775_807 + = + 9_223_372_036_854_775_807) + (min 0 -9_223_372_036_854_775_808 = -9_223_372_036_854_775_808) + (max 0 -9_223_372_036_854_775_808 = 0) + |}] +;; + +let%expect_test ("32-bit platforms" [@tags "no-js", "32-bits-only"]) = + test (module Int) Large; + [%expect + {| + (min -1_073_741_824 0 = -1_073_741_824) + (max -1_073_741_824 0 = 0) + (min 1_073_741_823 1_073_741_823 = 1_073_741_823) + (max 1_073_741_823 1_073_741_823 = 1_073_741_823) + (min 0 -1_073_741_824 = -1_073_741_824) + (max 0 -1_073_741_824 = 0) + |}]; + test (module Nativeint) Large; + [%expect + {| + (min -2_147_483_648 0 = -2_147_483_648) + (max -2_147_483_648 0 = 0) + (min 2_147_483_647 2_147_483_647 = 2_147_483_647) + (max 2_147_483_647 2_147_483_647 = 2_147_483_647) + (min 0 -2_147_483_648 = -2_147_483_648) + (max 0 -2_147_483_648 = 0) + |}] +;; + +let%expect_test ("js_of_ocaml platforms" [@tags "js-only"]) = + test (module Int) Large; + [%expect + {| + (min -2_147_483_648 0 = -2_147_483_648) + (max -2_147_483_648 0 = 0) + (min 2_147_483_647 2_147_483_647 = 2_147_483_647) + (max 2_147_483_647 2_147_483_647 = 2_147_483_647) + (min 0 -2_147_483_648 = -2_147_483_648) + (max 0 -2_147_483_648 = 0) + |}]; + test (module Nativeint) Large; + [%expect + {| + (min -2_147_483_648 0 = -2_147_483_648) + (max -2_147_483_648 0 = 0) + (min 2_147_483_647 2_147_483_647 = 2_147_483_647) + (max 2_147_483_647 2_147_483_647 = 2_147_483_647) + (min 0 -2_147_483_648 = -2_147_483_648) + (max 0 -2_147_483_648 = 0) + |}] +;; diff --git a/unikernel/duniverse/base/test/test_minmax.mli b/unikernel/duniverse/base/test/test_minmax.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_minmax.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_nativeint.ml b/unikernel/duniverse/base/test/test_nativeint.ml new file mode 100644 index 00000000..1e652cb2 --- /dev/null +++ b/unikernel/duniverse/base/test/test_nativeint.ml @@ -0,0 +1,75 @@ +open! Import +open! Nativeint + +let%expect_test "hash coherence" = + check_int_hash_coherence [%here] (module Nativeint); + [%expect {| |}] +;; + +type test_case = nativeint * int32 * int64 + +let test_cases : test_case list = + [ 0x0000_0011n, 0x1100_0000l, 0x1100_0000_0000_0000L + ; 0x0000_1122n, 0x2211_0000l, 0x2211_0000_0000_0000L + ; 0x0011_2233n, 0x3322_1100l, 0x3322_1100_0000_0000L + ; 0x1122_3344n, 0x4433_2211l, 0x4433_2211_0000_0000L + ] +;; + +let%expect_test "bswap native" = + List.iter test_cases ~f:(fun (arg, bswap_int32, bswap_int64) -> + let result = bswap arg in + match Sys.word_size_in_bits with + | 32 -> assert (Int32.equal bswap_int32 (Nativeint.to_int32_trunc result)) + | 64 -> assert (Int64.equal bswap_int64 (Nativeint.to_int64 result)) + | _ -> assert false) +;; + +let%expect_test "binary" = + quickcheck_m + [%here] + (module struct + type t = nativeint [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t : t) -> ignore (Binary.to_string t : string)); + [%expect {| |}] +;; + +let test_binary i = + Binary.to_string_hum i |> print_endline; + Binary.to_string i |> print_endline; + print_s [%sexp (i : Binary.t)] +;; + +let%expect_test "binary" = + test_binary 0b01n; + [%expect {| + 0b1 + 0b1 + 0b1 + |}]; + test_binary 0b100n; + [%expect {| + 0b100 + 0b100 + 0b100 + |}]; + test_binary 0b101n; + [%expect {| + 0b101 + 0b101 + 0b101 + |}]; + test_binary 0b101010_10101010n; + [%expect {| + 0b10_1010_1010_1010 + 0b10101010101010 + 0b10_1010_1010_1010 + |}]; + test_binary 0b111111_00000000n; + [%expect {| + 0b11_1111_0000_0000 + 0b11111100000000 + 0b11_1111_0000_0000 + |}] +;; diff --git a/unikernel/duniverse/base/test/test_nativeint.mli b/unikernel/duniverse/base/test/test_nativeint.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_nativeint.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_nativeint_pow2.ml b/unikernel/duniverse/base/test/test_nativeint_pow2.ml new file mode 100644 index 00000000..b9641e2f --- /dev/null +++ b/unikernel/duniverse/base/test/test_nativeint_pow2.ml @@ -0,0 +1,119 @@ +open! Import +open! Nativeint + +let examples = [ -1n; 0n; 1n; 2n; 3n; 4n; 5n; 7n; 8n; 9n; 63n; 64n; 65n ] +let examples_64_bit = [ min_value; succ min_value; pred max_value; max_value ] + +let print_for ints f = + List.iter ints ~f:(fun i -> + print_s + [%message + "" ~_:(i : nativeint) ~_:(Or_error.try_with (fun () -> f i) : int Or_error.t)]) +;; + +let%expect_test "[floor_log2]" = + print_for examples floor_log2; + [%expect + {| + (-1 (Error ("[Nativeint.floor_log2] got invalid input" -1))) + (0 (Error ("[Nativeint.floor_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 1)) + (4 (Ok 2)) + (5 (Ok 2)) + (7 (Ok 2)) + (8 (Ok 3)) + (9 (Ok 3)) + (63 (Ok 5)) + (64 (Ok 6)) + (65 (Ok 6)) + |}] +;; + +let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit floor_log2; + [%expect + {| + (-9_223_372_036_854_775_808 ( + Error ("[Nativeint.floor_log2] got invalid input" -9223372036854775808))) + (-9_223_372_036_854_775_807 ( + Error ("[Nativeint.floor_log2] got invalid input" -9223372036854775807))) + (9_223_372_036_854_775_806 (Ok 62)) + (9_223_372_036_854_775_807 (Ok 62)) + |}] +;; + +let%expect_test "[ceil_log2]" = + print_for examples ceil_log2; + [%expect + {| + (-1 (Error ("[Nativeint.ceil_log2] got invalid input" -1))) + (0 (Error ("[Nativeint.ceil_log2] got invalid input" 0))) + (1 (Ok 0)) + (2 (Ok 1)) + (3 (Ok 2)) + (4 (Ok 2)) + (5 (Ok 3)) + (7 (Ok 3)) + (8 (Ok 3)) + (9 (Ok 4)) + (63 (Ok 6)) + (64 (Ok 6)) + (65 (Ok 7)) + |}] +;; + +let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = + print_for examples_64_bit ceil_log2; + [%expect + {| + (-9_223_372_036_854_775_808 ( + Error ("[Nativeint.ceil_log2] got invalid input" -9223372036854775808))) + (-9_223_372_036_854_775_807 ( + Error ("[Nativeint.ceil_log2] got invalid input" -9223372036854775807))) + (9_223_372_036_854_775_806 (Ok 63)) + (9_223_372_036_854_775_807 (Ok 63)) + |}] +;; + +let%test_module "nativeint_math" = + (module struct + let test_cases () = + let cases = + [ 0b10101010n + ; 0b1010101010101010n + ; 0b101010101010101010101010n + ; 0b10000000n + ; 0b1000000000001000n + ; 0b100000000000000000001000n + ] + in + match Word_size.word_size with + | W64 -> + (* create some >32 bit values... *) + (* We can't use literals directly because the compiler complains on 32 bits. *) + let cases = + cases + @ [ (0b1010101010101010n lsl 16) lor 0b1010101010101010n + ; (0b1000000000000000n lsl 16) lor 0b0000000000001000n + ] + in + let added_cases = List.map cases ~f:(fun x -> x lsl 16) in + List.concat [ cases; added_cases ] + | W32 -> cases + ;; + + let%test_unit "ceil_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = ceil_pow2 x in + assert (is_pow2 p2 && p2 >= x && x >= p2 / of_int 2)) + ;; + + let%test_unit "floor_pow2" = + List.iter (test_cases ()) ~f:(fun x -> + let p2 = floor_pow2 x in + assert (is_pow2 p2 && of_int 2 * p2 >= x && x >= p2)) + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_nativeint_pow2.mli b/unikernel/duniverse/base/test/test_nativeint_pow2.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_nativeint_pow2.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_not_found.mlt b/unikernel/duniverse/base/test/test_not_found.mlt new file mode 100644 index 00000000..ca5c8ae3 --- /dev/null +++ b/unikernel/duniverse/base/test/test_not_found.mlt @@ -0,0 +1,23 @@ +open Base +open Expect_test_helpers_base;; + +print_s [%sexp (Not_found_s [%message "foo"] : exn)] + +[%%expect + {| +(Not_found_s foo) +|}] +;; + +Not_found + +[%%expect + {| +Line _, characters _-_: +Error (alert deprecated): Not_found +[2016-09] this element comes from the stdlib distributed with OCaml. +Instead of raising [Not_found], consider using [raise_s] with an informative error +message. If code needs to distinguish [Not_found] from other exceptions, please change +it to handle both [Not_found] and [Not_found_s]. Then, instead of raising [Not_found], +raise [Not_found_s] with an informative error message. +|}] diff --git a/unikernel/duniverse/base/test/test_obj_local.ml b/unikernel/duniverse/base/test/test_obj_local.ml new file mode 100644 index 00000000..0b417436 --- /dev/null +++ b/unikernel/duniverse/base/test/test_obj_local.ml @@ -0,0 +1,36 @@ +open! Import +open! Exported_for_specific_uses.Obj_local + +(* immediate *) +let%test_unit _ = + [%test_result: stack_or_heap] + (let x = 42 in + stack_or_heap (repr x)) + ~expect:Immediate +;; + +(* global*) +let%test_unit _ = + [%test_result: stack_or_heap] + (let s = "hello" in + let _r = ref s in + stack_or_heap (repr s)) + ~expect:Heap +;; + +let stack_enabled = + match Sys.backend_type with + | Sys.Native -> true + | _ -> false +;; + +(* local *) +let%test_unit _ = + [%test_result: stack_or_heap] + (let foo x = + let s = ref x in + stack_or_heap (repr s) [@nontail] + in + foo 42) + ~expect:(if stack_enabled then Stack else Heap) +;; diff --git a/unikernel/duniverse/base/test/test_obj_local.mli b/unikernel/duniverse/base/test/test_obj_local.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_obj_local.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_option.ml b/unikernel/duniverse/base/test/test_option.ml new file mode 100644 index 00000000..e3ca0db5 --- /dev/null +++ b/unikernel/duniverse/base/test/test_option.ml @@ -0,0 +1,50 @@ +open! Import +open! Option + +let f = ( + ) +let%test _ = [%compare.equal: int t] (merge None None ~f) None +let%test _ = [%compare.equal: int t] (merge (Some 3) None ~f) (Some 3) +let%test _ = [%compare.equal: int t] (merge None (Some 3) ~f) (Some 3) +let%test _ = [%compare.equal: int t] (merge (Some 1) (Some 3) ~f) (Some 4) + +let%expect_test "[value_or_thunk]" = + let default () = + print_endline "THUNK!"; + 0 + in + let value_or_thunk = value_or_thunk ~default in + let test t = print_s [%sexp (value_or_thunk t : int)] in + (* trigger the thunk *) + test None; + [%expect {| + THUNK! + 0 + |}]; + (* same value, no trigger *) + test (Some 0); + [%expect {| 0 |}]; + (* different value *) + test (Some 1); + [%expect {| 1 |}]; + (* trigger the thunk again: no memoization *) + test None; + [%expect {| + THUNK! + 0 + |}] +;; + +let%expect_test "map2" = + let m t1 t2 = + let result = Option.map2 ~f:(fun x y -> x + y) t1 t2 in + print_s [%sexp (result : int Option.t)] + in + m None None; + [%expect {| () |}]; + m (Some 1) (Some 2); + [%expect {| (3) |}]; + m None (Some 1); + [%expect {| () |}]; + m (Some 1) None; + [%expect {| () |}] +;; diff --git a/unikernel/duniverse/base/test/test_option.mli b/unikernel/duniverse/base/test/test_option.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_option.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_option_array.ml b/unikernel/duniverse/base/test/test_option_array.ml new file mode 100644 index 00000000..3891e1c5 --- /dev/null +++ b/unikernel/duniverse/base/test/test_option_array.ml @@ -0,0 +1,121 @@ +open! Import +open Option_array + +let%test_module "Cheap_option" = + (module struct + open For_testing.Unsafe_cheap_option + + let roundtrip_via_cheap_option (type a) (x : a) = + let opt : a t = some x in + assert (is_some opt); + assert (phys_equal (value_exn opt) x) + ;; + + let%test_unit _ = roundtrip_via_cheap_option 0 + let%test_unit _ = roundtrip_via_cheap_option 1 + let%test_unit _ = roundtrip_via_cheap_option (ref 0) + let%test_unit _ = roundtrip_via_cheap_option `x6e8ee3478e1d7449 + let%test_unit _ = roundtrip_via_cheap_option 0.0 + let%test _ = not (is_some none) + + let%test_unit "memory corruption" = + let make_list () = List.init ~f:(fun i -> Some i) 5 in + Stdlib.Gc.minor (); + let x = value_unsafe (some (make_list ())) in + Stdlib.Gc.minor (); + let (_ : int option list) = List.init ~f:(fun i -> Some (i * 100)) 10000 in + [%test_result: Int.t Option.t List.t] ~expect:(make_list ()) x + ;; + end) +;; + +module Sequence = struct + let length = length + let get = get + let set = set +end + +include + Base_for_tests.Test_blit.Test1_generic + (struct + include Option + + let equal a b = Option.equal Bool.equal a b + let of_bool b = Some b + end) + (struct + type nonrec 'a t = 'a t [@@deriving sexp] + type 'a z = 'a + + include Sequence + + let create_bool ~len = init_some len ~f:(fun _ -> false) + end) + (Option_array) + +let%test_unit "floats are not re-boxed" = + let one = 1.0 in + let array = init_some 1 ~f:(fun _ -> one) in + assert (phys_equal one (get_some_exn array 0)) +;; + +let%test_unit "segfault does not happen" = + (* if [Option_array] is implemented with [Core_array] instead of [Uniform_array], this + dies with a segfault *) + let _array = init 2 ~f:(fun i -> if i = 0 then Some 1.0 else None) in + () +;; + +module X = struct + type t = + [ `x6e8ee3478e1d7449 + | `some_other_value + ] + [@@deriving sexp_of] + + let magic_value : t = `x6e8ee3478e1d7449 + let some_other_value : t = `some_other_value + + let%expect_test _ = + assert ( + phys_equal magic_value (Stdlib.Obj.magic For_testing.Unsafe_cheap_option.none : t)) + ;; +end + +let%expect_test _ = + let t = create ~len:1 in + let check x = + set t 0 (Some x); + require [%here] (phys_equal x (unsafe_get_some_exn t 0)); + require [%here] (phys_equal x (unsafe_get_some_assuming_some t 0)) + in + check X.magic_value; + check X.some_other_value +;; + +let%test _ = foldi (of_array_some [||]) ~init:13 ~f:(fun _ _ _ -> failwith "bad") = 13 + +let%test _ = + foldi (of_array_some [| 13 |]) ~init:17 ~f:(fun i ac x -> ac + i + Option.value_exn x) + = 30 +;; + +let%test _ = + foldi + (of_array_some [| 13; 17 |]) + ~init:19 + ~f:(fun i ac x -> ac + i + Option.value_exn x) + = 50 +;; + +let%test _ = + counti (of_array_some [| 0; 1; 2; 3; 4 |]) ~f:(fun idx x -> idx = Option.value_exn x) + = 5 +;; + +let%test _ = + counti + (of_array_some [| 0; 1; 2; 3; 4 |]) + ~f:(fun idx x -> idx = 4 - Option.value_exn x) + = 1 +;; diff --git a/unikernel/duniverse/base/test/test_option_array.mli b/unikernel/duniverse/base/test/test_option_array.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_option_array.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_or_error.ml b/unikernel/duniverse/base/test/test_or_error.ml new file mode 100644 index 00000000..ac9efea6 --- /dev/null +++ b/unikernel/duniverse/base/test/test_or_error.ml @@ -0,0 +1,134 @@ +open! Import +open! Or_error + +let%test _ = [%compare.equal: string t] (errorf "foo %d" 13) (error_string "foo 13") + +let%test_unit _ = + for i = 0 to 10 do + assert ( + [%compare.equal: unit list t] + (combine_errors (List.init i ~f:(fun _ -> Ok ()))) + (Ok (List.init i ~f:(fun _ -> ())))) + done +;; + +let%test _ = Result.is_error (combine_errors [ error_string "" ]) +let%test _ = Result.is_error (combine_errors [ Ok (); error_string "" ]) +let ( = ) = [%compare.equal: unit t] +let%test _ = combine_errors_unit [ Ok (); Ok () ] = Ok () +let%test _ = combine_errors_unit [] = Ok () + +let%test _ = + let a = Error.of_string "a" + and b = Error.of_string "b" in + match combine_errors_unit [ Ok (); Error a; Ok (); Error b ] with + | Ok _ -> false + | Error e -> + String.equal (Error.to_string_hum e) (Error.to_string_hum (Error.of_list [ a; b ])) +;; + +let%expect_test "map2" = + let m t1 t2 = + let result = Or_error.map2 ~f:(fun x y -> x + y) t1 t2 in + print_s [%sexp (result : int Or_error.t)] + in + let foo = Error.of_string "foo" in + let bar = Error.of_string "bar" in + m (Error foo) (Error bar); + [%expect {| (Error (foo bar)) |}]; + m (Ok 1) (Ok 2); + [%expect {| (Ok 3) |}]; + m (Error foo) (Ok 1); + [%expect {| (Error foo) |}]; + m (Ok 1) (Error bar); + [%expect {| (Error bar) |}] +;; + +(* These tests check for stack overflow, and that we don't time out, when given large + lists. We also test that we preserve all errors, in order, so that performance-related + changes don't accidentally change behavior. + + History: in [2023-02], [all] and [all_unit] had O(N) stack usage and O(N^2) time for + lists of length N. These costs were hidden behind the [lazy] inside [Error] values, so + they could occur far from where the error was constructed. *) +let%expect_test "behavior and performance on lists of or_error's" = + let make_list len = + (* We construct atoms with spaces in them to show sexp rendering with quotes, which is + significant to [Error.to_string_hum]'s behavior below. *) + List.init len ~f:(Or_error.errorf "at %d") + in + let short_lists = List.map ~f:make_list [ 0; 1; 2; 10 ] in + let long_list = make_list 500_000 in + let to_string = function + | Ok _ -> "ok" + | Error error -> + (* Converting to string forces the [lazy] inside [Error.t]. Using [to_string_hum] + also happens to observe whether the error was created via [Error.of_string]. *) + Error.to_string_hum error + in + let test f = + (* Show behavior on short lists. *) + List.iter short_lists ~f:(fun list -> print_endline (to_string (f list))); + (* Test for timeout / stack overflow on a long list. *) + match to_string (f long_list) with + | (_ : string) -> () + | exception Stack_overflow -> print_cr [%here] [%message "stack overflow"] + in + (* test functions that combine a list of or_errors *) + test all; + [%expect + {| + ok + at 0 + ("at 0" "at 1") + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; + test all_unit; + [%expect + {| + ok + at 0 + ("at 0" "at 1") + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; + test combine_errors; + [%expect + {| + ok + "at 0" + ("at 0" "at 1") + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; + test combine_errors_unit; + [%expect + {| + ok + "at 0" + ("at 0" "at 1") + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; + test find_ok; + [%expect + {| + () + "at 0" + ("at 0" "at 1") + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; + test (find_map_ok ~f:Fn.id); + [%expect + {| + () + "at 0" + ("at 0" "at 1") + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; + test filter_ok_at_least_one; + [%expect + {| + () + "at 0" + ("at 0" "at 1") + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}] +;; diff --git a/unikernel/duniverse/base/test/test_or_error.mli b/unikernel/duniverse/base/test/test_or_error.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_or_error.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_ordered_collection_common.ml b/unikernel/duniverse/base/test/test_ordered_collection_common.ml new file mode 100644 index 00000000..494a6358 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ordered_collection_common.ml @@ -0,0 +1,78 @@ +open! Import +open! Ordered_collection_common + +let%test_unit "fast check_pos_len_exn is correct" = + let n_vals = + [ 0 + ; 1 + ; 2 + ; 10 + ; 100 + ; (Int.max_value / 2) - 2 + ; (Int.max_value / 2) - 1 + ; Int.max_value / 2 + ; Int.max_value - 2 + ; Int.max_value - 1 + ; Int.max_value + ] + in + let z_vals = + [ Int.min_value + ; Int.min_value + 1 + ; Int.min_value + 2 + ; Int.min_value / 2 + ; (Int.min_value / 2) + 1 + ; (Int.min_value / 2) + 2 + ; -100 + ; -10 + ; -2 + ; -1 + ] + @ n_vals + in + List.iter z_vals ~f:(fun pos -> + List.iter z_vals ~f:(fun len -> + List.iter n_vals ~f:(fun total_length -> + assert ( + Bool.equal + (Exn.does_raise (fun () -> + Private.slow_check_pos_len_exn ~pos ~len ~total_length)) + (Exn.does_raise (fun () -> check_pos_len_exn ~pos ~len ~total_length)))))) +;; + +let%test_unit _ = + let vals = [ -1; 0; 1; 2; 3 ] in + List.iter [ 0; 1; 2 ] ~f:(fun total_length -> + List.iter vals ~f:(fun pos -> + List.iter vals ~f:(fun len -> + let result = + Result.try_with (fun () -> check_pos_len_exn ~pos ~len ~total_length) + in + let valid = pos >= 0 && len >= 0 && len <= total_length - pos in + assert (Bool.equal valid (Result.is_ok result))))) +;; + +let%test_unit _ = + let opts = [ None; Some (-1); Some 0; Some 1; Some 2 ] in + List.iter [ 0; 1; 2 ] ~f:(fun total_length -> + List.iter opts ~f:(fun pos -> + List.iter opts ~f:(fun len -> + let result = get_pos_len () ?pos ?len ~total_length in + let pos = + match pos with + | Some x -> x + | None -> 0 + in + let len = + match len with + | Some x -> x + | None -> total_length - pos + in + let valid = pos >= 0 && len >= 0 && len <= total_length - pos in + match result with + | Error _ -> assert (not valid) + | Ok (pos', len') -> + assert (pos' = pos); + assert (len' = len); + assert valid))) +;; diff --git a/unikernel/duniverse/base/test/test_ordered_collection_common.mli b/unikernel/duniverse/base/test/test_ordered_collection_common.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ordered_collection_common.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_ordering.ml b/unikernel/duniverse/base/test/test_ordering.ml new file mode 100644 index 00000000..6e465430 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ordering.ml @@ -0,0 +1,13 @@ +open! Import +open! Ordering + +let%test _ = equal (of_int (-10)) Less +let%test _ = equal (of_int (-1)) Less +let%test _ = equal (of_int 0) Equal +let%test _ = equal (of_int 1) Greater +let%test _ = equal (of_int 10) Greater +let%test _ = equal (of_int (Int.compare 0 1)) Less +let%test _ = equal (of_int (Int.compare 1 1)) Equal +let%test _ = equal (of_int (Int.compare 1 0)) Greater +let%test _ = List.for_all all ~f:(fun t -> equal t (t |> to_int |> of_int)) +let%test _ = List.for_all [ -1; 0; 1 ] ~f:(fun i -> i = (i |> of_int |> to_int)) diff --git a/unikernel/duniverse/base/test/test_ordering.mli b/unikernel/duniverse/base/test/test_ordering.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ordering.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_popcount.ml b/unikernel/duniverse/base/test/test_popcount.ml new file mode 100644 index 00000000..c408d436 --- /dev/null +++ b/unikernel/duniverse/base/test/test_popcount.ml @@ -0,0 +1,57 @@ +open! Import + +module type T = sig + type t [@@deriving compare, quickcheck, sexp_of] + + (* for implementing popcount_naive *) + + val zero : t + val one : t + val ( + ) : t -> t -> t + val ( lsr ) : t -> int -> t + val ( land ) : t -> t -> t + val to_int_exn : t -> int + val popcount : t -> int +end + +module Make (Int : T) = struct + let popcount_naive (int : Int.t) : int = + let open Int in + let rec loop n count = + if Int.compare n zero <> 0 then loop (n lsr 1) (count + (n land one)) else count + in + loop int zero |> to_int_exn + ;; + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Int) + ~f:(fun int -> + let expect = popcount_naive int in + [%test_result: int] ~expect (Int.popcount int)) + ;; +end + +include Make (struct + include Int + + type t = int [@@deriving quickcheck] +end) + +include Make (struct + include Int32 + + type t = int32 [@@deriving quickcheck] +end) + +include Make (struct + include Int64 + + type t = int64 [@@deriving quickcheck] +end) + +include Make (struct + include Nativeint + + type t = nativeint [@@deriving quickcheck] +end) diff --git a/unikernel/duniverse/base/test/test_popcount.mli b/unikernel/duniverse/base/test/test_popcount.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_popcount.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_pp.ml b/unikernel/duniverse/base/test/test_pp.ml new file mode 100644 index 00000000..4c359356 --- /dev/null +++ b/unikernel/duniverse/base/test/test_pp.ml @@ -0,0 +1,52 @@ +open! Import + +let to_string pp v = + pp Stdlib.Format.str_formatter v; + Stdlib.Format.flush_str_formatter () +;; + +let print pp v = Stdlib.Printf.printf "%s\n" (to_string pp v) +let print_all pp vs = List.iter ~f:(print pp) vs + +let%expect_test "pretty-printers" = + print_all Char.pp [ '\000'; '\r'; 'a' ]; + [%expect {| + '\000' + '\r' + 'a' + |}]; + print_all String.pp [ ""; "foo"; "abc\tdef" ]; + [%expect {| + "" + "foo" + "abc\tdef" + |}]; + print_all Sign.pp Sign.all; + [%expect {| + Neg + Zero + Pos + |}]; + print_all Bool.pp Bool.all; + [%expect {| + false + true + |}]; + print_all Unit.pp Unit.all; + [%expect {| () |}]; + print_all Nothing.pp Nothing.all; + [%expect {| |}]; + print_all Float.pp [ 0.; 3.14; 1.0 /. 0.0 ]; + [%expect {| + 0. + 3.14 + inf + |}]; + print_all Int.pp [ 0; 1 ]; + [%expect {| + 0 + 1 + |}]; + print Info.pp (Info.create_s [%sexp "hello", "world"]); + [%expect {| (hello world) |}] +;; diff --git a/unikernel/duniverse/base/test/test_pp.mli b/unikernel/duniverse/base/test/test_pp.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_pp.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_ppx_compare_lib.ml b/unikernel/duniverse/base/test/test_ppx_compare_lib.ml new file mode 100644 index 00000000..10305b94 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ppx_compare_lib.ml @@ -0,0 +1,94 @@ +open! Import +open! Ppx_compare_lib + +module Unit = struct + type t = unit [@@deriving compare, sexp_of] +end + +module type T = sig + type t [@@deriving compare, sexp_of] +end + +let test (type a) (module T : T with type t = a) ordered = + List.iteri ordered ~f:(fun i ti -> + List.iteri ordered ~f:(fun j tj -> + require + [%here] + (Ordering.equal + (Ordering.of_int (T.compare ti tj)) + (Ordering.of_int (Int.compare i j))) + ~if_false_then_print_s:(lazy [%message "" ~_:(ti : T.t) ~_:(tj : T.t)]))) +;; + +let%expect_test "bool, char, unit" = + test (module Bool) [ false; true ]; + test (module Char) [ '\000'; 'a'; 'b' ]; + [%expect {| |}]; + test (module Unit) [ () ]; + [%expect {| |}] +;; + +module type Min_zero_max = sig + include T + + val min_value : t + val max_value : t + val zero : t +end + +let test_min_zero_max (type a) (module T : Min_zero_max with type t = a) = + test (module T) [ T.min_value; T.zero; T.max_value ] +;; + +let%expect_test _ = + test_min_zero_max (module Float); + test_min_zero_max (module Int); + test_min_zero_max (module Int32); + test_min_zero_max (module Int64); + test_min_zero_max (module Nativeint) +;; + +let%expect_test "option" = + test + (module struct + type t = int option [@@deriving compare, sexp_of] + end) + [ None; Some 0; Some 1 ] +;; + +let%expect_test "ref" = + test + (module struct + type t = int ref [@@deriving compare, sexp_of] + end) + ([ -1; 0; 1 ] |> List.map ~f:ref) +;; + +module type Sequence = sig + type 'a t [@@deriving compare, sexp_of] + + val of_list : 'a list -> 'a t +end + +let test_sequence (module T : Sequence) ordered = + test + (module struct + type t = int T.t [@@deriving compare, sexp_of] + end) + (ordered |> List.map ~f:T.of_list) +;; + +let%expect_test "array, list" = + test_sequence (module Array) [ []; [ 1 ]; [ 2 ]; [ 1; 2 ]; [ 2; 1 ] ]; + test_sequence (module List) [ []; [ 1 ]; [ 1; 2 ]; [ 2 ]; [ 2; 1 ] ] +;; + +let%expect_test "[compare_abstract]" = + show_raise (fun () -> compare_abstract ~type_name:"TY" () ()); + [%expect + {| + (raised ( + Failure + "Compare called on the type TY, which is abstract in an implementation.")) + |}] +;; diff --git a/unikernel/duniverse/base/test/test_ppx_compare_lib.mli b/unikernel/duniverse/base/test/test_ppx_compare_lib.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ppx_compare_lib.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_printexc.ml b/unikernel/duniverse/base/test/test_printexc.ml new file mode 100644 index 00000000..cb3eb217 --- /dev/null +++ b/unikernel/duniverse/base/test/test_printexc.ml @@ -0,0 +1,19 @@ +open! Import +module Printexc = Stdlib.Printexc + +let%expect_test "Printexc: built-in exception" = + print_endline (Printexc.to_string (Invalid_argument "bad")); + [%expect {| Invalid_argument("bad") |}] +;; + +let%expect_test "Sexp conversion of built-in exceptions" = + print_endline (Sexp.to_string (sexp_of_exn (Invalid_argument "bad"))); + [%expect {| (Invalid_argument bad) |}] +;; + +exception My_invalid_argument of string [@@deriving sexp] + +let%expect_test "Printexc: an exception with deriving sexp" = + print_endline (Printexc.to_string (My_invalid_argument "bad")); + [%expect {| (test_printexc.ml.My_invalid_argument bad) |}] +;; diff --git a/unikernel/duniverse/base/test/test_printexc.mli b/unikernel/duniverse/base/test/test_printexc.mli new file mode 100644 index 00000000..e69de29b diff --git a/unikernel/duniverse/base/test/test_queue.ml b/unikernel/duniverse/base/test/test_queue.ml new file mode 100644 index 00000000..a7cd6814 --- /dev/null +++ b/unikernel/duniverse/base/test/test_queue.ml @@ -0,0 +1,1173 @@ +open! Base +open Base_test_helpers + +let%test_module _ = + (module ( + struct + open Queue + + module type S = S + + let does_raise = Exn.does_raise + + type nonrec 'a t = 'a t [@@deriving sexp, sexp_grammar] + + let globalize = globalize + + let%expect_test _ = + let open Expect_test_helpers_base in + let check t = + require_does_not_raise [%here] (fun () -> + invariant ignore t; + print_s [%sexp (t : int t)]) + in + let a = of_list [ 1; 2; 3 ] in + check a; + [%expect {| (1 2 3) |}]; + let b = globalize globalize_int a in + check b; + [%expect {| (1 2 3) |}]; + enqueue b 4; + print_s [%sexp (dequeue a : int option)]; + [%expect {| (1) |}]; + check a; + [%expect {| (2 3) |}]; + check b; + [%expect {| (1 2 3 4) |}] + ;; + + let capacity = capacity + let set_capacity = set_capacity + + let%test_unit _ = + let t = create () in + [%test_result: int] (capacity t) ~expect:2; + enqueue t 1; + [%test_result: int] (capacity t) ~expect:2; + enqueue t 2; + [%test_result: int] (capacity t) ~expect:2; + enqueue t 3; + [%test_result: int] (capacity t) ~expect:4; + set_capacity t 0; + [%test_result: int] (capacity t) ~expect:4; + set_capacity t 3; + [%test_result: int] (capacity t) ~expect:4; + set_capacity t 100; + [%test_result: int] (capacity t) ~expect:128; + enqueue t 4; + enqueue t 5; + set_capacity t 0; + [%test_result: int] (capacity t) ~expect:8; + set_capacity t (-1); + [%test_result: int] (capacity t) ~expect:8 + ;; + + let round_trip_sexp t = + let sexp = sexp_of_t Int.sexp_of_t t in + let t' = t_of_sexp Int.t_of_sexp sexp in + [%test_result: int list] ~expect:(to_list t) (to_list t') + ;; + + let%test_unit _ = round_trip_sexp (of_list [ 1; 2; 3; 4 ]) + let%test_unit _ = round_trip_sexp (create ()) + let%test_unit _ = round_trip_sexp (of_list []) + let invariant = invariant + let create = create + + let%test_unit _ = + let t = create () in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:2 + ;; + + let%test_unit _ = + let t = create ~capacity:0 () in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:1 + ;; + + let%test_unit _ = + let t = create ~capacity:6 () in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:8 + ;; + + let%test_unit _ = + assert (does_raise (fun () : _ Queue.t -> create ~capacity:(-1) ())) + ;; + + let singleton = singleton + + let%test_unit _ = + let t = singleton 7 in + [%test_result: int] (length t) ~expect:1; + [%test_result: int] (capacity t) ~expect:1; + [%test_result: int option] (dequeue t) ~expect:(Some 7); + [%test_result: int option] (dequeue t) ~expect:None + ;; + + let init = init + + let%test_unit _ = + let t = init 0 ~f:(fun _ -> assert false) in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:1; + [%test_result: int option] (dequeue t) ~expect:None + ;; + + let%test_unit _ = + let t = init 3 ~f:(fun i -> i * 2) in + [%test_result: int] (length t) ~expect:3; + [%test_result: int] (capacity t) ~expect:4; + [%test_result: int option] (dequeue t) ~expect:(Some 0); + [%test_result: int option] (dequeue t) ~expect:(Some 2); + [%test_result: int option] (dequeue t) ~expect:(Some 4); + [%test_result: int option] (dequeue t) ~expect:None + ;; + + let%test_unit _ = + assert (does_raise (fun () : unit Queue.t -> init (-1) ~f:(fun _ -> ()))) + ;; + + let get = get + let set = set + + let%test_unit _ = + let t = create () in + let get_opt t i = Option.try_with (fun () -> get t i) in + [%test_result: int option] (get_opt t 0) ~expect:None; + [%test_result: int option] (get_opt t (-1)) ~expect:None; + [%test_result: int option] (get_opt t 10) ~expect:None; + List.iter [ -1; 0; 1 ] ~f:(fun i -> + assert (does_raise (fun () -> set t i 0))); + enqueue t 0; + enqueue t 1; + enqueue t 2; + [%test_result: int option] (get_opt t 0) ~expect:(Some 0); + [%test_result: int option] (get_opt t 1) ~expect:(Some 1); + [%test_result: int option] (get_opt t 2) ~expect:(Some 2); + [%test_result: int option] (get_opt t 3) ~expect:None; + ignore (dequeue_exn t : int); + [%test_result: int option] (get_opt t 0) ~expect:(Some 1); + [%test_result: int option] (get_opt t 1) ~expect:(Some 2); + [%test_result: int option] (get_opt t 2) ~expect:None; + set t 0 3; + [%test_result: int option] (get_opt t 0) ~expect:(Some 3); + [%test_result: int option] (get_opt t 1) ~expect:(Some 2); + List.iter [ -1; 2 ] ~f:(fun i -> + assert (does_raise (fun () -> set t i 0))) + ;; + + let map = map + + let%test_unit _ = + for i = 0 to 5 do + let l = List.init i ~f:Fn.id in + let t = of_list l in + let f x = x * 2 in + let t' = map t ~f in + [%test_result: int list] (to_list t') ~expect:(List.map l ~f) + done + ;; + + let%test_unit _ = + let t = create () in + let t' = map t ~f:(fun x -> x * 2) in + [%test_result: int] (length t') ~expect:(length t); + [%test_result: int] (length t') ~expect:0; + [%test_result: int list] (to_list t') ~expect:[] + ;; + + let mapi = mapi + + let%test_unit _ = + for i = 0 to 5 do + let l = List.init i ~f:Fn.id in + let t = of_list l in + let f i x = i, x * 2 in + let t' = mapi t ~f in + [%test_result: (int * int) list] (to_list t') ~expect:(List.mapi l ~f) + done + ;; + + let%test_unit _ = + let t = create () in + let t' = mapi t ~f:(fun i x -> i, x * 2) in + [%test_result: int] (length t') ~expect:(length t); + [%test_result: int] (length t') ~expect:0; + [%test_result: (int * int) list] (to_list t') ~expect:[] + ;; + + include Test_container.Test_S1 (Queue) + + let dequeue_exn = dequeue_exn + let enqueue = enqueue + let enqueue_front = enqueue_front + let dequeue_back = dequeue_back + let dequeue_back_exn = dequeue_back_exn + let peek = peek + let peek_exn = peek_exn + let peek_back = peek_back + let peek_back_exn = peek_back_exn + let last = last + let last_exn = last_exn + + let%test_unit _ = + let t = create () in + [%test_result: int option] (peek t) ~expect:None; + [%test_result: int option] (last t) ~expect:None; + enqueue t 1; + enqueue t 2; + [%test_result: int option] (peek t) ~expect:(Some 1); + [%test_result: int] (peek_exn t) ~expect:1; + [%test_result: int option] (last t) ~expect:(Some 2); + [%test_result: int] (last_exn t) ~expect:2; + [%test_result: int] (dequeue_exn t) ~expect:1; + [%test_result: int] (dequeue_exn t) ~expect:2; + assert (does_raise (fun () -> dequeue_exn t)); + assert (does_raise (fun () -> peek_exn t)); + assert (does_raise (fun () -> peek_back_exn t)); + assert (does_raise (fun () -> last_exn t)); + enqueue_front t 1; + enqueue t 2; + enqueue_front t 0; + enqueue t 3; + enqueue t 4; + enqueue t 5; + [%test_result: int option] (peek_back t) ~expect:(Some 5); + [%test_result: int] (peek_back_exn t) ~expect:5; + [%test_result: int] (dequeue_exn t) ~expect:0; + [%test_result: int] (dequeue_exn t) ~expect:1; + [%test_result: int] (dequeue_exn t) ~expect:2; + [%test_result: int] (dequeue_back_exn t) ~expect:5; + [%test_result: int] (dequeue_back_exn t) ~expect:4; + [%test_result: int] (dequeue_back_exn t) ~expect:3 + ;; + + let dequeue_and_ignore_exn = dequeue_and_ignore_exn + + let%test_unit _ = + let t = create () in + enqueue t 1; + enqueue t 2; + enqueue t 3; + [%test_result: int] (peek_exn t) ~expect:1; + dequeue_and_ignore_exn t; + [%test_result: int] (peek_exn t) ~expect:2; + dequeue_and_ignore_exn t; + [%test_result: int] (peek_exn t) ~expect:3; + dequeue_and_ignore_exn t; + [%test_result: int option] (peek t) ~expect:None; + assert (does_raise (fun () -> dequeue_and_ignore_exn t)); + assert (does_raise (fun () -> dequeue_and_ignore_exn t)); + [%test_result: int option] (peek t) ~expect:None + ;; + + let drain = drain + + let%test_unit _ = + let t = create () in + for i = 0 to 10 do + enqueue t i + done; + [%test_result: int] (peek_exn t) ~expect:0; + [%test_result: int] (length t) ~expect:11; + let r = ref 0 in + let add i = r := !r + i in + drain t ~f:add ~while_:(fun i -> i < 7); + [%test_result: int] (peek_exn t) ~expect:7; + [%test_result: int] (length t) ~expect:4; + [%test_result: int] !r ~expect:21; + drain t ~f:add ~while_:(fun i -> i > 7); + [%test_result: int] (peek_exn t) ~expect:7; + [%test_result: int] (length t) ~expect:4; + [%test_result: int] !r ~expect:21; + drain t ~f:add ~while_:(fun i -> i > 0); + [%test_result: int option] (peek t) ~expect:None; + [%test_result: int] (length t) ~expect:0; + [%test_result: int] !r ~expect:55 + ;; + + let enqueue_all = enqueue_all + + let%test_unit _ = + let t = create () in + enqueue_all t [ 1; 2; 3 ]; + [%test_result: int] (dequeue_exn t) ~expect:1; + [%test_result: int] (dequeue_exn t) ~expect:2; + [%test_result: int option] (last t) ~expect:(Some 3); + enqueue_all t [ 4; 5 ]; + [%test_result: int option] (last t) ~expect:(Some 5); + [%test_result: int] (dequeue_exn t) ~expect:3; + [%test_result: int] (dequeue_exn t) ~expect:4; + [%test_result: int] (dequeue_exn t) ~expect:5; + assert (does_raise (fun () -> dequeue_exn t)); + enqueue_all t []; + assert (does_raise (fun () -> dequeue_exn t)) + ;; + + let of_list = of_list + let to_list = to_list + + let%test_unit _ = + for i = 0 to 4 do + let list = List.init i ~f:Fn.id in + [%test_result: int list] (to_list (of_list list)) ~expect:list + done + ;; + + let%test _ = + let t = create () in + for i = 1 to 5 do + enqueue t i + done; + [%equal: int list] (to_list t) [ 1; 2; 3; 4; 5 ] + ;; + + let of_array = of_array + let to_array = to_array + + let%test_unit _ = + for len = 0 to 4 do + let array = Array.init len ~f:Fn.id in + [%test_result: int array] (to_array (of_array array)) ~expect:array + done + ;; + + let compare = compare + let compare__local = compare__local + let equal = equal + let equal__local = equal__local + + let%test_module "comparisons" = + (module struct + let sign x = if x < 0 then ~-1 else if x > 0 then 1 else 0 + + let test t1 t2 = + [%test_result: bool] + (equal Int.equal t1 t2) + ~expect:(List.equal Int.equal (to_list t1) (to_list t2)); + [%test_result: int] + (sign (compare Int.compare t1 t2)) + ~expect:(sign (List.compare Int.compare (to_list t1) (to_list t2))); + [%test_result: bool] + (equal__local Int.equal__local t1 t2) + ~expect: + (List.equal__local Int.equal__local (to_list t1) (to_list t2)); + [%test_result: int] + (sign (compare__local Int.compare__local t1 t2)) + ~expect: + (sign + (List.compare__local + Int.compare__local + (to_list t1) + (to_list t2))) + ;; + + let lists = + [ [] + ; [ 1 ] + ; [ 2 ] + ; [ 1; 1 ] + ; [ 1; 2 ] + ; [ 2; 1 ] + ; [ 1; 1; 1 ] + ; [ 1; 2; 3 ] + ; [ 1; 2; 4 ] + ; [ 1; 2; 4; 8 ] + ; [ 1; 2; 3; 4; 5 ] + ] + ;; + + let%test_unit _ = + (* [phys_equal] inputs *) + List.iter lists ~f:(fun list -> + let t = of_list list in + test t t) + ;; + + let%test_unit _ = + List.iter lists ~f:(fun list1 -> + List.iter lists ~f:(fun list2 -> + test (of_list list1) (of_list list2))) + ;; + end) + ;; + + let clear = clear + + let%test_unit "clear" = + let q = of_list [ 1; 2; 3; 4 ] in + [%test_result: int] (length q) ~expect:4; + clear q; + [%test_result: int] (length q) ~expect:0 + ;; + + let blit_transfer = blit_transfer + + let%test_unit _ = + let q_list = [ 1; 2; 3; 4 ] in + let q = of_list q_list in + let q' = create () in + blit_transfer ~src:q ~dst:q' (); + [%test_result: int list] (to_list q') ~expect:q_list; + [%test_result: int list] (to_list q) ~expect:[] + ;; + + let%test_unit _ = + let q = of_list [ 1; 2; 3; 4 ] in + let q' = create () in + blit_transfer ~src:q ~dst:q' ~len:2 (); + [%test_result: int list] (to_list q') ~expect:[ 1; 2 ]; + [%test_result: int list] (to_list q) ~expect:[ 3; 4 ] + ;; + + let%test_unit "blit_transfer on wrapped queues" = + let list = [ 1; 2; 3; 4 ] in + let q = of_list list in + let q' = copy q in + ignore (dequeue_exn q : int); + ignore (dequeue_exn q : int); + ignore (dequeue_exn q' : int); + ignore (dequeue_exn q' : int); + ignore (dequeue_exn q' : int); + enqueue q 5; + enqueue q 6; + blit_transfer ~src:q ~dst:q' ~len:3 (); + [%test_result: int list] (to_list q') ~expect:[ 4; 3; 4; 5 ]; + [%test_result: int list] (to_list q) ~expect:[ 6 ] + ;; + + let copy = copy + + let%test_unit "copies behave independently" = + let q = of_list [ 1; 2; 3; 4 ] in + let q' = copy q in + enqueue q 5; + ignore (dequeue_exn q' : int); + [%test_result: int list] (to_list q) ~expect:[ 1; 2; 3; 4; 5 ]; + [%test_result: int list] (to_list q') ~expect:[ 2; 3; 4 ] + ;; + + let dequeue = dequeue + let filter = filter + let filteri = filteri + let filter_inplace = filter_inplace + let filteri_inplace = filteri_inplace + let concat_map = concat_map + let concat_mapi = concat_mapi + let filter_map = filter_map + let filter_mapi = filter_mapi + let counti = counti + let existsi = existsi + let for_alli = for_alli + let iter = iter + let iteri = iteri + let foldi = foldi + let findi = findi + let find_mapi = find_mapi + + let%test_module "Linked_queue bisimulation" = + (module struct + module type Queue_intf = sig + type 'a t [@@deriving sexp_of] + + val create : unit -> 'a t + val enqueue : 'a t -> 'a -> unit + val dequeue : 'a t -> 'a option + val drain : 'a t -> f:('a -> unit) -> while_:('a -> bool) -> unit + val to_array : 'a t -> 'a array + val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b + val foldi : 'a t -> init:'b -> f:(int -> 'b -> 'a -> 'b) -> 'b + val iter : 'a t -> f:('a -> unit) -> unit + val iteri : 'a t -> f:(int -> 'a -> unit) -> unit + val length : 'a t -> int + val clear : 'a t -> unit + val concat_map : 'a t -> f:('a -> 'b list) -> 'b t + val concat_mapi : 'a t -> f:(int -> 'a -> 'b list) -> 'b t + val filter_map : 'a t -> f:('a -> 'b option) -> 'b t + val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t + val filter : 'a t -> f:('a -> bool) -> 'a t + val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t + val filter_inplace : 'a t -> f:('a -> bool) -> unit + val filteri_inplace : 'a t -> f:(int -> 'a -> bool) -> unit + val map : 'a t -> f:('a -> 'b) -> 'b t + val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t + val counti : 'a t -> f:(int -> 'a -> bool) -> int + val existsi : 'a t -> f:(int -> 'a -> bool) -> bool + val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool + val findi : 'a t -> f:(int -> 'a -> bool) -> (int * 'a) option + val find_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b option + val transfer : src:'a t -> dst:'a t -> unit + val copy : 'a t -> 'a t + end + + module That_queue : Queue_intf = Linked_queue + + module This_queue : Queue_intf = struct + include Queue + + let create () = create () + let transfer ~src ~dst = blit_transfer ~src ~dst () + end + + let this_to_string this_t = + Sexp.to_string (this_t |> [%sexp_of: int This_queue.t]) + ;; + + let that_to_string that_t = + Sexp.to_string (that_t |> [%sexp_of: int That_queue.t]) + ;; + + let array_string arr = Sexp.to_string (arr |> [%sexp_of: int array]) + let create () = This_queue.create (), That_queue.create () + + let enqueue (t_a, t_b) v = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + This_queue.enqueue t_a v; + That_queue.enqueue t_b v; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "enqueue transition failure of: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let iter (t_a, t_b) = + let r_a, r_b = ref 0, ref 0 in + This_queue.iter t_a ~f:(fun x -> r_a := !r_a + x); + That_queue.iter t_b ~f:(fun x -> r_b := !r_b + x); + if !r_a <> !r_b + then + Printf.failwithf + "error in iter: %s (from %s) <> %s (from %s)" + (Int.to_string !r_a) + (this_to_string t_a) + (Int.to_string !r_b) + (that_to_string t_b) + () + ;; + + let iteri (t_a, t_b) = + let r_a, r_b = ref 0, ref 0 in + This_queue.iteri t_a ~f:(fun i x -> r_a := !r_a + (x lxor i)); + That_queue.iteri t_b ~f:(fun i x -> r_b := !r_b + (x lxor i)); + if !r_a <> !r_b + then + Printf.failwithf + "error in iteri: %s (from %s) <> %s (from %s)" + (Int.to_string !r_a) + (this_to_string t_a) + (Int.to_string !r_b) + (that_to_string t_b) + () + ;; + + let dequeue (t_a, t_b) = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + let a, b = This_queue.dequeue t_a, That_queue.dequeue t_b in + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if (not ([%equal: int option] a b)) + || not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in dequeue: %s (%s -> %s) <> %s (%s -> %s)" + (Option.value ~default:"None" (Option.map a ~f:Int.to_string)) + (array_string start_a) + (array_string end_a) + (Option.value ~default:"None" (Option.map b ~f:Int.to_string)) + (array_string start_b) + (array_string end_b) + () + ;; + + let is_even x = x land 1 = 0 + + let drain (t_a, t_b) = + let orig_a = This_queue.to_array t_a in + let orig_b = That_queue.to_array t_b in + let r_a = ref 0 in + let r_b = ref 0 in + let add r i = r := !r + i in + This_queue.drain t_a ~f:(fun i -> add r_a i) ~while_:is_even; + That_queue.drain t_b ~f:(fun i -> add r_b i) ~while_:is_even; + if not + ([%equal: int array] + (This_queue.to_array t_a) + (That_queue.to_array t_b) + && !r_a = !r_b) + then + Printf.failwithf + "error in drain: %s -> %s, %d vs. %s -> %s, %d" + (array_string orig_a) + (this_to_string t_a) + !r_a + (array_string orig_b) + (that_to_string t_b) + !r_b + () + ;; + + let clear (t_a, t_b) = + This_queue.clear t_a; + That_queue.clear t_b + ;; + + let filter (t_a, t_b) = + let t_a' = This_queue.filter t_a ~f:is_even in + let t_b' = That_queue.filter t_b ~f:is_even in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filter: %s -> %s vs. %s -> %s" + (this_to_string t_a) + (this_to_string t_a') + (that_to_string t_b) + (that_to_string t_b') + () + ;; + + let filteri (t_a, t_b) = + let t_a' = + This_queue.filteri t_a ~f:(fun i j -> + [%equal: bool] (is_even i) (is_even j)) + in + let t_b' = + That_queue.filteri t_b ~f:(fun i j -> + [%equal: bool] (is_even i) (is_even j)) + in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filteri: %s -> %s vs. %s -> %s" + (this_to_string t_a) + (this_to_string t_a') + (that_to_string t_b) + (that_to_string t_b') + () + ;; + + let filter_inplace (t_a, t_b) = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + This_queue.filter_inplace t_a ~f:is_even; + That_queue.filter_inplace t_b ~f:is_even; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in filter_inplace: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let filteri_inplace (t_a, t_b) = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + let f i x = [%equal: bool] (is_even i) (is_even x) in + This_queue.filteri_inplace t_a ~f; + That_queue.filteri_inplace t_b ~f; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in filteri_inplace: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let concat_map (t_a, t_b) = + let f x = [ x; x + 1; x + 2 ] in + let t_a' = This_queue.concat_map t_a ~f in + let t_b' = That_queue.concat_map t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in concat_map: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let concat_mapi (t_a, t_b) = + let f i x = [ x; x + 1; x + 2; x + i ] in + let t_a' = This_queue.concat_mapi t_a ~f in + let t_b' = That_queue.concat_mapi t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in concat_mapi: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let filter_map (t_a, t_b) = + let f x = if is_even x then None else Some (x + 1) in + let t_a' = This_queue.filter_map t_a ~f in + let t_b' = That_queue.filter_map t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filter_map: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let filter_mapi (t_a, t_b) = + let f i x = + if [%equal: bool] (is_even i) (is_even x) + then None + else Some (x + 1 + i) + in + let t_a' = This_queue.filter_mapi t_a ~f in + let t_b' = That_queue.filter_mapi t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filter_mapi: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let map (t_a, t_b) = + let f x = x * 7 in + let t_a' = This_queue.map t_a ~f in + let t_b' = That_queue.map t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in map: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let mapi (t_a, t_b) = + let f i x = (x + 3) lxor i in + let t_a' = This_queue.mapi t_a ~f in + let t_b' = That_queue.mapi t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in mapi: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let counti (t_a, t_b) = + let f i x = i < 7 && i % 7 = x % 7 in + let a' = This_queue.counti t_a ~f in + let b' = That_queue.counti t_b ~f in + if a' <> b' + then + Printf.failwithf + "error in counti: %d (for %s) <> %d (for %s)" + a' + (this_to_string t_a) + b' + (that_to_string t_b) + () + ;; + + let existsi (t_a, t_b) = + let f i x = i < 7 && i % 7 = x % 7 in + let a' = This_queue.existsi t_a ~f in + let b' = That_queue.existsi t_b ~f in + if not ([%equal: bool] a' b') + then + Printf.failwithf + "error in existsi: %b (for %s) <> %b (for %s)" + a' + (this_to_string t_a) + b' + (that_to_string t_b) + () + ;; + + let for_alli (t_a, t_b) = + let f i x = i >= 7 || i % 7 <> x % 7 in + let a' = This_queue.for_alli t_a ~f in + let b' = That_queue.for_alli t_b ~f in + if not ([%equal: bool] a' b') + then + Printf.failwithf + "error in for_alli: %b (for %s) <> %b (for %s)" + a' + (this_to_string t_a) + b' + (that_to_string t_b) + () + ;; + + let findi (t_a, t_b) = + let f i x = i < 7 && i % 7 = x % 7 in + let a' = This_queue.findi t_a ~f in + let b' = That_queue.findi t_b ~f in + if not ([%equal: (int * int) option] a' b') + then + Printf.failwithf + "error in findi: %s (for %s) <> %s (for %s)" + (Sexp.to_string ([%sexp_of: (int * int) option] a')) + (this_to_string t_a) + (Sexp.to_string ([%sexp_of: (int * int) option] b')) + (that_to_string t_b) + () + ;; + + let find_mapi (t_a, t_b) = + let f i x = if i < 7 && i % 7 = x % 7 then Some (i + x) else None in + let a' = This_queue.find_mapi t_a ~f in + let b' = That_queue.find_mapi t_b ~f in + if not ([%equal: int option] a' b') + then + Printf.failwithf + "error in find_mapi: %s (for %s) <> %s (for %s)" + (Sexp.to_string ([%sexp_of: int option] a')) + (this_to_string t_a) + (Sexp.to_string ([%sexp_of: int option] b')) + (that_to_string t_b) + () + ;; + + let copy (t_a, t_b) = + let copy_a = This_queue.copy t_a in + let copy_b = That_queue.copy t_b in + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + let end_a = This_queue.to_array copy_a in + let end_b = That_queue.to_array copy_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in copy: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let transfer (t_a, t_b) = + let dst_a = This_queue.create () in + let dst_b = That_queue.create () in + (* sometimes puts some elements in the destination queues *) + if Random.bool () + then + List.iter [ 1; 2; 3; 4; 5 ] ~f:(fun elem -> + This_queue.enqueue dst_a elem; + That_queue.enqueue dst_b elem); + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + This_queue.transfer ~src:t_a ~dst:dst_a; + That_queue.transfer ~src:t_b ~dst:dst_b; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + let end_a' = This_queue.to_array dst_a in + let end_b' = That_queue.to_array dst_b in + if (not ([%equal: int array] end_a' end_b')) + || not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in transfer: %s -> (%s, %s) vs. %s -> (%s, %s)" + (array_string start_a) + (array_string end_a) + (array_string end_a') + (array_string start_b) + (array_string end_b) + (array_string end_b) + () + ;; + + let fold_check (t_a, t_b) = + let make_list fold t = fold t ~init:[] ~f:(fun acc x -> x :: acc) in + let this_l = make_list This_queue.fold t_a in + let that_l = make_list That_queue.fold t_b in + if not ([%equal: int list] this_l that_l) + then + Printf.failwithf + "error in fold: %s (from %s) <> %s (from %s)" + (Sexp.to_string (this_l |> [%sexp_of: int list])) + (this_to_string t_a) + (Sexp.to_string (that_l |> [%sexp_of: int list])) + (that_to_string t_b) + () + ;; + + let foldi_check (t_a, t_b) = + let make_list foldi t = + foldi t ~init:[] ~f:(fun i acc x -> (i, x) :: acc) + in + let this_l = make_list This_queue.foldi t_a in + let that_l = make_list That_queue.foldi t_b in + if not ([%equal: (int * int) list] this_l that_l) + then + Printf.failwithf + "error in foldi: %s (from %s) <> %s (from %s)" + (Sexp.to_string (this_l |> [%sexp_of: (int * int) list])) + (this_to_string t_a) + (Sexp.to_string (that_l |> [%sexp_of: (int * int) list])) + (that_to_string t_b) + () + ;; + + let length_check (t_a, t_b) = + let this_len = This_queue.length t_a in + let that_len = That_queue.length t_b in + if this_len <> that_len + then + Printf.failwithf + "error in length: %i (for %s) <> %i (for %s)" + this_len + (this_to_string t_a) + that_len + (that_to_string t_b) + () + ;; + + let%test_unit _ = + let t = create () in + let rec loop ~all_ops ~non_empty_ops = + if all_ops <= 0 && non_empty_ops <= 0 + then ( + let t_a, t_b = t in + let arr_a = This_queue.to_array t_a in + let arr_b = That_queue.to_array t_b in + if not ([%equal: int array] arr_a arr_b) + then + Printf.failwithf + "queue final states not equal: %s vs. %s" + (array_string arr_a) + (array_string arr_b) + ()) + else ( + let queue_was_empty = This_queue.length (fst t) = 0 in + let r = Random.int 200 in + if r < 60 + then enqueue t (Random.int 10_000) + else if r < 65 + then dequeue t + else if r < 70 + then clear t + else if r < 80 + then iter t + else if r < 85 + then iteri t + else if r < 90 + then fold_check t + else if r < 95 + then foldi_check t + else if r < 100 + then filter t + else if r < 105 + then filteri t + else if r < 110 + then concat_map t + else if r < 115 + then concat_mapi t + else if r < 120 + then transfer t + else if r < 130 + then filter_map t + else if r < 135 + then filter_mapi t + else if r < 140 + then copy t + else if r < 150 + then filter_inplace t + else if r < 155 + then for_alli t + else if r < 160 + then existsi t + else if r < 165 + then counti t + else if r < 170 + then findi t + else if r < 175 + then find_mapi t + else if r < 180 + then map t + else if r < 185 + then mapi t + else if r < 190 + then filteri_inplace t + else if r < 195 + then length_check t + else if r < 200 + then drain t + else failwith "Impossible: We did [Random.int 200] above"; + loop + ~all_ops:(all_ops - 1) + ~non_empty_ops: + (if queue_was_empty then non_empty_ops else non_empty_ops - 1)) + in + loop ~all_ops:30_000 ~non_empty_ops:20_000 + ;; + end) + ;; + + let%test_unit "modification-during-iteration" = + let x = `A 0 in + let t = of_list [ x; x ] in + let f (`A n) = + ignore n; + clear t + in + assert (does_raise (fun () -> iter t ~f)) + ;; + + let%test_unit "more-modification-during-iteration" = + let nested_iter_okay = ref false in + let t = of_list [ `iter; `clear ] in + assert ( + does_raise (fun () -> + iter t ~f:(function + | `iter -> + iter t ~f:ignore; + nested_iter_okay := true + | `clear -> clear t))); + assert !nested_iter_okay + ;; + + let%test_unit "modification-during-filter" = + let reached_unreachable = ref false in + let t = of_list [ `clear; `unreachable ] in + let f x = + match x with + | `clear -> + clear t; + false + | `unreachable -> + reached_unreachable := true; + false + in + assert (does_raise (fun () -> filter t ~f)); + assert (not !reached_unreachable) + ;; + + let%test_unit "modification-during-filter-inplace" = + let reached_unreachable = ref false in + let t = of_list [ `drop_this; `enqueue_new_element; `unreachable ] in + let f x = + (match x with + | `drop_this | `new_element -> () + | `enqueue_new_element -> enqueue t `new_element + | `unreachable -> reached_unreachable := true); + false + in + assert (does_raise (fun () -> filter_inplace t ~f)); + (* even though we said to drop the first element, the aborted call to [filter_inplace] + shouldn't have made that change *) + (match peek_exn t with + | `drop_this -> () + | `new_element | `enqueue_new_element | `unreachable -> + failwith "Expected the first element to be `drop_this"); + assert (not !reached_unreachable) + ;; + + let%test_unit "filter-inplace-during-iteration" = + let reached_unreachable = ref false in + let t = of_list [ `filter_inplace; `unreachable ] in + let f x = + match x with + | `filter_inplace -> filter_inplace t ~f:(fun _ -> false) + | `unreachable -> reached_unreachable := true + in + assert (does_raise (fun () -> iter t ~f)); + assert (not !reached_unreachable) + ;; + + module Iteration = struct + type t = Iteration.t + + let start = Iteration.start + + let assert_no_mutation_since_start = + Iteration.assert_no_mutation_since_start + ;; + + let%expect_test "mutation-detection" = + let open Expect_test_helpers_base in + let t = of_list [ `elt ] in + let token = start t in + let `elt = get t 0 in + require_does_not_raise [%here] (fun () -> + assert_no_mutation_since_start token t); + [%expect {| |}]; + enqueue t `elt; + require_does_raise [%here] (fun () -> + assert_no_mutation_since_start token t); + [%expect + {| + ("mutation of queue during iteration" ( + (num_mutations 2) + (front 0) + (mask 1) + (length 2) + (elts ( + (_) + (_))))) + |}] + ;; + end + end + (* This signature is here to remind us to update the unit tests whenever we + change [Queue]. *) : + module type of Queue)) +;; diff --git a/unikernel/duniverse/base/test/test_queue.mli b/unikernel/duniverse/base/test/test_queue.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_queue.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_random.ml b/unikernel/duniverse/base/test/test_random.ml new file mode 100644 index 00000000..95c04614 --- /dev/null +++ b/unikernel/duniverse/base/test/test_random.ml @@ -0,0 +1,367 @@ +open! Import +open! Random + +let%test_module "State" = + (module struct + include State + + let%test_unit ("random int above 2^30" [@tags "64-bits-only"]) = + let state = make [| 1; 2; 3; 4; 5 |] in + for _ = 1 to 100 do + let bound = Int.shift_left 1 40 in + let n = int state bound in + if n < 0 || n >= bound + then + failwith (Printf.sprintf "random result %d out of bounds (0,%d)" n (bound - 1)) + done + ;; + end) +;; + +external random_seed : unit -> Stdlib.Obj.t = "caml_sys_random_seed" + +let%test_unit _ = + (* test that the return type of "caml_sys_random_seed" is what we expect *) + let module Obj = Stdlib.Obj in + let obj = random_seed () in + assert (Obj.is_block obj); + assert (Obj.tag obj = Obj.tag (Obj.repr [| 13 |])); + for i = 0 to Obj.size obj - 1 do + assert (Obj.is_int (Obj.field obj i)) + done +;; + +module type T = sig + type t [@@deriving compare, sexp_of] +end + +(* We test that [count] trials of [generate ()] all produce values between [min, max], and + generate at least one value between [lo, hi]. *) +let test (type t) here m count generate ~min ~max ~check_range:(lo, hi) = + let (module T : T with type t = t) = m in + let between t ~lower_bound ~upper_bound = + T.compare t lower_bound >= 0 && T.compare t upper_bound <= 0 + in + let generated = + List.init count ~f:(fun _ -> generate ()) |> List.dedup_and_sort ~compare:T.compare + in + require + here + (List.for_all generated ~f:(fun t -> between t ~lower_bound:min ~upper_bound:max)) + ~if_false_then_print_s: + (lazy + [%message + "generated values outside of bounds" + (min : T.t) + (max : T.t) + (generated : T.t list)]); + require + here + (List.exists generated ~f:(fun t -> between t ~lower_bound:lo ~upper_bound:hi)) + ~if_false_then_print_s: + (lazy + [%message + "did not generate value inside range" + (lo : T.t) + (hi : T.t) + (generated : T.t list)]) +;; + +let%expect_test "float" = + test + [%here] + (module Float) + 1_000 + (fun () -> float 100.) + ~min:0. + ~max:100. + ~check_range:(10., 20.); + [%expect {| |}] +;; + +let%expect_test "float_range" = + test + [%here] + (module Float) + 1_000 + (fun () -> float_range (-100.) 100.) + ~min:(-100.) + ~max:100. + ~check_range:(-20., -10.); + [%expect {| |}] +;; + +let%expect_test "int" = + test [%here] (module Int) 1_000 (fun () -> int 100) ~min:0 ~max:99 ~check_range:(10, 20); + [%expect {| |}] +;; + +let%expect_test "int_incl" = + test + [%here] + (module Int) + 1_000 + (fun () -> int_incl (-100) 100) + ~min:(-100) + ~max:100 + ~check_range:(-20, -10); + [%expect {| |}]; + test + [%here] + (module Int) + 1_000 + (fun () -> int_incl 0 Int.max_value) + ~min:0 + ~max:Int.max_value + ~check_range:(0, Int.max_value / 100); + [%expect {| |}]; + test + [%here] + (module Int) + 1_000 + (fun () -> int_incl Int.min_value Int.max_value) + ~min:Int.min_value + ~max:Int.max_value + ~check_range:(Int.min_value / 100, Int.max_value / 100); + [%expect {| |}] +;; + +let%expect_test "int32" = + test + [%here] + (module Int32) + 1_000 + (fun () -> int32 100l) + ~min:0l + ~max:99l + ~check_range:(10l, 20l); + [%expect {| |}] +;; + +let%expect_test "int32_incl" = + test + [%here] + (module Int32) + 1_000 + (fun () -> int32_incl (-100l) 100l) + ~min:(-100l) + ~max:100l + ~check_range:(-20l, -10l); + [%expect {| |}]; + test + [%here] + (module Int32) + 1_000 + (fun () -> int32_incl 0l Int32.max_value) + ~min:0l + ~max:Int32.max_value + ~check_range:(0l, Int32.( / ) Int32.max_value 100l); + [%expect {| |}]; + test + [%here] + (module Int32) + 1_000 + (fun () -> int32_incl Int32.min_value Int32.max_value) + ~min:Int32.min_value + ~max:Int32.max_value + ~check_range:(Int32.( / ) Int32.min_value 100l, Int32.( / ) Int32.max_value 100l); + [%expect {| |}] +;; + +let%expect_test "int64" = + test + [%here] + (module Int64) + 1_000 + (fun () -> int64 100L) + ~min:0L + ~max:99L + ~check_range:(10L, 20L); + [%expect {| |}] +;; + +let%expect_test "int64_incl" = + test + [%here] + (module Int64) + 1_000 + (fun () -> int64_incl (-100L) 100L) + ~min:(-100L) + ~max:100L + ~check_range:(-20L, -10L); + [%expect {| |}]; + test + [%here] + (module Int64) + 1_000 + (fun () -> int64_incl 0L Int64.max_value) + ~min:0L + ~max:Int64.max_value + ~check_range:(0L, Int64.( / ) Int64.max_value 100L); + [%expect {| |}]; + test + [%here] + (module Int64) + 1_000 + (fun () -> int64_incl Int64.min_value Int64.max_value) + ~min:Int64.min_value + ~max:Int64.max_value + ~check_range:(Int64.( / ) Int64.min_value 100L, Int64.( / ) Int64.max_value 100L); + [%expect {| |}] +;; + +let%expect_test "nativeint" = + test + [%here] + (module Nativeint) + 1_000 + (fun () -> nativeint 100n) + ~min:0n + ~max:99n + ~check_range:(10n, 20n); + [%expect {| |}] +;; + +let%expect_test "nativeint_incl" = + test + [%here] + (module Nativeint) + 1_000 + (fun () -> nativeint_incl (-100n) 100n) + ~min:(-100n) + ~max:100n + ~check_range:(-20n, -10n); + [%expect {| |}]; + test + [%here] + (module Nativeint) + 1_000 + (fun () -> nativeint_incl 0n Nativeint.max_value) + ~min:0n + ~max:Nativeint.max_value + ~check_range:(0n, Nativeint.( / ) Nativeint.max_value 100n); + [%expect {| |}]; + test + [%here] + (module Nativeint) + 1_000 + (fun () -> nativeint_incl Nativeint.min_value Nativeint.max_value) + ~min:Nativeint.min_value + ~max:Nativeint.max_value + ~check_range: + (Nativeint.( / ) Nativeint.min_value 100n, Nativeint.( / ) Nativeint.max_value 100n); + [%expect {| |}] +;; + +(* The int63 functions come from [Int63] rather than [Random], but we test them here + along with the others anyway. *) + +let%expect_test "int63" = + let i = Int63.of_int in + test + [%here] + (module Int63) + 1_000 + (fun () -> Int63.random (i 100)) + ~min:(i 0) + ~max:(i 99) + ~check_range:(i 10, i 20); + [%expect {| |}] +;; + +let%expect_test "int63_incl" = + let i = Int63.of_int in + test + [%here] + (module Int63) + 1_000 + (fun () -> Int63.random_incl (i (-100)) (i 100)) + ~min:(i (-100)) + ~max:(i 100) + ~check_range:(i (-20), i (-10)); + [%expect {| |}]; + test + [%here] + (module Int63) + 1_000 + (fun () -> Int63.random_incl (i 0) Int63.max_value) + ~min:(i 0) + ~max:Int63.max_value + ~check_range:(i 0, Int63.( / ) Int63.max_value (i 100)); + [%expect {| |}]; + test + [%here] + (module Int63) + 1_000 + (fun () -> Int63.random_incl Int63.min_value Int63.max_value) + ~min:Int63.min_value + ~max:Int63.max_value + ~check_range:(Int63.( / ) Int63.min_value (i 100), Int63.( / ) Int63.max_value (i 100)); + [%expect {| |}] +;; + +let%expect_test "ascii" = + test + [%here] + (module Char) + 1_000 + ascii + ~min:Char.min_value + ~max:(Char.of_int_exn 127) + ~check_range:('a', 'z'); + [%expect {| |}] +;; + +let%expect_test "char" = + test + [%here] + (module Char) + 1_000 + char + ~min:Char.min_value + ~max:Char.max_value + ~check_range:('\128', '\255'); + [%expect {| |}] +;; + +let%test_module "float upper bound is inclusive despite docs" = + (module struct + (* The fact that this test passes doesn't demonstrate that the bug has gone away, + since the test was explicitly contrived to provoke the bug. *) + + (* This bug is more clearly illustrated by copying the implementation of + [Random.float] from the stdlib (which is just re-exported by Base). + + Basically, when [r1 /. scale +. r2] requires more than 53 bits of precision, and + [bits2] consists of all 1s, rounding causes [rawfloat] to return 1. *) + + let rawfloat bits1 bits2 = + let scale = 1073741824.0 + and r1 = Stdlib.float bits1 + and r2 = Stdlib.float bits2 in + ((r1 /. scale) +. r2) /. scale + ;; + + let%expect_test "likelihood of failure" = + (* test 256 states of the random number generator, highest as 60-bit numbers, out of + which 64 would have yield a float exactly equal to 1 if [Random.State.float] was + not recursive. *) + let lbound = (1 lsl 30) - (1 lsl 8) in + let ubound = (1 lsl 30) - 1 in + let bits2 = ubound in + let failures = ref 0 in + for bits1 = lbound to ubound do + let open Float.O in + if rawfloat bits1 bits2 >= 1. then Int.incr failures + done; + let prob = Stdlib.float !failures *. 0x1p-60 in + print_s [%message "likelihood of failure" (failures : int ref) (prob : float)]; + [%expect + {| + ("likelihood of failure" + (failures 64) + (prob 5.5511151231257827E-17)) + |}] + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_random.mli b/unikernel/duniverse/base/test/test_random.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_random.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_ref.ml b/unikernel/duniverse/base/test/test_ref.ml new file mode 100644 index 00000000..518f0715 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ref.ml @@ -0,0 +1,69 @@ +open! Import +open Ref + +let%test_unit "[set_temporarily] without raise" = + let r = ref 0 in + [%test_result: int] ~expect:1 (set_temporarily r 1 ~f:(fun () -> !r)); + [%test_result: int] ~expect:0 !r +;; + +let%expect_test "[set_temporarily] with raise" = + let r = ref 0 in + require_does_raise [%here] (fun () -> + Nothing.unreachable_code (set_temporarily r 1 ~f:(fun () -> failwith ""))); + [%expect {| (Failure "") |}]; + require_equal [%here] (module Int) !r 0 +;; + +let%test_unit "[set_temporarily] where [f] sets the ref" = + let r = ref 0 in + set_temporarily r 1 ~f:(fun () -> r := 2); + [%test_result: int] ~expect:0 !r +;; + +let%expect_test "[sets_temporarily] without raise" = + let r1 = ref 1 in + let r2 = ref 2 in + let test and_values = + let i1 = !r1 in + let i2 = !r2 in + sets_temporarily and_values ~f:(fun () -> + print_s [%message (r1 : int ref) (r2 : int ref)]); + require_equal + [%here] + (module struct + type t = int * int [@@deriving equal, sexp_of] + end) + (!r1, !r2) + (i1, i2) + in + test []; + [%expect {| + ((r1 1) + (r2 2)) + |}]; + test [ T (r1, 13) ]; + [%expect {| + ((r1 13) + (r2 2)) + |}]; + test [ T (r1, 13); T (r1, 17) ]; + [%expect {| + ((r1 17) + (r2 2)) + |}]; + test [ T (r1, 13); T (r2, 17) ]; + [%expect {| + ((r1 13) + (r2 17)) + |}] +;; + +let%expect_test "[sets_temporarily] with raise" = + let r = ref 0 in + require_does_raise [%here] (fun () -> + Nothing.unreachable_code (sets_temporarily [ T (r, 1) ] ~f:(fun () -> failwith ""))); + [%expect {| (Failure "") |}]; + print_s [%message (r : int ref)]; + [%expect {| (r 0) |}] +;; diff --git a/unikernel/duniverse/base/test/test_ref.mli b/unikernel/duniverse/base/test/test_ref.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_ref.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_result.ml b/unikernel/duniverse/base/test/test_result.ml new file mode 100644 index 00000000..f97f6a3c --- /dev/null +++ b/unikernel/duniverse/base/test/test_result.ml @@ -0,0 +1,60 @@ +open! Base +open! Import + +let%test_module "Result.Error" = + (module struct + open Result.Error.Let_syntax + + module Int_or_string = struct + type t = (int, string) Result.t [@@deriving equal, sexp_of] + end + + let%expect_test "return" = + require_equal [%here] (module Int_or_string) (return "error") (Error "error"); + [%expect {| |}] + ;; + + let%expect_test "bind Error" = + let result = + let%bind e1 = Error "e1" in + let%bind e2 = Error "e2" in + let%bind e3 = Error "e3" in + return (String.concat ~sep:"," [ e1; e2; e3 ]) + in + require_equal [%here] (module Int_or_string) result (Error "e1,e2,e3"); + [%expect {| |}] + ;; + + let%expect_test "bind Ok" = + let result = + let%bind e1 = Error "e1" in + let%bind e2 = Ok 1 in + let%bind e3 = Error "e3" in + return (String.concat ~sep:"," [ e1; e2; e3 ]) + in + require_equal [%here] (module Int_or_string) result (Ok 1); + [%expect {| |}] + ;; + + let%expect_test "map Error" = + let result = + let%map e1 = Error "e1" in + e1 ^ "!" + in + require_equal [%here] (module Int_or_string) result (Error "e1!"); + [%expect {| |}] + ;; + + let%expect_test "map Ok" = + let result = + let%map e1 = Ok 1 in + e1 ^ "!" + in + require_equal [%here] (module Int_or_string) result (Ok 1); + [%expect {| |}] + ;; + + (* The rest of the Monad functions are derived using the Monad.Make functor, which is + well-tested. *) + end) +;; diff --git a/unikernel/duniverse/base/test/test_result.mli b/unikernel/duniverse/base/test/test_result.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_result.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_sequence.ml b/unikernel/duniverse/base/test/test_sequence.ml new file mode 100644 index 00000000..3847257e --- /dev/null +++ b/unikernel/duniverse/base/test/test_sequence.ml @@ -0,0 +1,724 @@ +open! Import +open! Sequence + +let%test_unit "of_lazy" = + let t = range 0 100 in + [%test_result: int list] (to_list (of_lazy (lazy t))) ~expect:(to_list t) +;; + +let%test_unit _ = + let seq_of_seqs = + unfold ~init:0 ~f:(fun i -> + Some (unfold ~init:i ~f:(fun j -> Some ((i, j), j + 1)), i + 1)) + in + [%test_result: (int * int) list] + (to_list (take (interleave seq_of_seqs) 10)) + ~expect:[ 0, 0; 0, 1; 1, 1; 0, 2; 1, 2; 2, 2; 0, 3; 1, 3; 2, 3; 3, 3 ] +;; + +let%expect_test "round_robin vs interleave" = + let list_of_lists = [ [ 1; 10; 100; 1000 ]; [ 2; 20; 200 ]; [ 3; 30 ]; [ 4 ] ] in + let list_of_seqs = List.map list_of_lists ~f:of_list in + let seq_of_seqs = of_list list_of_seqs in + print_s [%sexp (to_list (round_robin list_of_seqs) : int list)]; + [%expect {| (1 2 3 4 10 20 30 100 200 1_000) |}]; + print_s [%sexp (to_list (interleave seq_of_seqs) : int list)]; + [%expect {| (1 10 2 100 20 3 1_000 200 30 4) |}] +;; + +let%test_unit _ = + let evens = unfold ~init:0 ~f:(fun i -> Some (i, i + 2)) in + let vowels = cycle_list_exn [ 'a'; 'e'; 'i'; 'o'; 'u' ] in + [%test_result: (int * char) list] + (to_list (take (interleaved_cartesian_product evens vowels) 10)) + ~expect: + [ 0, 'a'; 0, 'e'; 2, 'a'; 0, 'i'; 2, 'e'; 4, 'a'; 0, 'o'; 2, 'i'; 4, 'e'; 6, 'a' ] +;; + +let%test_module "Sequence.merge*" = + (module struct + let%test_unit _ = + [%test_eq: (int, int) Merge_with_duplicates_element.t list] + (to_list + (merge_with_duplicates + (of_list [ 1; 2 ]) + (of_list [ 2; 3 ]) + (* Can't use Core_int.compare because it would be a dependency cycle. *) + ~compare:Int.compare)) + [ Left 1; Both (2, 2); Right 3 ] + ;; + + let%test_unit _ = + [%test_eq: (int, int) Merge_with_duplicates_element.t list] + (to_list + (merge_with_duplicates + (of_list [ 2; 1 ]) + (of_list [ 2; 3 ]) + ~compare:Int.compare)) + [ Both (2, 2); Left 1; Right 3 ] + ;; + + let test_merge_semantics ~merge ~(normalize_list : _ -> compare:(_ -> _ -> _) -> _) = + Base_quickcheck.Test.run_exn + (module struct + module Deduped_and_sorted_int_list = struct + type t = int list [@@deriving quickcheck, sexp_of] + + let sort t = normalize_list t ~compare:Int.compare + + let quickcheck_generator = + Base_quickcheck.Generator.map quickcheck_generator ~f:sort + ;; + + let quickcheck_shrinker = + Base_quickcheck.Shrinker.map quickcheck_shrinker ~f:sort ~f_inverse:sort + ;; + end + + type t = Deduped_and_sorted_int_list.t * Deduped_and_sorted_int_list.t + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (xs, ys) -> + [%test_result: int list] + (Sequence.to_list + (merge (Sequence.of_list xs) (Sequence.of_list ys) ~compare:Int.compare)) + ~expect:(normalize_list (xs @ ys) ~compare:Int.compare)) + ;; + + let%test_unit "merge_deduped_and_sorted" = + test_merge_semantics + ~merge:Sequence.merge_deduped_and_sorted + ~normalize_list:List.dedup_and_sort + ;; + + let%test_unit "merge_sorted" = + test_merge_semantics ~merge:Sequence.merge_sorted ~normalize_list:List.sort + ;; + end) +;; + +let%test _ = fold ~f:( + ) ~init:0 (of_list [ 1; 2; 3; 4; 5 ]) = 15 +let%test _ = fold ~f:( + ) ~init:0 (of_list []) = 0 + +let%test_unit _ = + let test_equal l = [%test_result: int list] (to_list (of_list l)) ~expect:l in + test_equal []; + test_equal [ 1; 2; 3; 4; 5 ] +;; + +(* The test for longer list is after range *) + +let%test_unit _ = [%test_result: int list] (to_list (range 0 5)) ~expect:[ 0; 1; 2; 3; 4 ] + +let%test_unit _ = + [%test_result: int list] + (to_list (range ~stop:`inclusive 0 5)) + ~expect:[ 0; 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (range ~start:`exclusive 0 5)) ~expect:[ 1; 2; 3; 4 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (range ~stride:(-2) 5 1)) ~expect:[ 5; 3 ] +;; + +(* Test for to_list *) +let%test_unit _ = + [%test_result: int list] (to_list (range 0 5000)) ~expect:(List.range 0 5000) +;; + +(* Functions used for testing by comparing to List implementation*) +let test_to_list s f g = [%test_result: int list] (to_list (f s)) ~expect:(g (to_list s)) + +(* For testing, we create a sequence which is equal to 1;2;3;4;5, but + with a more interesting structure inside*) + +let s12345 = + map + ~f:(fun x -> x / 2) + (filter ~f:(fun x -> x % 2 = 0) (of_list [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ])) +;; + +let sempty = filter ~f:(fun x -> x < 0) (of_list [ 1; 2; 3; 4 ]) + +let test f g = + test_to_list s12345 f g; + test_to_list sempty f g +;; + +let%test_unit _ = + [%test_result: int list] (to_list s12345) ~expect:[ 1; 2; 3; 4; 5 ]; + [%test_result: int list] (to_list sempty) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list + (unfold_with s12345 ~init:1 ~f:(fun s _ -> + if s % 2 = 0 + then Skip { state = s + 1 } + else if s = 5 + then Done + else Yield { value = s; state = s + 1 }))) + ~expect:[ 1; 3 ] +;; + +let test_delay init = + unfold_with_and_finish + ~init + ~running_step:(fun prev next -> Yield { value = prev; state = next }) + ~inner_finished:(fun x -> Some x) + ~finishing_step:(fun prev -> + match prev with + | None -> Done + | Some prev -> Yield { value = prev; state = None }) +;; + +let%test_unit _ = + [%test_result: int list] (to_list (test_delay 0 s12345)) ~expect:[ 0; 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = [%test_result: int list] (to_list (test_delay 0 sempty)) ~expect:[ 0 ] +let%test_unit _ = [%test_result: int list] (to_list s12345) ~expect:[ 1; 2; 3; 4; 5 ] +let%test_unit _ = test (map ~f:(fun i -> -i)) (List.map ~f:(fun i -> -i)) + +let%test_unit _ = + test (mapi ~f:(fun i j -> j - (2 * i))) (List.mapi ~f:(fun i j -> j - (2 * i))) +;; + +let%test_unit _ = + test (filter ~f:(fun i -> i % 2 = 0)) (List.filter ~f:(fun i -> i % 2 = 0)) +;; + +let%test _ = length s12345 = 5 && length sempty = 0 + +let%test_unit _ = + [%test_result: int option] (find s12345 ~f:(fun x -> x = 3)) ~expect:(Some 3); + [%test_result: int option] (find s12345 ~f:(fun x -> x = 7)) ~expect:None +;; + +let%test_unit _ = + [%test_result: string option] + (find_map s12345 ~f:(fun x -> if x = 3 then Some "a" else None)) + ~expect:(Some "a"); + [%test_result: string option] + (find_map s12345 ~f:(fun x -> if x = 7 then Some "a" else None)) + ~expect:None +;; + +let%test_unit _ = + [%test_result: string option] + (find_mapi s12345 ~f:(fun _ x -> if x = 3 then Some "a" else None)) + ~expect:(Some "a") +;; + +let%test_unit _ = + [%test_result: string option] + (find_mapi s12345 ~f:(fun _ x -> if x = 7 then Some "a" else None)) + ~expect:None +;; + +let%test_unit _ = + [%test_result: (int * int) option] + (find_mapi s12345 ~f:(fun i x -> if i + x >= 6 then Some (i, x) else None)) + ~expect:(Some (3, 4)) +;; + +let%test _ = for_all sempty ~f:(fun _ -> false) +let%test _ = for_all s12345 ~f:(fun x -> x > 0) +let%test _ = not (for_all s12345 ~f:(fun x -> x < 5)) +let%test _ = for_alli sempty ~f:(fun _ _ -> false) +let%test _ = for_alli s12345 ~f:(fun _ x -> x > 0) +let%test _ = not (for_alli s12345 ~f:(fun _ x -> x < 5)) +let%test _ = for_alli s12345 ~f:(fun i x -> x = i + 1) +let%test _ = not (exists sempty ~f:(fun _ -> assert false)) +let%test _ = exists s12345 ~f:(fun x -> x = 5) +let%test _ = not (exists s12345 ~f:(fun x -> x = 0)) +let%test _ = not (existsi sempty ~f:(fun _ _ -> assert false)) +let%test _ = existsi s12345 ~f:(fun _ x -> x = 5) +let%test _ = not (existsi s12345 ~f:(fun _ x -> x = 0)) +let%test _ = not (existsi s12345 ~f:(fun i x -> x <> i + 1)) + +let%test_unit _ = + let l = ref [] in + iter s12345 ~f:(fun x -> l := x :: !l); + [%test_result: int list] !l ~expect:[ 5; 4; 3; 2; 1 ] +;; + +let%test _ = is_empty sempty +let%test _ = not (is_empty (of_list [ 1 ])) +let%test _ = mem s12345 1 ~equal:Int.equal +let%test _ = not (mem s12345 6 ~equal:Int.equal) +let%test_unit _ = [%test_result: int list] (to_list empty) ~expect:[] + +let%test_unit _ = + [%test_result: int list] (to_list (bind sempty ~f:(fun _ -> s12345))) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (bind s12345 ~f:(fun _ -> sempty))) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (bind s12345 ~f:(fun x -> of_list [ x; -x ]))) + ~expect:[ 1; -1; 2; -2; 3; -3; 4; -4; 5; -5 ] +;; + +let%test_unit _ = [%test_result: int list] (to_list (return 1)) ~expect:[ 1 ] +let%test_unit _ = [%test_result: int option] (nth s12345 3) ~expect:(Some 4) +let%test_unit _ = [%test_result: int option] (nth s12345 5) ~expect:None +let%test_unit _ = [%test_result: int option] (hd s12345) ~expect:(Some 1) +let%test_unit _ = [%test_result: int option] (hd sempty) ~expect:None +let%test_unit _ = [%test_result: int t option] (tl sempty) ~expect:None + +let%test_unit _ = + match tl s12345 with + | Some l -> [%test_result: int list] (to_list l) ~expect:[ 2; 3; 4; 5 ] + | None -> failwith "expected Some" +;; + +let%test_unit _ = [%test_result: (int * int t) option] (next sempty) ~expect:None + +let%test_unit _ = + match next s12345 with + | Some (hd, tl) -> + [%test_result: int] hd ~expect:1; + [%test_result: int list] (to_list tl) ~expect:[ 2; 3; 4; 5 ] + | None -> failwith "expected Some" +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (filter_opt (of_list [ None; Some 1; None; Some 2; Some 3 ]))) + ~expect:[ 1; 2; 3 ] +;; + +let%test_unit _ = + let l, r = split_n s12345 2 in + [%test_result: int list] l ~expect:[ 1; 2 ]; + [%test_result: int list] (to_list r) ~expect:[ 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: int list list] + (to_list (chunks_exn s12345 2)) + ~expect:[ [ 1; 2 ]; [ 3; 4 ]; [ 5 ] ] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (append s12345 s12345)) + ~expect:[ 1; 2; 3; 4; 5; 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (append sempty s12345)) ~expect:[ 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: (int * int) list] (to_list (zip s12345 sempty)) ~expect:[] +;; + +let%test_unit _ = + [%test_result: (int * int) list] + (to_list (zip s12345 (of_list [ 6; 5; 4; 3; 2; 1 ]))) + ~expect:[ 1, 6; 2, 5; 3, 4; 4, 3; 5, 2 ] +;; + +let%test_unit _ = + [%test_result: (int * string) list] + (to_list (zip s12345 (of_list [ "a" ]))) + ~expect:[ 1, "a" ] +;; + +let%test_unit _ = + [%test_result: (int * int) option] + (find_consecutive_duplicate s12345 ~equal:( = )) + ~expect:None +;; + +let%test_unit _ = + [%test_result: (int * int) option] + (find_consecutive_duplicate (of_list [ 1; 2; 2; 3; 4; 4; 5 ]) ~equal:( = )) + ~expect:(Some (2, 2)) +;; + +let%test_unit _ = + [%test_result: int list] + (to_list + (remove_consecutive_duplicates + ~equal:( = ) + (of_list [ 1; 2; 2; 3; 3; 3; 3; 4; 4; 5; 6; 6; 7 ]))) + ~expect:[ 1; 2; 3; 4; 5; 6; 7 ] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (remove_consecutive_duplicates ~equal:( = ) s12345)) + ~expect:[ 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (remove_consecutive_duplicates ~equal:(fun _ _ -> true) s12345)) + ~expect:[ 1 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (init (-1) ~f:(fun _ -> assert false))) ~expect:[] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (init 5 ~f:Fn.id)) ~expect:[ 0; 1; 2; 3; 4 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (sub s12345 ~pos:4 ~len:10)) ~expect:[ 5 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (sub s12345 ~pos:1 ~len:2)) ~expect:[ 2; 3 ] +;; + +let%test_unit _ = [%test_result: int list] (to_list (sub s12345 ~pos:0 ~len:0)) ~expect:[] +let%test_unit _ = [%test_result: int list] (to_list (take s12345 2)) ~expect:[ 1; 2 ] +let%test_unit _ = [%test_result: int list] (to_list (take s12345 0)) ~expect:[] + +let%test_unit _ = + [%test_result: int list] (to_list (take s12345 9)) ~expect:[ 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = [%test_result: int list] (to_list (drop s12345 2)) ~expect:[ 3; 4; 5 ] + +let%test_unit _ = + [%test_result: int list] (to_list (drop s12345 0)) ~expect:[ 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = [%test_result: int list] (to_list (drop s12345 9)) ~expect:[] + +let%test_unit _ = + [%test_result: int list] + (to_list (take_while ~f:(fun x -> x < 3) s12345)) + ~expect:[ 1; 2 ] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (drop_while ~f:(fun x -> x < 3) s12345)) + ~expect:[ 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (shift_right (shift_right s12345 0) (-1))) + ~expect:[ -1; 0; 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: char list] (to_list (intersperse ~sep:'a' (of_list []))) ~expect:[] +;; + +let%test_unit _ = + [%test_result: char list] + (to_list (intersperse ~sep:'a' (of_list [ 'b' ]))) + ~expect:[ 'b' ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (intersperse ~sep:(-1) (take s12345 1))) ~expect:[ 1 ] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (intersperse ~sep:0 s12345)) + ~expect:[ 1; 0; 2; 0; 3; 0; 4; 0; 5 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (take (repeat 1) 3)) ~expect:[ 1; 1; 1 ] +;; + +let%test_unit _ = + [%test_result: int list] + (to_list (take (cycle_list_exn [ 1; 2; 3; 4; 5 ]) 7)) + ~expect:[ 1; 2; 3; 4; 5; 1; 2 ] +;; + +let%expect_test _ = + require_does_raise [%here] (fun () -> cycle_list_exn []); + [%expect {| (Invalid_argument Sequence.cycle_list_exn) |}] +;; + +let%test_unit _ = + [%test_result: (char * int) list] + (to_list (cartesian_product (of_list [ 'a'; 'b' ]) s12345)) + ~expect: + [ 'a', 1; 'a', 2; 'a', 3; 'a', 4; 'a', 5; 'b', 1; 'b', 2; 'b', 3; 'b', 4; 'b', 5 ] +;; + +let%test_unit _ = + [%test_result: float] + (delayed_fold + s12345 + ~init:0.0 + ~f:(fun a i ~k -> if Float.( <= ) a 5.0 then k (a +. Float.of_int i) else a) + ~finish:(fun _ -> assert false)) + ~expect:6.0 +;; + +let%expect_test "fold_m" = + let module Simple_monad = struct + type 'a t = + | Return of 'a + | Step of 'a t + [@@deriving sexp_of] + + let return a = Return a + + let rec bind t ~f = + match t with + | Return a -> f a + | Step t -> Step (bind t ~f) + ;; + + let step = Step (Return ()) + end + in + fold_m + ~bind:Simple_monad.bind + ~return:Simple_monad.return + s12345 + ~init:[] + ~f:(fun acc n -> + Simple_monad.bind Simple_monad.step ~f:(fun () -> Simple_monad.return (n :: acc))) + |> printf !"%{sexp: int list Simple_monad.t}\n"; + [%expect {| (Step (Step (Step (Step (Step (Return (5 4 3 2 1))))))) |}] +;; + +let%expect_test "iter_m" = + iter_m ~bind:Generator.bind ~return:Generator.return s12345 ~f:Generator.yield + |> Generator.run + |> printf !"%{sexp: int t}\n"; + [%expect {| (1 2 3 4 5) |}] +;; + +let%test _ = + let num_computations = ref 0 in + let t = + memoize + (unfold ~init:() ~f:(fun () -> + Int.incr num_computations; + None)) + in + iter t ~f:Fn.id; + iter t ~f:Fn.id; + !num_computations = 1 +;; + +let%test_unit _ = + [%test_result: int list] (to_list (drop_eagerly s12345 0)) ~expect:[ 1; 2; 3; 4; 5 ] +;; + +let%test_unit _ = + [%test_result: int list] (to_list (drop_eagerly s12345 2)) ~expect:[ 3; 4; 5 ] +;; + +let%test_unit _ = [%test_result: int list] (to_list (drop_eagerly s12345 5)) ~expect:[] +let%test_unit _ = [%test_result: int list] (to_list (drop_eagerly s12345 8)) ~expect:[] + +let compare_tests = + [ [ 1; 2; 3 ], [ 1; 2; 3 ], 0 + ; [ 1; 2; 3 ], [], 1 + ; [], [ 1; 2; 3 ], -1 + ; [ 1; 2 ], [ 1; 2; 3 ], -1 + ; [ 1; 2; 3 ], [ 1; 2 ], 1 + ; [ 1; 3; 2 ], [ 1; 2; 3 ], 1 + ; [ 1; 2; 3 ], [ 1; 3; 2 ], -1 + ] +;; + +(* this test has to use base OCaml library functions to avoid circular dependencies *) +let%test _ = + List.for_all + ~f:Fn.id + (List.map + ~f:(fun (l1, l2, expected_res) -> + compare Int.compare (of_list l1) (of_list l2) = expected_res) + compare_tests) +;; + +let%expect_test "[equal]" = + let equal l1 l2 = + let t1 = of_list l1 in + let t2 = of_list l2 in + let b = equal Int.equal t1 t2 in + print_s [%sexp (b : bool)]; + require [%here] (Bool.equal b (equal Int.equal t2 t1)) + in + equal [] []; + [%expect {| true |}]; + equal [] [ 1 ]; + [%expect {| false |}]; + equal [ 1 ] [ 1 ]; + [%expect {| true |}]; + equal [ 1 ] [ 1; 2 ]; + [%expect {| false |}] +;; + +let%test_unit "[equal] randomised test" = + let with_gen ?examples gen = + Base_quickcheck.Test.run_exn + ?examples + (module struct + type t = int list * int list [@@deriving quickcheck, sexp_of] + + let quickcheck_generator = gen + end) + ~f:(fun (left, right) -> + [%test_result: bool] + ~expect:(List.equal Int.equal left right) + (Comparable.lift (Sequence.equal Int.equal) ~f:Sequence.of_list left right)) + in + let list_gen = [%generator: int list] in + (* certainly equal. *) + with_gen + ~examples: + (List.map ~f:(fun x -> x, x) [ []; [ 1 ]; [ Int.max_value ]; [ 5; 4; 3; 2; 1 ] ]) + (Base_quickcheck.Generator.map list_gen ~f:(fun x -> x, x)); + (* Probably not equal. *) + with_gen + ~examples:[ [], []; [], [ 1 ]; [ 1 ], []; [ Int.min_value ], [ Int.max_value ] ] + (Base_quickcheck.Generator.both list_gen list_gen) +;; + +let%test_unit _ = + [%test_result: int list] + (folding_map + (of_list [ 1; 2; 3; 4 ]) + ~init:0 + ~f:(fun acc x -> + let y = acc + x in + y, y) + |> to_list) + ~expect:[ 1; 3; 6; 10 ] +;; + +let%test_unit _ = + [%test_result: bool] + (folding_map empty ~init:0 ~f:(fun acc x -> + let y = acc + x in + y, y) + |> is_empty) + ~expect:true +;; + +let%test_unit _ = + [%test_result: int list] + (folding_mapi + (of_list [ 1; 2; 3; 4 ]) + ~init:0 + ~f:(fun i acc x -> + let y = acc + (i * x) in + y, y) + |> to_list) + ~expect:[ 0; 2; 8; 20 ] +;; + +let%test_unit _ = + [%test_result: bool] + (folding_mapi empty ~init:0 ~f:(fun i acc x -> + let y = acc + (i * x) in + y, y) + |> is_empty) + ~expect:true +;; + +let%expect_test "findi" = + Base_quickcheck.Test.run_exn + (module struct + type t = int option list * (int -> int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (option_list, f) -> + let sequence = option_list |> of_list |> filter_opt in + [%test_result: (int * int) option] + (findi sequence ~f) + ~expect:(List.findi (to_list sequence) ~f)); + [%expect {| |}] +;; + +let%expect_test _ = + let xs = init 3 ~f:Fn.id |> Generator.of_sequence in + let ( @ ) xs ys = Generator.bind xs ~f:(fun () -> ys) in + xs @ xs @ xs @ xs @ xs |> Generator.run |> [%sexp_of: int t] |> print_s; + [%expect {| (0 1 2 0 1 2 0 1 2 0 1 2 0 1 2) |}] +;; + +let%test_module "group" = + (module struct + let%test _ = + of_list [ 1; 2; 3; 4 ] + |> group ~break:(fun _ x -> Int.equal x 3) + |> [%compare.equal: int list t] (of_list [ [ 1; 2 ]; [ 3; 4 ] ]) + ;; + + let%test _ = + group empty ~break:(fun _ -> assert false) |> [%compare.equal: unit list t] empty + ;; + + let mis = of_list [ 'M'; 'i'; 's'; 's'; 'i'; 's'; 's'; 'i'; 'p'; 'p'; 'i' ] + + let equal_letters = + of_list + [ [ 'M' ] + ; [ 'i' ] + ; [ 's'; 's' ] + ; [ 'i' ] + ; [ 's'; 's' ] + ; [ 'i' ] + ; [ 'p'; 'p' ] + ; [ 'i' ] + ] + ;; + + let single_letters = + of_list [ [ 'M'; 'i'; 's'; 's'; 'i'; 's'; 's'; 'i'; 'p'; 'p'; 'i' ] ] + ;; + + let%test _ = + group ~break:Char.( <> ) mis |> [%compare.equal: char list t] equal_letters + ;; + + let%test _ = + group ~break:(fun _ _ -> false) mis |> [%compare.equal: char list t] single_letters + ;; + end) +;; + +let%test_module "Caml.Seq" = + (module struct + let list = [ 1; 2; 3; 4 ] + + let%expect_test "of_seq" = + list |> Stdlib.List.to_seq |> Sequence.of_seq |> Sequence.iter ~f:(printf "%d\n"); + [%expect {| + 1 + 2 + 3 + 4 + |}] + ;; + + let%expect_test "to_seq" = + list |> Sequence.of_list |> Sequence.to_seq |> Stdlib.Seq.iter (printf "%d\n"); + [%expect {| + 1 + 2 + 3 + 4 + |}] + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_sequence.mli b/unikernel/duniverse/base/test/test_sequence.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_sequence.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_set.ml b/unikernel/duniverse/base/test/test_set.ml new file mode 100644 index 00000000..4cfd70dc --- /dev/null +++ b/unikernel/duniverse/base/test/test_set.ml @@ -0,0 +1,89 @@ +open! Import +open! Set + +type int_set = Set.M(Int).t [@@deriving compare, equal, hash, sexp] + +let%test _ = invariants (of_increasing_iterator_unchecked (module Int) ~len:20 ~f:Fn.id) +let%test _ = invariants (Poly.of_increasing_iterator_unchecked ~len:20 ~f:Fn.id) +let of_list = of_list (module Int) + +let%expect_test "split_le_gt" = + for len = 1 to 4 do + print_endline ""; + for key = 0 to len + 1 do + let le, gt = split_le_gt (of_list (List.init len ~f:Int.succ)) key in + Core.print_s [%sexp (le : int_set), "<=", (key : int), "<", (gt : int_set)] + done + done; + [%expect + {| + (() <= 0 < (1)) + ((1) <= 1 < ()) + ((1) <= 2 < ()) + + (() <= 0 < (1 2)) + ((1) <= 1 < (2)) + ((1 2) <= 2 < ()) + ((1 2) <= 3 < ()) + + (() <= 0 < (1 2 3)) + ((1) <= 1 < (2 3)) + ((1 2) <= 2 < (3)) + ((1 2 3) <= 3 < ()) + ((1 2 3) <= 4 < ()) + + (() <= 0 < (1 2 3 4)) + ((1) <= 1 < (2 3 4)) + ((1 2) <= 2 < (3 4)) + ((1 2 3) <= 3 < (4)) + ((1 2 3 4) <= 4 < ()) + ((1 2 3 4) <= 5 < ()) + |}] +;; + +let%expect_test "split_lt_ge" = + for len = 1 to 4 do + print_endline ""; + for key = 0 to len + 1 do + let lt, ge = split_lt_ge (of_list (List.init len ~f:Int.succ)) key in + Core.print_s [%sexp (lt : int_set), "<", (key : int), "<=", (ge : int_set)] + done + done; + [%expect + {| + (() < 0 <= (1)) + (() < 1 <= (1)) + ((1) < 2 <= ()) + + (() < 0 <= (1 2)) + (() < 1 <= (1 2)) + ((1) < 2 <= (2)) + ((1 2) < 3 <= ()) + + (() < 0 <= (1 2 3)) + (() < 1 <= (1 2 3)) + ((1) < 2 <= (2 3)) + ((1 2) < 3 <= (3)) + ((1 2 3) < 4 <= ()) + + (() < 0 <= (1 2 3 4)) + (() < 1 <= (1 2 3 4)) + ((1) < 2 <= (2 3 4)) + ((1 2) < 3 <= (3 4)) + ((1 2 3) < 4 <= (4)) + ((1 2 3 4) < 5 <= ()) + |}] +;; + +let%test_module "Poly" = + (module struct + let%test _ = length Poly.empty = 0 + let%test _ = Poly.equal (Poly.of_list []) Poly.empty + + let%test _ = + let a = Poly.of_list [ 1; 1 ] in + let b = Poly.of_list [ "a" ] in + length a = length b + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_set.mli b/unikernel/duniverse/base/test/test_set.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_set.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_set_interface.ml b/unikernel/duniverse/base/test/test_set_interface.ml new file mode 100644 index 00000000..81d7d059 --- /dev/null +++ b/unikernel/duniverse/base/test/test_set_interface.ml @@ -0,0 +1,21 @@ +open! Base + +(* Typechecking this code is a compile-time check that the specific interfaces have not + drifted apart from each other. *) + +module _ : sig + open Set + + type ('a, 'b) t + + include + Creators_and_accessors_generic + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_first_class_module.t + with type ('a, 'b) set := ('a, 'b) t + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) Set.Using_comparator.Tree.t + with type 'a elt := 'a + with type 'c cmp := 'c +end = + Set diff --git a/unikernel/duniverse/base/test/test_set_interface.mli b/unikernel/duniverse/base/test/test_set_interface.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_set_interface.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_sexpable.ml b/unikernel/duniverse/base/test/test_sexpable.ml new file mode 100644 index 00000000..c3a80ab7 --- /dev/null +++ b/unikernel/duniverse/base/test/test_sexpable.ml @@ -0,0 +1,34 @@ +open! Import +open Sexpable + +let%test_module "Of_stringable" = + (module struct + module Doubled_string = struct + (* Example module with a partial [of_string] function *) + + type t = Double of string [@@deriving quickcheck] + + include Of_stringable (struct + type nonrec t = t + + let to_string (Double x) = x ^ x + + let of_string x = + let length = String.length x in + let first_half = String.drop_suffix x (length / 2) in + let second_half = String.drop_suffix x (length / 2) in + if length % 2 = 0 && String.(first_half = second_half) + then Double first_half + else failwith [%string "Invalid doubled string %{x}"] + ;; + end) + end + + let%expect_test "validate sexp grammar" = + require_ok + [%here] + (Sexp_grammar_validation.validate_grammar (module Doubled_string)); + [%expect {| String |}] + ;; + end) +;; diff --git a/unikernel/duniverse/base/test/test_sexpable.mli b/unikernel/duniverse/base/test/test_sexpable.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_sexpable.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_sign.ml b/unikernel/duniverse/base/test/test_sign.ml new file mode 100644 index 00000000..d00bd2dc --- /dev/null +++ b/unikernel/duniverse/base/test/test_sign.ml @@ -0,0 +1,15 @@ +open! Import +open! Sign + +let%test "of_int" = of_int 37 = Pos && of_int (-22) = Neg && of_int 0 = Zero + +let%test_unit "( * )" = + List.cartesian_product all all + |> List.iter ~f:(fun (s1, s2) -> + [%test_result: int] (to_int (s1 * s2)) ~expect:(Int.( * ) (to_int s1) (to_int s2))) +;; + +let%expect_test ("hash coherence" [@tags "64-bits-only"]) = + check_hash_coherence [%here] (module Sign) all; + [%expect {| |}] +;; diff --git a/unikernel/duniverse/base/test/test_sign.mli b/unikernel/duniverse/base/test/test_sign.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_sign.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_sign_or_nan.ml b/unikernel/duniverse/base/test/test_sign_or_nan.ml new file mode 100644 index 00000000..18549fb2 --- /dev/null +++ b/unikernel/duniverse/base/test/test_sign_or_nan.ml @@ -0,0 +1,24 @@ +open! Import +open! Sign_or_nan + +let%test "of_int" = of_int 37 = Pos && of_int (-22) = Neg && of_int 0 = Zero + +let%expect_test ("hash coherence" [@tags "64-bits-only"]) = + check_hash_coherence [%here] (module Sign_or_nan) all; + [%expect {| |}] +;; + +let%expect_test "to_string_hum" = + List.iter all ~f:(fun t -> + let string = to_string_hum t in + print_endline string; + match to_sign_exn t with + | exception _ -> () + | sign -> require_equal [%here] (module String) string (Sign.to_string_hum sign)); + [%expect {| + negative + zero + positive + not-a-number + |}] +;; diff --git a/unikernel/duniverse/base/test/test_sign_or_nan.mli b/unikernel/duniverse/base/test/test_sign_or_nan.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_sign_or_nan.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_source_code_position.ml b/unikernel/duniverse/base/test/test_source_code_position.ml new file mode 100644 index 00000000..8adbeebf --- /dev/null +++ b/unikernel/duniverse/base/test/test_source_code_position.ml @@ -0,0 +1,13 @@ +open! Base +open! Import + +let%expect_test "[%here]" = + print_s [%sexp [%here]]; + [%expect {| lib/base/test/test_source_code_position.ml:5:17 |}] +;; + +let%expect_test "of_pos __POS__" = + let here = Source_code_position.of_pos Stdlib.__POS__ in + print_s [%sexp (here : Source_code_position.t)]; + [%expect {| test_source_code_position.ml:10:41 |}] +;; diff --git a/unikernel/duniverse/base/test/test_source_code_position.mli b/unikernel/duniverse/base/test/test_source_code_position.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_source_code_position.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_stdlib_shadowing.mlt b/unikernel/duniverse/base/test/test_stdlib_shadowing.mlt new file mode 100644 index 00000000..47a893fe --- /dev/null +++ b/unikernel/duniverse/base/test/test_stdlib_shadowing.mlt @@ -0,0 +1,50 @@ +(* Additional shadowing tests, to make sure the [@@deprecated] attributes are properly + transported in [Base] *) +open Base + +let () = seek_in stdin 0 + +[%%expect + {| +Line _, characters _-_: +Error (alert deprecated): Base.seek_in +[2016-09] this element comes from the stdlib distributed with OCaml. +Use [Stdio.In_channel.seek] instead. + +Line _, characters _-_: +Error (alert deprecated): Base.stdin +[2016-09] this element comes from the stdlib distributed with OCaml. +Use [Stdio.stdin] instead. +|}] + +let (_ : _) = StringLabels.make 10 'x' + +[%%expect + {| +Line _, characters _-_: +Error (alert deprecated): module Base.StringLabels +[2016-09] this element comes from the stdlib distributed with OCaml. +Referring to the stdlib directly is discouraged by Base. You should either +use the equivalent functionality offered by Base, or if you really want to +refer to the stdlib, use Stdlib.StringLabels instead +|}] + +let _ = ( == ) + +[%%expect + {| +Line _, characters _-_: +Error (alert deprecated): Base.== +[2016-09] this element comes from the stdlib distributed with OCaml. +Use [phys_equal] instead. +|}] + +let _ = ( != ) + +[%%expect + {| +Line _, characters _-_: +Error (alert deprecated): Base.!= +[2016-09] this element comes from the stdlib distributed with OCaml. +Use [not (phys_equal ...)] instead. +|}] diff --git a/unikernel/duniverse/base/test/test_string.ml b/unikernel/duniverse/base/test/test_string.ml new file mode 100644 index 00000000..8b59bb12 --- /dev/null +++ b/unikernel/duniverse/base/test/test_string.ml @@ -0,0 +1,1956 @@ +open! Import +open! String + +let%expect_test ("hash coherence" [@tags "64-bits-only"]) = + check_hash_coherence [%here] (module String) [ ""; "a"; "foo" ]; + [%expect {| |}] +;; + +let%expect_test "edit distance" = + let strings = [ "catch"; "patch"; "pitch"; "pith"; "pits"; "spits"; "spots" ] in + List.iteri strings ~f:(fun i a -> + List.iteri strings ~f:(fun j b -> + if Int.( >= ) i j + then ( + let d = edit_distance a b in + print_s [%sexp (d : int), (a : string), (b : string)]; + if a = b && Int.( <> ) d 0 then print_cr [%here] [%message "non-zero"]; + let d' = edit_distance b a in + if Int.( <> ) d d' + then print_cr [%here] [%message "non-symmetric" ~_:(d : int) ~_:(d' : int)]))); + [%expect + {| + (0 catch catch) + (1 patch catch) + (0 patch patch) + (2 pitch catch) + (1 pitch patch) + (0 pitch pitch) + (3 pith catch) + (2 pith patch) + (1 pith pitch) + (0 pith pith) + (4 pits catch) + (3 pits patch) + (2 pits pitch) + (1 pits pith) + (0 pits pits) + (5 spits catch) + (4 spits patch) + (3 spits pitch) + (2 spits pith) + (1 spits pits) + (0 spits spits) + (5 spots catch) + (4 spots patch) + (4 spots pitch) + (3 spots pith) + (2 spots pits) + (1 spots spits) + (0 spots spots) + |}] +;; + +let%test_module "concat" = + (module struct + let test ?sep list = + let from_list = concat ?sep list in + let from_array = concat_array ?sep (Array.of_list list) in + require_equal [%here] (module String) from_list from_array; + print_s [%sexp (from_list : string)] + ;; + + let%expect_test "empty" = + test [] ~sep:":"; + [%expect {| "" |}] + ;; + + let%expect_test "singleton" = + test [ "a" ]; + [%expect {| a |}] + ;; + + let%expect_test "empty separator" = + test [ "a"; "b" ]; + [%expect {| ab |}] + ;; + + let%expect_test "non-empty separator" = + test [ "a"; "b" ] ~sep:":"; + [%expect {| a:b |}] + ;; + end) +;; + +let%expect_test "to_list and to_list_rev" = + let test s = + let list = to_list s in + require_equal + [%here] + (module struct + type t = char list [@@deriving equal, sexp_of] + end) + (to_list_rev s) + (List.rev list); + print_s [%sexp (list : char list)] + in + test ""; + [%expect {| () |}]; + test "bladderwrack"; + [%expect {| (b l a d d e r w r a c k) |}] +;; + +let%expect_test "[of_sequence] and [to_sequence]" = + let test t = + let seq = to_sequence t in + print_s [%sexp (seq : char Sequence.t)]; + require_equal [%here] (module String) (of_sequence seq) t; + require_equal + [%here] + (module struct + type t = char Sequence.t [@@deriving equal, sexp_of] + end) + seq + (Sequence.of_list (to_list t)) + in + test ""; + [%expect {| () |}]; + test "a"; + [%expect {| (a) |}]; + test "ab"; + [%expect {| (a b) |}]; + test "abc"; + [%expect {| (a b c) |}]; + test "lorem ipsum dolor sit amet"; + [%expect {| (l o r e m " " i p s u m " " d o l o r " " s i t " " a m e t) |}] +;; + +let%expect_test "sub/unsafe_sub" = + let test ~pos ~len = + let string = "0123456789" in + match Or_error.try_with (fun () -> sub string ~pos ~len) with + | Ok safe_substring -> + let unsafe_substring = unsafe_sub string ~pos ~len in + require_equal [%here] (module String) safe_substring unsafe_substring; + print_s [%sexp (safe_substring : t)] + | Error e -> print_s [%sexp (e : Error.t)] + in + test ~pos:0 ~len:0; + [%expect {| "" |}]; + test ~pos:0 ~len:5; + [%expect {| 01234 |}]; + test ~pos:0 ~len:10; + [%expect {| 0123456789 |}]; + test ~pos:0 ~len:11; + [%expect {| (Invalid_argument "pos + len past end: 0 + 11 > 10") |}]; + test ~pos:1 ~len:5; + [%expect {| 12345 |}]; + test ~pos:1 ~len:10; + [%expect {| (Invalid_argument "pos + len past end: 1 + 10 > 10") |}]; + test ~pos:9 ~len:1; + [%expect {| 9 |}]; + test ~pos:9 ~len:2; + [%expect {| (Invalid_argument "pos + len past end: 9 + 2 > 10") |}]; + test ~pos:10 ~len:0; + [%expect {| "" |}]; + test ~pos:10 ~len:1; + [%expect {| (Invalid_argument "pos + len past end: 10 + 1 > 10") |}] +;; + +let%test_module "Unicode" = + (module struct + let encodings : (module Utf) list = + [ (module Utf8) + ; (module Utf16le) + ; (module Utf16be) + ; (module Utf32le) + ; (module Utf32be) + ] + ;; + + let test_validity (module Utf : Utf) string ~expect = + let actual = (Utf.is_valid string : bool) in + match actual, expect with + | true, true | false, false -> () + | true, false -> print_cr [%here] [%message "expected valid result, got invalid"] + | false, true -> print_cr [%here] [%message "expected invalid result, got valid"] + ;; + + let%expect_test "valid" = + let test_validity = test_validity ~expect:true in + (* Valid UTF-8 encoding for ASCII 'a' *) + test_validity (module Utf8) "\x61"; + [%expect {| |}]; + (* Valid UTF-16LE encoding for ASCII 'a' *) + test_validity (module Utf16le) "\x61\x00"; + [%expect {| |}]; + (* Valid UTF-16BE encoding for ASCII 'a' *) + test_validity (module Utf16be) "\x00\x61"; + [%expect {| |}]; + (* Valid UTF-32LE encoding for ASCII 'a' *) + test_validity (module Utf32le) "\x61\x00\x00\x00"; + [%expect {| |}]; + (* Valid UTF-32BE encoding for ASCII 'a' *) + test_validity (module Utf32be) "\x00\x00\x00\x61"; + [%expect {| |}]; + (* Valid UTF-8 encoding for 'aö' *) + test_validity (module Utf8) "\x61\xc3\xb6"; + [%expect {| |}]; + (* Valid UTF-16LE encoding for 'aö' *) + test_validity (module Utf16le) "\x61\x00\xf6\x00"; + [%expect {| |}]; + (* Valid UTF-16BE encoding for 'aö' *) + test_validity (module Utf16be) "\x00\x61\x00\xf6"; + [%expect {| |}]; + (* Valid UTF-32LE encoding for 'aö' *) + test_validity (module Utf32le) "\x61\x00\x00\x00\xf6\x00\x00\x00"; + [%expect {| |}]; + (* Valid UTF-32BE encoding for 'aö' *) + test_validity (module Utf32be) "\x00\x00\x00\x61\x00\x00\x00\xf6"; + [%expect {| |}]; + (* Valid UTF-16LE encoding for '𝕬' *) + test_validity (module Utf16le) "\x35\xd8\x6c\xdd"; + [%expect {| |}]; + (* Valid UTF-16LE encoding for '𝕬' *) + test_validity (module Utf16be) "\xd8\x35\xdd\x6c"; + [%expect {| |}] + ;; + + let%expect_test "invalid" = + let test_validity = test_validity ~expect:false in + (* Invalid UTF-8: Premature end-of-string after start of 2-byte sequence *) + test_validity (module Utf8) "\x61\xc3"; + [%expect {| |}]; + (* Invalid UTF-8: second byte does not start with bits '10' *) + test_validity (module Utf8) "\xc3\x28"; + [%expect {| |}]; + (* Invalid UTF-8: surrogate pair encoded in UTF-8 *) + test_validity (module Utf8) "\xed\xa0\x80"; + [%expect {| |}]; + (* Invalid UTF-8: ASCII character "/" (U+002F) is encoded in an overlong form *) + test_validity (module Utf8) "\xc0\xaf"; + [%expect {| |}]; + (* Invalid UTF-8: The encoded value is outside the Unicode code point range *) + test_validity (module Utf8) "\xc0\x28"; + [%expect {| |}]; + (* Invalid UTF-16LE: Single byte is not a complete UTF-16 character *) + test_validity (module Utf16le) "\x61"; + [%expect {| |}]; + (* Invalid UTF-16BE: Single byte is not a complete UTF-16 character *) + test_validity (module Utf16be) "\x61"; + [%expect {| |}]; + (* Invalid UTF-32LE: Only 3 bytes is not a complete UTF-32 character *) + test_validity (module Utf32le) "\x61\x00\x00"; + [%expect {| |}]; + (* Invalid UTF-32BE: Only 3 bytes is not a complete UTF-32 character *) + test_validity (module Utf32be) "\x61\x00\x00"; + [%expect {| |}]; + (* Invalid UTF-16LE: high surrogate not followed by low surrogate *) + test_validity (module Utf16le) "\x00\xd8\x00\x00"; + [%expect {| |}]; + (* Invalid UTF-16BE: high surrogate not followed by low surrogate *) + test_validity (module Utf16be) "\xd8\x00\x00\x00"; + [%expect {| |}]; + (* Invalid UTF-32LE: surrogate pair encoded in UTF-32 *) + test_validity (module Utf32le) "\x00\xD8\x00\x00"; + [%expect {| |}]; + (* Invalid UTF-32BE: surrogate pair encoded in UTF-32 *) + test_validity (module Utf32be) "\x00\x00\xD8\x00"; + [%expect {| |}] + ;; + + let test_conversions utf8 = + let utf8 = + match Utf8.of_string utf8 with + | utf8 -> utf8 + | exception exn -> + print_s [%sexp (exn : exn)]; + Utf8.sanitize utf8 + in + let uchars = Utf8.to_list utf8 in + printf "Appearance: %s\n" (Utf8.of_list uchars :> string); + print_s [%sexp (uchars : Uchar.t list)]; + List.iter encodings ~f:(fun (module Utf : Utf) -> + let codec_name = Utf.codec_name in + let t = Utf.of_list uchars in + print_s [%sexp (codec_name : string), (t : Utf.t)]; + let round_trip = Utf.to_list t in + if not ([%equal: Uchar.t list] uchars round_trip) + then + print_cr + [%here] + [%message + "encoding does not round trip" + (codec_name : string) + (uchars : Uchar.t list) + ~string:(t : Utf.t) + (round_trip : Uchar.t list)]) + ;; + + let%expect_test "conversions" = + test_conversions "abc"; + [%expect + {| + Appearance: abc + (U+0061 U+0062 U+0063) + (UTF-8 abc) + (UTF-16LE "a\000b\000c\000") + (UTF-16BE "\000a\000b\000c") + (UTF-32LE "a\000\000\000b\000\000\000c\000\000\000") + (UTF-32BE "\000\000\000a\000\000\000b\000\000\000c") + |}]; + test_conversions "\u{0065}\u{0301}"; + [%expect + {| + Appearance: é + (U+0065 U+0301) + (UTF-8 "e\204\129") + (UTF-16LE "e\000\001\003") + (UTF-16BE "\000e\003\001") + (UTF-32LE "e\000\000\000\001\003\000\000") + (UTF-32BE "\000\000\000e\000\000\003\001") + |}]; + test_conversions "\u{0063}\u{030C}"; + [%expect + {| + Appearance: č + (U+0063 U+030C) + (UTF-8 "c\204\140") + (UTF-16LE "c\000\012\003") + (UTF-16BE "\000c\003\012") + (UTF-32LE "c\000\000\000\012\003\000\000") + (UTF-32BE "\000\000\000c\000\000\003\012") + |}]; + test_conversions "\u{0E28}\u{0E34}"; + [%expect + {| + Appearance: ศิ + (U+0E28 U+0E34) + (UTF-8 "\224\184\168\224\184\180") + (UTF-16LE "(\0144\014") + (UTF-16BE "\014(\0144") + (UTF-32LE "(\014\000\0004\014\000\000") + (UTF-32BE "\000\000\014(\000\000\0144") + |}]; + test_conversions "\u{1D11E}"; + [%expect + {| + Appearance: 𝄞 + (U+1D11E) + (UTF-8 "\240\157\132\158") + (UTF-16LE "4\216\030\221") + (UTF-16BE "\2164\221\030") + (UTF-32LE "\030\209\001\000") + (UTF-32BE "\000\001\209\030") + |}]; + test_conversions "\u{1D56C}"; + [%expect + {| + Appearance: 𝕬 + (U+1D56C) + (UTF-8 "\240\157\149\172") + (UTF-16LE "5\216l\221") + (UTF-16BE "\2165\221l") + (UTF-32LE "l\213\001\000") + (UTF-32BE "\000\001\213l") + |}]; + test_conversions "\xFF\xFF"; + [%expect + {| + ("Base.String.Utf8.of_string: invalid UTF-8" "\255\255") + Appearance: �� + (U+FFFD U+FFFD) + (UTF-8 "\239\191\189\239\191\189") + (UTF-16LE "\253\255\253\255") + (UTF-16BE "\255\253\255\253") + (UTF-32LE "\253\255\000\000\253\255\000\000") + (UTF-32BE "\000\000\255\253\000\000\255\253") + |}] + ;; + + let%expect_test "Test [get] used at an invalid offset" = + let utf8 = Utf8.of_string "αβ" in + printf "%s\n" (utf8 :> string); + [%expect {| αβ |}]; + print_s [%message "" ~_:(utf8 : Utf8.t) ~_:(Utf8.to_list utf8 : Uchar.t list)]; + [%expect {| ("\206\177\206\178" (U+03B1 U+03B2)) |}]; + require_does_raise [%here] (fun () -> Utf8.get utf8 ~byte_pos:1); + [%expect + {| + ("Base.String.Utf8.get: invalid UTF-8 encoding at given position" + "\206\177\206\178" + (pos 1)) + |}] + ;; + end) +;; + +let%test_module "Caseless Suffix/Prefix" = + (module struct + let%test _ = Caseless.is_suffix "OCaml" ~suffix:"AmL" + let%test _ = Caseless.is_suffix "OCaml" ~suffix:"ocAmL" + let%test _ = Caseless.is_suffix "a@!$b" ~suffix:"a@!$B" + let%test _ = not (Caseless.is_suffix "a@!$b" ~suffix:"C@!$B") + let%test _ = not (Caseless.is_suffix "aa" ~suffix:"aaa") + let%test _ = Caseless.is_prefix "OCaml" ~prefix:"oc" + let%test _ = Caseless.is_prefix "OCaml" ~prefix:"ocAmL" + let%test _ = Caseless.is_prefix "a@!$b" ~prefix:"a@!$B" + let%test _ = not (Caseless.is_prefix "a@!$b" ~prefix:"a@!$C") + let%test _ = not (Caseless.is_prefix "aa" ~prefix:"aaa") + end) +;; + +let%test_module "Caseless Substring" = + (module struct + let%test _ = Caseless.is_substring "OCaml" ~substring:"AmL" + let%test _ = Caseless.is_substring "OCaml" ~substring:"oc" + let%test _ = Caseless.is_substring "OCaml" ~substring:"ocAmL" + let%test _ = Caseless.is_substring "a@!$b" ~substring:"a@!$B" + let%test _ = not (Caseless.is_substring "a@!$b" ~substring:"C@!$B") + let%test _ = not (Caseless.is_substring "a@!$b" ~substring:"a@!$C") + let%test _ = not (Caseless.is_substring "aa" ~substring:"aaa") + let%test _ = not (Caseless.is_substring "aa" ~substring:"AAA") + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = string * string [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (t, substring) -> + let actual = Caseless.is_substring t ~substring in + let expect = is_substring (lowercase t) ~substring:(lowercase substring) in + [%test_result: bool] actual ~expect) + ;; + end) +;; + +let%test_module "Caseless Comparable" = + (module struct + (* examples from docs *) + let%test _ = Caseless.equal "OCaml" "ocaml" + let%test _ = Caseless.("apple" < "Banana") + let%test _ = Caseless.("aa" < "aaa") + let%test _ = Int.( <> ) (Caseless.compare "apple" "Banana") (compare "apple" "Banana") + let%test _ = Caseless.equal "XxX" "xXx" + let%test _ = Caseless.("XxX" < "xXxX") + let%test _ = Caseless.("XxXx" > "xXx") + + let%test _ = + List.is_sorted ~compare:Caseless.compare [ "Apples"; "bananas"; "Carrots" ] + ;; + end) +;; + +let%test_module "Caseless Hashable" = + (module struct + let%test _ = + Int.( <> ) (hash "x") (hash "X") + && Int.( = ) (Caseless.hash "x") (Caseless.hash "X") + ;; + + let%test _ = Int.( = ) (Caseless.hash "OCaml") (Caseless.hash "ocaml") + let%test _ = Int.( <> ) (Caseless.hash "aaa") (Caseless.hash "aaaa") + let%test _ = Int.( <> ) (Caseless.hash "aaa") (Caseless.hash "aab") + + let%test _ = + let tbl = Hashtbl.create (module Caseless) in + Hashtbl.add_exn tbl ~key:"x" ~data:7; + [%compare.equal: int option] (Hashtbl.find tbl "X") (Some 7) + ;; + end) +;; + +let%test _ = not (contains "" 'a') +let%test _ = contains "a" 'a' +let%test _ = not (contains "a" 'b') +let%test _ = contains "ab" 'a' +let%test _ = contains "ab" 'b' +let%test _ = not (contains "ab" 'c') +let%test _ = not (contains "abcd" 'b' ~pos:1 ~len:0) +let%test _ = contains "abcd" 'b' ~pos:1 ~len:1 +let%test _ = contains "abcd" 'c' ~pos:1 ~len:2 +let%test _ = not (contains "abcd" 'd' ~pos:1 ~len:2) +let%test _ = contains "abcd" 'd' ~pos:1 +let%test _ = not (contains "abcd" 'a' ~pos:1) + +let%test_module "Search_pattern" = + (module struct + open Search_pattern + + let%test_module "Search_pattern.create" = + (module struct + let prefix s n = sub s ~pos:0 ~len:n + let suffix s n = sub s ~pos:(length s - n) ~len:n + + let slow_create pattern ~case_sensitive = + let string_equal = + if case_sensitive then String.equal else String.Caseless.equal + in + (* Compute the longest prefix-suffix array from definition, O(n^3) *) + let n = length pattern in + let kmp_array = Array.create ~len:n (-1) in + for i = 0 to n - 1 do + let x = prefix pattern (i + 1) in + for j = 0 to i do + if string_equal (prefix x j) (suffix x j) then kmp_array.(i) <- j + done + done; + ({ pattern; kmp_array; case_sensitive } : Private.t) + ;; + + let test_both ({ pattern; case_sensitive; kmp_array = _ } as expected : Private.t) + = + let create_repr = Private.representation (create pattern ~case_sensitive) in + let slow_create_repr = slow_create pattern ~case_sensitive in + require_equal [%here] (module Private) create_repr expected; + require_equal [%here] (module Private) slow_create_repr expected + ;; + + let cmp_both pattern ~case_sensitive = + let create_repr = Private.representation (create pattern ~case_sensitive) in + let slow_create_repr = slow_create pattern ~case_sensitive in + require_equal [%here] (module Private) create_repr slow_create_repr + ;; + + let%expect_test _ = + List.iter [%all: bool] ~f:(fun case_sensitive -> + test_both { pattern = ""; case_sensitive; kmp_array = [||] }) + ;; + + let%expect_test _ = + List.iter [%all: bool] ~f:(fun case_sensitive -> + test_both + { pattern = "ababab"; case_sensitive; kmp_array = [| 0; 0; 1; 2; 3; 4 |] }) + ;; + + let%expect_test _ = + List.iter [%all: bool] ~f:(fun case_sensitive -> + test_both + { pattern = "abaCabaD" + ; case_sensitive + ; kmp_array = [| 0; 0; 1; 0; 1; 2; 3; 0 |] + }) + ;; + + let%expect_test _ = + List.iter [%all: bool] ~f:(fun case_sensitive -> + test_both + { pattern = "abaCabaDabaCabaCabaDabaCabaEabab" + ; case_sensitive + ; kmp_array = + [| 0 + ; 0 + ; 1 + ; 0 + ; 1 + ; 2 + ; 3 + ; 0 + ; 1 + ; 2 + ; 3 + ; 4 + ; 5 + ; 6 + ; 7 + ; 4 + ; 5 + ; 6 + ; 7 + ; 8 + ; 9 + ; 10 + ; 11 + ; 12 + ; 13 + ; 14 + ; 15 + ; 0 + ; 1 + ; 2 + ; 3 + ; 2 + |] + }) + ;; + + let%expect_test _ = + test_both { pattern = "aaA"; case_sensitive = true; kmp_array = [| 0; 1; 0 |] } + ;; + + let%expect_test _ = + test_both { pattern = "aaA"; case_sensitive = false; kmp_array = [| 0; 1; 2 |] } + ;; + + let%expect_test _ = + test_both + { pattern = "aAaAaA" + ; case_sensitive = true + ; kmp_array = [| 0; 0; 1; 2; 3; 4 |] + } + ;; + + let%expect_test _ = + test_both + { pattern = "aAaAaA" + ; case_sensitive = false + ; kmp_array = [| 0; 1; 2; 3; 4; 5 |] + } + ;; + + let rec x k = + if Int.( < ) k 0 + then "" + else ( + let b = x (k - 1) in + b ^ make 1 (Stdlib.Char.unsafe_chr (65 + k)) ^ b) + ;; + + let%expect_test _ = + List.iter [%all: bool] ~f:(fun case_sensitive -> + cmp_both ~case_sensitive (x 10)) + ;; + + let%expect_test _ = + List.iter [%all: bool] ~f:(fun case_sensitive -> + cmp_both ~case_sensitive (x 5 ^ "E" ^ x 4 ^ "D" ^ x 3 ^ "B" ^ x 2 ^ "C" ^ x 3)) + ;; + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = string [@@deriving quickcheck, sexp_of] + end) + ~f:(fun pattern -> + let case_insensitive = + Private.representation (create pattern ~case_sensitive:false) + in + let case_sensitive_but_lowercase = + Private.representation (create (lowercase pattern) ~case_sensitive:true) + in + [%test_result: String.Caseless.t] + case_insensitive.pattern + ~expect:case_sensitive_but_lowercase.pattern; + [%test_result: int array] + case_insensitive.kmp_array + ~expect:case_sensitive_but_lowercase.kmp_array) + ;; + end) + ;; + + let ( = ) = [%compare.equal: int option] + let%test _ = index (create "") ~in_:"abababac" = Some 0 + let%test _ = index ~pos:(-1) (create "") ~in_:"abababac" = None + let%test _ = index ~pos:1 (create "") ~in_:"abababac" = Some 1 + let%test _ = index ~pos:7 (create "") ~in_:"abababac" = Some 7 + let%test _ = index ~pos:8 (create "") ~in_:"abababac" = Some 8 + let%test _ = index ~pos:9 (create "") ~in_:"abababac" = None + let%test _ = index (create "abababaca") ~in_:"abababac" = None + let%test _ = index (create "abababac") ~in_:"abababac" = Some 0 + let%test _ = index ~pos:0 (create "abababac") ~in_:"abababac" = Some 0 + let%test _ = index (create "abac") ~in_:"abababac" = Some 4 + let%test _ = index ~pos:4 (create "abac") ~in_:"abababac" = Some 4 + let%test _ = index ~pos:5 (create "abac") ~in_:"abababac" = None + let%test _ = index ~pos:5 (create "abac") ~in_:"abababaca" = None + let%test _ = index ~pos:5 (create "baca") ~in_:"abababaca" = Some 5 + let%test _ = index ~pos:(-1) (create "a") ~in_:"abc" = None + let%test _ = index ~pos:2 (create "a") ~in_:"abc" = None + let%test _ = index ~pos:2 (create "c") ~in_:"abc" = Some 2 + let%test _ = index ~pos:3 (create "c") ~in_:"abc" = None + let ( = ) = [%compare.equal: bool] + let%test _ = matches (create "") "abababac" = true + let%test _ = matches (create "abababaca") "abababac" = false + let%test _ = matches (create "abababac") "abababac" = true + let%test _ = matches (create "abac") "abababac" = true + let%test _ = matches (create "abac") "abababaca" = true + let%test _ = matches (create "baca") "abababaca" = true + let%test _ = matches (create "a") "abc" = true + let%test _ = matches (create "c") "abc" = true + let ( = ) = [%compare.equal: int list] + let%test _ = index_all (create "") ~may_overlap:false ~in_:"abcd" = [ 0; 1; 2; 3; 4 ] + let%test _ = index_all (create "") ~may_overlap:true ~in_:"abcd" = [ 0; 1; 2; 3; 4 ] + let%test _ = index_all (create "abab") ~may_overlap:false ~in_:"abababab" = [ 0; 4 ] + let%test _ = index_all (create "abab") ~may_overlap:true ~in_:"abababab" = [ 0; 2; 4 ] + let%test _ = index_all (create "abab") ~may_overlap:false ~in_:"ababababab" = [ 0; 4 ] + + let%test _ = + index_all (create "abab") ~may_overlap:true ~in_:"ababababab" = [ 0; 2; 4; 6 ] + ;; + + let%test _ = + index_all (create "aaa") ~may_overlap:false ~in_:"aaaaBaaaaaa" = [ 0; 5; 8 ] + ;; + + let%test _ = + index_all (create "aaa") ~may_overlap:true ~in_:"aaaaBaaaaaa" = [ 0; 1; 5; 6; 7; 8 ] + ;; + + let ( = ) = [%compare.equal: string] + let%test _ = replace_first (create "abab") ~in_:"abababab" ~with_:"" = "abab" + let%test _ = replace_first (create "abab") ~in_:"abacabab" ~with_:"" = "abac" + let%test _ = replace_first (create "abab") ~in_:"ababacab" ~with_:"A" = "Aacab" + let%test _ = replace_first (create "abab") ~in_:"acabababab" ~with_:"A" = "acAabab" + let%test _ = replace_first (create "ababab") ~in_:"acabababab" ~with_:"A" = "acAab" + + let%test _ = + replace_first (create "abab") ~in_:"abababab" ~with_:"abababab" = "abababababab" + ;; + + let%test _ = replace_all (create "abab") ~in_:"abababab" ~with_:"" = "" + let%test _ = replace_all (create "abab") ~in_:"abacabab" ~with_:"" = "abac" + let%test _ = replace_all (create "abab") ~in_:"acabababab" ~with_:"A" = "acAA" + let%test _ = replace_all (create "ababab") ~in_:"acabababab" ~with_:"A" = "acAab" + + let%test _ = + replace_all (create "abaC") ~in_:"abaCabaDCababaCabaCaba" ~with_:"x" + = "xabaDCabxxaba" + ;; + + let%test _ = replace_all (create "a") ~in_:"aa" ~with_:"aaa" = "aaaaaa" + + let%test _ = + replace_all (create "") ~in_:"abcdeefff" ~with_:"X1" + = "X1aX1bX1cX1dX1eX1eX1fX1fX1fX1" + ;; + + (* a doc comment in core_string.mli gives this as an example *) + let%test _ = replace_all (create "bc") ~in_:"aabbcc" ~with_:"cb" = "aabcbc" + + let%test _ = + [%compare.equal: string list] + (split_on (create "====") "aa====bbb====c=====d======e========fff") + [ "aa"; "bbb"; "c"; "=d"; "==e"; ""; "fff" ] + ;; + + let%test _ = + [%compare.equal: string list] + (split_on (create "XYXYX") "XYXYXaaXYXYXYXbbXYXYXYXYXYX") + [ ""; "aa"; "YXbb"; "Y"; "" ] + ;; + + let%test _ = + [%compare.equal: string list] + (split_on (create "") "abcd") + (* [index_all (create "")] includes the occurrences at index 0 and at the end of + the string, and the result of [split_on (create "")] is a consequence of this + *) + [ ""; "a"; "b"; "c"; "d"; "" ] + ;; + + let%test _ = + [%compare.equal: string list] + (split_on (create "not present") "here is a string with no matches") + [ "here is a string with no matches" ] + ;; + end) +;; + +let%test _ = rev "" = "" +let%test _ = rev "a" = "a" +let%test _ = rev "ab" = "ba" +let%test _ = rev "abc" = "cba" + +let%test_unit _ = + List.iter + ~f:(fun (t, expect) -> + let actual = split_lines t in + if not ([%compare.equal: string list] actual expect) + then + raise_s [%message "split_lines bug" (t : t) (actual : t list) (expect : t list)]) + [ "", [] + ; "\n", [ "" ] + ; "a", [ "a" ] + ; "a\n", [ "a" ] + ; "a\nb", [ "a"; "b" ] + ; "a\nb\n", [ "a"; "b" ] + ; "a\n\n", [ "a"; "" ] + ; "a\n\nb", [ "a"; ""; "b" ] + ] +;; + +let%test_unit _ = + let lines = [ ""; "a"; "bc" ] in + let newlines = [ "\n"; "\r\n" ] in + let rec loop n expect to_concat = + if Int.( = ) n 0 + then ( + let input = concat to_concat in + let actual = Or_error.try_with (fun () -> split_lines input) in + if not ([%compare.equal: t list Or_error.t] actual (Ok expect)) + then + raise_s + [%message + "split_lines bug" (input : t) (actual : t list Or_error.t) (expect : t list)]) + else ( + loop (n - 1) expect to_concat; + List.iter lines ~f:(fun t -> + let loop to_concat = loop (n - 1) (t :: expect) (t :: to_concat) in + if (not (is_empty t)) && List.is_empty to_concat then loop []; + List.iter newlines ~f:(fun newline -> loop (newline :: to_concat)))) + in + loop 3 [] [] +;; + +let%test_unit _ = + let s = init 10 ~f:Char.of_int_exn in + assert (phys_equal s (sub s ~pos:0 ~len:(String.length s))); + assert (phys_equal s (prefix s (String.length s))); + assert (phys_equal s (suffix s (String.length s))); + assert (phys_equal s (concat [ s ])); + assert (phys_equal s (tr s ~target:'\255' ~replacement:'\000')) +;; + +let%test_module "tr_multi" = + (module struct + let gold_standard ~target ~replacement string = + map string ~f:(fun char -> + match rindex target char with + | None -> char + | Some i -> get replacement (Int.min i (length replacement - 1))) + ;; + + module Test = struct + type nonrec t = + { target : t + ; replacement : t + ; string : t + ; expected : t option [@sexp.option] + } + [@@deriving sexp_of] + + let quickcheck_generator = + let open Base_quickcheck.Generator in + let open Base_quickcheck.Generator.Let_syntax in + let%bind size = size in + let%bind target_len = int_log_uniform_inclusive 1 255 in + let%bind target = string_with_length ~length:target_len in + let%bind replacement_len = int_inclusive 1 target_len in + let%bind replacement = string_with_length ~length:replacement_len in + let%bind string_length = int_inclusive 0 size in + let%map string = string_with_length ~length:string_length in + { target; replacement; string; expected = None } + ;; + + let quickcheck_shrinker = Base_quickcheck.Shrinker.atomic + end + + let examples = + [ "", "", "abcdefg", "abcdefg" + ; "", "a", "abcdefg", "abcdefg" + ; "aaaa", "abcd", "abcdefg", "dbcdefg" + ; "abcd", "bcde", "abcdefg", "bcdeefg" + ; "abcd", "bcde", "", "" + ; "abcd", "_", "abcdefg", "____efg" + ; "abcd", "b_", "abcdefg", "b___efg" + ; "a", "dcba", "abcdefg", "dbcdefg" + ; "ab", "dcba", "abcdefg", "dccdefg" + ] + |> List.map ~f:(fun (target, replacement, string, expected) -> + { Test.target; replacement; string; expected = Some expected }) + ;; + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Test) + ~examples + ~f:(fun ({ target; replacement; string; expected } : Test.t) -> + (* test implementation behavior against gold standard *) + let impl_result = unstage (tr_multi ~target ~replacement) string in + let gold_result = gold_standard ~target ~replacement string in + [%test_result: t] ~expect:gold_result impl_result; + (* test against expected result, if one is provided (non-random examples) *) + Option.iter expected ~f:(fun expected -> + [%test_result: t] ~expect:expected impl_result); + (* test for returning input if the string is unchanged *) + if equal string impl_result then assert (phys_equal string impl_result)) + ;; + end) +;; + +let%test_unit _ = [%test_result: int option] (index "bob" 'b') ~expect:(Some 0) +let%test_unit _ = [%test_result: int option] (rindex "bob" 'b') ~expect:(Some 2) +let%test_unit _ = [%test_result: int option] (index "bob" 'c') ~expect:None +let%test_unit _ = [%test_result: int option] (rindex "bob" 'c') ~expect:None +let%test_unit _ = [%test_result: int option] (index_from "bobob" 1 'b') ~expect:(Some 2) +let%test_unit _ = [%test_result: int option] (rindex_from "bobob" 3 'b') ~expect:(Some 2) + +let%test_unit _ = + [%test_result: int option] (lfindi "bob" ~f:(fun _ -> Char.( = ) 'b')) ~expect:(Some 0) +;; + +let%test_unit _ = + [%test_result: int option] + (lfindi ~pos:0 "bob" ~f:(fun _ -> Char.( = ) 'b')) + ~expect:(Some 0) +;; + +let%test_unit _ = + [%test_result: int option] + (lfindi ~pos:1 "bob" ~f:(fun _ -> Char.( = ) 'b')) + ~expect:(Some 2) +;; + +let%test_unit _ = + [%test_result: int option] (lfindi "bob" ~f:(fun _ -> Char.( = ) 'x')) ~expect:None +;; + +let%test_unit _ = + [%test_result: char option] + (find_map "fop" ~f:(fun c -> if Char.(c >= 'o') then Some c else None)) + ~expect:(Some 'o') +;; + +let%test_unit _ = + [%test_result: _ option] (find_map "bar" ~f:(fun _ -> None)) ~expect:None +;; + +let%test_unit _ = + [%test_result: _ option] (find_map "" ~f:(fun _ -> assert false)) ~expect:None +;; + +let%test_unit _ = + [%test_result: int option] (rfindi "bob" ~f:(fun _ -> Char.( = ) 'b')) ~expect:(Some 2) +;; + +let%test_unit _ = + [%test_result: int option] + (rfindi ~pos:2 "bob" ~f:(fun _ -> Char.( = ) 'b')) + ~expect:(Some 2) +;; + +let%test_unit _ = + [%test_result: int option] + (rfindi ~pos:1 "bob" ~f:(fun _ -> Char.( = ) 'b')) + ~expect:(Some 0) +;; + +let%test_unit _ = + [%test_result: int option] (rfindi "bob" ~f:(fun _ -> Char.( = ) 'x')) ~expect:None +;; + +let%test_module "strip" = + (module struct + let test ?drop s = print_s [%sexp (strip ?drop s : string)] + + let%expect_test "whitespace on both ends" = + test " foo bar \n"; + [%expect {| "foo bar" |}] + ;; + + let%expect_test "custom drop, present on end" = + test ~drop:(Char.( = ) '"') "\" foo bar "; + [%expect {| " foo bar " |}] + ;; + + let%expect_test "custom drop, absent from end" = + test ~drop:(Char.( = ) '"') " \" foo bar "; + [%expect {| " \" foo bar " |}] + ;; + + let%expect_test "all whitespace" = + test "\n\t \n"; + [%expect {| "" |}] + ;; + + let%expect_test "no whitespace on ends" = + test "as \t\ndf"; + [%expect {| "as \t\ndf" |}] + ;; + + let%expect_test "just one side" = + test " a"; + [%expect {| a |}]; + test "a "; + [%expect {| a |}] + ;; + end) +;; + +let%test_module "lstrip" = + (module struct + let test ?drop s = print_s [%sexp (lstrip ?drop s : string)] + + let%expect_test "whitespace on left" = + test " \t\r\n123 \t\n"; + [%expect {| "123 \t\n" |}] + ;; + + let%expect_test "all whitespace" = + test " \t \n\n\r "; + [%expect {| "" |}] + ;; + + let%expect_test "no whitespace on left" = + test "foo Bar \n "; + [%expect {| "foo Bar \n " |}] + ;; + end) +;; + +let%test_module "rstrip" = + (module struct + let test ?drop s = print_s [%sexp (rstrip ?drop s : string)] + + let%expect_test "whitespace on right" = + test " \t\r\n123 \t\n\r"; + [%expect {| " \t\r\n123" |}] + ;; + + let%expect_test "all whitespace" = + test " \t \n\n\r "; + [%expect {| "" |}] + ;; + + let%expect_test "no whitespace on right" = + test " \n foo Bar"; + [%expect {| " \n foo Bar" |}] + ;; + end) +;; + +let%test_module "map" = + (module struct + let%expect_test "empty" = require_equal [%here] (module String) (map "" ~f:Fn.id) "" + + let%expect_test "non-empty" = + let s = "faboo" in + require_equal + [%here] + (module String) + (map s ~f:(function + | 'a' -> 'b' + | 'b' -> 'a' + | x -> x)) + "fbaoo" + ;; + end) +;; + +let%expect_test "split" = + let test s = print_s [%sexp (split s ~on:'c' : string list)] in + test ""; + [%expect {| ("") |}]; + test "c"; + [%expect {| ("" "") |}]; + test "fooc"; + [%expect {| (foo "") |}]; + test "cfoo"; + [%expect {| ("" foo) |}]; + test "cfooc"; + [%expect {| ("" foo "") |}]; + test "bocci ball"; + [%expect {| (bo "" "i ball") |}] +;; + +let%expect_test "split_on_chars" = + let test s ~on = print_s [%sexp (split_on_chars s ~on : string list)] in + test "" ~on:[ 'c' ]; + [%expect {| ("") |}]; + test "c" ~on:[ 'c' ]; + [%expect {| ("" "") |}]; + test "chr" ~on:[ 'h'; 'c'; 'r' ]; + [%expect {| ("" "" "" "") |}]; + test "fooc" ~on:[ 'c' ]; + [%expect {| (foo "") |}]; + test "fooc" ~on:[ 'c'; 'o' ]; + [%expect {| (f "" "" "") |}]; + test "cfoo" ~on:[ 'c' ]; + [%expect {| ("" foo) |}]; + test "cfoo" ~on:[ 'c'; 'f' ]; + [%expect {| ("" "" oo) |}]; + test "bocci ball" ~on:[ 'c' ]; + [%expect {| (bo "" "i ball") |}]; + test "bocci ball" ~on:[ 'c'; ' '; 'i' ]; + [%expect {| (bo "" "" "" ball) |}] +;; + +let%test_unit _ = + [%test_result: bool] ~expect:false (exists "" ~f:(fun _ -> assert false)) +;; + +let%test_unit _ = [%test_result: bool] ~expect:false (exists "abc" ~f:(Fn.const false)) +let%test_unit _ = [%test_result: bool] ~expect:true (exists "abc" ~f:(Fn.const true)) + +let%test_unit _ = + [%test_result: bool] + ~expect:true + (exists "abc" ~f:(function + | 'a' -> false + | 'b' -> true + | _ -> assert false)) +;; + +let%test_unit _ = + [%test_result: bool] ~expect:true (for_all "" ~f:(fun _ -> assert false)) +;; + +let%test_unit _ = [%test_result: bool] ~expect:true (for_all "abc" ~f:(Fn.const true)) +let%test_unit _ = [%test_result: bool] ~expect:false (for_all "abc" ~f:(Fn.const false)) + +let%test_unit _ = + [%test_result: bool] + ~expect:false + (for_all "abc" ~f:(function + | 'a' -> true + | 'b' -> false + | _ -> assert false)) +;; + +let%test_unit _ = + [%test_result: char list] + (fold "hello" ~init:[] ~f:(fun acc ch -> ch :: acc)) + ~expect:(List.rev [ 'h'; 'e'; 'l'; 'l'; 'o' ]); + [%test_result: (int * char) list] + (foldi "hello" ~init:[] ~f:(fun i acc ch -> (i, ch) :: acc)) + ~expect:(List.rev [ 0, 'h'; 1, 'e'; 2, 'l'; 3, 'l'; 4, 'o' ]) +;; + +let%expect_test "iteri" = + iteri "hello" ~f:(fun i ch -> printf "%d%c " i ch); + [%expect {| 0h 1e 2l 3l 4o |}] +;; + +let%test_unit _ = [%test_result: t] (filter "hello" ~f:(Char.( <> ) 'h')) ~expect:"ello" +let%test_unit _ = [%test_result: t] (filter "hello" ~f:(Char.( <> ) 'l')) ~expect:"heo" +let%test_unit _ = [%test_result: t] (filter "hello" ~f:(fun _ -> false)) ~expect:"" +let%test_unit _ = [%test_result: t] (filter "hello" ~f:(fun _ -> true)) ~expect:"hello" + +let%test_unit _ = + [%test_result: t] (filteri "hello" ~f:(fun i _ -> Int.(i % 2 = 0))) ~expect:"hlo" +;; + +let%test_unit _ = + let s = "hello" in + [%test_result: bool] ~expect:true (phys_equal (filter s ~f:(fun _ -> true)) s) +;; + +let%test_unit _ = + let s = "abc" in + let r = ref 0 in + assert ( + phys_equal + s + (filter s ~f:(fun _ -> + Int.incr r; + true))); + assert (Int.( = ) !r (String.length s)) +;; + +let%test_module "Hash" = + (module struct + external hash : string -> int = "Base_hash_string" [@@noalloc] + + let%test_unit _ = + List.iter + ~f:(fun string -> + assert (Int.( = ) (hash string) (Stdlib.Hashtbl.hash string)); + (* with 31-bit integers, the hash computed by ppx_hash overflows so it doesn't match + polymorphic hash exactly. *) + if Int.( > ) Int.num_bits 31 + then assert (Int.( = ) (hash string) ([%hash: string] string))) + [ "Oh Gloria inmarcesible! Oh jubilo inmortal!" + ; "Oh say can you see, by the dawn's early light" + ; "Hahahaha\200" + ] + ;; + end) +;; + +let%test _ = of_char_list [ 'a'; 'b'; 'c' ] = "abc" +let%test _ = of_char_list [] = "" + +let%expect_test "is_substring_at" = + let string = "lorem ipsum dolor sit amet" in + let test pos substring = + match is_substring_at string ~pos ~substring with + | bool -> print_s [%sexp (bool : bool)] + | exception exn -> print_s [%message "raised" ~_:(exn : exn)] + in + test 0 "lorem"; + [%expect {| true |}]; + test 1 "lorem"; + [%expect {| false |}]; + test 6 "ipsum"; + [%expect {| true |}]; + test 5 "ipsum"; + [%expect {| false |}]; + test 22 "amet"; + [%expect {| true |}]; + test 23 "amet"; + [%expect {| false |}]; + test 22 "amet and some other stuff"; + [%expect {| false |}]; + test 0 ""; + [%expect {| true |}]; + test 10 ""; + [%expect {| true |}]; + test 26 ""; + [%expect {| true |}]; + test 100 ""; + [%expect + {| + (raised ( + Invalid_argument + "String.is_substring_at: invalid index 100 for string of length 26")) + |}]; + test (-1) ""; + [%expect + {| + (raised ( + Invalid_argument + "String.is_substring_at: invalid index -1 for string of length 26")) + |}] +;; + +let%expect_test "prefixes and suffixes" = + let s = "0123456789" in + require_equal [%here] (module String) (String.prefix s 0) ""; + require_equal [%here] (module String) (String.prefix s 1) "0"; + require_equal [%here] (module String) (String.prefix s 2) "01"; + require_equal [%here] (module String) (String.prefix s 10) s; + require_equal [%here] (module String) (String.prefix s 20) s; + require_does_raise [%here] (fun () -> String.prefix s (-1)); + [%expect {| (Invalid_argument "prefix expecting nonnegative argument") |}]; + require_equal [%here] (module String) (String.suffix s 0) ""; + require_equal [%here] (module String) (String.suffix s 1) "9"; + require_equal [%here] (module String) (String.suffix s 2) "89"; + require_equal [%here] (module String) (String.suffix s 10) s; + require_equal [%here] (module String) (String.suffix s 20) s; + require_does_raise [%here] (fun () -> String.suffix s (-1)); + [%expect {| (Invalid_argument "suffix expecting nonnegative argument") |}] +;; + +let%expect_test "drop prefixes and suffixes" = + let s = "0123456789" in + require_equal [%here] (module String) (String.drop_prefix s 0) s; + require_equal [%here] (module String) (String.drop_prefix s 1) "123456789"; + require_equal [%here] (module String) (String.drop_prefix s 2) "23456789"; + require_equal [%here] (module String) (String.drop_prefix s 10) ""; + require_equal [%here] (module String) (String.drop_prefix s 20) ""; + require_does_raise [%here] (fun () -> String.drop_prefix s (-1)); + [%expect {| (Invalid_argument "drop_prefix expecting nonnegative argument") |}]; + require_equal [%here] (module String) (String.drop_suffix s 0) s; + require_equal [%here] (module String) (String.drop_suffix s 1) "012345678"; + require_equal [%here] (module String) (String.drop_suffix s 2) "01234567"; + require_equal [%here] (module String) (String.drop_suffix s 10) ""; + require_equal [%here] (module String) (String.drop_suffix s 20) ""; + require_does_raise [%here] (fun () -> String.drop_suffix s (-1)); + [%expect {| (Invalid_argument "drop_suffix expecting nonnegative argument") |}] +;; + +let%expect_test "testing prefixes and suffixes" = + let test outer inner = + print_s + [%message + "" + ~is_prefix:(is_prefix outer ~prefix:inner : bool) + ~is_suffix:(is_suffix outer ~suffix:inner : bool)] + in + test "" "a"; + [%expect {| + ((is_prefix false) + (is_suffix false)) + |}]; + test "" ""; + [%expect {| + ((is_prefix true) + (is_suffix true)) + |}]; + test "Foo" ""; + [%expect {| + ((is_prefix true) + (is_suffix true)) + |}]; + test "H" "H"; + [%expect {| + ((is_prefix true) + (is_suffix true)) + |}]; + test "Hello" "He"; + [%expect {| + ((is_prefix true) + (is_suffix false)) + |}]; + test "Hello" "lo"; + [%expect {| + ((is_prefix false) + (is_suffix true)) + |}]; + test "HelloFoo" "lo"; + [%expect {| + ((is_prefix false) + (is_suffix false)) + |}] +;; + +let%expect_test "chop_prefix" = + let s = "__x__" in + let test_prefix ~prefix = + let result = Or_error.try_with (fun () -> chop_prefix_exn s ~prefix) in + require_equal + [%here] + (module struct + type t = string option [@@deriving equal, sexp_of] + end) + (chop_prefix s ~prefix) + (Or_error.ok result); + require_equal + [%here] + (module String) + (chop_prefix_if_exists s ~prefix) + (result |> Or_error.ok |> Option.value ~default:s); + print_s [%sexp (result : string Or_error.t)] + in + test_prefix ~prefix:""; + [%expect {| (Ok __x__) |}]; + test_prefix ~prefix:"__"; + [%expect {| (Ok x__) |}]; + test_prefix ~prefix:"=="; + [%expect {| (Error (Invalid_argument "String.chop_prefix_exn \"__x__\" \"==\"")) |}] +;; + +let%expect_test "chop_suffix" = + let s = "__x__" in + let test_suffix ~suffix = + let result = Or_error.try_with (fun () -> chop_suffix_exn s ~suffix) in + require_equal + [%here] + (module struct + type t = string option [@@deriving equal, sexp_of] + end) + (chop_suffix s ~suffix) + (Or_error.ok result); + require_equal + [%here] + (module String) + (chop_suffix_if_exists s ~suffix) + (result |> Or_error.ok |> Option.value ~default:s); + print_s [%sexp (result : string Or_error.t)] + in + test_suffix ~suffix:""; + [%expect {| (Ok __x__) |}]; + test_suffix ~suffix:"__"; + [%expect {| (Ok __x) |}]; + test_suffix ~suffix:"=="; + [%expect {| (Error (Invalid_argument "String.chop_suffix_exn \"__x__\" \"==\"")) |}] +;; + +let%expect_test "String.concat_lines" = + let concat_lines_reference lines ~crlf = + String.concat (List.map lines ~f:(fun line -> line ^ if crlf then "\r\n" else "\n")) + in + quickcheck_m + [%here] + (module struct + type t = string list * bool [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (lines, crlf) -> + require_equal + [%here] + (module String) + (String.concat_lines lines ~crlf) + (concat_lines_reference lines ~crlf)); + [%expect {| |}] +;; + +let%expect_test "String.concat_lines examples" = + let test ?crlf lines = print_s [%sexp (String.concat_lines ?crlf lines : string)] in + test [ "foo"; "bar" ]; + [%expect {| "foo\nbar\n" |}]; + test [ "foo\n"; "b\nar\n"; "x" ]; + [%expect {| "foo\n\nb\nar\n\nx\n" |}]; + test []; + [%expect {| "" |}]; + test ~crlf:true [ "foo"; "bar" ]; + [%expect {| "foo\r\nbar\r\n" |}] +;; + +let%expect_test "pad_left and pad_right" = + let test ?char t ~len = + let padded_left = pad_left ?char t ~len in + require [%here] (Int.( >= ) (length padded_left) len); + require [%here] (String.is_suffix padded_left ~suffix:t); + let padded_right = pad_right ?char t ~len in + require [%here] (Int.( >= ) (length padded_right) len); + require [%here] (String.is_prefix padded_right ~prefix:t); + if Int.( >= ) (length t) len + then ( + require [%here] (phys_equal t padded_left); + require [%here] (phys_equal t padded_right)); + print_s [%message (t : string) (padded_left : string) (padded_right : string)] + in + test "" ~len:2; + [%expect + {| + ((t "") + (padded_left " ") + (padded_right " ")) + |}]; + test "foo" ~len:2; + [%expect + {| + ((t foo) + (padded_left foo) + (padded_right foo)) + |}]; + test "foo" ~len:3; + [%expect + {| + ((t foo) + (padded_left foo) + (padded_right foo)) + |}]; + test "foo" ~len:10 ~char:'_'; + [%expect + {| + ((t foo) + (padded_left _______foo) + (padded_right foo_______)) + |}] +;; + +let%test_module "functions that raise Not_found_s" = + (module struct + let show f sexp_of_ok = print_s [%sexp (Result.try_with f : (ok, exn) Result.t)] + + let%expect_test "index_exn" = + let test s = show (fun () -> index_exn s ':') [%sexp_of: int] in + test ""; + [%expect {| (Error (Not_found_s "String.index_exn: not found")) |}]; + test "abc"; + [%expect {| (Error (Not_found_s "String.index_exn: not found")) |}]; + test ":abc"; + [%expect {| (Ok 0) |}]; + test "abc:"; + [%expect {| (Ok 3) |}]; + test "ab:cd:ef"; + [%expect {| (Ok 2) |}] + ;; + + let%expect_test "index_from_exn" = + let test_at s i = show (fun () -> index_from_exn s i ':') [%sexp_of: int] in + let test s = + for i = 0 to length s do + test_at s i + done + in + test ""; + [%expect {| (Error (Not_found_s "String.index_from_exn: not found")) |}]; + test "abc"; + [%expect + {| + (Error (Not_found_s "String.index_from_exn: not found")) + (Error (Not_found_s "String.index_from_exn: not found")) + (Error (Not_found_s "String.index_from_exn: not found")) + (Error (Not_found_s "String.index_from_exn: not found")) + |}]; + test "a:b:c"; + [%expect + {| + (Ok 1) + (Ok 1) + (Ok 3) + (Ok 3) + (Error (Not_found_s "String.index_from_exn: not found")) + (Error (Not_found_s "String.index_from_exn: not found")) + |}]; + let test_bounds s = + test_at s (-1); + test_at s (length s + 1) + in + test_bounds "abc"; + [%expect + {| + (Error (Invalid_argument String.index_from_exn)) + (Error (Invalid_argument String.index_from_exn)) + |}] + ;; + + let%expect_test "rindex_exn" = + let test s = show (fun () -> rindex_exn s ':') [%sexp_of: int] in + test ""; + [%expect {| (Error (Not_found_s "String.rindex_exn: not found")) |}]; + test "abc"; + [%expect {| (Error (Not_found_s "String.rindex_exn: not found")) |}]; + test ":abc"; + [%expect {| (Ok 0) |}]; + test "abc:"; + [%expect {| (Ok 3) |}]; + test "ab:cd:ef"; + [%expect {| (Ok 5) |}] + ;; + + let%expect_test "rindex_from_exn" = + let test_at s i = show (fun () -> rindex_from_exn s i ':') [%sexp_of: int] in + let test s = + for i = length s - 1 downto -1 do + test_at s i + done + in + test ""; + [%expect {| (Error (Not_found_s "String.rindex_from_exn: not found")) |}]; + test "abc"; + [%expect + {| + (Error (Not_found_s "String.rindex_from_exn: not found")) + (Error (Not_found_s "String.rindex_from_exn: not found")) + (Error (Not_found_s "String.rindex_from_exn: not found")) + (Error (Not_found_s "String.rindex_from_exn: not found")) + |}]; + test "a:b:c"; + [%expect + {| + (Ok 3) + (Ok 3) + (Ok 1) + (Ok 1) + (Error (Not_found_s "String.rindex_from_exn: not found")) + (Error (Not_found_s "String.rindex_from_exn: not found")) + |}]; + let test_bounds s = + test_at s (-2); + test_at s (length s) + in + test_bounds "abc"; + [%expect + {| + (Error (Invalid_argument String.rindex_from_exn)) + (Error (Invalid_argument String.rindex_from_exn)) + |}] + ;; + + let%expect_test "lsplit2_exn" = + let test s = + let option_result = lsplit2 s ~on:':' in + let exn_result = Or_error.try_with (fun () -> lsplit2_exn s ~on:':') in + require_equal + [%here] + (module struct + type t = (string * string) option [@@deriving equal, sexp_of] + end) + option_result + (Or_error.ok exn_result); + print_s [%sexp (exn_result : (string * string) Or_error.t)] + in + test ""; + [%expect {| (Error (Not_found_s "String.lsplit2_exn: not found")) |}]; + test "abc"; + [%expect {| (Error (Not_found_s "String.lsplit2_exn: not found")) |}]; + test ":abc"; + [%expect {| (Ok ("" abc)) |}]; + test "abc:"; + [%expect {| (Ok (abc "")) |}]; + test "ab:cd:ef"; + [%expect {| (Ok (ab cd:ef)) |}] + ;; + + let%expect_test "rsplit2_exn" = + let test s = + let option_result = rsplit2 s ~on:':' in + let exn_result = Or_error.try_with (fun () -> rsplit2_exn s ~on:':') in + require_equal + [%here] + (module struct + type t = (string * string) option [@@deriving equal, sexp_of] + end) + option_result + (Or_error.ok exn_result); + print_s [%sexp (exn_result : (string * string) Or_error.t)] + in + test ""; + [%expect {| (Error (Not_found_s "String.rsplit2_exn: not found")) |}]; + test "abc"; + [%expect {| (Error (Not_found_s "String.rsplit2_exn: not found")) |}]; + test ":abc"; + [%expect {| (Ok ("" abc)) |}]; + test "abc:"; + [%expect {| (Ok (abc "")) |}]; + test "ab:cd:ef"; + [%expect {| (Ok (ab:cd ef)) |}] + ;; + end) +;; + +let%test_module "Escaping" = + (module struct + open Escaping + + let%test_module "escape_gen" = + (module struct + let escape = + unstage + (escape_gen_exn ~escapeworthy_map:[ '%', 'p'; '^', 'c' ] ~escape_char:'_') + ;; + + let%test _ = escape "" = "" + let%test _ = escape "foo" = "foo" + let%test _ = escape "_" = "__" + let%test _ = escape "foo%bar" = "foo_pbar" + let%test _ = escape "^foo%" = "_cfoo_p" + + let escape2 = + unstage + (escape_gen_exn + ~escapeworthy_map:[ '_', '.'; '%', 'p'; '^', 'c' ] + ~escape_char:'_') + ;; + + let%test _ = escape2 "_." = "_.." + let%test _ = escape2 "_" = "_." + let%test _ = escape2 "foo%_bar" = "foo_p_.bar" + let%test _ = escape2 "_foo%" = "_.foo_p" + + let checks_for_one_to_one escapeworthy_map = + Exn.does_raise (fun () -> escape_gen_exn ~escapeworthy_map ~escape_char:'_') + ;; + + let%test _ = checks_for_one_to_one [ '%', 'p'; '^', 'c'; '$', 'c' ] + let%test _ = checks_for_one_to_one [ '%', 'p'; '^', 'c'; '%', 'd' ] + end) + ;; + + let%test_module "unescape_gen" = + (module struct + let unescape = + unstage + (unescape_gen_exn ~escapeworthy_map:[ '%', 'p'; '^', 'c' ] ~escape_char:'_') + ;; + + let%test _ = unescape "__" = "_" + let%test _ = unescape "foo" = "foo" + let%test _ = unescape "__" = "_" + let%test _ = unescape "foo_pbar" = "foo%bar" + let%test _ = unescape "_cfoo_p" = "^foo%" + + let unescape2 = + unstage + (unescape_gen_exn + ~escapeworthy_map:[ '_', '.'; '%', 'p'; '^', 'c' ] + ~escape_char:'_') + ;; + + (* this one is ill-formed, just ignore the escape_char without escaped char *) + let%test _ = unescape2 "_" = "" + let%test _ = unescape2 "a_" = "a" + let%test _ = unescape2 "__" = "_" + let%test _ = unescape2 "_.." = "_." + let%test _ = unescape2 "_." = "_" + let%test _ = unescape2 "foo_p_.bar" = "foo%_bar" + let%test _ = unescape2 "_.foo_p" = "_foo%" + + (* generate [n] random string and check if escaping and unescaping are consistent *) + let random_test ~escapeworthy_map ~escape_char n = + let escape = unstage (escape_gen_exn ~escapeworthy_map ~escape_char) in + let unescape = unstage (unescape_gen_exn ~escapeworthy_map ~escape_char) in + let test str = + let escaped = escape str in + let unescaped = unescape escaped in + if str <> unescaped + then + failwith + (Printf.sprintf + "string: %s\nescaped string: %s\nunescaped string: %s" + str + escaped + unescaped) + in + let random_char = + let print_chars = + List.range (Char.to_int Char.min_value) (Char.to_int Char.max_value + 1) + |> List.filter_map ~f:Char.of_int + |> List.filter ~f:Char.is_print + |> Array.of_list + in + fun () -> Array.random_element_exn print_chars + in + let escapeworthy_chars = List.map escapeworthy_map ~f:fst |> Array.of_list in + try + for _ = 0 to n - 1 do + let str = + List.init (Random.int 50) ~f:(fun _ -> + let p = Random.int 100 in + if Int.(p < 10) + then escape_char + else if Int.(p < 25) + then Array.random_element_exn escapeworthy_chars + else random_char ()) + |> of_char_list + in + test str + done; + true + with + | e -> raise e + ;; + + let%test _ = + random_test 1000 ~escapeworthy_map:[ '%', 'p'; '^', 'c' ] ~escape_char:'_' + ;; + + let%test _ = + random_test + 1000 + ~escapeworthy_map:[ '_', '.'; '%', 'p'; '^', 'c' ] + ~escape_char:'_' + ;; + end) + ;; + + let%test_module "escape" = + (module struct + let escape = unstage (escape ~escape_char:'_' ~escapeworthy:[ '_'; '%'; '^' ]) + let%test _ = escape "foo" = "foo" + let%test _ = escape "_" = "__" + let%test _ = escape "foo%bar" = "foo_%bar" + let%test _ = escape "^foo%" = "_^foo_%" + end) + ;; + + let%test_module "unescape" = + (module struct + let unescape = unstage (unescape ~escape_char:'_') + let%test _ = unescape "foo" = "foo" + let%test _ = unescape "__" = "_" + let%test _ = unescape "foo_%bar" = "foo%bar" + let%test _ = unescape "_^foo_%" = "^foo%" + end) + ;; + + let%test_module "is_char_escaping" = + (module struct + let is = is_char_escaping ~escape_char:'_' + let%test_unit _ = [%test_result: bool] (is "___" 0) ~expect:true + let%test_unit _ = [%test_result: bool] (is "___" 1) ~expect:false + let%test_unit _ = [%test_result: bool] (is "___" 2) ~expect:true + + (* considered escaping, though there's nothing to escape *) + let%test_unit _ = [%test_result: bool] (is "a_b__c" 0) ~expect:false + let%test_unit _ = [%test_result: bool] (is "a_b__c" 1) ~expect:true + let%test_unit _ = [%test_result: bool] (is "a_b__c" 2) ~expect:false + let%test_unit _ = [%test_result: bool] (is "a_b__c" 3) ~expect:true + let%test_unit _ = [%test_result: bool] (is "a_b__c" 4) ~expect:false + let%test_unit _ = [%test_result: bool] (is "a_b__c" 5) ~expect:false + end) + ;; + + let%test_module "is_char_escaped" = + (module struct + let is = is_char_escaped ~escape_char:'_' + let%test_unit _ = [%test_result: bool] (is "___" 2) ~expect:false + let%test_unit _ = [%test_result: bool] (is "x" 0) ~expect:false + let%test_unit _ = [%test_result: bool] (is "_x" 1) ~expect:true + let%test_unit _ = [%test_result: bool] (is "sadflkas____sfff" 12) ~expect:false + let%test_unit _ = [%test_result: bool] (is "s_____s" 6) ~expect:true + end) + ;; + + let%test_module "is_char_literal" = + (module struct + let is_char_literal = is_char_literal ~escape_char:'_' + let%test_unit _ = [%test_result: bool] (is_char_literal "123456" 4) ~expect:true + let%test_unit _ = [%test_result: bool] (is_char_literal "12345_6" 6) ~expect:false + let%test_unit _ = [%test_result: bool] (is_char_literal "12345_6" 5) ~expect:false + + let%test_unit _ = + [%test_result: bool] (is_char_literal "123__456" 4) ~expect:false + ;; + + let%test_unit _ = + [%test_result: bool] (is_char_literal "123456__" 7) ~expect:false + ;; + + let%test_unit _ = + [%test_result: bool] (is_char_literal "__123456" 1) ~expect:false + ;; + + let%test_unit _ = + [%test_result: bool] (is_char_literal "__123456" 0) ~expect:false + ;; + + let%test_unit _ = [%test_result: bool] (is_char_literal "__123456" 2) ~expect:true + end) + ;; + + let%test_module "index_from" = + (module struct + let f = index_from ~escape_char:'_' + let%test_unit _ = [%test_result: int option] (f "__" 0 '_') ~expect:None + let%test_unit _ = [%test_result: int option] (f "_.." 0 '.') ~expect:(Some 2) + + let%test_unit _ = + [%test_result: int option] (f "1273456_7789" 3 '7') ~expect:(Some 9) + ;; + + let%test_unit _ = + [%test_result: int option] (f "1273_7456_7789" 3 '7') ~expect:(Some 11) + ;; + + let%test_unit _ = + [%test_result: int option] (f "1273_7456_7789" 3 'z') ~expect:None + ;; + end) + ;; + + let%test_module "rindex" = + (module struct + let f = rindex_from ~escape_char:'_' + let%test_unit _ = [%test_result: int option] (f "__" 0 '_') ~expect:None + + let%test_unit _ = + [%test_result: int option] (f "123456_37839" 9 '3') ~expect:(Some 2) + ;; + + let%test_unit _ = [%test_result: int option] (f "123_2321" 6 '2') ~expect:(Some 6) + let%test_unit _ = [%test_result: int option] (f "123_2321" 5 '2') ~expect:(Some 1) + + let%test_unit _ = + [%test_result: int option] (rindex "" ~escape_char:'_' 'x') ~expect:None + ;; + + let%test_unit _ = + [%test_result: int option] (rindex "a_a" ~escape_char:'_' 'a') ~expect:(Some 0) + ;; + end) + ;; + + let%test_module "split" = + (module struct + let split = split ~escape_char:'_' ~on:',' + + let%test_unit _ = + [%test_result: string list] + (split "foo,bar,baz") + ~expect:[ "foo"; "bar"; "baz" ] + ;; + + let%test_unit _ = + [%test_result: string list] (split "foo_,bar,baz") ~expect:[ "foo_,bar"; "baz" ] + ;; + + let%test_unit _ = + [%test_result: string list] (split "foo_,bar_,baz") ~expect:[ "foo_,bar_,baz" ] + ;; + + let%test_unit _ = + [%test_result: string list] + (split "foo__,bar,baz") + ~expect:[ "foo__"; "bar"; "baz" ] + ;; + + let%test_unit _ = + [%test_result: string list] + (split "foo,bar,baz_,") + ~expect:[ "foo"; "bar"; "baz_," ] + ;; + + let%test_unit _ = + [%test_result: string list] + (split "foo,bar_,baz_,,") + ~expect:[ "foo"; "bar_,baz_,"; "" ] + ;; + end) + ;; + + let%test_module "split_on_chars" = + (module struct + let split = split_on_chars ~escape_char:'_' ~on:[ ','; ':' ] + + let%test_unit _ = + [%test_result: string list] + (split "foo,bar:baz") + ~expect:[ "foo"; "bar"; "baz" ] + ;; + + let%test_unit _ = + [%test_result: string list] (split "foo_,bar,baz") ~expect:[ "foo_,bar"; "baz" ] + ;; + + let%test_unit _ = + [%test_result: string list] (split "foo_:bar_,baz") ~expect:[ "foo_:bar_,baz" ] + ;; + + let%test_unit _ = + [%test_result: string list] + (split "foo,bar,baz_,") + ~expect:[ "foo"; "bar"; "baz_," ] + ;; + + let%test_unit _ = + [%test_result: string list] + (split "foo:bar_,baz_,,") + ~expect:[ "foo"; "bar_,baz_,"; "" ] + ;; + end) + ;; + + let%test_module "split2" = + (module struct + let escape_char = '_' + let on = ',' + + let%test_unit _ = + [%test_result: (string * string) option] + (lsplit2 ~escape_char ~on "foo_,bar,baz_,0") + ~expect:(Some ("foo_,bar", "baz_,0")) + ;; + + let%test_unit _ = + [%test_result: (string * string) option] + (rsplit2 ~escape_char ~on "foo_,bar,baz_,0") + ~expect:(Some ("foo_,bar", "baz_,0")) + ;; + + let%test_unit _ = + [%test_result: string * string] + (lsplit2_exn ~escape_char ~on "foo_,bar,baz_,0") + ~expect:("foo_,bar", "baz_,0") + ;; + + let%test_unit _ = + [%test_result: string * string] + (rsplit2_exn ~escape_char ~on "foo_,bar,baz_,0") + ~expect:("foo_,bar", "baz_,0") + ;; + + let%test_unit _ = + [%test_result: (string * string) option] + (lsplit2 ~escape_char ~on "foo_,bar") + ~expect:None + ;; + + let%test_unit _ = + [%test_result: (string * string) option] + (rsplit2 ~escape_char ~on "foo_,bar") + ~expect:None + ;; + + let%test _ = Exn.does_raise (fun () -> lsplit2_exn ~escape_char ~on "foo_,bar") + let%test _ = Exn.does_raise (fun () -> rsplit2_exn ~escape_char ~on "foo_,bar") + end) + ;; + + let%test _ = strip_literal ~escape_char:' ' " foo bar \n" = " foo bar \n" + let%test _ = strip_literal ~escape_char:' ' " foo bar \n\n" = " foo bar \n" + let%test _ = strip_literal ~escape_char:'\n' " foo bar \n" = "foo bar \n" + let%test _ = lstrip_literal ~escape_char:' ' " foo bar \n\n" = " foo bar \n\n" + let%test _ = rstrip_literal ~escape_char:' ' " foo bar \n\n" = " foo bar \n" + let%test _ = lstrip_literal ~escape_char:'\n' " foo bar \n" = "foo bar \n" + let%test _ = rstrip_literal ~escape_char:'\n' " foo bar \n" = " foo bar \n" + let%test _ = strip_literal ~drop:Char.is_alpha ~escape_char:'\\' "foo boar" = " " + let%test _ = strip_literal ~drop:Char.is_alpha ~escape_char:'\\' "fooboar" = "" + let%test _ = strip_literal ~drop:Char.is_alpha ~escape_char:'o' "foo boar" = "oo boa" + let%test _ = strip_literal ~drop:Char.is_alpha ~escape_char:'a' "foo boar" = " boar" + let%test _ = strip_literal ~drop:Char.is_alpha ~escape_char:'b' "foo boar" = " bo" + + let%test _ = + lstrip_literal ~drop:Char.is_alpha ~escape_char:'o' "foo boar" = "oo boar" + ;; + + let%test _ = + rstrip_literal ~drop:Char.is_alpha ~escape_char:'o' "foo boar" = "foo boa" + ;; + + let%test _ = lstrip_literal ~drop:Char.is_alpha ~escape_char:'b' "foo boar" = " boar" + let%test _ = rstrip_literal ~drop:Char.is_alpha ~escape_char:'b' "foo boar" = "foo bo" + end) +;; diff --git a/unikernel/duniverse/base/test/test_string.mli b/unikernel/duniverse/base/test/test_string.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_string.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_type_equal.ml b/unikernel/duniverse/base/test/test_type_equal.ml new file mode 100644 index 00000000..abdce55b --- /dev/null +++ b/unikernel/duniverse/base/test/test_type_equal.ml @@ -0,0 +1,213 @@ +open! Import + +let%expect_test "[Id.sexp_of_t]" = + let id = Type_equal.Id.create ~name:"some-type-id" [%sexp_of: unit] in + print_s [%sexp (id : _ Type_equal.Id.t)]; + [%expect {| some-type-id |}] +;; + +let%test_module "Type_equal.Id" = + (module struct + open Type_equal.Id + + let t1 = create ~name:"t1" [%sexp_of: _] + let t2 = create ~name:"t2" [%sexp_of: _] + let%test _ = same t1 t1 + let%test _ = not (same t1 t2) + let%test _ = Option.is_some (same_witness t1 t1) + let%test _ = Option.is_none (same_witness t1 t2) + let%test_unit _ = ignore (same_witness_exn t1 t1 : (_, _) Type_equal.t) + let%test _ = Result.is_error (Result.try_with (fun () -> same_witness_exn t1 t2)) + end) +;; + +(* This test shows that we need [conv] even though [Type_equal.T] is exposed. *) +let%test_module "Type_equal" = + (module struct + open Type_equal + + let id = Id.create ~name:"int" [%sexp_of: int] + + module A : sig + type t + + val id : t Id.t + end = struct + type t = int + + let id = id + end + + module B : sig + type t + + val id : t Id.t + end = struct + type t = int + + let id = id + end + + let _a_to_b (a : A.t) = + let eq = Id.same_witness_exn A.id B.id in + (conv eq a : B.t) + ;; + + (* the following is rejected by the compiler *) + (* let _a_to_b (a : A.t) = + * let T = Id.same_witness_exn A.id B.id in + * (a : B.t) + *) + + module C = struct + type 'a t + end + + module Liftc = Lift (C) + + let _ac_to_bc (ac : A.t C.t) = + let eq = Liftc.lift (Id.same_witness_exn A.id B.id) in + (conv eq ac : B.t C.t) + ;; + end) +;; + +let%expect_test "Create*" = + let test id1 id2 = + let same_according_to_id = Type_equal.Id.same id1 id2 in + let eq = if same_according_to_id then "==" else "<>" in + print_s [%sexp (id1 : _ Type_equal.Id.t), (eq : string), (id2 : _ Type_equal.Id.t)]; + let uid1 = Type_equal.Id.uid id1 in + let uid2 = Type_equal.Id.uid id2 in + let same_according_to_uid = Type_equal.Id.Uid.equal uid1 uid2 in + if Bool.( <> ) same_according_to_id same_according_to_uid + then + print_cr + [%here] + [%message + "[Type_equal.Id] and [Type_equal.Id.Uid] disagree" + (id1 : _ Type_equal.Id.t) + (id2 : _ Type_equal.Id.t) + (uid1 : Type_equal.Id.Uid.t) + (uid2 : Type_equal.Id.Uid.t) + (same_according_to_id : bool) + (same_according_to_uid : bool)] + in + let module Bool = + Type_equal.Id.Create0 (struct + type t = bool [@@deriving sexp_of] + + let name = "bool" + end) + in + (* self comparison *) + test Bool.type_equal_id Bool.type_equal_id; + [%expect {| (bool == bool) |}]; + let module Int = + Type_equal.Id.Create0 (struct + type t = int [@@deriving sexp_of] + + let name = "int" + end) + in + (* another self comparison *) + test Int.type_equal_id Int.type_equal_id; + [%expect {| (int == int) |}]; + (* non-self comparison *) + test Int.type_equal_id Bool.type_equal_id; + [%expect {| (int <> bool) |}]; + (* re-creating the same type *) + test Int.type_equal_id (Type_equal.Id.create ~name:"Stdlib.int" sexp_of_int); + [%expect {| (int <> Stdlib.int) |}]; + let module Option = + Type_equal.Id.Create1 (struct + type 'a t = 'a option [@@deriving sexp_of] + + let name = "option" + end) + in + (* 1-ary vs 0-ary *) + test (Option.type_equal_id Int.type_equal_id) Int.type_equal_id; + [%expect {| ((option int) <> int) |}]; + (* 1-ary applied twice to same argument *) + test (Option.type_equal_id Int.type_equal_id) (Option.type_equal_id Int.type_equal_id); + [%expect {| ((option int) == (option int)) |}]; + (* 1-ary with different argument *) + test (Option.type_equal_id Int.type_equal_id) (Option.type_equal_id Bool.type_equal_id); + [%expect {| ((option int) <> (option bool)) |}]; + let module Either = + Type_equal.Id.Create2 (struct + type ('a, 'b) t = ('a, 'b) Either.t [@@deriving sexp_of] + + let name = "either" + end) + in + (* 2-ary vs 0-ary *) + test (Either.type_equal_id Int.type_equal_id Bool.type_equal_id) Int.type_equal_id; + [%expect {| ((either int bool) <> int) |}]; + (* 2-ary vs 1-ary *) + test + (Either.type_equal_id Int.type_equal_id Bool.type_equal_id) + (Option.type_equal_id Int.type_equal_id); + [%expect {| ((either int bool) <> (option int)) |}]; + (* 2-ary applied twice to same arguments *) + test + (Either.type_equal_id Int.type_equal_id Bool.type_equal_id) + (Either.type_equal_id Int.type_equal_id Bool.type_equal_id); + [%expect {| ((either int bool) == (either int bool)) |}]; + (* 2-ary with different arguments *) + test + (Either.type_equal_id Int.type_equal_id Bool.type_equal_id) + (Either.type_equal_id Bool.type_equal_id Int.type_equal_id); + [%expect {| ((either int bool) <> (either bool int)) |}]; + let module Tuple3 = + Type_equal.Id.Create3 (struct + type ('a, 'b, 'c) t = 'a * 'b * 'c [@@deriving sexp_of] + + let name = "tuple3" + end) + in + (* 3-ary vs 0-ary *) + test + (Tuple3.type_equal_id + Int.type_equal_id + Bool.type_equal_id + (Option.type_equal_id Bool.type_equal_id)) + Int.type_equal_id; + [%expect {| ((tuple3 int bool (option bool)) <> int) |}]; + (* 3-ary vs 1-ary *) + test + (Tuple3.type_equal_id + Int.type_equal_id + Bool.type_equal_id + (Option.type_equal_id Bool.type_equal_id)) + (Option.type_equal_id Int.type_equal_id); + [%expect {| ((tuple3 int bool (option bool)) <> (option int)) |}]; + (* 3-ary vs 2-ary *) + test + (Tuple3.type_equal_id + Int.type_equal_id + Bool.type_equal_id + (Option.type_equal_id Bool.type_equal_id)) + (Either.type_equal_id Int.type_equal_id Bool.type_equal_id); + [%expect {| ((tuple3 int bool (option bool)) <> (either int bool)) |}]; + (* 3-ary applied twice to same arguments *) + test + (Tuple3.type_equal_id + Int.type_equal_id + Bool.type_equal_id + (Option.type_equal_id Bool.type_equal_id)) + (Tuple3.type_equal_id + Int.type_equal_id + Bool.type_equal_id + (Option.type_equal_id Bool.type_equal_id)); + [%expect {| ((tuple3 int bool (option bool)) == (tuple3 int bool (option bool))) |}]; + (* 3-ary with different arguments *) + test + (Tuple3.type_equal_id + Int.type_equal_id + Bool.type_equal_id + (Option.type_equal_id Bool.type_equal_id)) + (Tuple3.type_equal_id Int.type_equal_id Bool.type_equal_id Int.type_equal_id); + [%expect {| ((tuple3 int bool (option bool)) <> (tuple3 int bool int)) |}] +;; diff --git a/unikernel/duniverse/base/test/test_type_equal.mli b/unikernel/duniverse/base/test/test_type_equal.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_type_equal.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_uchar.ml b/unikernel/duniverse/base/test/test_uchar.ml new file mode 100644 index 00000000..fa89632e --- /dev/null +++ b/unikernel/duniverse/base/test/test_uchar.ml @@ -0,0 +1,89 @@ +open! Import + +let min_int = Int.min_value +let max_int = Int.max_value +let raises f v = Exn.does_raise (fun () -> f v) + +let%test_module "test_constants" = + (module struct + let%test _ = Uchar.(to_scalar min_value) = 0x0000 + let%test _ = Uchar.(to_scalar max_value) = 0x10FFFF + end) +;; + +let%test_module "test_succ_exn" = + (module struct + let%test _ = raises Uchar.succ_exn Uchar.max_value + let%test _ = Uchar.(to_scalar (succ_exn min_value)) = 0x0001 + let%test _ = Uchar.(to_scalar (succ_exn (of_scalar_exn 0xD7FF))) = 0xE000 + let%test _ = Uchar.(to_scalar (succ_exn (of_scalar_exn 0xE000))) = 0xE001 + end) +;; + +let%test_module "test_pred_exn" = + (module struct + let%test _ = raises Uchar.pred_exn Uchar.min_value + let%test _ = Uchar.(to_scalar (pred_exn (of_scalar_exn 0xD7FF))) = 0xD7FE + let%test _ = Uchar.(to_scalar (pred_exn (of_scalar_exn 0xE000))) = 0xD7FF + let%test _ = Uchar.(to_scalar (pred_exn max_value)) = 0x10FFFE + end) +;; + +let%test_module "test_int_is_scalar" = + (module struct + let%test _ = not (Uchar.int_is_scalar (-1)) + let%test _ = Uchar.int_is_scalar 0x0000 + let%test _ = Uchar.int_is_scalar 0xD7FF + let%test _ = not (Uchar.int_is_scalar 0xD800) + let%test _ = not (Uchar.int_is_scalar 0xDFFF) + let%test _ = Uchar.int_is_scalar 0xE000 + let%test _ = Uchar.int_is_scalar 0x10FFFF + let%test _ = not (Uchar.int_is_scalar 0x110000) + let%test _ = not (Uchar.int_is_scalar min_int) + let%test _ = not (Uchar.int_is_scalar max_int) + end) +;; + +let char_max = Uchar.of_scalar_exn 0x00FF + +let%test_module "test_is_char" = + (module struct + let%test _ = Uchar.(is_char Uchar.min_value) + let%test _ = Uchar.(is_char char_max) + let%test _ = Uchar.(not (is_char (of_scalar_exn 0x0100))) + let%test _ = not (Uchar.is_char Uchar.max_value) + end) +;; + +let%test_module "test_of_char" = + (module struct + let%test _ = Uchar.(equal (of_char '\xFF') char_max) + let%test _ = Uchar.(equal (of_char '\x00') min_value) + end) +;; + +let%test_module "test_to_char_exn" = + (module struct + let%test _ = Char.equal Uchar.(to_char_exn min_value) '\x00' + let%test _ = Char.equal Uchar.(to_char_exn char_max) '\xFF' + let%test _ = raises Uchar.to_char_exn (Uchar.succ_exn char_max) + let%test _ = raises Uchar.to_char_exn Uchar.max_value + end) +;; + +let%test_module "test_equal" = + (module struct + let%test _ = Uchar.(equal min_value min_value) + let%test _ = Uchar.(equal max_value max_value) + let%test _ = not Uchar.(equal min_value max_value) + end) +;; + +let%test_module "test_compare" = + (module struct + let%test _ = Uchar.(compare min_value min_value) = 0 + let%test _ = Uchar.(compare max_value max_value) = 0 + let%test _ = Uchar.(compare min_value max_value) = -1 + let%test _ = Uchar.(compare max_value min_value) = 1 + end) +;; diff --git a/unikernel/duniverse/base/test/test_uchar.mli b/unikernel/duniverse/base/test/test_uchar.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_uchar.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_uniform_array.ml b/unikernel/duniverse/base/test/test_uniform_array.ml new file mode 100644 index 00000000..cfeb7ad6 --- /dev/null +++ b/unikernel/duniverse/base/test/test_uniform_array.ml @@ -0,0 +1,330 @@ +open! Import +open Uniform_array + +let does_raise = Exn.does_raise +let zero_obj = Stdlib.Obj.repr (0 : int) + +(* [create_obj_array] *) +let%test_unit _ = + let t = create_obj_array ~len:0 in + assert (length t = 0) +;; + +(* [create] *) +let%test_unit _ = + let str = Stdlib.Obj.repr "foo" in + let t = create ~len:2 str in + assert (phys_equal (get t 0) str); + assert (phys_equal (get t 1) str) +;; + +let%test_unit _ = + let float = Stdlib.Obj.repr 3.5 in + let t = create ~len:2 float in + assert (Stdlib.Obj.tag (Stdlib.Obj.repr t) = 0); + (* not a double array *) + assert (phys_equal (get t 0) float); + assert (phys_equal (get t 1) float); + set t 1 (Stdlib.Obj.repr 4.); + assert (Float.( = ) (Stdlib.Obj.obj (get t 1)) 4.) +;; + +(* [empty] *) +let%test _ = length empty = 0 +let%test _ = does_raise (fun () -> get empty 0) + +(* [singleton] *) +let%test _ = length (singleton zero_obj) = 1 +let%test _ = phys_equal (get (singleton zero_obj) 0) zero_obj +let%test _ = does_raise (fun () -> get (singleton zero_obj) 1) + +let%test_unit _ = + let f = 13. in + let t = singleton (Stdlib.Obj.repr f) in + invariant t; + assert (Poly.equal (Stdlib.Obj.repr f) (get t 0)) +;; + +(* [get], [unsafe_get], [set], [unsafe_set], [unsafe_set_assuming_currently_int], + [set_with_caml_modify] *) +let%test_unit _ = + let t = create_obj_array ~len:1 in + assert (length t = 1); + assert (phys_equal (get t 0) zero_obj); + assert (phys_equal (unsafe_get t 0) zero_obj); + let one_obj = Stdlib.Obj.repr (1 : int) in + let check_get expect = + assert (phys_equal (get t 0) expect); + assert (phys_equal (unsafe_get t 0) expect) + in + set t 0 one_obj; + check_get one_obj; + unsafe_set t 0 zero_obj; + check_get zero_obj; + unsafe_set_assuming_currently_int t 0 one_obj; + check_get one_obj; + set_with_caml_modify t 0 zero_obj; + check_get zero_obj +;; + +let%expect_test "exists" = + let test arr f = of_list arr |> exists ~f in + let r here = require_equal here (module Bool) in + r [%here] false (test [] Fn.id); + r [%here] true (test [ true ] Fn.id); + r [%here] true (test [ false; false; false; false; true ] Fn.id); + r [%here] true (test [ 0; 1; 2; 3; 4 ] (fun i -> i % 2 = 1)); + r [%here] false (test [ 0; 2; 4; 6; 8 ] (fun i -> i % 2 = 1)); + [%expect {| |}] +;; + +let%expect_test "for_all" = + let test arr f = of_list arr |> for_all ~f in + let r here = require_equal here (module Bool) in + r [%here] true (test [] Fn.id); + r [%here] true (test [ true ] Fn.id); + r [%here] false (test [ false; false; false; false; true ] Fn.id); + r [%here] false (test [ 0; 1; 2; 3; 4 ] (fun i -> i % 2 = 1)); + r [%here] true (test [ 0; 2; 4; 6; 8 ] (fun i -> i % 2 = 0)); + [%expect {| |}] +;; + +let%expect_test "iteri" = + let test arr = of_list arr |> iteri ~f:(printf "(%d %c)") in + test []; + [%expect {| |}]; + test [ 'a' ]; + [%expect {| (0 a) |}]; + test [ 'a'; 'b'; 'c'; 'd' ]; + [%expect {| (0 a)(1 b)(2 c)(3 d) |}] +;; + +module Sequence = struct + type nonrec 'a t = 'a t + type 'a z = 'a + + let length = length + let get = get + let set = set + let create_bool ~len = create ~len false +end + +include Base_for_tests.Test_blit.Test1 (Sequence) (Uniform_array) + +let%expect_test "map2_exn" = + let test a1 a2 f = + let result = map2_exn ~f (of_list a1) (of_list a2) in + print_s [%message (result : int Uniform_array.t)] + in + test [] [] (fun _ -> failwith "don't call me"); + [%expect {| (result ()) |}]; + test [ 1; 2; 3 ] [ 100; 200; 300 ] ( + ); + [%expect {| (result (101 202 303)) |}]; + require_does_raise [%here] (fun () -> test [ 1 ] [] (fun _ _ -> 0)); + [%expect {| (Invalid_argument Array.map2_exn) |}] +;; + +let%expect_test "fold2_exn" = + let test a1 a2 = + let result = + fold2_exn ~init:0 ~f:(fun acc x y -> acc + x + (1000 * y)) (of_list a1) (of_list a2) + in + print_s [%sexp (result : int)] + in + test [] []; + [%expect {| 0 |}]; + test [ 1; 2; 3 ] [ 7; 8; 9 ]; + [%expect {| 24_006 |}]; + require_does_raise [%here] (fun () -> test [ 1 ] []); + [%expect {| (Invalid_argument Array.fold2_exn) |}] +;; + +let%expect_test "mapi" = + let test arr = + let mapped = of_list arr |> mapi ~f:(fun i str -> i, String.capitalize str) in + print_s [%sexp (mapped : (int * string) t)] + in + test []; + [%expect {| () |}]; + test [ "foo"; "bar" ]; + [%expect {| + ((0 Foo) + (1 Bar)) + |}] +;; + +let%expect_test "of_list_rev" = + let test a = print_s [%sexp (of_list_rev a : int t)] in + test []; + [%expect {| () |}]; + test [ 1; 2; 3; 4 ]; + [%expect {| (4 3 2 1) |}] +;; + +let%expect_test "concat" = + let test ts = print_s [%sexp (concat ts : int t)] in + test []; + [%expect {| () |}]; + test [ of_list [ 1; 2; 3 ]; of_list [ 4; 5; 6 ]; empty; of_list [ 7 ] ]; + [%expect {| (1 2 3 4 5 6 7) |}] +;; + +let%expect_test "concat_map" = + let test t = + print_s + [%sexp + (concat_map t ~f:(fun i -> of_list [ i * 10; (i * 10) + 1; (i * 10) + 2 ]) + : int t)] + in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 2; 3; 4 ]); + [%expect {| (10 11 12 20 21 22 30 31 32 40 41 42) |}] +;; + +let%expect_test "concat_mapi" = + let test t = + print_s + [%sexp + (concat_mapi t ~f:(fun idx i -> + if idx = 1 then empty else of_list [ i * 10; (i * 10) + 1; (i * 10) + 2 ]) + : int t)] + in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 2; 3; 4 ]); + [%expect {| (10 11 12 30 31 32 40 41 42) |}] +;; + +let%expect_test "partition_map" = + let test t = + let first, second = + partition_map t ~f:(fun i -> + match i % 2 = 0 with + | true -> First i + | false -> Second i) + in + print_s [%sexp (first : int t)]; + print_s [%sexp (second : int t)] + in + test empty; + [%expect {| + () + () + |}]; + test (of_list [ 0; 1; 2; 3 ]); + [%expect {| + (0 2) + (1 3) + |}]; + test (of_list [ 0; 2; 4; 6 ]); + [%expect {| + (0 2 4 6) + () + |}]; + test (of_list [ 1; 3; 5; 7 ]); + [%expect {| + () + (1 3 5 7) + |}] +;; + +let%expect_test "filter" = + let test t = print_s [%sexp (filter t ~f:(fun i -> i % 2 = 0) : int t)] in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 2; 3; 4; 5; 6; 7; 8 ]); + [%expect {| (2 4 6 8) |}] +;; + +let%expect_test "filteri" = + let test t = + print_s [%sexp (filteri t ~f:(fun idx i -> idx = 0 || i % 2 = 0) : int t)] + in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 2; 3; 4; 5; 6; 7; 8 ]); + [%expect {| (1 2 4 6 8) |}] +;; + +let%expect_test "filter_map" = + let test t = + print_s + [%sexp + (filter_map t ~f:(fun i -> + if i % 2 = 0 then None else Some (Char.of_int_exn (Char.to_int 'a' + i))) + : char t)] + in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 2; 3; 4; 5; 6; 7; 8 ]); + [%expect {| (b d f h) |}] +;; + +let%expect_test "filter_mapi" = + let test t = + print_s + [%sexp + (filter_mapi t ~f:(fun idx i -> + if idx = 0 || i % 2 = 0 + then None + else + Some + (Int.to_string idx + ^ ": " + ^ Char.to_string (Char.of_int_exn (Char.to_int 'a' + i)))) + : string t)] + in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 2; 3; 4; 5; 6; 7; 8 ]); + [%expect {| ("2: d" "4: f" "6: h") |}] +;; + +let%expect_test "find" = + let test t = print_s [%sexp (find t ~f:(fun i -> i >= 6) : int option)] in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 5; 2; 6; 7; 3; 0; -8; 10 ]); + [%expect {| (6) |}] +;; + +let%expect_test "findi" = + let test t = + print_s [%sexp (findi t ~f:(fun idx i -> idx % 2 = 0 && i >= 6) : (int * int) option)] + in + test empty; + [%expect {| () |}]; + test (of_list [ 1; 5; 2; 6; 7; 3; 0; -8; 10 ]); + [%expect {| ((4 7)) |}] +;; + +let%expect_test "find_map" = + let test t = print_s [%sexp (find_map t ~f:Char.of_int : char option)] in + test empty; + [%expect {| () |}]; + test (of_list [ 500; 1000; -3; 65; 66; 7000 ]); + [%expect {| (A) |}] +;; + +let%expect_test "find_mapi" = + let test t = + print_s + [%sexp + (find_mapi t ~f:(fun idx i -> if idx % 2 = 1 then None else Char.of_int i) + : char option)] + in + test empty; + [%expect {| () |}]; + test (of_list [ 500; 1000; -3; 65; 66; 7000 ]); + [%expect {| (B) |}] +;; + +let%expect_test "unsafe_to_array_inplace__promise_not_a_float" = + let arr = of_list [ 1; 2; 3; 4; 5 ] in + print_s [%sexp (arr : int t)]; + [%expect {| (1 2 3 4 5) |}]; + let arr = unsafe_to_array_inplace__promise_not_a_float arr in + print_s [%sexp (arr : int array)]; + [%expect {| (1 2 3 4 5) |}] +;; diff --git a/unikernel/duniverse/base/test/test_uniform_array.mli b/unikernel/duniverse/base/test/test_uniform_array.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_uniform_array.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_with_return.ml b/unikernel/duniverse/base/test/test_with_return.ml new file mode 100644 index 00000000..e679f271 --- /dev/null +++ b/unikernel/duniverse/base/test/test_with_return.ml @@ -0,0 +1,50 @@ +open! Import +open! With_return + +let test_loop loop_limit jump_out = + with_return (fun { return } -> + for i = 0 to loop_limit do + if i = jump_out then return (`Jumped_out i) + done; + `Normal) +;; + +let ( = ) = Poly.equal +let%test _ = test_loop 5 10 = `Normal +let%test _ = test_loop 10 5 = `Jumped_out 5 +let%test _ = test_loop 5 5 = `Jumped_out 5 + +let test_nested outer inner = + with_return (fun { return = return_outer } -> + if outer = `Outer_jump then return_outer `Outer_jump; + let inner_res = + with_return (fun { return = return_inner } -> + if inner = `Inner_jump_out_completely then return_outer `Inner_jump; + if inner = `Inner_jump then return_inner `Inner_jump; + `Inner_normal) + in + if outer = `Jump_with_inner then return_outer (`Outer_later_jump inner_res); + `Outer_normal inner_res) +;; + +let%test _ = test_nested `Outer_jump `Inner_jump = `Outer_jump +let%test _ = test_nested `Outer_jump `Inner_jump_out_completely = `Outer_jump +let%test _ = test_nested `Outer_jump `Foo = `Outer_jump +let%test _ = test_nested `Jump_with_inner `Inner_jump_out_completely = `Inner_jump +let%test _ = test_nested `Jump_with_inner `Inner_jump = `Outer_later_jump `Inner_jump +let%test _ = test_nested `Jump_with_inner `Foo = `Outer_later_jump `Inner_normal +let%test _ = test_nested `Foo `Inner_jump_out_completely = `Inner_jump +let%test _ = test_nested `Foo `Inner_jump = `Outer_normal `Inner_jump +let%test _ = test_nested `Foo `Foo = `Outer_normal `Inner_normal + +let test_loop loop_limit jump_out = + with_return_option (fun { return } -> + for i = 0 to loop_limit do + if i = jump_out then return (`Jumped_out i) + done) +;; + +let ( = ) = Poly.equal +let%test _ = test_loop 5 10 = None +let%test _ = test_loop 10 5 = Some (`Jumped_out 5) +let%test _ = test_loop 5 5 = Some (`Jumped_out 5) diff --git a/unikernel/duniverse/base/test/test_with_return.mli b/unikernel/duniverse/base/test/test_with_return.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_with_return.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/base/test/test_word_size.ml b/unikernel/duniverse/base/test/test_word_size.ml new file mode 100644 index 00000000..44e1e8e9 --- /dev/null +++ b/unikernel/duniverse/base/test/test_word_size.ml @@ -0,0 +1,9 @@ +open! Import +open! Word_size + +let%expect_test _ = + print_s [%message (W32 : t)]; + [%expect {| (W32 W32) |}]; + print_s [%message (W64 : t)]; + [%expect {| (W64 W64) |}] +;; diff --git a/unikernel/duniverse/base/test/test_word_size.mli b/unikernel/duniverse/base/test/test_word_size.mli new file mode 100644 index 00000000..74bb7298 --- /dev/null +++ b/unikernel/duniverse/base/test/test_word_size.mli @@ -0,0 +1 @@ +(*_ This signature is deliberately empty. *) diff --git a/unikernel/duniverse/bigstringaf/.github/workflows/test.yml b/unikernel/duniverse/bigstringaf/.github/workflows/test.yml new file mode 100644 index 00000000..2070328c --- /dev/null +++ b/unikernel/duniverse/bigstringaf/.github/workflows/test.yml @@ -0,0 +1,40 @@ +name: build + +on: + - push + - pull_request + +jobs: + tests: + name: Tests + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + ocaml-version: + - 4.08.1 + - 4.09.1 + - 4.11.2 + - 4.13.1 + - 4.14.0 + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v2 + + - name: Use OCaml ${{ matrix.ocaml-version }} + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-version }} + + - name: Deps + run: opam install -t --deps-only . + + - name: Build + run: opam exec -- dune build + + - name: Test + run: opam exec -- dune runtest diff --git a/unikernel/duniverse/bigstringaf/.gitignore b/unikernel/duniverse/bigstringaf/.gitignore new file mode 100644 index 00000000..637b5004 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/.gitignore @@ -0,0 +1,5 @@ +.*.sw[a-z] +*~ +_build/ +_opam/ +*.install diff --git a/unikernel/duniverse/bigstringaf/CHANGES.md b/unikernel/duniverse/bigstringaf/CHANGES.md new file mode 100644 index 00000000..89fe10ea --- /dev/null +++ b/unikernel/duniverse/bigstringaf/CHANGES.md @@ -0,0 +1,21 @@ +### 0.4.0 (2018-10-26) + +* freestanding: fix dependencies (ocaml-freestanding #22 @hannesm) +* xen: unify usage of mirage-xen-posix package (#17 @hannesm) +* fix typo in comment (#18 @tiensonqin) +* jbuild: do not use bash (#16 #21 @rgrinberg, #22 @hannesm) +* opam: add '"-p" name' to subst command (#15 @seliopou) + +### 0.3.0 (2018-07-07) + +* Add linking support for mirage-xen-ocaml and ocaml-freestanding (#12, #13, #14, h/t @samoht, @hannesm, @dinosaure) + +### 0.2.0 (2018-06-10) + +* Add memcmp operations (#2) +* Fix bounds checking bugs in constructors (#4, #5, h/t @yallop) +* Add safe blit/memcmp operations (#8) + +### 0.1.0 (2018-04-01) + +* initial release \ No newline at end of file diff --git a/unikernel/duniverse/bigstringaf/LICENSE b/unikernel/duniverse/bigstringaf/LICENSE new file mode 100644 index 00000000..4429ca31 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, Inhabited Type LLC + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/unikernel/duniverse/bigstringaf/Makefile b/unikernel/duniverse/bigstringaf/Makefile new file mode 100644 index 00000000..0f459184 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/Makefile @@ -0,0 +1,18 @@ +.PHONY: all build clean test + +build: + dune build @install + +all: build + +test: + dune runtest + +install: + dune install + +uninstall: + dune uninstall + +clean: + rm -rf _build *.install diff --git a/unikernel/duniverse/bigstringaf/README.md b/unikernel/duniverse/bigstringaf/README.md new file mode 100644 index 00000000..62765ae4 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/README.md @@ -0,0 +1,46 @@ +# Bigstringaf + +The OCaml compiler has a bunch of intrinsics for Bigstrings, but they're not +widely-known, sometimes misused, and programs that use Bigstrings are slower +than they have to be. And even if a library got that part right and exposed +the intrinsics properly, the compiler doesn't have any fast blits between +Bigstrings and other string-like types. + +So here they are. Go crazy. + +[![Build Status](https://github.com/inhabitedtype/bigstringaf/workflows/build/badge.svg)](https://github.com/inhabitedtype/bigstringaf/actions?query=workflow%3A%22build%22) + +## Installation + +Install the library and its dependencies via [OPAM][opam]: + +[opam]: http://opam.ocaml.org/ + +```bash +opam install bigstringaf +``` + +## Development + +To install development dependencies, pin the package from the root of the +repository: + +```bash +opam pin add -n bigstringaf . +opam install --deps-only bigstringaf +``` + +After this, you may install a development version of the library using the +install command as usual. + +For building and running the tests during development, you will need to install +the `alcotest` package: + +```bash +opam install alcotest +make test +``` + +## License + +BSD3, see LICENSE file for its text. diff --git a/unikernel/duniverse/bigstringaf/bigstringaf.opam b/unikernel/duniverse/bigstringaf/bigstringaf.opam new file mode 100644 index 00000000..b150d2c5 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/bigstringaf.opam @@ -0,0 +1,45 @@ +version: "0.10.0" +opam-version: "2.0" +maintainer: "Spiros Eliopoulos " +authors: [ "Spiros Eliopoulos " ] +license: "BSD-3-clause" +homepage: "https://github.com/inhabitedtype/bigstringaf" +bug-reports: "https://github.com/inhabitedtype/bigstringaf/issues" +dev-repo: "git+https://github.com/inhabitedtype/bigstringaf.git" +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +depends: [ + "dune" {>= "3.0"} + "dune-configurator" {>= "3.0"} + "alcotest" {with-test} + "ocaml" {>= "4.08.0"} +] +conflicts: [ + "mirage-xen" {< "6.0.0"} + "ocaml-freestanding" + "js_of_ocaml" {< "3.5.0"} +] +synopsis: "Bigstring intrinsics and fast blits based on memcpy/memmove" +description: """ +Bigstring intrinsics and fast blits based on memcpy/memmove + +The OCaml compiler has a bunch of intrinsics for Bigstrings, but they're not +widely-known, sometimes misused, and so programs that use Bigstrings are slower +than they have to be. And even if a library got that part right and exposed the +intrinsics properly, the compiler doesn't have any fast blits between +Bigstrings and other string-like types. + +So here they are. Go crazy. +""" diff --git a/unikernel/duniverse/bigstringaf/dune-project b/unikernel/duniverse/bigstringaf/dune-project new file mode 100644 index 00000000..efb9888f --- /dev/null +++ b/unikernel/duniverse/bigstringaf/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.0) +(name bigstringaf) +(formatting (enabled_for dune)) diff --git a/unikernel/duniverse/bigstringaf/lib/bigstringaf.ml b/unikernel/duniverse/bigstringaf/lib/bigstringaf.ml new file mode 100644 index 00000000..7556728f --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib/bigstringaf.ml @@ -0,0 +1,346 @@ +type bigstring = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +type t = bigstring + +let create size = Bigarray.(Array1.create char c_layout size) +let empty = create 0 + +module BA1 = Bigarray.Array1 + +let length t = BA1.dim t + +external get : t -> int -> char = "%caml_ba_ref_1" +external set : t -> int -> char -> unit = "%caml_ba_set_1" + +external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1" +external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1" + +external unsafe_blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit = + "bigstringaf_blit_to_bigstring" [@@noalloc] + +external unsafe_blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit = + "bigstringaf_blit_to_bytes" [@@noalloc] + +external unsafe_blit_from_bytes : Bytes.t -> src_off:int -> t -> dst_off:int -> len:int -> unit = + "bigstringaf_blit_from_bytes" [@@noalloc] + +external unsafe_blit_from_string : string -> src_off:int -> t -> dst_off:int -> len:int -> unit = + "bigstringaf_blit_from_bytes" [@@noalloc] + +external unsafe_memcmp : t -> int -> t -> int -> int -> int = + "bigstringaf_memcmp_bigstring" [@@noalloc] + +external unsafe_memcmp_string : t -> int -> string -> int -> int -> int = + "bigstringaf_memcmp_string" [@@noalloc] + +external unsafe_memchr : t -> int -> char -> int -> int = + "bigstringaf_memchr" [@@noalloc] + +let sub t ~off ~len = + BA1.sub t off len + +let[@inline never] invalid_bounds op buffer_len off len = + let message = + Printf.sprintf "Bigstringaf.%s invalid range: { buffer_len: %d, off: %d, len: %d }" + op buffer_len off len + in + raise (Invalid_argument message) +;; + +let[@inline never] invalid_bounds_blit op src_len src_off dst_len dst_off len = + let message = + Printf.sprintf "Bigstringaf.%s invalid range: { src_len: %d, src_off: %d, dst_len: %d, dst_off: %d, len: %d }" + op src_len src_off dst_len dst_off len + in + raise (Invalid_argument message) +;; + +let[@inline never] invalid_bounds_memcmp op buf1_len buf1_off buf2_len buf2_off len = + let message = + Printf.sprintf "Bigstringaf.%s invalid range: { buf1_len: %d, buf1_off: %d, buf2_len: %d, buf2_off: %d, len: %d }" + op buf1_len buf1_off buf2_len buf2_off len + in + raise (Invalid_argument message) +;; + +(* A note on bounds checking. + * + * The code should perform the following check to ensure that the blit doesn't + * run off the end of the input buffer: + * + * {[off + len <= buffer_len]} + * + * However, this may lead to an integer overflow for large values of [off], + * e.g., [max_int], which will cause the comparison to return [true] when it + * should really return [false]. + * + * An equivalent comparison that does not run into this integer overflow + * problem is: + * + * {[buffer_len - off => len]} + * + * This is checking that the input buffer, less the offset, is sufficiently + * long to perform the blit. Since the expression is subtracting [off] rather + * than adding it, it doesn't suffer from the overflow that the previous + * inequality did. As long as there is a check to ensure that [off] is not + * negative, it won't underflow either. *) + +let copy t ~off ~len = + let buffer_len = length t in + if len < 0 || off < 0 || buffer_len - off < len + then invalid_bounds "copy" buffer_len off len; + let dst = create len in + unsafe_blit t ~src_off:off dst ~dst_off:0 ~len; + dst +;; + +let substring t ~off ~len = + let buffer_len = length t in + if len < 0 || off < 0 || buffer_len - off < len + then invalid_bounds "substring" buffer_len off len; + let b = Bytes.create len in + unsafe_blit_to_bytes t ~src_off:off b ~dst_off:0 ~len; + Bytes.unsafe_to_string b +;; + +let to_string t = + let len = length t in + let b = Bytes.create len in + unsafe_blit_to_bytes t ~src_off:0 b ~dst_off:0 ~len; + Bytes.unsafe_to_string b +;; + +let of_string ~off ~len s = + let buffer_len = String.length s in + if len < 0 || off < 0 || buffer_len - off < len + then invalid_bounds "of_string" buffer_len off len; + let b = create len in + unsafe_blit_from_string s ~src_off:off b ~dst_off:0 ~len; + b +;; + +let blit src ~src_off dst ~dst_off ~len = + let src_len = length src in + let dst_len = length dst in + if len < 0 + then invalid_bounds_blit "blit" src_len src_off dst_len dst_off len; + if src_off < 0 || src_len - src_off < len + then invalid_bounds_blit "blit" src_len src_off dst_len dst_off len; + if dst_off < 0 || dst_len - dst_off < len + then invalid_bounds_blit "blit" src_len src_off dst_len dst_off len; + unsafe_blit src ~src_off dst ~dst_off ~len +;; + +let blit_from_string src ~src_off dst ~dst_off ~len = + let src_len = String.length src in + let dst_len = length dst in + if len < 0 + then invalid_bounds_blit "blit_from_string" src_len src_off dst_len dst_off len; + if src_off < 0 || src_len - src_off < len + then invalid_bounds_blit "blit_from_string" src_len src_off dst_len dst_off len; + if dst_off < 0 || dst_len - dst_off < len + then invalid_bounds_blit "blit_from_string" src_len src_off dst_len dst_off len; + unsafe_blit_from_string src ~src_off dst ~dst_off ~len +;; + +let blit_from_bytes src ~src_off dst ~dst_off ~len = + let src_len = Bytes.length src in + let dst_len = length dst in + if len < 0 + then invalid_bounds_blit "blit_from_bytes" src_len src_off dst_len dst_off len; + if src_off < 0 || src_len - src_off < len + then invalid_bounds_blit "blit_from_bytes" src_len src_off dst_len dst_off len; + if dst_off < 0 || dst_len - dst_off < len + then invalid_bounds_blit "blit_from_bytes" src_len src_off dst_len dst_off len; + unsafe_blit_from_bytes src ~src_off dst ~dst_off ~len +;; + +let blit_to_bytes src ~src_off dst ~dst_off ~len = + let src_len = length src in + let dst_len = Bytes.length dst in + if len < 0 + then invalid_bounds_blit "blit_to_bytes" src_len src_off dst_len dst_off len; + if src_off < 0 || src_len - src_off < len + then invalid_bounds_blit "blit_to_bytes" src_len src_off dst_len dst_off len; + if dst_off < 0 || dst_len - dst_off < len + then invalid_bounds_blit "blit_to_bytes" src_len src_off dst_len dst_off len; + unsafe_blit_to_bytes src ~src_off dst ~dst_off ~len +;; + +let memcmp buf1 buf1_off buf2 buf2_off len = + let buf1_len = length buf1 in + let buf2_len = length buf2 in + if len < 0 + then invalid_bounds_memcmp "memcmp" buf1_len buf1_off buf2_len buf2_off len; + if buf1_off < 0 || buf1_len - buf1_off < len + then invalid_bounds_memcmp "memcmp" buf1_len buf1_off buf2_len buf2_off len; + if buf2_off < 0 || buf2_len - buf2_off < len + then invalid_bounds_memcmp "memcmp" buf1_len buf1_off buf2_len buf2_off len; + unsafe_memcmp buf1 buf1_off buf2 buf2_off len +;; + +let memcmp_string buf1 buf1_off buf2 buf2_off len = + let buf1_len = length buf1 in + let buf2_len = String.length buf2 in + if len < 0 + then invalid_bounds_memcmp "memcmp_string" buf1_len buf1_off buf2_len buf2_off len; + if buf1_off < 0 || buf1_len - buf1_off < len + then invalid_bounds_memcmp "memcmp_string" buf1_len buf1_off buf2_len buf2_off len; + if buf2_off < 0 || buf2_len - buf2_off < len + then invalid_bounds_memcmp "memcmp_string" buf1_len buf1_off buf2_len buf2_off len; + unsafe_memcmp_string buf1 buf1_off buf2 buf2_off len +;; + +let memchr buf buf_off chr len = + let buf_len = length buf in + if len < 0 + then invalid_bounds "memchr" buf_len buf_off len; + if buf_off < 0 || buf_len - buf_off < len + then invalid_bounds "memchr" buf_len buf_off len; + unsafe_memchr buf buf_off chr len + +(* Safe operations *) + +external caml_bigstring_set_16 : bigstring -> int -> int -> unit = "%caml_bigstring_set16" +external caml_bigstring_set_32 : bigstring -> int -> int32 -> unit = "%caml_bigstring_set32" +external caml_bigstring_set_64 : bigstring -> int -> int64 -> unit = "%caml_bigstring_set64" + +external caml_bigstring_get_16 : bigstring -> int -> int = "%caml_bigstring_get16" +external caml_bigstring_get_32 : bigstring -> int -> int32 = "%caml_bigstring_get32" +external caml_bigstring_get_64 : bigstring -> int -> int64 = "%caml_bigstring_get64" + +module Swap = struct + external bswap16 : int -> int = "%bswap16" + external bswap_int32 : int32 -> int32 = "%bswap_int32" + external bswap_int64 : int64 -> int64 = "%bswap_int64" + + let caml_bigstring_set_16 bs off i = + caml_bigstring_set_16 bs off (bswap16 i) + + let caml_bigstring_set_32 bs off i = + caml_bigstring_set_32 bs off (bswap_int32 i) + + let caml_bigstring_set_64 bs off i = + caml_bigstring_set_64 bs off (bswap_int64 i) + + let caml_bigstring_get_16 bs off = + bswap16 (caml_bigstring_get_16 bs off) + + let caml_bigstring_get_32 bs off = + bswap_int32 (caml_bigstring_get_32 bs off) + + let caml_bigstring_get_64 bs off = + bswap_int64 (caml_bigstring_get_64 bs off) + + let get_int16_sign_extended x off = + ((caml_bigstring_get_16 x off) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) +end + +let set_int16_le, set_int16_be = + if Sys.big_endian + then Swap.caml_bigstring_set_16, caml_bigstring_set_16 + else caml_bigstring_set_16 , Swap.caml_bigstring_set_16 + +let set_int32_le, set_int32_be = + if Sys.big_endian + then Swap.caml_bigstring_set_32, caml_bigstring_set_32 + else caml_bigstring_set_32 , Swap.caml_bigstring_set_32 + +let set_int64_le, set_int64_be = + if Sys.big_endian + then Swap.caml_bigstring_set_64, caml_bigstring_set_64 + else caml_bigstring_set_64 , Swap.caml_bigstring_set_64 + +let get_int16_le, get_int16_be = + if Sys.big_endian + then Swap.caml_bigstring_get_16, caml_bigstring_get_16 + else caml_bigstring_get_16 , Swap.caml_bigstring_get_16 + +let get_int16_sign_extended_noswap x off = + ((caml_bigstring_get_16 x off) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) + +let get_int16_sign_extended_le, get_int16_sign_extended_be = + if Sys.big_endian + then Swap.get_int16_sign_extended , get_int16_sign_extended_noswap + else get_int16_sign_extended_noswap, Swap.get_int16_sign_extended + +let get_int32_le, get_int32_be = + if Sys.big_endian + then Swap.caml_bigstring_get_32, caml_bigstring_get_32 + else caml_bigstring_get_32 , Swap.caml_bigstring_get_32 + +let get_int64_le, get_int64_be = + if Sys.big_endian + then Swap.caml_bigstring_get_64, caml_bigstring_get_64 + else caml_bigstring_get_64 , Swap.caml_bigstring_get_64 + +(* Unsafe operations *) + +external caml_bigstring_unsafe_set_16 : bigstring -> int -> int -> unit = "%caml_bigstring_set16u" +external caml_bigstring_unsafe_set_32 : bigstring -> int -> int32 -> unit = "%caml_bigstring_set32u" +external caml_bigstring_unsafe_set_64 : bigstring -> int -> int64 -> unit = "%caml_bigstring_set64u" + +external caml_bigstring_unsafe_get_16 : bigstring -> int -> int = "%caml_bigstring_get16u" +external caml_bigstring_unsafe_get_32 : bigstring -> int -> int32 = "%caml_bigstring_get32u" +external caml_bigstring_unsafe_get_64 : bigstring -> int -> int64 = "%caml_bigstring_get64u" + +module USwap = struct + external bswap16 : int -> int = "%bswap16" + external bswap_int32 : int32 -> int32 = "%bswap_int32" + external bswap_int64 : int64 -> int64 = "%bswap_int64" + + let caml_bigstring_unsafe_set_16 bs off i = + caml_bigstring_unsafe_set_16 bs off (bswap16 i) + + let caml_bigstring_unsafe_set_32 bs off i = + caml_bigstring_unsafe_set_32 bs off (bswap_int32 i) + + let caml_bigstring_unsafe_set_64 bs off i = + caml_bigstring_unsafe_set_64 bs off (bswap_int64 i) + + let caml_bigstring_unsafe_get_16 bs off = + bswap16 (caml_bigstring_unsafe_get_16 bs off) + + let caml_bigstring_unsafe_get_32 bs off = + bswap_int32 (caml_bigstring_unsafe_get_32 bs off) + + let caml_bigstring_unsafe_get_64 bs off = + bswap_int64 (caml_bigstring_unsafe_get_64 bs off) +end + +let unsafe_set_int16_le, unsafe_set_int16_be = + if Sys.big_endian + then USwap.caml_bigstring_unsafe_set_16, caml_bigstring_unsafe_set_16 + else caml_bigstring_unsafe_set_16 , USwap.caml_bigstring_unsafe_set_16 + +let unsafe_set_int32_le, unsafe_set_int32_be = + if Sys.big_endian + then USwap.caml_bigstring_unsafe_set_32, caml_bigstring_unsafe_set_32 + else caml_bigstring_unsafe_set_32 , USwap.caml_bigstring_unsafe_set_32 + +let unsafe_set_int64_le, unsafe_set_int64_be = + if Sys.big_endian + then USwap.caml_bigstring_unsafe_set_64, caml_bigstring_unsafe_set_64 + else caml_bigstring_unsafe_set_64 , USwap.caml_bigstring_unsafe_set_64 + +let unsafe_get_int16_le, unsafe_get_int16_be = + if Sys.big_endian + then USwap.caml_bigstring_unsafe_get_16, caml_bigstring_unsafe_get_16 + else caml_bigstring_unsafe_get_16 , USwap.caml_bigstring_unsafe_get_16 + +let unsafe_get_int16_sign_extended_le x off = + ((unsafe_get_int16_le x off) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) + +let unsafe_get_int16_sign_extended_be x off = + ((unsafe_get_int16_be x off ) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) + +let unsafe_get_int32_le, unsafe_get_int32_be = + if Sys.big_endian + then USwap.caml_bigstring_unsafe_get_32, caml_bigstring_unsafe_get_32 + else caml_bigstring_unsafe_get_32 , USwap.caml_bigstring_unsafe_get_32 + +let unsafe_get_int64_le, unsafe_get_int64_be = + if Sys.big_endian + then USwap.caml_bigstring_unsafe_get_64, caml_bigstring_unsafe_get_64 + else caml_bigstring_unsafe_get_64 , USwap.caml_bigstring_unsafe_get_64 diff --git a/unikernel/duniverse/bigstringaf/lib/bigstringaf.mli b/unikernel/duniverse/bigstringaf/lib/bigstringaf.mli new file mode 100644 index 00000000..5d4037fe --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib/bigstringaf.mli @@ -0,0 +1,282 @@ +(** Bigstrings, but fast. + + The OCaml compiler has a bunch of intrinsics for Bigstrings, but they're + not widely-known, sometimes misused, and so programs that use Bigstrings + are slower than they have to be. And even if a library got that part right + and exposed the intrinsics properly, the compiler doesn't have any fast blits + between Bigstrings and other string-like types. + + So here they are. Go crazy. *) + +type t = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +(** {2 Constructors} *) + +val create : int -> t +(** [create n] returns a bigstring of length [n] *) + +val empty : t +(** [empty] is the empty bigstring. It has length [0] and you can't really do + much with it, but it's a good placeholder that only needs to be allocated + once. *) + +val of_string : off:int -> len:int -> string -> t +(** [of_string ~off ~len s] returns a bigstring of length [len] that contains + the contents of string from the range [\[off, len)]. *) + +val copy : t -> off:int -> len:int -> t +(** [copy t ~off ~len] allocates a new bigstring of length [len] and copies the + bytes from [t] copied into it starting from [off]. *) + +val sub : t -> off:int -> len:int -> t +(** [sub t ~off ~len] does not allocate a bigstring, but instead returns a new + view into [t] starting at [off], and with length [len]. + + {b Note} that this does not allocate a new buffer, but instead shares the + buffer of [t] with the newly-returned bigstring. *) + + +(** {2 Memory-safe Operations} *) + +val length : t -> int +(** [length t] is the length of the bigstring, in bytes. *) + +val substring : t -> off:int -> len:int -> string +(** [substring t ~off ~len] returns a string of length [len] containing the + bytes of [t] starting at [off]. *) + +val to_string : t -> string +(** [to_string t] is equivalent to [substring t ~off:0 ~len:(length t)] *) + +external get : t -> int -> char = "%caml_ba_ref_1" +(** [get t i] returns the character at offset [i] in [t]. *) + +external set : t -> int -> char -> unit = "%caml_ba_set_1" +(** [set t i c] sets the character at offset [i] in [t] to be [c] *) + +(** {3 Little-endian Byte Order} + + The following operations assume a little-endian byte ordering of the + bigstring. If the machine-native byte ordering differs, then the get + operations will reorder the bytes so that they are in machine-native byte + order before returning the result, and the set operations will reorder the + bytes so that they are written out in the appropriate order. + + Most modern processor architectures are little-endian, so more likely than + not, these operations will not do any byte reordering. *) + +val get_int16_le : t -> int -> int +(** [get_int16_le t i] returns the two bytes in [t] starting at offset [i], + interpreted as an unsigned integer. *) + +val get_int16_sign_extended_le : t -> int -> int +(** [get_int16_sign_extended_le t i] returns the two bytes in [t] starting at + offset [i], interpreted as a signed integer and performing sign extension + to the native word size before returning the result. *) + +val set_int16_le : t -> int -> int -> unit +(** [set_int16_le t i v] sets the two bytes in [t] starting at offset [i] to + the value [v]. *) + +val get_int32_le : t -> int -> int32 +(** [get_int32_le t i] returns the four bytes in [t] starting at offset [i]. *) + +val set_int32_le : t -> int -> int32 -> unit +(** [set_int32_le t i v] sets the four bytes in [t] starting at offset [i] to + the value [v]. *) + +val get_int64_le : t -> int -> int64 +(** [get_int64_le t i] returns the eight bytes in [t] starting at offset [i]. *) + +val set_int64_le : t -> int -> int64 -> unit +(** [set_int64_le t i v] sets the eight bytes in [t] starting at offset [i] to + the value [v]. *) + + +(** {3 Big-endian Byte Order} + + The following operations assume a big-endian byte ordering of the + bigstring. If the machine-native byte ordering differs, then the get + operations will reorder the bytes so that they are in machine-native byte + order before returning the result, and the set operations will reorder the + bytes so that they are written out in the appropriate order. + + Network byte order is big-endian, so you may need these operations when + dealing with raw frames, for example, in a userland networking stack. *) + +val get_int16_be : t -> int -> int +(** [get_int16_be t i] returns the two bytes in [t] starting at offset [i], + interpreted as an unsigned integer. *) + +val get_int16_sign_extended_be : t -> int -> int +(** [get_int16_sign_extended_be t i] returns the two bytes in [t] starting at + offset [i], interpreted as a signed integer and performing sign extension + to the native word size before returning the result. *) + +val set_int16_be : t -> int -> int -> unit +(** [set_int16_be t i v] sets the two bytes in [t] starting at offset [off] to + the value [v]. *) + +val get_int32_be : t -> int -> int32 +(** [get_int32_be t i] returns the four bytes in [t] starting at offset [i]. *) + +val set_int32_be : t -> int -> int32 -> unit +(** [set_int32_be t i v] sets the four bytes in [t] starting at offset [i] to + the value [v]. *) + +val get_int64_be : t -> int -> int64 +(** [get_int64_be t i] returns the eight bytes in [t] starting at offset [i]. *) + +val set_int64_be : t -> int -> int64 -> unit +(** [set_int64_be t i v] sets the eight bytes in [t] starting at offset [i] to + the value [v]. *) + +(** {3 Blits} + + All the following blit operations do the same thing. They copy a given + number of bytes from a source starting at some offset to a destination + starting at some other offset. Forgetting for a moment that OCaml is a + memory-safe language, these are all equivalent to: + + {[ + memcpy(dst + dst_off, src + src_off, len); + ]} + + And in fact, that's how they're implemented. Except that bounds checking + is performed before performing the blit. *) + +val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +val blit_from_string : string -> src_off:int -> t -> dst_off:int -> len:int -> unit +val blit_from_bytes : Bytes.t -> src_off:int -> t -> dst_off:int -> len:int -> unit + +val blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit + +(** {3 [memcmp]} + + Fast comparisons based on [memcmp]. Similar to the blits, these are + implemented as C calls after performing bounds checks. + + {[ + memcmp(buf1 + off1, buf2 + off2, len); + ]} *) + +val memcmp : t -> int -> t -> int -> int -> int +val memcmp_string : t -> int -> string -> int -> int -> int + +(** {3 [memchr]} + + Search for a byte using [memchr], returning [-1] if the byte is not found. + Performing bounds checking before the C call. *) + +val memchr : t -> int -> char -> int -> int + +(** {2 Memory-unsafe Operations} + + The following operations are not memory safe. However, they do compile down + to just a couple instructions. Make sure when using them to perform your + own bounds checking. Or don't. Just make sure you know what you're doing. + You can do it, but only do it if you have to. *) + +external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1" +(** [unsafe_get t i] is like {!get} except no bounds checking is performed. *) + +external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1" +(** [unsafe_set t i c] is like {!set} except no bounds checking is performed. *) + +val unsafe_get_int16_le : t -> int -> int +(** [unsafe_get_int16_le t i] is like {!get_int16_le} except no bounds checking + is performed. *) + +val unsafe_get_int16_be : t -> int -> int +(** [unsafe_get_int16_be t i] is like {!get_int16_be} except no bounds checking + is performed. *) + +val unsafe_get_int16_sign_extended_le : t -> int -> int +(** [unsafe_get_int16_sign_extended_le t i] is like + {!get_int16_sign_extended_le} except no bounds checking is performed. *) + +val unsafe_get_int16_sign_extended_be : t -> int -> int +(** [unsafe_get_int16_sign_extended_be t i] is like + {!get_int16_sign_extended_be} except no bounds checking is performed. *) + +val unsafe_set_int16_le : t -> int -> int -> unit +(** [unsafe_set_int16_le t i v] is like {!set_int16_le} except no bounds + checking is performed. *) + +val unsafe_set_int16_be : t -> int -> int -> unit +(** [unsafe_set_int16_be t i v] is like {!set_int16_be} except no bounds + checking is performed. *) + +val unsafe_get_int32_le : t -> int -> int32 +(** [unsafe_get_int32_le t i] is like {!get_int32_le} except no bounds checking + is performed. *) + +val unsafe_get_int32_be : t -> int -> int32 +(** [unsafe_get_int32_be t i] is like {!get_int32_be} except no bounds checking + is performed. *) + +val unsafe_set_int32_le : t -> int -> int32 -> unit +(** [unsafe_set_int32_le t i v] is like {!set_int32_le} except no bounds + checking is performed. *) + +val unsafe_set_int32_be : t -> int -> int32 -> unit +(** [unsafe_set_int32_be t i v] is like {!set_int32_be} except no bounds + checking is performed. *) + +val unsafe_get_int64_le : t -> int -> int64 +(** [unsafe_get_int64_le t i] is like {!get_int64_le} except no bounds checking + is performed. *) + +val unsafe_get_int64_be : t -> int -> int64 +(** [unsafe_get_int64_be t i] is like {!get_int64_be} except no bounds checking + is performed. *) + +val unsafe_set_int64_le : t -> int -> int64 -> unit +(** [unsafe_set_int64_le t i v] is like {!set_int64_le} except no bounds + checking is performed. *) + +val unsafe_set_int64_be : t -> int -> int64 -> unit +(** [unsafe_set_int64_be t i v] is like {!set_int64_be} except no bounds + checking is performed. *) + + +(** {3 Blits} + + All the following blit operations do the same thing. They copy a given + number of bytes from a source starting at some offset to a destination + starting at some other offset. Forgetting for a moment that OCaml is a + memory-safe language, these are all equivalent to: + + {[ + memcpy(dst + dst_off, src + src_off, len); + ]} + + And in fact, that's how they're implemented. Except in the case of + [unsafe_blit] which uses a [memmove] so that overlapping blits behave as + expected. But in both cases, there's no bounds checking. *) + +val unsafe_blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +val unsafe_blit_from_string : string -> src_off:int -> t -> dst_off:int -> len:int -> unit +val unsafe_blit_from_bytes : Bytes.t -> src_off:int -> t -> dst_off:int -> len:int -> unit + +val unsafe_blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit + +(** {3 [memcmp]} + + Fast comparisons based on [memcmp]. Similar to the blits, these are not + memory safe and are implemented by the same C call: + + {[ + memcmp(buf1 + off1, buf2 + off2, len); + ]} *) + +val unsafe_memcmp : t -> int -> t -> int -> int -> int +val unsafe_memcmp_string : t -> int -> string -> int -> int -> int + +(** {3 [memchr]} + + Search for a byte using [memchr], returning [-1] if the byte is not found. + It does not check bounds before the C call. *) + +val unsafe_memchr : t -> int -> char -> int -> int diff --git a/unikernel/duniverse/bigstringaf/lib/bigstringaf_stubs.c b/unikernel/duniverse/bigstringaf/lib/bigstringaf_stubs.c new file mode 100644 index 00000000..d66e676e --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib/bigstringaf_stubs.c @@ -0,0 +1,107 @@ +/*---------------------------------------------------------------------------- + Copyright (c) 2017 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*/ + +#include +#include +#include + +CAMLprim value +bigstringaf_blit_to_bytes(value vsrc, value vsrc_off, value vdst, value vdst_off, value vlen) +{ + void *src = ((char *)Caml_ba_data_val(vsrc)) + Unsigned_long_val(vsrc_off), + *dst = ((char *)String_val(vdst)) + Unsigned_long_val(vdst_off); + size_t len = Unsigned_long_val(vlen); + memcpy(dst, src, len); + return Val_unit; +} + +CAMLprim value +bigstringaf_blit_to_bigstring(value vsrc, value vsrc_off, value vdst, value vdst_off, value vlen) +{ + void *src = ((char *)Caml_ba_data_val(vsrc)) + Unsigned_long_val(vsrc_off), + *dst = ((char *)Caml_ba_data_val(vdst)) + Unsigned_long_val(vdst_off); + size_t len = Unsigned_long_val(vlen); + memmove(dst, src, len); + return Val_unit; +} + +CAMLprim value +bigstringaf_blit_from_bytes(value vsrc, value vsrc_off, value vdst, value vdst_off, value vlen) +{ + void *src = ((char *)String_val(vsrc)) + Unsigned_long_val(vsrc_off), + *dst = ((char *)Caml_ba_data_val(vdst)) + Unsigned_long_val(vdst_off); + size_t len = Unsigned_long_val(vlen); + memcpy(dst, src, len); + return Val_unit; +} + +CAMLprim value +bigstringaf_memcmp_bigstring(value vba1, value vba1_off, value vba2, value vba2_off, value vlen) +{ + void *ba1 = ((char *)Caml_ba_data_val(vba1)) + Unsigned_long_val(vba1_off), + *ba2 = ((char *)Caml_ba_data_val(vba2)) + Unsigned_long_val(vba2_off); + size_t len = Unsigned_long_val(vlen); + + int result = memcmp(ba1, ba2, len); + return Val_int(result); +} + +CAMLprim value +bigstringaf_memcmp_string(value vba, value vba_off, value vstr, value vstr_off, value vlen) +{ + void *buf1 = ((char *)Caml_ba_data_val(vba)) + Unsigned_long_val(vba_off), + *buf2 = ((char *)String_val(vstr)) + Unsigned_long_val(vstr_off); + size_t len = Unsigned_long_val(vlen); + + int result = memcmp(buf1, buf2, len); + return Val_int(result); +} + +CAMLprim value +bigstringaf_memchr(value vba, value vba_off, value vchr, value vlen) +{ + size_t off = Unsigned_long_val(vba_off); + char *buf = ((char *)Caml_ba_data_val(vba)) + off; + size_t len = Unsigned_long_val(vlen); + int c = Int_val(vchr); + + char* res = memchr(buf, c, len); + if (res == NULL) + { + return Val_long(-1); + } + else + { + return Val_long(off + res - buf); + } +} diff --git a/unikernel/duniverse/bigstringaf/lib/config/discover.ml b/unikernel/duniverse/bigstringaf/lib/config/discover.ml new file mode 100644 index 00000000..df0c1501 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib/config/discover.ml @@ -0,0 +1,11 @@ +open Configurator.V1 + +let get_warning_flags t = + match ocaml_config_var t "ccomp_type" with + | Some "msvc" -> ["/Wall"; "/W3"] + | _ -> ["-Wall"; "-Wextra"; "-Wpedantic"] + +let () = + main ~name:"discover" (fun t -> + let wflags = get_warning_flags t in + Flags.write_sexp "cflags.sexp" wflags) diff --git a/unikernel/duniverse/bigstringaf/lib/config/dune b/unikernel/duniverse/bigstringaf/lib/config/dune new file mode 100644 index 00000000..187bd5e1 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib/config/dune @@ -0,0 +1,3 @@ +(executable + (name discover) + (libraries dune-configurator)) diff --git a/unikernel/duniverse/bigstringaf/lib/dune b/unikernel/duniverse/bigstringaf/lib/dune new file mode 100644 index 00000000..9e7ced6d --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib/dune @@ -0,0 +1,16 @@ +(library + (name bigstringaf) + (public_name bigstringaf) + (foreign_stubs + (language c) + (names bigstringaf_stubs) + (flags + (:standard + (:include cflags.sexp)))) + (js_of_ocaml + (javascript_files runtime.js))) + +(rule + (targets cflags.sexp) + (action + (run config/discover.exe))) diff --git a/unikernel/duniverse/bigstringaf/lib/runtime.js b/unikernel/duniverse/bigstringaf/lib/runtime.js new file mode 100644 index 00000000..276d9e48 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib/runtime.js @@ -0,0 +1,81 @@ +/*---------------------------------------------------------------------------- + Copyright (c) 2017 Inhabited Type LLC. + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR + ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + ----------------------------------------------------------------------------*/ + +//Provides: bigstringaf_blit_to_bytes +//Requires: caml_bigstring_blit_ba_to_bytes +function bigstringaf_blit_to_bytes(src, src_off, dst, dst_off, len) { + return caml_bigstring_blit_ba_to_bytes(src,src_off,dst,dst_off,len); +} + +//Provides: bigstringaf_blit_to_bigstring +//Requires: caml_bigstring_blit_ba_to_ba +function bigstringaf_blit_to_bigstring(src, src_off, dst, dst_off, len) { + return caml_bigstring_blit_ba_to_ba(src, src_off, dst, dst_off, len); +} + +//Provides: bigstringaf_blit_from_bytes +//Requires: caml_bigstring_blit_string_to_ba +function bigstringaf_blit_from_bytes(src, src_off, dst, dst_off, len) { + return caml_bigstring_blit_string_to_ba(src, src_off, dst, dst_off, len); +} + +//Provides: bigstringaf_memcmp_bigstring +//Requires: caml_ba_get_1, caml_int_compare +function bigstringaf_memcmp_bigstring(ba1, ba1_off, ba2, ba2_off, len) { + for (var i = 0; i < len; i++) { + var c = caml_int_compare(caml_ba_get_1(ba1, ba1_off + i), caml_ba_get_1(ba2, ba2_off + i)); + if (c != 0) return c + } + return 0; +} + +//Provides: bigstringaf_memcmp_string +//Requires: caml_ba_get_1, caml_int_compare, caml_string_unsafe_get +function bigstringaf_memcmp_string(ba, ba_off, str, str_off, len) { + for (var i = 0; i < len; i++) { + var c = caml_int_compare(caml_ba_get_1(ba, ba_off + i), caml_string_unsafe_get(str, str_off + i)); + if (c != 0) return c + } + return 0; +} + +//Provides: bigstringaf_memchr +//Requires: caml_ba_get_1 +function bigstringaf_memchr(ba, ba_off, chr, len) { + for (var i = 0; i < len; i++) { + if (caml_ba_get_1(ba, ba_off + i) == chr) { + return (ba_off + i); + } + } + return -1; +} diff --git a/unikernel/duniverse/bigstringaf/lib_test/dune b/unikernel/duniverse/bigstringaf/lib_test/dune new file mode 100644 index 00000000..48789f33 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib_test/dune @@ -0,0 +1,4 @@ +(test + (name test_bigstringaf) + (libraries alcotest bigstringaf) + (modules test_bigstringaf s)) diff --git a/unikernel/duniverse/bigstringaf/lib_test/s.ml b/unikernel/duniverse/bigstringaf/lib_test/s.ml new file mode 100644 index 00000000..d7b66029 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib_test/s.ml @@ -0,0 +1,42 @@ +module type Getters = sig + val get : Bigstringaf.t -> int -> char + + val get_int16_le : Bigstringaf.t -> int -> int + val get_int16_sign_extended_le : Bigstringaf.t -> int -> int + val get_int32_le : Bigstringaf.t -> int -> int32 + val get_int64_le : Bigstringaf.t -> int -> int64 + + val get_int16_be : Bigstringaf.t -> int -> int + val get_int16_sign_extended_be : Bigstringaf.t -> int -> int + val get_int32_be : Bigstringaf.t -> int -> int32 + val get_int64_be : Bigstringaf.t -> int -> int64 +end + +module type Setters = sig + val set : Bigstringaf.t -> int -> char -> unit + + val set_int16_le : Bigstringaf.t -> int -> int -> unit + val set_int32_le : Bigstringaf.t -> int -> int32 -> unit + val set_int64_le : Bigstringaf.t -> int -> int64 -> unit + + val set_int16_be : Bigstringaf.t -> int -> int -> unit + val set_int32_be : Bigstringaf.t -> int -> int32 -> unit + val set_int64_be : Bigstringaf.t -> int -> int64 -> unit +end + +module type Blit = sig + val blit : Bigstringaf.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit + val blit_from_string : String.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit + val blit_from_bytes : Bytes.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit + + val blit_to_bytes : Bigstringaf.t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit +end + +module type Memcmp = sig + val memcmp : Bigstringaf.t -> int -> Bigstringaf.t -> int -> int -> int + val memcmp_string : Bigstringaf.t -> int -> String.t -> int -> int -> int +end + +module type Memchr = sig + val memchr : Bigstringaf.t -> int -> char -> int -> int +end diff --git a/unikernel/duniverse/bigstringaf/lib_test/test_bigstringaf.ml b/unikernel/duniverse/bigstringaf/lib_test/test_bigstringaf.ml new file mode 100644 index 00000000..37fdf5e7 --- /dev/null +++ b/unikernel/duniverse/bigstringaf/lib_test/test_bigstringaf.ml @@ -0,0 +1,385 @@ +let of_string () = + let open Bigstringaf in + let exn = Invalid_argument (Printf.sprintf "Bigstringaf.of_string invalid range: { buffer_len: 3, off: %d, len: 2 }" max_int) in + Alcotest.check_raises "safe overflow" exn (fun () -> ignore (of_string ~off:max_int ~len:2 "abc")) +;; + +let constructors = + [ "of_string", `Quick, of_string ] + +let index_out_of_bounds () = + let open Bigstringaf in + let exn = Invalid_argument "index out of bounds" in + let string = "\xde\xad\xbe\xef" in + let buffer = of_string ~off:0 ~len:(String.length string) string in + Alcotest.check_raises "get empty 0" exn (fun () -> ignore (get empty 0)); + let check_safe_getter name get = + Alcotest.check_raises name exn (fun () -> ignore (get buffer (-1))); + Alcotest.check_raises name exn (fun () -> ignore (get buffer (length buffer))); + in + check_safe_getter "get" get; + check_safe_getter "get_int16_le" get_int16_le; + check_safe_getter "get_int16_be" get_int16_be; + check_safe_getter "get_int16_sign_extended_le" get_int16_sign_extended_le; + check_safe_getter "get_int16_sign_extended_be" get_int16_sign_extended_be; + check_safe_getter "get_int32_le" get_int32_le; + check_safe_getter "get_int32_be" get_int32_be; + check_safe_getter "get_int64_le" get_int64_le; + check_safe_getter "get_int64_be" get_int64_be; +;; + +let getters m () = + let module Getters = (val m : S.Getters) in + let open Getters in + let string = "\xde\xad\xbe\xef\x8b\xad\xf0\x0d" in + let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in + + Alcotest.(check char "get" '\xde' (get buffer 0)); + Alcotest.(check char "get" '\xbe' (get buffer 2)); + + Alcotest.(check int "get_int16_be" 0xdead (get_int16_be buffer 0)); + Alcotest.(check int "get_int16_be" 0xbeef (get_int16_be buffer 2)); + Alcotest.(check int "get_int16_le" 0xadde (get_int16_le buffer 0)); + Alcotest.(check int "get_int16_le" 0xefbe (get_int16_le buffer 2)); + Alcotest.(check int "get_int16_sign_extended_be" (Int64.to_int 0x7fffffffffffdeadL) (get_int16_sign_extended_be buffer 0)); + Alcotest.(check int "get_int16_sign_extended_le" (Int64.to_int 0x7fffffffffffaddeL) (get_int16_sign_extended_le buffer 0)); + Alcotest.(check int "get_int16_sign_extended_le" 0x0df0 (get_int16_sign_extended_le buffer 6)); + + Alcotest.(check int32 "get_int32_be" 0xdeadbeefl (get_int32_be buffer 0)); + Alcotest.(check int32 "get_int32_be" 0xbeef8badl (get_int32_be buffer 2)); + Alcotest.(check int32 "get_int32_le" 0xefbeaddel (get_int32_le buffer 0)); + Alcotest.(check int32 "get_int32_le" 0xad8befbel (get_int32_le buffer 2)); + + Alcotest.(check int64 "get_int64_be" 0xdeadbeef8badf00dL (get_int64_be buffer 0)); + Alcotest.(check int64 "get_int64_le" 0x0df0ad8befbeaddeL (get_int64_le buffer 0)); +;; + +let setters m () = + let module Setters = (val m : S.Setters) in + let open Setters in + let string = Bytes.make 16 '_' |> Bytes.unsafe_to_string in + let with_buffer ~f = + let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in + f buffer + in + let substring ~len buffer = Bigstringaf.substring ~off:0 ~len buffer in + + with_buffer ~f:(fun buffer -> + set buffer 0 '\xde'; + Alcotest.(check string "set" "\xde___" (substring ~len:4 buffer))); + + with_buffer ~f:(fun buffer -> + set buffer 2 '\xbe'; + Alcotest.(check string "set" "__\xbe_" (substring ~len:4 buffer))); + + with_buffer ~f:(fun buffer -> + set_int16_be buffer 0 0xdead; + Alcotest.(check string "set_int16_be" "\xde\xad__" (substring ~len:4 buffer))); + + with_buffer ~f:(fun buffer -> + set_int16_be buffer 2 0xbeef; + Alcotest.(check string "set_int16_be" "__\xbe\xef" (substring ~len:4 buffer))); + + with_buffer ~f:(fun buffer -> + set_int16_le buffer 0 0xdead; + Alcotest.(check string "set_int16_le" "\xad\xde__" (substring ~len:4 buffer))); + + with_buffer ~f:(fun buffer -> + set_int16_le buffer 2 0xbeef; + Alcotest.(check string "set_int16_le" "__\xef\xbe" (substring ~len:4 buffer))); + + with_buffer ~f:(fun buffer -> + set_int32_be buffer 0 0xdeadbeefl; + Alcotest.(check string "set_int32_be" "\xde\xad\xbe\xef____" (substring ~len:8 buffer))); + + with_buffer ~f:(fun buffer -> + set_int32_le buffer 0 0xdeadbeefl; + Alcotest.(check string "set_int32_le" "\xef\xbe\xad\xde____" (substring ~len:8 buffer))); + + with_buffer ~f:(fun buffer -> + set_int32_be buffer 2 0xbeef8badl; + Alcotest.(check string "set_int32_be" "__\xbe\xef\x8b\xad__" (substring ~len:8 buffer))); + + with_buffer ~f:(fun buffer -> + set_int32_le buffer 2 0xbeef8badl; + Alcotest.(check string "set_int32_le" "__\xad\x8b\xef\xbe__" (substring ~len:8 buffer))); + + with_buffer ~f:(fun buffer -> + set_int64_be buffer 0 0xdeadbeef8badf00dL; + Alcotest.(check string "set_int64_be" "\xde\xad\xbe\xef\x8b\xad\xf0\x0d" (substring ~len:8 buffer))); + + with_buffer ~f:(fun buffer -> + set_int64_le buffer 0 0xdeadbeef8badf00dL; + Alcotest.(check string "set_int64_le" "\x0d\xf0\xad\x8b\xef\xbe\xad\xde" (substring ~len:8 buffer))); +;; + +let string1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" +let string2 = "abcdefghijklmnopqrstuvwxyz" + +let blit m () = + let module Blit = (val m : S.Blit) in + let open Blit in + let with_buffers ~f = + let buffer1 = Bigstringaf.of_string string1 ~off:0 ~len:(String.length string1) in + let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in + f buffer1 buffer2 + in + with_buffers ~f:(fun buf1 buf2 -> + blit buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0; + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "empty blit" string2 new_string2)); + + with_buffers ~f:(fun buf1 buf2 -> + blit buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2); + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "full blit to another buffer" string1 new_string2)); + + with_buffers ~f:(fun buf1 _buf2 -> + blit buf1 ~src_off:0 buf1 ~dst_off:0 ~len:(Bigstringaf.length buf1); + let new_string1 = Bigstringaf.substring buf1 ~off:0 ~len:(Bigstringaf.length buf1) in + Alcotest.(check string "entirely overlapping blit (unchanged)" string1 new_string1)); + + with_buffers ~f:(fun buf1 buf2 -> + blit buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8; + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2)); + + with_buffers ~f:(fun buf1 _buf2 -> + blit buf1 ~src_off:0 buf1 ~dst_off:4 ~len:8; + let new_string1 = Bigstringaf.substring buf1 ~off:0 ~len:(Bigstringaf.length buf1) in + Alcotest.(check string "partially overlapping" "ABCDABCDEFGHMNOPQRSTUVWXYZ" new_string1)); +;; + +let blit_to_bytes m () = + let module Blit = (val m : S.Blit) in + let open Blit in + let with_buffers ~f = + let buffer1 = string1 in + let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in + f buffer1 buffer2 + in + with_buffers ~f:(fun buf1 buf2 -> + blit_from_string buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0; + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "empty blit" string2 new_string2)); + + with_buffers ~f:(fun buf1 buf2 -> + blit_from_string buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2); + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "full blit to another buffer" string1 new_string2)); + + with_buffers ~f:(fun buf1 buf2 -> + blit_from_string buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8; + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2)); +;; + +let blit_from_bytes m () = + let module Blit = (val m : S.Blit) in + let open Blit in + let with_buffers ~f = + let buffer1 = Bytes.of_string string1 in + let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in + f buffer1 buffer2 + in + with_buffers ~f:(fun buf1 buf2 -> + blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0; + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "empty blit" string2 new_string2)); + + with_buffers ~f:(fun buf1 buf2 -> + blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2); + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "full blit to another buffer" string1 new_string2)); + + with_buffers ~f:(fun buf1 buf2 -> + blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8; + let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in + Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2)); +;; + +let memcmp m () = + let module Memcmp = (val m : S.Memcmp) in + let open Memcmp in + let buffer1 = Bigstringaf.of_string ~off:0 ~len:(String.length string1) string1 in + let buffer2 = Bigstringaf.of_string ~off:0 ~len:(String.length string2) string2 in + Alcotest.(check bool "identical buffers are equal" true + (memcmp buffer1 0 buffer1 0 (Bigstringaf.length buffer1) = 0)); + Alcotest.(check bool "prefix of identical buffers are equal" true + (memcmp buffer1 0 buffer1 0 (Bigstringaf.length buffer1 - 10 ) = 0)); + Alcotest.(check bool "suffix of identical buffers are equal" true + (memcmp buffer1 10 buffer1 10 (Bigstringaf.length buffer1 - 10) = 0)); + Alcotest.(check bool "uppercase is less than uppercase" true + (memcmp buffer1 0 buffer2 0 (Bigstringaf.length buffer1) < 0)); + Alcotest.(check bool "lowercase is greater than uppercase" true + (memcmp buffer2 0 buffer1 0 (Bigstringaf.length buffer1) > 0)); +;; + +let memcmp_string m () = + let module Memcmp = (val m : S.Memcmp) in + let open Memcmp in + let buffer1 = Bigstringaf.of_string ~off:0 ~len:(String.length string1) string1 in + let buffer2 = Bigstringaf.of_string ~off:0 ~len:(String.length string2) string2 in + Alcotest.(check bool "of_string'd and original buffer are equal" true + (memcmp_string buffer1 0 string1 0 (Bigstringaf.length buffer1) = 0)); + Alcotest.(check bool "prefix of of_string'd and original buffer are equal" true + (memcmp_string buffer1 10 string1 10 (Bigstringaf.length buffer1 - 10) = 0)); + Alcotest.(check bool "suffix of identical buffers are equal" true + (memcmp_string buffer1 10 string1 10 (Bigstringaf.length buffer1 - 10) = 0)); + Alcotest.(check bool "uppercase is less than uppercase" true + (memcmp_string buffer1 0 string2 0 (Bigstringaf.length buffer1) < 0)); + Alcotest.(check bool "lowercase is greater than uppercase" true + (memcmp_string buffer2 0 string1 0 (Bigstringaf.length buffer1) > 0)); + () +;; + +let memchr m () = + let module Memchr = (val m : S.Memchr) in + let open Memchr in + let string = "hello world foo bar baz" in + let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in + let buffer_len = Bigstringaf.length buffer in + Alcotest.(check int) "memchr starting at offset 0" (String.index_from string 0 ' ') + (memchr buffer 0 ' ' buffer_len); + Alcotest.(check int) "memchr with an offset" (String.index_from string 7 ' ') + (memchr buffer 7 ' ' (buffer_len - 7)); + Alcotest.(check int) "memchr char not found" (-1) + (memchr buffer 0 'Z' buffer_len) + +let negative_bounds_check () = + let open Bigstringaf in + let buf = Bigstringaf.empty in + let exn_str fn = + Invalid_argument + (Printf.sprintf + "Bigstringaf.%s invalid range: { buffer_len: 0, off: 0, len: -8 }" + fn) + in + let exn_ba fn = + Invalid_argument + (Printf.sprintf + "Bigstringaf.%s invalid range: { src_len: 0, src_off: 0, dst_len: 0, dst_off: 4, len: -8 }" + fn) + in + let exn_cmp fn = + Invalid_argument + (Printf.sprintf + "Bigstringaf.%s invalid range: { buf1_len: 0, buf1_off: 0, buf2_len: 0, buf2_off: 0, len: -8 }" + fn) + in + Alcotest.check_raises "copy" + (exn_str "copy") + (fun () -> ignore (copy buf ~off:0 ~len:(-8))); + Alcotest.check_raises "substring" + (exn_str "substring") + (fun () -> ignore (substring buf ~off:0 ~len:(-8))); + Alcotest.check_raises "of_string" + (exn_str "of_string") + (fun () -> ignore (of_string "" ~off:0 ~len:(-8))); + Alcotest.check_raises "blit" + (exn_ba "blit") + (fun () -> ignore (blit buf ~src_off:0 buf ~dst_off:4 ~len:(-8))); + Alcotest.check_raises "blit_from_string" + (exn_ba "blit_from_string") + (fun () -> + ignore (blit_from_string "" ~src_off:0 buf ~dst_off:4 ~len:(-8))); + Alcotest.check_raises "blit_from_bytes" + (exn_ba "blit_from_bytes") + (fun () -> + ignore (blit_from_bytes (Bytes.of_string "") ~src_off:0 buf ~dst_off:4 ~len:(-8))); + Alcotest.check_raises "blit_to_bytes" + (exn_ba "blit_to_bytes") + (fun () -> + ignore (blit_to_bytes buf ~src_off:0 (Bytes.of_string "") ~dst_off:4 ~len:(-8))); + Alcotest.check_raises "memcmp" + (exn_cmp "memcmp") + (fun () -> + ignore (memcmp buf 0 buf 0 (-8))); + Alcotest.check_raises "memcmp_string" + (exn_cmp "memcmp_string") + (fun () -> + ignore (memcmp_string buf 0 "" 0 (-8))); +;; + +let safe_operations = + let module Getters : S.Getters = Bigstringaf in + let module Setters : S.Setters = Bigstringaf in + let module Blit : S.Blit = Bigstringaf in + let module Memcmp : S.Memcmp = Bigstringaf in + let module Memchr : S.Memchr = Bigstringaf in + [ "index out of bounds", `Quick, index_out_of_bounds + ; "getters" , `Quick, getters (module Getters) + ; "setters" , `Quick, setters (module Setters) + ; "blit" , `Quick, blit (module Blit) + ; "blit_to_bytes" , `Quick, blit_to_bytes (module Blit) + ; "blit_from_bytes" , `Quick, blit_from_bytes (module Blit) + ; "memcmp" , `Quick, memcmp (module Memcmp) + ; "memcmp_string" , `Quick, memcmp_string (module Memcmp) + ; "negative length" , `Quick, negative_bounds_check + ; "memchr" , `Quick, memchr (module Memchr) + ] + +let unsafe_operations = + let module Getters : S.Getters = struct + open Bigstringaf + + let get = unsafe_get + + let get_int16_le = unsafe_get_int16_le + let get_int16_sign_extended_le = unsafe_get_int16_sign_extended_le + let get_int32_le = unsafe_get_int32_le + let get_int64_le = unsafe_get_int64_le + + let get_int16_be = unsafe_get_int16_be + let get_int16_sign_extended_be = unsafe_get_int16_sign_extended_be + let get_int32_be = unsafe_get_int32_be + let get_int64_be = unsafe_get_int64_be + end in + let module Setters : S.Setters = struct + open Bigstringaf + + let set = unsafe_set + + let set_int16_le = unsafe_set_int16_le + let set_int32_le = unsafe_set_int32_le + let set_int64_le = unsafe_set_int64_le + + let set_int16_be = unsafe_set_int16_be + let set_int32_be = unsafe_set_int32_be + let set_int64_be = unsafe_set_int64_be + end in + let module Blit : S.Blit = struct + open Bigstringaf + + let blit = unsafe_blit + let blit_from_string = unsafe_blit_from_string + let blit_from_bytes = unsafe_blit_from_bytes + + let blit_to_bytes = unsafe_blit_to_bytes + end in + let module Memcmp : S.Memcmp = struct + open Bigstringaf + + let memcmp = unsafe_memcmp + let memcmp_string = unsafe_memcmp_string + end in + let module Memchr : S.Memchr = struct + open Bigstringaf + + let memchr = unsafe_memchr + end in + [ "getters" , `Quick, getters (module Getters) + ; "setters" , `Quick, setters (module Setters) + ; "blit" , `Quick, blit (module Blit) + ; "blit_to_bytes" , `Quick, blit_to_bytes (module Blit) + ; "blit_from_bytes", `Quick, blit_from_bytes (module Blit) + ; "memcmp" , `Quick, memcmp (module Memcmp) + ; "memcmp_string" , `Quick, memcmp_string (module Memcmp) + ; "memchr" , `Quick, memchr (module Memchr) + ] + +let () = + Alcotest.run "test suite" + [ "constructors" , constructors + ; "safe operations" , safe_operations + ; "unsafe operations", unsafe_operations ] diff --git a/unikernel/duniverse/bos/.gitignore b/unikernel/duniverse/bos/.gitignore new file mode 100644 index 00000000..ef72ad26 --- /dev/null +++ b/unikernel/duniverse/bos/.gitignore @@ -0,0 +1,6 @@ +_b0 +_build +tmp +*.native +*.byte +*.install \ No newline at end of file diff --git a/unikernel/duniverse/bos/.merlin b/unikernel/duniverse/bos/.merlin new file mode 100644 index 00000000..6c57f0e7 --- /dev/null +++ b/unikernel/duniverse/bos/.merlin @@ -0,0 +1,5 @@ +PKG b0.kit unix result rresult astring fpath fmt fmt.tty logs logs.fmt mtime mtime.clock.os +S src +S test +B _b0/b/** +B _build/** diff --git a/unikernel/duniverse/bos/.ocp-indent b/unikernel/duniverse/bos/.ocp-indent new file mode 100644 index 00000000..1540f8a5 --- /dev/null +++ b/unikernel/duniverse/bos/.ocp-indent @@ -0,0 +1 @@ +strict_with=always,match_clause=4,strict_else=never,strict_comments=true \ No newline at end of file diff --git a/unikernel/duniverse/bos/B0.ml b/unikernel/duniverse/bos/B0.ml new file mode 100644 index 00000000..1e08a281 --- /dev/null +++ b/unikernel/duniverse/bos/B0.ml @@ -0,0 +1,129 @@ +open B0_kit.V000 +open B00_std +open Result.Syntax + +(* OCaml library names *) + +let unix = B0_ocaml.libname "unix" +let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel" +let rresult = B0_ocaml.libname "rresult" +let rresult_top = B0_ocaml.libname "rresult.top" +let astring = B0_ocaml.libname "astring" +let astring_top = B0_ocaml.libname "astring.top" +let fpath = B0_ocaml.libname "fpath" +let fpath_top = B0_ocaml.libname "fpath.top" +let fmt = B0_ocaml.libname "fmt" +let fmt_top = B0_ocaml.libname "fmt.tty" +let fmt_tty = B0_ocaml.libname "fmt.tty" +let logs = B0_ocaml.libname "logs" +let logs_fmt = B0_ocaml.libname "logs.fmt" +let logs_top = B0_ocaml.libname "logs.top" +let mtime = B0_ocaml.libname "mtime" +let mtime_clock_os = B0_ocaml.libname "mtime.clock.os" + +let bos = B0_ocaml.libname "bos" +let bos_setup = B0_ocaml.libname "bos.setup" +let bos_top = B0_ocaml.libname "bos.top" + +(* Libraries *) + +let bos_lib = + let srcs = + Fpath.[ `Dir (v "src"); + `X (v "src/bos_setup.ml"); + `X (v "src/bos_setup.mli"); + `X (v "src/bos_top.ml"); + `X (v "src/bos_top_init.ml") ] + in + let requires = [rresult; astring; fpath; fmt; unix; logs] + in + B0_ocaml.lib bos ~doc:"The bos library" ~srcs ~requires + +let bos_setup_lib = + let srcs = Fpath.[ `File (v "src/bos_setup.ml"); + `File (v "src/bos_setup.mli") ] + in + let requires = [rresult; fmt_tty; logs_fmt; astring; fpath; logs; fmt; bos] + in + B0_ocaml.lib bos_setup ~doc:"The bos.setup library" ~srcs ~requires + +let bos_top_lib = + let srcs = Fpath.[ `File (v "src/bos_top.ml") ] in + let requires = + [ rresult_top; astring_top; fpath_top; fmt_top; logs_top; + compiler_libs_toplevel] + in + B0_ocaml.lib bos_top ~doc:"The bos.top library" ~srcs ~requires + +(* Tools *) + +(* Tests *) + +let test = + let srcs = + Fpath.[ `File (v "test/testing.mli"); + `File (v "test/testing.ml"); + `File (v "test/test.ml"); + `File (v "test/test_cmd.ml"); + `File (v "test/test_os_cmd.ml"); + `File (v "test/test_pat.ml"); ] + in + let meta = B0_meta.(empty |> tag test) in + let requires = [ rresult; astring; fpath; logs_fmt; bos] in + B0_ocaml.exe "test" ~doc:"Test suite" ~srcs ~meta ~requires + +let test_arg = + let srcs = Fpath.[ `File (v "test/test_arg.ml")] in + let meta = B0_meta.(empty |> tag test) in + let requires = [ astring; fmt; fpath; logs_fmt; bos ] in + B0_ocaml.exe "test-arg" ~doc:"Test argument parsing" ~srcs ~meta ~requires + +let test_arg_pos = + let srcs = Fpath.[ `File (v "test/test_arg_pos.ml")] in + let meta = B0_meta.(empty |> tag test) in + let requires = [ fmt; logs_fmt; bos ] in + B0_ocaml.exe "test-arg-pos" ~doc:"Test argument parsing" ~srcs ~meta ~requires + +let watch = + let srcs = Fpath.[`File (v "test/watch.ml")] in + let meta = B0_meta.(empty |> tag test) in + let requires = + [ logs_fmt; fmt_tty; mtime; mtime_clock_os; rresult; fpath; bos; bos_setup ] + in + B0_ocaml.exe "watch" ~doc:"Watch files for changes." ~srcs ~meta ~requires + +(* Packs *) + +let default = + let meta = + let open B0_meta in + empty + |> add authors ["The bos programmers"] + |> add maintainers ["Daniel Bünzli "] + |> add homepage "https://erratique.ch/software/bos" + |> add online_doc "https://erratique.ch/software/bos/doc" + |> add licenses ["ISC"] + |> add repo "git+https://erratique.ch/repos/bos.git" + |> add issues "https://github.com/dbuenzli/bos/issues" + |> add description_tags + ["os"; "system"; "cli"; "command"; "file"; "path"; "log"; "unix"; + "org:erratique"] + |> tag B0_opam.tag + |> add B0_opam.Meta.depends + [ "ocaml", {|>= "4.08.0"|}; + "ocamlfind", {|build|}; + "ocamlbuild", {|build|}; + "topkg", {|build & >= "1.0.3"|}; + "base-unix", ""; + "rresult", {|>= "0.7.0"|}; + "astring", ""; + "fpath", ""; + "fmt", {|>= "0.8.10"|}; + "logs", ""; + "mtime", {|test|}; + ] + |> add B0_opam.Meta.build + {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|} + in + B0_pack.v "default" ~doc:"bos package" ~meta ~locked:true @@ + B0_unit.list () diff --git a/unikernel/duniverse/bos/BRZO b/unikernel/duniverse/bos/BRZO new file mode 100644 index 00000000..e69de29b diff --git a/unikernel/duniverse/bos/CHANGES.md b/unikernel/duniverse/bos/CHANGES.md new file mode 100644 index 00000000..767b366e --- /dev/null +++ b/unikernel/duniverse/bos/CHANGES.md @@ -0,0 +1,87 @@ +v0.2.1 2021-10-04 Zagreb +------------------------ + +- Require OCaml >= 4.08. +- `OS.Dir.create` fix function result on existing files. It returned + non-sensical results. The function now errors as it should + be. Thanks to Léo Andrès for the report. +- `OS.Dir.create` fix function returning `false` instead of + `true` when the directory is created with `~path:false`. + Thanks to Léo Andrès for the report and patch. +- `OS.File.read` support for reading character devices and named + pipes. Thanks to Rizo Isrof for the patch. + +v0.2.0 2017-12-27 La Forclaz (VS) +--------------------------------- + +- Built-in support for tool search. No longer relies on `which` (unix) + or `where` (Windows). +- `OS.Cmd.{exist,must_exist}` get an optional `?search` argument. This can + break existing programs. +- Add `OS.Cmd.{find_tool,get_tool,resolve,search_path_dirs}`. +- Add `OS.File.is_executable`. +- Deprecate `Cmd.[get_]line_exec` in favor of `Cmd.[get_]line_tool`. +- Fix `OS.Path.symlink ~force:true` when the forced file is a symbolic + link, the operation errored before. Thanks to Anil Madhavapeddy for + the report. + +v0.1.6 2017-05-04 La Forclaz (VS) +--------------------------------- + +- Fix `OS.Dir.create`. The documentation says it returns `true` if the + directory was created and `false` otherwise. The implementation did + the converse, the latter was adjusted to match the doc + specification. + +v0.1.5 2017-03-18 La Forclaz (VS) +--------------------------------- + +- Fix `OS.Cmd.{err_file,out_file,to_file}`. Files were not truncated + on `append = false`. +- `OS.File.with_input`, allow to specify the input buffer as an + optional argument. + +v0.1.4 2016-08-30 Zagreb +------------------------ + +- Fix `OS.Path.fold` on root and relative paths (#61). + Thanks to Hezekiah M. Carty for the report and the help. +- Fix `OS.File.write` on Windows (#59). Thanks + to Hezekiah M. Carty for the report and the fix. + +v0.1.3 2016-07-12 Cambridge (UK) +-------------------------------- + +- `Cmd.dump`, make representation cut and paste friendly. This + affects logging made by the library. +- Add `Cmd.of_values`, converts arbitrary list of values to + a corresponding argument list. +- Fix `OS.Path.exists`. Existing file path traversals returned + and error rather than `false`. + +v0.1.2 2016-06-17 Cambridge (UK) +-------------------------------- + +- Fix `OS.File` creation mode from `0o622` to `0o644` (#55). +- Fix semantics of dotfile handling in `OS.Path.{matches,query}`. + `~dotfile:false` (default) used to not return any path that had a + dot segment, even if this was a constant segment without pattern + variables. This is no longer the case, `~dotfile:false` now only + prevents segments starting with a pattern variable to match against + dot files, i.e. it controls the exploration of the file system made + by the function. Thanks to David Kaloper for the discussion. + +v0.1.1 2016-06-08 Cambridge (UK) +-------------------------------- + +- Fix `OS.Cmd` combinators on Linux. Thanks to Andreas Hauptmann for + the help (#51) +- Fix `OS.Dir.delete` on Linux and Windows. Thanks to Andreas Hauptmann + for the help (#50). +- Fix `OS.Cmd.exists` on Linux. Thanks to Andreas Hauptmann and + Petter Urkedal for the help (#52). + +v0.1.0 2016-05-23 La Forclaz (VS) +--------------------------------- + +First release. diff --git a/unikernel/duniverse/bos/LICENSE.md b/unikernel/duniverse/bos/LICENSE.md new file mode 100644 index 00000000..2276ee19 --- /dev/null +++ b/unikernel/duniverse/bos/LICENSE.md @@ -0,0 +1,13 @@ +Copyright (c) 2016 The bos programmers + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/unikernel/duniverse/bos/README.md b/unikernel/duniverse/bos/README.md new file mode 100644 index 00000000..cc5f1f67 --- /dev/null +++ b/unikernel/duniverse/bos/README.md @@ -0,0 +1,40 @@ +Bos — Basic OS interaction for OCaml +------------------------------------------------------------------------------- +v0.2.1+dune + +Bos provides support for basic and robust interaction with the +operating system in OCaml. It has functions to access the process +environment, parse command line arguments, interact with the file +system and run command line programs. + +Bos works equally well on POSIX and Windows operating systems. + +Bos depends on [Rresult][rresult], [Astring][astring], [Fmt][fmt], +[Fpath][fpath] and [Logs][logs] and the OCaml Unix library. It is +distributed under the ISC license. + +[rresult]: http://erratique.ch/software/rresult +[astring]: http://erratique.ch/software/astring +[fmt]: http://erratique.ch/software/fmt +[fpath]: http://erratique.ch/software/fpath +[logs]: http://erratique.ch/software/logs + +Home page: http://erratique.ch/software/bos +Contact: Daniel Bünzli `` + +## Installation + +Bos can be installed with `opam`: + + opam install bos + +If you don't use `opam` consult the [`opam`](opam) file for build +instructions. + +## Documentation + +The documentation and API reference is automatically generated by from +the interfaces. It can be consulted [online][doc] or via `odig doc bos`. + +[doc]: http://erratique.ch/software/bos/doc/ + diff --git a/unikernel/duniverse/bos/_tags b/unikernel/duniverse/bos/_tags new file mode 100644 index 00000000..a62cc80d --- /dev/null +++ b/unikernel/duniverse/bos/_tags @@ -0,0 +1,12 @@ +true : bin_annot, safe_string, package(rresult), \ + package(astring), package(fpath), package(fmt), package(logs), \ + package(unix) + +<_b0> : -traverse + : include + : package(compiler-libs.toplevel) + : package(fmt.tty), package(logs.fmt) + + : include + : package(logs.fmt) + : package(fmt.tty), package(mtime), package(mtime.clock.os) \ No newline at end of file diff --git a/unikernel/duniverse/bos/bos.opam b/unikernel/duniverse/bos/bos.opam new file mode 100644 index 00000000..a5aca2e1 --- /dev/null +++ b/unikernel/duniverse/bos/bos.opam @@ -0,0 +1,40 @@ +version: "0.2.1+dune" +opam-version: "2.0" +maintainer: "Daniel Bünzli " +authors: ["Daniel Bünzli "] +dev-repo: "git+https://github.com/dune-universe/bos.git" +tags: [ "os" "system" "cli" "command" "file" "path" "log" "unix" "org:erratique" ] +license: "ISC" +build: [[ "dune" "build" "-p" name ]] +depends: [ + "dune" + "ocaml" {>= "4.01.0"} + "base-unix" + "rresult" {>= "0.4.0"} + "astring" + "fpath" + "fmt" {>= "0.8.0"} + "logs" + "mtime" {with-test} +] +synopsis: "Basic OS interaction for OCaml" +description: """ +Bos provides support for basic and robust interaction with the +operating system in OCaml. It has functions to access the process +environment, parse command line arguments, interact with the file +system and run command line programs. + +Bos works equally well on POSIX and Windows operating systems. + +Bos depends on [Rresult][rresult], [Astring][astring], [Fmt][fmt], +[Fpath][fpath] and [Logs][logs] and the OCaml Unix library. It is +distributed under the ISC license. + +[rresult]: http://erratique.ch/software/rresult +[astring]: http://erratique.ch/software/astring +[fmt]: http://erratique.ch/software/fmt +[fpath]: http://erratique.ch/software/fpath +[logs]: http://erratique.ch/software/logs + +Home page: http://erratique.ch/software/bos +Contact: Daniel Bünzli ``""" \ No newline at end of file diff --git a/unikernel/duniverse/bos/doc/index.mld b/unikernel/duniverse/bos/doc/index.mld new file mode 100644 index 00000000..83913e3a --- /dev/null +++ b/unikernel/duniverse/bos/doc/index.mld @@ -0,0 +1,15 @@ +{0 Bos {%html: v0.2.1+dune%}} + +Bos provides support for basic and robust interaction with the +operating system in OCaml. It has functions to access the process +environment, parse command line arguments, interact with the file +system and run command line programs. + +Bos works equally well on POSIX and Windows operating systems. + +{1:api API} + +{!modules: +Bos +Bos_setup +} diff --git a/unikernel/duniverse/bos/dune-project b/unikernel/duniverse/bos/dune-project new file mode 100644 index 00000000..37b05ff0 --- /dev/null +++ b/unikernel/duniverse/bos/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.0) +(name bos) +(version v0.2.1+dune) diff --git a/unikernel/duniverse/bos/pkg/META b/unikernel/duniverse/bos/pkg/META new file mode 100644 index 00000000..bcdabd3f --- /dev/null +++ b/unikernel/duniverse/bos/pkg/META @@ -0,0 +1,27 @@ +description = "Basic OS interaction for OCaml" +version = "0.2.1+dune" +requires = "rresult astring fpath fmt unix logs" +archive(byte) = "bos.cma" +archive(native) = "bos.cmxa" +plugin(byte) = "bos.cma" +plugin(native) = "bos.cmxs" + +package "top" ( + description = "Bos toplevel support" + version = "0.2.1+dune" + requires = "rresult.top astring.top fpath.top fmt.top logs.top bos" + archive(byte) = "bos_top.cma" + archive(native) = "bos_top.cmxa" + plugin(byte) = "bos_top.cma" + plugin(native) = "bos_top.cmxs" +) + +package "setup" ( + description = "Bos quick setup for simple programs" + version = "0.2.1+dune" + requires = "fmt.tty logs.fmt bos" + archive(byte) = "bos_setup.cma" + archive(native) = "bos_setup.cmxa" + plugin(byte) = "bos_setup.cma" + plugin(native) = "bos_setup.cmxs" +) diff --git a/unikernel/duniverse/bos/pkg/pkg.ml b/unikernel/duniverse/bos/pkg/pkg.ml new file mode 100755 index 00000000..a432e7bd --- /dev/null +++ b/unikernel/duniverse/bos/pkg/pkg.ml @@ -0,0 +1,15 @@ +#!/usr/bin/env ocaml +#use "topfind" +#require "topkg" +open Topkg + +let () = + Pkg.describe "bos" @@ fun c -> + Ok [ Pkg.mllib ~api:["Bos"] "src/bos.mllib"; + Pkg.mllib "src/bos_setup.mllib"; + Pkg.mllib ~api:[] "src/bos_top.mllib"; + Pkg.lib "src/bos_top_init.ml"; + Pkg.test "test/test"; + Pkg.test ~run:false "test/test_arg"; + Pkg.test ~run:false "test/test_arg_pos"; + Pkg.test ~run:false "test/watch"; ] diff --git a/unikernel/duniverse/bos/src/bos.ml b/unikernel/duniverse/bos/src/bos.ml new file mode 100644 index 00000000..622926ef --- /dev/null +++ b/unikernel/duniverse/bos/src/bos.ml @@ -0,0 +1,40 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Rresult + +(* Basic types *) + +module Pat = Bos_pat +module Cmd = Bos_cmd + +(* OS interaction *) + +module OS = struct + type ('a, 'b) result = ('a, [> R.msg] as 'b) R.t + module Env = Bos_os_env + module Arg = Bos_os_arg + module Path = Bos_os_path + module File = Bos_os_file + module Dir = Bos_os_dir + module Cmd = Bos_os_cmd + module U = Bos_os_u +end + +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos.mli b/unikernel/duniverse/bos/src/bos.mli new file mode 100644 index 00000000..23354b90 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos.mli @@ -0,0 +1,1431 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Basic OS interaction. + + Open the module to use it, this defines only modules in your scope. + + {b WARNING.} This API is still subject to change in the future but + feedback and suggestions are welcome on the project's issue tracker. *) + +(** {1 Basic types} *) + +open Rresult +open Astring + +(** Named string patterns. + + Named string patterns are strings with variables of the form + ["$(VAR)"] where [VAR] is any (possibly empty) sequence of bytes + except [')'] or [',']. In a named string pattern a ["$"] literal + must be escaped by ["$$"]. + + Named string patterns can be used to {{!Pat.format}format} strings or + to {{!Pat.match}match} data. *) +module Pat : sig + + (** {1:pats Patterns} *) + + type t + (** The type for patterns. *) + + val v : string -> t + (** [v s] is a pattern from the string [s]. + + @raise Invalid_argument if [s] is not a valid pattern. Use + {!of_string} to deal with errors. *) + + val empty : t + (** [empty] is an empty pattern. *) + + val dom : t -> String.Set.t + (** [dom p] is the set of variables in [p]. *) + + val equal : t -> t -> bool + (** [equal p p'] is [p = p']. *) + + val compare : t -> t -> int + (** [compare p p'] is {!Stdlib.compare}[ p p']. *) + + val of_string : string -> (t, [> R.msg]) result + (** [of_string s] parses [s] according to the pattern syntax + (i.e. a literal ['$'] must be represented by ["$$"] in [s]). *) + + val to_string : t -> string + (** [to_string p] converts [p] to a string according to the pattern + syntax (i.e. a literal ['$'] will be represented by ["$$"]). *) + + val pp : Format.formatter -> t -> unit + (** [pp ppf p] prints [p] on [ppf] according to the pattern syntax. *) + + val dump : Format.formatter -> t -> unit + (** [dump ppf p] prints [p] as a syntactically valid OCaml string on + [ppf]. *) + + (** {1:subst Substitution} + + {b Note.} Substitution replaces variables with data, + i.e. strings. It cannot substitute variables with variables. *) + + type defs = string String.Map.t + (** Type type for variable definitions. Maps pattern variable names + to strings. *) + + val subst : ?undef:(string -> string option) -> defs -> t -> t + (** [subst ~undef defs p] tries to substitute variables in [p] by + their value. First a value is looked up in [defs] and if + not found in [undef]. [undef] defaults to [(fun _ -> None)]. *) + + val format : ?undef:(string -> string) -> defs -> t -> string + (** [format ~undef defs p] substitutes all variables in [p] with + data. First a value is looked up in [defs] and if not found in + [undef] (defaults to [fun _ -> ""]). The resulting string is + not in pattern syntax (i.e. a literal ['$'] is represented by + ['$'] in the result). *) + + (** {1:match Matching} + + Pattern variables greedily match from zero to more bytes from + left to right. This is [.*] in regexp speak. *) + + val matches : t -> string -> bool + (** [matches p s] is [true] iff the string [s] matches [p]. Here are a few + examples: + {ul + {- [matches (v "$(mod).mli") "string.mli"] is [true].} + {- [matches (v "$(mod).mli") "string.mli "] is [false].} + {- [matches (v "$(mod).mli") ".mli"] is [true].} + {- [matches (v "$(mod).$(suff)") "string.mli"] is [true].} + {- [matches (v "$(mod).$(suff)") "string.mli "] is [true].}} *) + + val query : ?init:defs -> t -> string -> defs option + (** [query ~init p s] is like {!matches} except that a matching + string returns a map from each pattern variable to its matched + part in the string (mappings are added to [init], defaults to + {!String.Map.empty}) or [None] if [s] doesn't match [p]. If a + variable appears more than once in [pat] the first match is + returned in the map. *) +end + +(** Command lines. + + Both command lines and command line fragments using the same are + represented with the same {{!Cmd.t}type}. + + When a command line is {{!section:OS.Cmd.run}run}, the first + element of the line defines the program name and each other + element is an argument that will be passed {e as is} in the + program's [argv] array: no shell interpretation or any form of + argument quoting and/or concatenation occurs. + + See {{!Cmd.ex}examples}. *) +module Cmd : sig + + (** {1:frags Command line fragments} *) + + type t + (** The type for command line fragments. *) + + val v : string -> t + (** [v cmd] is a new command line (or command line fragment) + whose first argument is [cmd]. *) + + val empty : t + (** [empty] is an empty command line. *) + + val is_empty : t -> bool + (** [is_empty l] is [true] iff [l] is empty. *) + + val ( % ) : t -> string -> t + (** [l % arg] adds [arg] to the command line [l]. *) + + val ( %% ) : t -> t -> t + (** [l %% frag] appends the line fragment [frag] to [l]. *) + + val add_arg : t -> string -> t + (** [add_arg l arg] is [l % arg]. *) + + val add_args : t -> t -> t + (** [add_args l frag] is [l %% frag]. *) + + val on : bool -> t -> t + (** [on bool line] is [line] if [bool] is [true] and {!empty} + otherwise. *) + + val p : Fpath.t -> string + (** [p] is {!Fpath.to_string}. This combinator makes path argument + specification brief. *) + + (** {1:lines Command lines} *) + + val line_tool : t -> string option + (** [line_tool l] is [l]'s first element, usually the executable tool + name or file path. *) + + val get_line_tool : t -> string + (** [get_line_tool l] is like {!line_tool} but raises [Invalid_argument] + if there's no first element. *) + + val line_args : t -> string list + (** [line_args] is [l]'s command line arguments, the elements of [l] without + the command name. *) + + val line_exec : t -> string option + (** @deprecated Use {!line_tool} instead. *) + + val get_line_exec : t -> string + (** @deprecated Use {!get_line_tool} instead. *) + + (** {1:predicates Predicates and comparison} *) + + val equal : t -> t -> bool + (** [equal l l'] is [true] iff [l] and [l'] are litterally equal. *) + + val compare : t -> t -> int + (** [compare l l'] is a total order on command lines. *) + + (** {1:convert Conversions and pretty printing} *) + + val of_string : string -> (t, R.msg) result + (** [of_string s] tokenizes [s] into a command line. The tokens + are recognized according to the [token] production of the following + grammar which should be mostly be compatible with POSIX shell + tokenization. +{v +white ::= ' ' | '\t' | '\n' | '\x0B' | '\x0C' | '\r' +squot ::= '\'' +dquot ::= '\"' +bslash ::= '\\' +tokens ::= white+ tokens | token tokens | ϵ +token ::= ([^squot dquot white] | squoted | dquoted) token | ϵ +squoted ::= squot [^squot]* squot +dquoted ::= dquot (qchar | [^dquot])* dquot +qchar ::= bslash (bslash | dquot | '$' | '`' | '\n') +v} + + [qchar] are substitued by the byte they escape except for ['\n'] + which removes the backslash and newline from the byte stream. + [squoted] and [dquoted] represent the bytes they enclose. *) + + val to_string : t -> string + (** [to_string l] converts [l] to a string that can be passed + to the + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/system.html} + [command(3)]} POSIX system call. *) + + val to_list : t -> string list + (** [to_list l] is [l] as a list of strings. *) + + val of_list : ?slip:string -> string list -> t + (** [of_list ?slip l] is a command line from the list of arguments + [l]. If [slip] is specified it is added on the command line + before each element of [l]. *) + + val of_values : ?slip:string -> ('a -> string) -> 'a list -> t + (** [of_values ?slip conv l] is like {!of_list} but acts on a list + of values, each converted to an argument with [conv]. *) + + val pp : Format.formatter -> t -> unit + (** [pp ppf l] formats an unspecified representation of [l] on + [ppf]. *) + + val dump : Format.formatter -> t -> unit + (** [dump ppf l] dumps and unspecified representation of [l] + on [ppf]. *) + + (** {1:ex Examples} +{[ +let ls path = Cmd.(v "ls" % "-a" % p path) + +let tar archive path = Cmd.(v "tar" % "-cvf" % p archive % p path) + +let opam cmd = Cmd.(v "opam" % cmd) + +let opam_install pkgs = Cmd.(opam "install" %% of_list pkgs) + +let ocamlc ?(debug = false) file = + Cmd.(v "ocamlc" % "-c" %% on debug (v "-g") % p file) + +let ocamlopt ?(profile = false) ?(debug = false) incs file = + let profile = Cmd.(on profile @@ v "-p") in + let debug = Cmd.(on debug @@ v "-g") in + let incs = Cmd.of_list ~slip:"-I" incs in + Cmd.(v "ocamlopt" % "-c" %% debug %% profile %% incs % p file) +]} *) +end + +(** {1 OS interaction} *) + +(** OS interaction *) +module OS : sig + + (** {1 Results} + + The functions of this module never raise {!Sys_error} or + {!Unix.Unix_error} instead they turn these errors into + {{!Rresult.R.msgs}error messages}. If you need fine grained + control over unix errors use the lower level functions in + {!Bos.OS.U}. *) + + type ('a, 'e) result = ('a, [> R.msg] as 'e) Stdlib.result + (** The type for OS results. *) + + (** {1:env Environment variables and program arguments} *) + + (** Environment variables. *) + module Env : sig + + (** {1:env Process environment} *) + + type t = string String.map + (** The type for process environments. *) + + val current : unit -> (t, 'e) result + (** [current ()] is the current process environment. *) + + (** {1:vars Variables} *) + + val var : string -> string option + (** [var name] is the value of the environment variable [name], if + defined. *) + + val set_var : string -> string option -> (unit, 'e) result + (** [set_var name v] sets the environment variable [name] to [v]. + + {b BUG.} The {!Unix} module doesn't bind to [unsetenv(3)], + hence for now using [None] will not unset the variable, it + will set it to [""]. This behaviour may change in future + versions of the library. *) + + val opt_var : string -> absent:string -> string + (** [opt_var name absent] is the value of the optionally defined + environment variable [name] if defined and [absent] if + undefined. *) + + val req_var : string -> (string, 'e) result + (** [req_var name] is the value of the environment variable [name] or + an error if [name] is undefined in the environment. *) + + (** {1 Typed lookup} + + See the {{!examples}examples}. *) + + type 'a parser = string -> ('a, R.msg) result + (** The type for environment variable value parsers. *) + + val parser : string -> (string -> 'a option) -> 'a parser + (** [parser kind k_of_string] is an environment variable value + from the [k_of_string] function. [kind] is used for error + reports (e.g. could be ["int"] for an [int] parser). *) + + val bool : bool parser + (** [bool s] is a boolean parser. The string is lowercased and + the result is: + {ul + {- [Ok false] if it is one of [""], ["false"], ["no"], ["n"] or ["0"].} + {- [Ok true] if it is one of ["true"], ["yes"], ["y"] or ["1"].} + {- An [Error] otherwise.}} *) + + val string : string parser + (** [string s] is a string parser, it always succeeds. *) + + val path : Fpath.t parser + (** [path s] is a path parser using {!Fpath.of_string}. *) + + val cmd : Cmd.t parser + (** [cmd s] is a {b non-empty} command parser using + {!Cmd.of_string}. *) + + val some : 'a parser -> 'a option parser + (** [some p] is wraps [p]'s parse result in [Some]. *) + + val parse : + string -> 'a parser -> absent:'a -> ('a, 'e) result + (** [parse name p ~absent] is: + {ul + {- [Ok absent] if [Env.var name = None]} + {- [Ok v] if [Env.var name = Some s] and [p s = Ok v]} + {- [Error (`Msg m)] otherwise with [m] an error message + that mentions [name] and the parse error of [p].}} *) + + val value : ?log:Logs.level -> string -> 'a parser -> absent:'a -> 'a + (** [value ~log name p ~absent] is like {!parse} but in case + of error the message is logged with level [log] (defaults to + {!Logs.Error}) and [~absent] is returned. *) + + (** {1:examples Examples} +{[ +let debug : bool = OS.Env.(value "DEBUG" bool ~absent:false) +let msg : string = OS.Env.(value "MSG" string ~absent:"no message") + +let timeout : int option = + let int = OS.Env.(some @@ parser "int" String.to_int) in + OS.Env.value "TIMEOUT" int ~absent:None +]} +*) + end + + (** Quick and dirty program arguments parsing. + + This is for quick hacks and scripts. If your program evolves to + a tool for end users you should rather use {!Cmdliner} to parse + your command lines: it generates man pages and its parsing is + more flexible and user friendly. The syntax of command lines + parsed by this module is a subset of what {!Cmdliner} is able to + parse so migrating there should not be a problem for existing + invocations of your program. + + This module supports short and long options with option + arguments either glued to the option or specified as the next + program argument. It also supports the [--] program argument to + notify that subsequent arguments have to be treated as + positional arguments. Parsing functions always respond to the + [-h], [-help] or [--help] flags by showing the program's usage + and command line options documentation. + + See the {{!argbasics}basics}. + + {b Warning.} This module is not thread-safe. *) + module Arg : sig + + (** {1 Executable name} *) + + val exec : string + (** [exec] is the name of the executable. This is [Sys.argv.(0)] + if [Sys.argv] is non-empty or {!Sys.executable_name} otherwise. *) + + (** {1:conv Argument converters} + + Argument converters transform string arguments of the command + line to OCaml values. Consult the predefined + {{!predefconvs}converters}. *) + + type 'a conv + (** The type for argument converters. *) + + val conv : + ?docv:string -> + (string -> ('a, R.msg) result) -> + (Format.formatter -> 'a -> unit) -> 'a conv + (** [conv ~docv parse print] is an argument converter parsing + values with [parse] and printing them with [print]. [docv] + is a documentation meta-variable used in the documentation + to stand for the argument value, defaults to ["VALUE"]. *) + + val conv_parser : 'a conv -> (string -> ('a, R.msg) result) + (** [conv_parser c] is [c]'s parser. *) + + val conv_printer : 'a conv -> (Format.formatter -> 'a -> unit) + (** [conv_printer c] is [c]'s printer. *) + + val conv_docv : 'a conv -> string + (** [conv_printer c] is [c]'s documentation meta-variable. *) + + val parser_of_kind_of_string : + kind:string -> (string -> 'a option) -> + (string -> ('a, R.msg) result) + (** [parser_of_kind_of_string ~kind kind_of_string] is an argument + parser using the [kind_of_string] function for parsing and + [kind] for errors (e.g. could be ["an integer"] for an [int] + parser). *) + + val some : ?none:string -> 'a conv -> 'a option conv + (** [some none c] is like the converter [c] but wraps its result + in [Some]. This is used for command line arguments that + default to [None] when absent. [none] is what should be printed + by the printer for [None] (defaults to [""]). *) + + (** {1:queries Flag and option queries} + + {b Flag and option names.} They are specified without dashes. + A one character name defines a short option; ["d"] is [-d]. + Longer names define long options ["debug"] is [--debug]. + + {b Option argument specification.} On the command line, option + arguments are either specified as the next program argument or + glued to the option. For short options gluing is done + directly: [-farchive.tar]. For long options an ["="] characters + stands between the option and the value: [--file=archive.tar]. + + {b Warning.} These functions are effectful invoking them twice + on the same option names will result in parse errors. All the + following functions raise [Invalid_argument] if they are + invoked after {{!section:parse}parsing}. *) + + val flag : ?doc:string -> ?env:string -> string list -> bool + (** [flag ~doc ~env names] is [true] if one of the flags in + [names] is present on the command line {e at most once} and + [false] otherwise. + + If there is no flag on the command line and [env] is specified + and defined in the environment, its value is parsed with + {!Env.bool} and the resulting value is used. [doc] is a + documentation string. *) + + val flag_all : ?doc:string -> ?env:string -> string list -> int + (** [flag_all] is like {!flag} but counts the number of occurences + of the flag on the command line. If there is no flag on the command + line and [env] is specified and defined in the environment, its + value is parsed with {!Env.bool} and converted to an integer. *) + + val opt : ?docv:string -> ?doc:string -> ?env:string -> string list -> + 'a conv -> absent:'a -> 'a + (** [opt ~docv ~doc ~env names c ~absent] is a value defined by + the value of an optional argument that may appear {e at most + once} on the command line under one of the names specified by + [names]. + + The argument of the option is converted with [c] and [absent] + is used if the option is absent from the command line. If + there is no option on the command line and [env] is specified + and defined in the environment, its value is parsed with + [parse] and that value is used instead of [absent]. + + [doc] is is a documentation string. [docv] a documentation + meta-variable used in the documentation to stand for the option + argument, if unspecified [c]'s {!conv_docv} is used. In [doc] + occurences of the substring ["$(docv)"] in are replaced by the value + of [docv]. *) + + val opt_all : ?docv:string -> ?doc:string -> ?env:string -> string list -> + 'a conv -> absent:'a list -> 'a list + (** [opt_all] is like {!opt} but the optional argument can be repeated. *) + + (** {1:parse Parsing} + + {b Note.} Before parsing make sure you have invoked all the + {{!queries}queries}. + + {b Warning.} All the following functions raise + [Invalid_argument] if they are reinvoked after + {{!section:parse}parsing}. *) + + val parse_opts : ?doc:string -> ?usage:string -> unit -> unit + (** [parse_opts ()] can: + {ul + {- Return [()] if no command line error occured and [-help] or [--help] + was not specified.} + {- Never return and exit the program with [0] after having + printed the help on {!stdout}.} + {- Never return and exit the program with [1] after having + printed an error on {!stderr} if a parsing + error occured.}} + + A parsing error occurs either if an option parser failed, if a + non repeatable option was specified more than once, if there + is an unknown option on the line, if there is a positional + argument on the command line (use {!val-parse} to parse them). + [usage] is the command argument synopsis (default is + automatically inferred). [doc] is a documentation string for + the program. *) + + val parse : ?doc:string -> ?usage:string -> pos:'a conv -> unit -> + 'a list + (** [parse ~pos] is like {!parse_opts} but returns and converts + the positional arguments with [pos] rather than error on them. + Note that any thing that comes after a [--] argument on the + command line is deemed to be a positional argument. *) + + (** {1:predefconvs Predefined argument converters} *) + + val string : string conv + (** [string] converts a string argument. This never errors. *) + + val path : Fpath.t conv + (** [path] converts a path argument using {!Fpath.of_string}. *) + + val bin : Cmd.t conv + (** [bin] is {!string} mapped by {!Cmd.v}. *) + + val cmd : Cmd.t conv + (** [cmd] converts a {b non-empty} command line with {!Cmd.of_string} *) + + val char : char conv + (** [char] converts a single character. *) + + val bool : bool conv + (** [bool] converts a boolean with {!String.to_bool}. *) + + val int : int conv + (** [int] converts an integer with {!String.to_int}. *) + + val nativeint : nativeint conv + (** [int] converts a [nativeint] with {!String.to_nativeint}. *) + + val int32 : int32 conv + (** [int32] converts an [int32] with {!String.to_int32}. *) + + val int64 : int64 conv + (** [int64] converts an [int64] with {!String.to_int64}. *) + + val float : float conv + (** [float] converts an float with {!String.to_float}. *) + + val enum : (string * 'a) list -> 'a conv + (** [enum l p] converts values such that string names in [l] + map to the corresponding value of type ['a]. + + {b Warning.} The type ['a] must be comparable with + {!Stdlib.compare}. + + @raise Invalid_argument if [l] is empty. *) + + val list : ?sep:string -> 'a conv -> 'a list conv + (** [list ~sep c] converts a list of [c]. For parsing the + argument is first {!String.cuts}[ ~sep] and the resulting + string list is converted using [c]. *) + + val array : ?sep:string -> 'a conv -> 'a array conv + (** [array ~sep c] is like {!list} but returns an array instead. *) + + val pair : ?sep:string -> 'a conv -> 'b conv -> ('a * 'b) conv + (** [pair ~sep fst snd] converts a pair of [fst] and [snd]. For parsing + the argument is {!String.cut}[ ~sep] and the resulting strings + are converted using [fst] and [snd]. *) + + (** {1:argbasics Basics} + + To parse a command line, {b first} perform all the option + {{!queries}queries} and then invoke one of the + {{!section-parse}parsing} functions. Do not invoke any query after + parsing has been done, this will raise [Invalid_argument]. + This leads to the following program structure: +{[ +(* It is possible to define things at the toplevel as follows. But do not + abuse this. The following flag, if unspecified on the command line, can + also be specified with the DEBUG environment variable. *) +let debug = OS.Arg.(flag ["g"; "debug"] ~env:"DEBUG" ~doc:"debug mode.") +... + +let main () = + let depth = + OS.Arg.(opt ["d"; "depth"] int ~absent:2 ~doc:"recurses $(docv) times.") + in + let pos_args = OS.Arg.(parse ~pos:string ()) in + (* No command line error or help request occured, run the program. *) + ... + +let main () = main () +]} + *) + end + + (** {1 File system operations} + + {b Note.} When paths are relative they are expressed relative to + the {{!Dir.current}current working directory}. *) + + (** Path operations. + + These functions operate on files and directories equally. Similar + and specific functions operating only on one kind of path + can be found in the {!File} and {!Dir} modules. *) + module Path : sig + + (** {1:ops Existence, move, deletion, information and mode } *) + + val exists : Fpath.t -> (bool, 'e) result + (** [exists p] is [true] if [p] exists for the file system + and [false] otherwise. *) + + val must_exist : Fpath.t -> (Fpath.t, 'e) result + (** [must_exist p] is [Ok p] if [p] exists for the file system + and an error otherwise. *) + + val move : + ?force:bool -> Fpath.t -> Fpath.t -> (unit, 'e) result + (** [move ~force src dst] moves path [src] to [dst]. If [force] is + [true] (defaults to [false]) the operation doesn't error if + [dst] exists and can be replaced by [src]. *) + + val delete : + ?must_exist:bool -> ?recurse:bool -> Fpath.t -> (unit, 'e) result + (** [delete ~must_exist ~recurse p] deletes the path [p]. If + [must_exist] is [true] (defaults to [false]) an error is returned + if [p] doesn't exist. If [recurse] is [true] (defaults to [false]) + and [p] is a directory, no error occurs if the directory is + non-empty: its contents is recursively deleted first. *) + + val stat : Fpath.t -> (Unix.stats, 'e) result + (** [stat p] is [p]'s file information. *) + + (** Path permission modes. *) + module Mode : sig + + (** {1:modes Modes} *) + + type t = int + (** The type for file path permission modes. *) + + val get : Fpath.t -> (t, 'e) result + (** [get p] is [p] is permission mode. *) + + val set : Fpath.t -> t -> (unit, 'e) result + (** [set p m] sets [p]'s permission mode to [m]. *) + end + + (** {1:link Path links} *) + + val link : + ?force:bool -> target:Fpath.t -> Fpath.t -> + (unit, 'e) result + (** [link ~force target p] hard links [target] to [p]. If + [force] is [true] (defaults to [false]) and [p] exists, it is + is [rmdir]ed or [unlink]ed before making the link. *) + + val symlink : + ?force:bool -> target:Fpath.t -> Fpath.t -> + (unit, 'e) result + (** [symlink ~force target p] symbolically links [target] to + [p]. If [force] is [true] (defaults to [false]) and [p] + exists, it is [rmdir]ed or [unlink]ed before making the + link.*) + + val symlink_target : Fpath.t -> (Fpath.t, 'e) result + (** [slink_target p] is [p]'s target iff [p] is a symbolic link. *) + + val symlink_stat : Fpath.t -> (Unix.stats, 'e) result + (** [symlink_stat p] is the same as {!stat} but if [p] is a link + returns information about the link itself. *) + + (** {1:pathmatch Matching path patterns against the file system} + + A path pattern [pat] is a path whose segments are made of + {{!Pat}named string patterns}. Each variable of the pattern + greedily matches a segment or sub-segment. For example the path + pattern: +{[ + Fpath.(v "data" / "$(dir)" / "$(file).txt") +]} + matches any existing path of the file system that matches the + regexp [data/.*/.*\.txt]. + + {b Warning.} When segments with pattern variables are matched + against the file system they never match ["."] and + [".."]. For example the pattern ["$(file).$(ext)"] does not + match ["."]. *) + + val matches : + ?dotfiles:bool -> Fpath.t -> (Fpath.t list, 'e) result + (** [matches ~dotfiles pat] is the list of paths in the file + system that match the path pattern [pat]. If [dotfiles] is + [false] (default) segments that start with a pattern variable + do not match dotfiles. *) + + val query : + ?dotfiles:bool -> ?init:Pat.defs -> Fpath.t -> + ((Fpath.t * Pat.defs) list, 'e) result + (** [query ~init pat] is like {!matches} except each matching path + is returned with an environment mapping pattern variables to + their matched part in the path. For each path the mappings are + added to [init] (defaults to {!String.Map.empty}). *) + + (** {1:fold Folding over file system hierarchies} *) + + type traverse = [ `Any | `None | `Sat of Fpath.t -> (bool, R.msg) result ] + (** The type for controlling directory traversals. The predicate + of [`Sat] should only be called with directory paths, however this + may not be the case due to OS races. *) + + type elements = [ `Any | `Files | `Dirs + | `Sat of Fpath.t -> (bool, R.msg) result ] + (** The type for specifying elements being folded over. *) + + type 'a fold_error = Fpath.t -> ('a, R.msg) result -> (unit, R.msg) result + (** The type for managing fold errors. + + During the fold, errors may be generated at different points + of the process. For example, determining traversal with + {!traverse}, determining folded {!elements} or trying to + [readdir(3)] a directory without having permissions. + + These errors are given to a function of this type. If the + function returns [Error _] the fold stops and returns that + error. If the function returns [`Ok ()] the path is ignored + for the operation and the fold continues. *) + + val log_fold_error : level:Logs.level -> 'a fold_error + (** [log_fold_error level] is a {!fold_error} function that logs + error with level [level] and always returns [`Ok ()]. *) + + val fold : + ?err:'b fold_error -> ?dotfiles:bool -> ?elements:elements -> + ?traverse:traverse -> (Fpath.t -> 'a -> 'a) -> 'a -> Fpath.t list -> + ('a, 'e) result + (** [fold err dotfiles elements traverse f acc paths] folds over the list of + paths [paths] traversing directories according to [traverse] + (defaults to [`Any]) and selecting elements to fold over + according to [elements] (defaults to [`Any]). + + If [dotfiles] if [false] (default) both elements and + directories to traverse that start with a [.] except [.] and + [..] are skipped without being considered by [elements] or + [traverse]'s values. + + [err] manages fold errors (see {!fold_error}), defaults to + {!log_fold_error}[ ~level:Log.Error]. *) + end + + (** File operations. *) + module File : sig + + (** {1:paths Famous file paths} *) + + val null : Fpath.t + (** [null] is [Fpath.v "/dev/null"] on POSIX and [Fpath.v "NUL"] on + Windows. It represents a file on the OS that discards all + writes and returns end of file on reads. *) + + val dash : Fpath.t + (** [dash] is [Fpath.v "-"]. This value is used by {{!section-input}input} + and {{!section-output}output} functions to respectively denote [stdin] + and [stdout]. + + {b Note.} Representing [stdin] and [stdout] by this path is a + widespread command line tool convention. However it is + perfectly possible to have files that bear this name in the + file system. If you need to operate on such path from the + current directory you can simply specify them as + [Fpath.(cur_dir / "-")] and so can your users on the command + line by using ["./-"]. *) + + (** {1:ops Existence, deletion and properties} *) + + val exists : Fpath.t -> (bool, 'e) result + (** [exists file] is [true] if [file] is a regular file in the + file system and [false] otherwise. Symbolic links are + followed. *) + + val must_exist : Fpath.t -> (Fpath.t, 'e) result + (** [must_exist file] is [Ok file] if [file] is a regular file in the + file system and an error otherwise. Symbolic links are + followed. *) + + val delete : ?must_exist:bool -> Fpath.t -> (unit, 'e) result + (** [delete ~must_exist file] deletes file [file]. If [must_exist] + is [true] (defaults to [false]) an error is returned if [file] + doesn't exist. *) + + val truncate : Fpath.t -> int -> (unit, 'e) result + (** [truncate p size] truncates [p] to [s]. *) + + val is_executable : Fpath.t -> bool + (** [is_executable p] is [true] iff file [p] exists and is + executable. *) + + (** {1:input Input} + + {b Stdin.} In the following functions if the path is {!dash}, + bytes are read from [stdin]. *) + + type input = unit -> (Bytes.t * int * int) option + (** The type for file inputs. The function is called by the client + to input more bytes. It returns [Some (b, pos, len)] if the + bytes [b] can be read in the range \[[pos];[pos+len]\]; this + byte range is immutable until the next function call. [None] + is returned at the end of input. *) + + val with_input : + ?bytes:Bytes.t -> + Fpath.t -> (input -> 'a -> 'b) -> 'a -> ('b, 'e) result + (** [with_input ~bytes file f v] provides contents of [file] with an + input [i] using [bytes] to read the data and returns [f i v]. After + the function returns (normally or via an exception) a call to [i] by + the client raises [Invalid_argument]. + + @raise Invalid_argument if the length of [bytes] is [0]. *) + + val with_ic : + Fpath.t -> (in_channel -> 'a -> 'b) -> 'a -> ('b, 'e) result + (** [with_ic file f v] opens [file] as a channel [ic] and returns + [Ok (f ic v)]. After the function returns (normally or via an + exception), [ic] is ensured to be closed. If [file] is + {!dash}, [ic] is {!Stdlib.stdin} and not closed when the + function returns. [End_of_file] exceptions raised by [f] are + turned it into an error message. *) + + val read : Fpath.t -> (string, 'e) result + (** [read file] is [file]'s content as a string. *) + + val read_lines : Fpath.t -> (string list, 'e) result + (** [read_lines file] is [file]'s content, split at each + ['\n'] character. *) + + val fold_lines : + ('a -> string -> 'a) -> 'a -> Fpath.t -> ('a, 'e) result + (** [fold_lines f acc file] is like + [List.fold_left f acc (read_lines p)]. *) + + (** {1:output Output} + + The following applies to every function in this section. + + {b Stdout.} If the path is {!dash}, bytes are written to + [stdout]. + + {b Default permission mode.} The optional [mode] argument + specifies the permissions of the created file. It defaults to + [0o644] (readable by everyone writeable by the user). + + {b Atomic writes.} Files are written atomically by the + functions. They create a temporary file [t] in the directory + of the file [f] to write, write the contents to [t] and + renames it to [f] on success. In case of error [t] is + deleted and [f] left intact. *) + + type output = (Bytes.t * int * int) option -> unit + (** The type for file outputs. The function is called by the + client with [Some (b, pos, len)] to output the bytes of [b] in + the range \[[pos];[pos+len]\]. [None] is called to denote + end of output. *) + + val with_output : + ?mode:int -> Fpath.t -> + (output -> 'a -> (('c, 'd) result as 'b)) -> 'a -> + ('b, 'e) result + (** [with_output file f v] writes the contents of [file] using an + output [o] given to [f] and returns [Ok (f o v)]. [file] is + not written if [f] returns an error. After the function + returns (normally or via an exception) a call to [o] by the + client raises [Invalid_argument]. *) + + val with_oc : + ?mode:int -> Fpath.t -> + (out_channel -> 'a -> (('c, 'd) result as 'b)) -> + 'a -> ('b, 'e) result + (** [with_oc file f v] opens [file] as a channel [oc] and returns + [Ok (f oc v)]. After the function returns (normally or via an + exception) [oc] is closed. [file] is not written if [f] + returns an error. If [file] is {!dash}, [oc] is + {!Stdlib.stdout} and not closed when the function + returns. *) + + val write : + ?mode:int -> Fpath.t -> string -> (unit, 'e) result + (** [write file content] outputs [content] to [file]. If [file] + is {!dash}, writes to {!Stdlib.stdout}. If an error is + returned [file] is left untouched except if {!Stdlib.stdout} + is written. *) + + val writef : + ?mode:int -> Fpath.t -> + ('a, Format.formatter, unit, (unit, 'e) result ) format4 -> + 'a + (** [write file fmt ...] is like [write file (Format.asprintf fmt ...)]. *) + + val write_lines : + ?mode:int -> Fpath.t -> string list -> (unit, 'e) result + (** [write_lines file lines] is like [write file (String.concat + ~sep:"\n" lines)]. *) + + (** {1:tmpfiles Temporary files} *) + + type tmp_name_pat = (string -> string, Format.formatter, unit, string) + format4 + (** The type for temporary file name patterns. The string format is + replaced by random characters. *) + + val tmp : + ?mode:int -> ?dir:Fpath.t -> tmp_name_pat -> + (Fpath.t, 'e) result + (** [tmp mode dir pat] is a new empty temporary file in [dir] + (defaults to {!Dir.default_tmp}) named according to [pat] and + created with permissions [mode] (defaults to [0o600] only + readable and writable by the user). The file is deleted at the + end of program execution using a {!Stdlib.at_exit} + handler. + + {b Warning.} If you want to write to the file, using + {!with_tmp_output} or {!with_tmp_oc} is more secure as it + ensures that noone replaces the file, e.g. by a symbolic link, + between the time you create the file and open it. *) + + val with_tmp_output : + ?mode:int -> ?dir:Fpath.t -> tmp_name_pat -> + (Fpath.t -> output -> 'a -> 'b) -> 'a -> ('b, 'e) result + (** [with_tmp_output dir pat f v] is a new temporary file in [dir] + (defaults to {!Dir.default_tmp}) named according to [pat] and + atomically created and opened with permissions [mode] + (defaults to [0o600] only readable and writable by the + user). Returns [Ok (f file o v)] with [file] the file + path and [o] an output to write the file. After the function + returns (normally or via an exception), calls to [o] raise + [Invalid_argument] and [file] is deleted. *) + + val with_tmp_oc : + ?mode:int -> ?dir:Fpath.t -> tmp_name_pat -> + (Fpath.t -> out_channel -> 'a -> 'b) -> 'a -> + ('b, 'e) result + (** [with_tmp_oc mode dir pat f v] is a new temporary file in + [dir] (defaults to {!Dir.default_tmp}) named according to + [pat] and atomically created and opened with permission [mode] + (defaults to [0o600] only readable and writable by the + user). Returns [Ok (f file oc v)] with [file] the file path + and [oc] an output channel to write the file. After the + function returns (normally or via an exception), [oc] is + closed and [file] is deleted. *) +end + + (** Directory operations. *) + module Dir : sig + + (** {1:dirops Existence, creation, deletion and contents} *) + + val exists : Fpath.t -> (bool, 'e) result + (** [exists dir] is [true] if [dir] is a directory in the file system + and [false] otherwise. Symbolic links are followed. *) + + val must_exist : Fpath.t -> (Fpath.t, 'e) result + (** [must_exist dir] is [Ok dir] if [dir] is a directory in the file system + and an error otherwise. Symbolic links are followed. *) + + val create : + ?path:bool -> ?mode:int -> Fpath.t -> (bool, 'e) result + (** [create ~path ~mode dir] creates, if needed, the directory + [dir] with file permission [mode] (defaults [0o755] readable + and traversable by everyone, writeable by the user). If [path] + is [true] (default) intermediate directories are created with + the same [mode], otherwise missing intermediate directories + lead to an error. The result is: + {ul + {- [Ok true] if [dir] did not exist and was created.} + {- [Ok false] if [dir] did exist as (possibly a symlink to) a + directory. In this case the mode of [dir] and any other + directory is kept unchanged.} + {- [Error _] otherwise and in particular if [dir] exists + as a non-directory}} *) + + val delete : + ?must_exist:bool -> ?recurse:bool -> Fpath.t -> + (unit, 'e) result + (** [delete ~must_exist ~recurse dir] deletes the directory [dir]. If + [must_exist] is [true] (defaults to [false]) an error is returned + if [dir] doesn't exist. If [recurse] is [true] (default to [false]) + no error occurs if the directory is non-empty: its contents is + recursively deleted first. *) + + val contents : + ?dotfiles:bool -> ?rel:bool -> Fpath.t -> (Fpath.t list, 'e) result + (** [contents ~dotfiles ~rel dir] is the list of directories and files + in [dir]. If [rel] is [true] (defaults to [false]) the resulting paths + are relative to [dir], otherwise they have [dir] prepended. See also + {!fold_contents}. If [dotfiles] is [false] (default) elements that + start with a [.] are omitted. *) + + val fold_contents : + ?err:'b Path.fold_error -> ?dotfiles:bool -> ?elements:Path.elements -> + ?traverse:Path.traverse -> (Fpath.t -> 'a -> 'a) -> 'a -> Fpath.t -> + ('a, 'e) result + (** [fold_contents err dotfiles elements traverse f acc d] is: +{[ +contents d >>= Path.fold err dotfiles elements traverse f acc +]} + For more details see {!Path.section-fold}. *) + + (** {1:user_current User and current working directory} *) + + val user : unit -> (Fpath.t, 'e) result + (** [user ()] is the home directory of the user executing + the process. Determined by consulting the [passwd] database + with the user id of the process. If this fails or on Windows + falls back to parse a path from the [HOME] environment variable. *) + + val current : unit -> (Fpath.t, 'e) result + (** [current ()] is the current working directory. The resulting + path is guaranteed to be absolute. *) + + val set_current : Fpath.t -> (unit, 'e) result + (** [set_current dir] sets the current working directory to [dir]. *) + + val with_current : Fpath.t -> ('a -> 'b) -> 'a -> ('b, 'e) result + (** [with_current dir f v] is [f v] with the current working directory + bound to [dir]. After the function returns the current working + directory is back to its initial value. *) + + (** {1:tmpdirs Temporary directories} *) + + type tmp_name_pat = (string -> string, Format.formatter, unit, string) + format4 + (** The type for temporary directory name patterns. The string format is + replaced by random characters. *) + + val tmp : + ?mode:int -> ?dir:Fpath.t -> tmp_name_pat -> + (Fpath.t, 'e) result + (** [tmp mode dir pat] is a new empty directory in [dir] (defaults + to {!Dir.default_tmp}) named according to [pat] and created + with permissions [mode] (defaults to [0o700] only readable and + writable by the user). The directory path and its content is + deleted at the end of program execution using a + {!Stdlib.at_exit} handler. *) + + val with_tmp : + ?mode:int -> ?dir:Fpath.t -> tmp_name_pat -> (Fpath.t -> 'a -> 'b) -> + 'a -> ('b, 'e) result + (** [with_tmp mode dir pat f v] is a new empty directory in [dir] + (defaults to {!Dir.default_tmp}) named according to [pat] and + created with permissions [mode] (defaults to [0o700] only + readable and writable by the user). Returns the value of [f + tmpdir v] with [tmpdir] the directory path. After the function + returns the directory path [tmpdir] and its content is + deleted. *) + + (** {1:defaulttmpdir Default temporary directory} *) + + val default_tmp : unit -> Fpath.t + (** [default_tmp ()] is the directory used as a default value for + creating {{!File.tmpfiles}temporary files} and + {{!tmpdirs}directories}. If {!set_default_tmp} hasn't been + called this is: + {ul + {- On POSIX, the value of the [TMPDIR] environment variable or + [Fpath.v "/tmp"] if the variable is not set or empty.} + {- On Windows, the value of the [TEMP] environment variable or + {!Fpath.cur_dir} if it is not set or empty}} *) + + val set_default_tmp : Fpath.t -> unit + (** [set_default_tmp p] sets the value returned by {!default_tmp} to + [p]. *) + end + + (** {1 Commands} *) + + (** Executing commands. *) + module Cmd : sig + + (** {1:exist Tool existence and search} + + {b Tool search procedure.} Given a list of directories, the + {{!Cmd.line_tool}tool} of a command line is searched, in list + order, for the first matching {e executable} file. If the tool + name is already a file path (i.e. contains a + {!Fpath.dir_sep}) it is neither searched nor tested for + {{!File.is_executable}existence and executability}. In the + functions below if the list of directories [search] is + unspecified the result of parsing the [PATH] environment + variable with {!search_path_dirs} is used. + + {b Portability.} In order to maximize portability no [.exe] + suffix should be added to executable names on Windows, the tool + search procedure will add the suffix during the tool search + procedure if absent. *) + + val find_tool : ?search:Fpath.t list -> Cmd.t -> (Fpath.t option, 'e) result + (** [find_tool ~search cmd] is the path to the {{!Bos.Cmd.line_tool}tool} + of [cmd] as found by the tool search procedure in [search]. *) + + val get_tool : ?search:Fpath.t list -> Cmd.t -> (Fpath.t, 'e) result + (** [get_tool cmd] is like {!find_tool} except it errors if the + tool path cannot be found. *) + + val exists : ?search:Fpath.t list -> Cmd.t -> (bool, 'e) result + (** [exists ~search cmd] is [Ok true] if {!find_tool} finds a path + and [Ok false] if it does not. *) + + val must_exist : ?search:Fpath.t list -> Cmd.t -> (Cmd.t, 'e) result + (** [must_exist ~search cmd] is [Ok cmd] if {!get_tool} succeeds. *) + + val resolve : ?search:Fpath.t list -> Cmd.t -> (Cmd.t, 'e) result + (** [resolve ~search cmd] is like {!must_exist} except the tool of the + resulting command value has the path to the tool of [cmd] as + determined by {!get_tool}. *) + + val search_path_dirs : ?sep:string -> string -> (Fpath.t list, 'e) result + (** [search_path_dirs ~sep s] parses [sep] seperated file paths + from [s]. [sep] is not allowed to appear in the file paths, it + defaults to [";"] if {!Sys.win32} is [true] and [":"] + otherwise. *) + + (** {1:run Command runs} + + The following set of combinators are designed to be used with + {!Stdlib.(|>)} operator. See a few {{!ex}examples}. + + {b WARNING Windows.} The [~append:true] options for appending + to files are unsupported on Windows. + {{:http://caml.inria.fr/mantis/view.php?id=4431}This} old + feature request should be fixed upstream. + + {2:run_exit Run statuses & information} *) + + type status = [ `Exited of int | `Signaled of int ] + (** The type for process exit statuses. *) + + val pp_status : status Fmt.t + (** [pp_status] is a formatter for statuses. *) + + type run_info + (** The type for run information. *) + + val run_info_cmd : run_info -> Cmd.t + (** [run_info_cmd ri] is the command that was run. *) + + type run_status = run_info * status + (** The type for run statuses the run information and the process + exit status. *) + + val success : ('a * run_status, 'e) result -> ('a, 'e) result + (** [success r] is: + {ul + {- [Ok v] if [r = Ok (v, (_, `Exited 0))]} + {- [Error _] otherwise. Non [`Exited 0] statuses are turned + into an error message.}} *) + + (** {2:stderrs Run standard errors} *) + + type run_err + (** The type for representing the standard error of a command run. *) + + val err_file : ?append:bool -> Fpath.t -> run_err + (** [err_file f] is a standard error that writes to file [f]. If [append] + is [true] (defaults to [false]) the data is appended to [f]. *) + + val err_null : run_err + (** [err_null] is [err_file File.null]. *) + + val err_run_out : run_err + (** [err_run_out] is a standard error that is redirected to the run's + standard output. *) + + val err_stderr : run_err + (** [err_stderr] is a standard error that is redirected to the current + process standard error. *) + + (** {2:stdins Run standard inputs} *) + + type run_in + (** The type for representing the standard input of a command run. *) + + val in_string : string -> run_in + (** [in_string s] is a standard input that reads [s]. *) + + val in_file : Fpath.t -> run_in + (** [in_file f] is a standard input that reads from file [f]. *) + + val in_null : run_in + (** [in_null] is [in_file File.null]. *) + + val in_stdin : run_in + (** [in_stdin] is a standard input that reads from the current + process standard input. *) + + (** {2:stdouts Run standard outputs} + + The following functions trigger actual command runs, consume + their standard output and return the command and its status. In + {{!out_run_in}pipelined} runs, the reported status is the one + of the first failing run in the pipeline. + + {b Warning.} When a value of type {!type-run_out} has been "consumed" + with one of the following functions it cannot be reused. *) + + type run_out + (** The type for representing the standard output and status of a + command run. *) + + val out_string : ?trim:bool -> run_out -> (string * run_status, 'e) result + (** [out_string ~trim o] captures the standard output [o] as + a string. If [trim] is [true] (default) the result is passed through + {!String.trim}. *) + + val out_lines : + ?trim:bool -> run_out -> (string list * run_status, 'e) result + (** [out_lines] is like {!out_string} but the result is splitted on + newlines (['\n']). If the standard output is empty then the empty + list is returned. Note that [trim] is applied before lines are + splitted, it is not applied on the individual lines. *) + + val out_file : + ?append:bool -> Fpath.t -> run_out -> (unit * run_status, 'e) result + (** [out_file f o] writes the standard output [o] to file [f]. If + [append] is [true] (defaults to [false]) the data is appended + to [f]. *) + + val out_run_in : run_out -> (run_in, 'e) result + (** [out_run_in o] is a run input that can be used to feed the + standard output of [o] to the standard input of another, {b + single}, command run. Note that when the function returns the + command run of [o] may not be terminated yet. The run using + the resulting input will report an unsucessful status or + error of [o] rather than its own error. *) + + val out_null : run_out -> (unit * run_status, 'e) result + (** [out_null o] is [out_file File.null o]. *) + + val out_stdout : run_out -> (unit * run_status, 'e) result + (** [to_stdout o] redirects the standard output [o] to the current + process standard output. *) + + (** {3:success Extracting success} + + The following functions can be used if you only care about + success. *) + + val to_string : ?trim:bool -> run_out -> (string, 'e) result + (** [to_string ~trim o] is [(out_string ~trim o |> success)]. *) + + val to_lines : ?trim:bool -> run_out -> (string list, 'e) result + (** [to_lines ~trim o] is [(out_lines ~trim o |> success)]. *) + + val to_file : ?append:bool -> Fpath.t -> run_out -> (unit, 'e) result + (** [to_file ?append f o] is [(out_file ?append f o |> success)]. *) + + val to_null : run_out -> (unit, 'e) result + (** [to_null o] is [to_file File.null o]. *) + + val to_stdout : run_out -> (unit, 'e) result + (** [to_stdout o] is [(out_stdout o |> success)]. *) + + (** {2:runs Run specifications} *) + + val run_io : ?env:Env.t -> ?err:run_err -> Cmd.t -> run_in -> run_out + (** [run_io ~env ~err cmd i] represents the standard output of the + command run [cmd] performed in process environment [env] with + its standard error output handled according to [err] (defaults + to {!err_stderr}) and standard input connected to [i]. Note that + the command run is not started before the output is consumed, see + {{!stdouts}run standard outputs}. *) + + val run_out : ?env:Env.t -> ?err:run_err -> Cmd.t -> run_out + (** [run_out ?env ?err cmd] is [(in_stdin |> run_io ?env ?err cmd)]. *) + + val run_in : ?env:Env.t -> ?err:run_err -> Cmd.t -> run_in -> + (unit, 'e) result + (** [run_in ?env ?err cmd i] is [(run_io ?env ?err cmd |> to_stdout)]. *) + + val run : ?env:Env.t -> ?err:run_err -> Cmd.t -> (unit, 'e) result + (** [run ?env ?err cmd] is + [(in_stdin |> run_io ?env ?err cmd |> to_stdout)]. *) + + val run_status : ?env:Env.t -> ?err:run_err -> ?quiet:bool -> Cmd.t -> + (status, 'e) result + (** [run_status ?env ?err ?quiet cmd] is + [(in_stdin |> run_io ?env ?err ?cmd |> out_stdout)] and extracts + the run status. + + If [quiet] is [true] (defaults to [false]), [in_stdin] and + [out_stdout] are respectively replaced by [in_null] and + [out_null] and [err] defaults to [err_null] rather than + [err_stderr]. *) + + (** {1:ex Examples} + + Identity miaouw. +{[ +let id s = OS.Cmd.(in_string s |> run_io Cmd.(v "cat") |> out_string) +]} + Get the current list of git tracked files in OCaml: +{[ +let git = Cmd.v "git" +let git_tracked () = + let git_ls_files = Cmd.(git % "ls-files") in + OS.Cmd.(run_out git_ls_files |> to_lines) +]} + Tarbzip the current list of git tracked files, without reading the + tracked files in OCaml: +{[ +let tbz_git_tracked dst = + let git_ls_files = Cmd.(git % "ls-files") in + let tbz = Cmd.(v "tar" % "-cvzf" % p dst % "-T" % "-") in + OS.Cmd.(run_out git_ls_files |> out_run_in) >>= fun tracked -> + OS.Cmd.(tracked |> run_in tbz) +]} + Send the email [mail]. +{[ +let send_email mail = + let sendmail = Cmd.v "sendmail" in + OS.Cmd.(in_string mail |> run_in sendmail) +]} *) + + end + + (** {1 Low level {!Unix} access} *) + + (** Low level {!Unix} access. + + These functions simply {{!call}call} functions from the {!Unix} + module and replace strings with {!Fpath.t} where appropriate. They + also provide more fine grained error handling, for example + {!OS.Path.stat} converts the error to a message while {!stat} + gives you the {{!Unix.error}Unix error}. *) + module U : sig + + (** {1 Error handling} *) + + type 'a result = ('a, [`Unix of Unix.error]) Stdlib.result + (** The type for Unix results. *) + + val pp_error : Format.formatter -> [`Unix of Unix.error] -> unit + (** [pp_error ppf e] prints [e] on [ppf]. *) + + val open_error : + 'a result -> ('a, [> `Unix of Unix.error]) Stdlib.result + (** [open_error r] allows to combine a closed unix error + variant with other variants. *) + + val error_to_msg : 'a result -> ('a, [> R.msg]) Stdlib.result + (** [error_to_msg r] converts unix errors in [r] to an error message. *) + + (** {1 Wrapping {!Unix} calls} *) + + val call : ('a -> 'b) -> 'a -> 'b result + (** [call f v] is [Ok (f v)] but {!Unix.EINTR} errors are catched + and handled by retrying the call. Other errors [e] are catched + aswell and returned as [Error (`Unix e)]. *) + + (** {1 File system operations} *) + + val mkdir : Fpath.t -> Unix.file_perm -> unit result + (** [mkdir] is {!Unix.mkdir}, see + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/mkdir.html} + POSIX [mkdir]}. *) + + val link : Fpath.t -> Fpath.t -> unit result + (** [link] is {!Unix.link}, see + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/link.html} + POSIX [link]}. *) + + val unlink : Fpath.t -> unit result + (** [stat] is {!Unix.unlink}, + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/unlink.html} + POSIX [unlink]}. *) + + val rename : Fpath.t -> Fpath.t -> unit result + (** [rename] is {!Unix.rename}, see + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/rename.html} + POSIX [rename]}. *) + + val stat : Fpath.t -> Unix.stats result + (** [stat] is {!Unix.stat}, see + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/stat.html} + POSIX [stat]}. *) + + val lstat : Fpath.t -> Unix.stats result + (** [lstat] is {!Unix.lstat}, see + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/lstat.html} + POSIX [lstat]}. *) + + val truncate : Fpath.t -> int -> unit result + (** [truncate] is {!Unix.truncate}, see + {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/truncate.html} + POSIX [truncate]}. *) + end +end + +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos.mllib b/unikernel/duniverse/bos/src/bos.mllib new file mode 100644 index 00000000..d9726f6a --- /dev/null +++ b/unikernel/duniverse/bos/src/bos.mllib @@ -0,0 +1,13 @@ +Bos_base +Bos_pat +Bos_log +Bos_cmd +Bos_os_u +Bos_os_tmp +Bos_os_path +Bos_os_file +Bos_os_dir +Bos_os_cmd +Bos_os_env +Bos_os_arg +Bos \ No newline at end of file diff --git a/unikernel/duniverse/bos/src/bos_base.ml b/unikernel/duniverse/bos/src/bos_base.ml new file mode 100644 index 00000000..cd05a24d --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_base.ml @@ -0,0 +1,29 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring + +let apply f x ~finally y = + let result = try f x with + | e -> try finally y; raise e with _ -> raise e + in + finally y; + result + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_cmd.ml b/unikernel/duniverse/bos/src/bos_cmd.ml new file mode 100644 index 00000000..965b0360 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_cmd.ml @@ -0,0 +1,148 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring +open Rresult + +(* Command line fragments *) + +type t = string list + +let empty = [] +let is_empty = function [] -> true | _ -> false +let v a = [a] +let ( % ) l a = a :: l +let ( %% ) l0 l1 = List.rev_append (List.rev l1) l0 +let add_arg l a = l % a +let add_args l a = l %% a +let on bool l = if bool then l else [] +let p = Fpath.to_string + +(* Command lines *) + +let line_tool l = match List.rev l with [] -> None | t :: _ -> Some t +let get_line_tool l = match List.rev l with +| t :: _ -> t +| [] -> invalid_arg "the command is empty" + +let line_args l = match List.rev l with +| _ :: args -> args +| [] -> [] + +(* Deprecated *) + +let line_exec = line_tool +let get_line_exec = get_line_tool + +(* Predicates and comparison *) + +let equal l l' = l = l' +let compare l l' = Stdlib.compare l l' + +(* Conversions and pretty printing *) + +(* Parsing is loosely based on + http://pubs.opengroup.org/onlinepubs/009695399/utilities/\ + xcu_chap02.html#tag_02_03 *) + +let parse_cmdline s = + try + let err_unclosed kind s = + failwith @@ + strf "%d: unclosed %s quote delimited string" + (String.Sub.start_pos s) kind + in + let skip_white s = String.Sub.drop ~sat:Char.Ascii.is_white s in + let tok_sep c = c = '\'' || c = '\"' || Char.Ascii.is_white c in + let tok_char c = not (tok_sep c) in + let not_squote c = c <> '\'' in + let parse_squoted s = + let tok, rem = String.Sub.span ~sat:not_squote (String.Sub.tail s) in + if not (String.Sub.is_empty rem) then tok, String.Sub.tail rem else + err_unclosed "single" s + in + let parse_dquoted acc s = + let is_data = function '\\' | '"' -> false | _ -> true in + let rec loop acc s = + let data, rem = String.Sub.span ~sat:is_data s in + match String.Sub.head rem with + | Some '"' -> (data :: acc), (String.Sub.tail rem) + | Some '\\' -> + let rem = String.Sub.tail rem in + begin match String.Sub.head rem with + | Some ('"' | '\\' | '$' | '`' as c) -> + let acc = String.(sub (of_char c)) :: data :: acc in + loop acc (String.Sub.tail rem) + | Some ('\n') -> loop (data :: acc) (String.Sub.tail rem) + | Some c -> + let acc = String.Sub.extend ~max:2 data :: acc in + loop acc (String.Sub.tail rem) + | None -> + err_unclosed "double" s + end + | None -> err_unclosed "double" s + | Some _ -> assert false + in + loop acc (String.Sub.tail s) + in + let parse_token s = + let ret acc s = String.Sub.(to_string @@ concat (List.rev acc)), s in + let rec loop acc s = match String.Sub.head s with + | None -> ret acc s + | Some c when Char.Ascii.is_white c -> ret acc s + | Some '\'' -> + let tok, rem = parse_squoted s in loop (tok :: acc) rem + | Some '\"' -> + let acc, rem = parse_dquoted acc s in loop acc rem + | Some c -> + let sat = tok_char in + let tok, rem = String.Sub.span ~sat s in loop (tok :: acc) rem + in + loop [] s + in + let rec loop acc s = + if String.Sub.is_empty s then acc else + let token, s = parse_token s in + loop (token :: acc) (skip_white s) + in + Ok (loop [] (skip_white (String.sub s))) + with Failure err -> R.error_msgf "command line %a:%s" String.dump s err + +let of_string s = parse_cmdline s +let to_string l = String.concat ~sep:" " (List.rev_map Filename.quote l) + +let to_list line = List.rev line +let of_list ?slip line = match slip with +| None -> List.rev line +| Some slip -> List.fold_left (fun acc v -> v :: slip :: acc) [] line + +let of_values ?slip conv vs = match slip with +| None -> List.rev_map conv vs +| Some slip -> List.fold_left (fun acc v -> conv v :: slip :: acc) [] vs + +let pp ppf cmd = match List.rev cmd with +| [] -> () +| cmd :: [] -> Fmt.(pf ppf "%s" cmd) +| cmd :: args -> Fmt.(pf ppf "@[<2>%s@ %a@]" cmd (list ~sep:sp string) args) + +let dump ppf cmd = + let pp_arg ppf a = Fmt.pf ppf "%s" (Filename.quote a) in + Fmt.pf ppf "@[<1>[%a]@]" Fmt.(list ~sep:sp pp_arg) (List.rev cmd) + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_log.ml b/unikernel/duniverse/bos/src/bos_log.ml new file mode 100644 index 00000000..223981af --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_log.ml @@ -0,0 +1,25 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Log level and output *) + +let src = Logs.Src.create "bos" ~doc:"bos library" +include (val Logs.src_log src : Logs.LOG) + +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_arg.ml b/unikernel/duniverse/bos/src/bos_os_arg.ml new file mode 100644 index 00000000..a19f28ab --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_arg.ml @@ -0,0 +1,517 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring +open Rresult + +(* Errors *) + +let quote pp ppf v = Fmt.pf ppf "`%a'" pp v + +let err_done = "Bos.OS.Arg.parse_opts or Bos.OS.Arg.parse already called" +let err_no_name = "names list cannot be empty" +let err_env v msg = R.msgf "environment variable %s: %s" v msg +let err_repeat n = R.msgf "option %a cannot be repeated" (quote Fmt.string) n +let err_need_argument n = + R.msgf "option %a needs an argument" (quote Fmt.string) n + +let err_dupe n n' = + R.msgf "options %a and %a cannot be present at the same time" + (quote Fmt.string) n (quote Fmt.string) n' + +let err_unknown_opt ppf l = + Fmt.pf ppf "unknown option %a." (quote Fmt.string) l + +let err_too_many ppf l = + Fmt.pf ppf "too many arguments, don't know what to do with %a" + Fmt.(list ~sep:(Fmt.any ",@ ") (quote Fmt.string)) l + +(* Executable name. *) + +let exec = match Array.length Sys.argv with +| 0 -> Sys.executable_name +| n -> Sys.argv.(0) + +(* Argument converters *) + +type 'a conv = + { parse : string -> ('a, Rresult.R.msg) Rresult.result; + print : Format.formatter -> 'a -> unit; + docv : string } + +let conv ?(docv = "VALUE") parse print = { parse; print; docv } +let conv_parser c = c.parse +let conv_printer c = c.print +let conv_docv c = c.docv +let conv_with_docv conv ~docv = { conv with docv } + +let err_invalid s kind = + R.msgf "invalid value %a, expected %s" (quote Fmt.string) s kind + +let parser_of_kind_of_string ~kind k_of_string = + fun s -> match k_of_string s with + | None -> Error (err_invalid s kind) + | Some v -> Ok v + +let some ?(none = "") c = + let parse s = match c.parse s with + | Ok v -> Ok (Some v) + | Error _ as e -> e + in + let print = Fmt.option ~none:Fmt.(const string none) c.print in + { c with parse; print } + +(* Parsing *) + +type parse = Done | Perror of R.msg | Line of string list + +let raw_args = match Array.to_list Sys.argv with +| [] -> [] +| cmd :: args -> args + +let get_parse, set_parse = + let parse = ref (Line raw_args) in + (fun () -> !parse), + (fun p -> parse := p) + +(* Option names and values *) + +let make_opt_names names = + if names = [] then invalid_arg err_no_name else + let opt n = if String.length n = 1 then strf "-%s" n else strf "--%s" n in + List.map opt names + +let is_short_opt n = + if String.length n < 2 then false else + n.[0] = '-' && n.[1] <> '-' + +let is_long_opt n = + if String.length n < 3 then false else + n.[0] = '-' && n.[1] = '-' && n.[2] <> '-' + +let is_opt n = is_short_opt n || is_long_opt n + +let short_opt_arg n = + if String.length n <= 2 then None else + Some (String.with_index_range ~last:1 n, + String.with_index_range ~first:2 n) + +let long_opt_arg n = String.cut ~sep:"=" n + +let opt_arg n = if is_short_opt n then short_opt_arg n else long_opt_arg n + +let opt_name_compare n0 n1 = + let name n = + if is_short_opt n then String.sub ~start:1 n else String.sub ~start:2 n + in + String.Sub.compare_bytes (name n0) (name n1) + +let partition_opt_pos l = + let rec loop opts poss = function + | "--" :: l -> List.rev opts, List.rev_append poss l + | [] -> List.rev opts, List.rev poss + | a :: l -> + if is_opt a then loop (a :: opts) poss l else loop opts (a :: poss) l + in + loop [] [] l + +(* Documentation *) + +let undocumented = "Undocumented." + +type doc_opt_kind = +| Flag of string +| Opt of string * string * unit Fmt.t (* pretty prints the absent value. *) + +type opt_doc = + { names : string list; + env : string option; + repeat : bool; + kind : doc_opt_kind; } + +let get_opt_docs, add_opt_doc = + let docs = ref [] in + (fun () -> !docs), + (fun doc -> docs := doc :: !docs) + +let pp_opt_doc ppf = function +| Flag d -> Fmt.text ppf d +| Opt (d, docv, _) -> + let b = Buffer.create 244 in + let bppf = Fmt.with_buffer ~like:ppf b in + let d = + try + let subst = function + | "docv" -> Fmt.pf bppf "%a@?" Fmt.(styled `Underline string) docv; "" + | s -> strf "$(%s)" s + in + Buffer.add_substitute b subst d; + Buffer.contents b + with Not_found -> d + in + Fmt.text ppf d + +let pp_opt_docs ppf opt_docs = + let is_flag o = match o.kind with Flag _ -> true | _ -> false in + let sort_opts o o' = opt_name_compare (List.hd o.names) (List.hd o'.names) in + let opt_docs = List.sort sort_opts opt_docs in + let pp_name = Fmt.(styled `Bold string) in + let pp_var = Fmt.(styled `Underline string) in + let pp_short var ppf name = Fmt.pf ppf "%a %a" pp_name name pp_var var in + let pp_long var ppf name = Fmt.pf ppf "%a=%a" pp_name name pp_var var in + let pp_env = Fmt.(styled `Underline string) in + let pp_absent ppf absent env = match absent, env with + | "", None -> () + | "", Some v -> Fmt.pf ppf "@ (or %a env)" pp_env v + | absent, None -> Fmt.pf ppf "@ (absent=%s)" absent + | absent, Some v -> Fmt.pf ppf "@ (absent=%s or %a env)" absent pp_env v + in + let pp_opt var ppf n = + if is_short_opt n then pp_short var ppf n else pp_long var ppf n + in + let pp_opts ppf o = + let compare n n' = match compare (String.length n) (String.length n') with + | 0 -> compare n n' + | c -> c + in + let names = List.sort compare o.names in + match o.kind with + | Flag _ -> + Fmt.(list ~sep:(any ",@ ") pp_name) ppf names; + pp_absent ppf "" o.env + | Opt (_, var, absent) -> + Fmt.(list ~sep:(any ",@ ") (pp_opt var)) ppf names; + let absent = strf "@[%a@]" absent () in + pp_absent ppf absent o.env; + in + let pp_opt_doc ppf o = match o.names with + | [n] when is_short_opt n && o.env = None && is_flag o -> + Fmt.pf ppf "@[@[%a@] @[%a@]@]" pp_opts o pp_opt_doc o.kind + | _ -> + Fmt.pf ppf "@[@[%a@]@,@[%a@]@]" + pp_opts o pp_opt_doc o.kind + in + if opt_docs = [] then () else + Fmt.pf ppf "@[Options:@,@, @[%a@]@]" + Fmt.(list ~sep:cut pp_opt_doc) opt_docs + +(* Environment default parsing *) + +let env_default var parser = match var with +| None -> Ok None +| Some var -> + match Bos_os_env.var var with + | None -> Ok None + | Some s -> + match parser s with + | Ok v -> Ok (Some v) + | Error (`Msg e) -> Error (err_env var e) + +(* Flag queries *) + +let rec rem_flag names rleft = function +| "--" :: _ -> None +| s :: ss when List.mem s names -> Some (s, List.rev_append rleft ss) +| s :: ss -> rem_flag names (s :: rleft) ss +| [] -> None + +let flag ?(doc = undocumented) ?env names = + let names = make_opt_names names in + add_opt_doc { names; env; repeat = false; kind = Flag doc }; + match get_parse () with + | Done -> invalid_arg err_done + | Perror _ -> false + | Line line -> + match rem_flag names [] line with + | None -> + begin match env_default env Bos_os_env.bool with + | Ok (Some v) -> v + | Ok None -> false + | Error e -> set_parse (Perror e); false + end + | Some (flag, rest) -> + match rem_flag names [] rest with + | None -> set_parse (Line rest); true + | Some (flag', _) -> + if flag = flag' + then (set_parse @@ Perror (err_repeat flag); false) + else (set_parse @@ Perror (err_dupe flag flag'); false) + +let flag_all ?(doc = undocumented) ?env names = + let names = make_opt_names names in + add_opt_doc { names; env; repeat = true; kind = Flag doc }; + match get_parse () with + | Done -> invalid_arg err_done + | Perror _ -> 0 + | Line line -> + let rec find acc line = match rem_flag names [] line with + | Some (flag, rest) -> find (acc + 1) rest + | None -> + if acc <> 0 then (set_parse (Line line); acc) else + match env_default env Bos_os_env.bool with + | Ok (Some v) -> if v then 1 else 0 + | Ok None -> 0 + | Error e -> set_parse (Perror e); 0 + in + find 0 line + +(* Option queries *) + +let rec rem_option names rleft = function +| "--" :: _ -> Ok None +| s :: ss -> + begin match opt_arg s with + | None -> + if not (List.mem s names) + then rem_option names (s :: rleft) ss + else begin match ss with + | [] -> Error (err_need_argument s) + | "--" :: _ -> Error (err_need_argument s) + | s' :: _ when is_opt s' -> Error (err_need_argument s) + | arg :: ss -> Ok (Some (s, arg, List.rev_append rleft ss)) + end + | Some (opt, arg) -> + if not (List.mem opt names) + then rem_option names (s :: rleft) ss + else Ok (Some (opt, arg, List.rev_append rleft ss)) + end +| [] -> Ok None + +let opt ?docv ?(doc = undocumented) ?env names c ~absent = + let names = make_opt_names names in + let docv = match docv with None -> c.docv | Some docv -> docv in + let opt = Opt (doc, docv, fun ppf () -> c.print ppf absent) in + add_opt_doc { names; env; repeat = false; kind = opt }; + match get_parse () with + | Done -> invalid_arg err_done + | Perror _ -> absent + | Line line -> + match rem_option names [] line with + | Error e -> set_parse (Perror e); absent + | Ok None -> + begin match env_default env c.parse with + | Ok (Some v) -> v + | Ok None -> absent + | Error e -> set_parse (Perror e); absent + end + | Ok (Some (opt, arg, rest)) -> + match rem_option names [] rest with + | Ok None -> set_parse (Line rest); + begin match c.parse arg with + | Ok v -> v + | Error e -> set_parse (Perror e); absent + end + | Ok (Some (opt', _, _)) -> + if opt = opt' + then (set_parse @@ Perror (err_repeat opt); absent) + else (set_parse @@ Perror (err_dupe opt opt'); absent) + | Error e -> (* well... *) set_parse (Perror e); absent + +let opt_all ?docv ?(doc = undocumented) ?env names c ~absent = + let names = make_opt_names names in + let docv = match docv with None -> c.docv | Some docv -> docv in + let opt = + Opt (doc, docv, fun ppf () -> Fmt.(list ~sep:sp c.print) ppf absent) + in + add_opt_doc { names; env; repeat = false; kind = opt }; + match get_parse () with + | Done -> invalid_arg err_done + | Perror _ -> absent + | Line line -> + let rec find acc line = match rem_option names [] line with + | Error e -> set_parse (Perror e); absent + | Ok (Some (_, arg, rest)) -> + begin match c.parse arg with + | Error e -> set_parse (Perror e); absent + | Ok arg -> find (arg :: acc) rest + end + | Ok None -> + if acc <> [] then (set_parse (Line line); acc) else + match env_default env c.parse with + | Ok (Some v) -> [v] + | Ok None -> absent + | Error e -> set_parse (Perror e); absent + in + find [] line + +(* Parsing *) + +let get_pp_usage ~pos = function +| Some u -> Fmt.(const string) u +| None -> + fun ppf () -> + Fmt.pf ppf "[%a]..." Fmt.(styled `Underline (any "OPTION")) (); + if pos then Fmt.pf ppf " %a..." Fmt.(styled `Underline (any "ARG")) () + +let pp_usage ppf usage = Fmt.pf ppf "Usage: %s %a@." exec usage () +let pp_usage_try_help ppf usage = + pp_usage ppf usage; + Fmt.pf ppf "Try %a for more information@." + (quote Fmt.(string ++ (any " --help"))) exec; + () + +let parse_error ~usage msg = + Fmt.epr "%s: %s@." exec msg; + Fmt.epr "%a" pp_usage_try_help usage; + exit 1 + +let maybe_help ~doc ~usage = + let help_opts = ["-h"; "-help"; "--help" ] in + let rec find_help = function + | "--" :: _ | [] -> false + | s :: ss -> List.mem s help_opts || find_help ss + in + if not (find_help raw_args) then () else + begin + add_opt_doc { names = help_opts; env = None; repeat = false; + kind = Flag "Show this help." }; + Fmt.(pf stdout "%a - @[%a@]@." Fpath.pp Fpath.(base @@ v exec) text doc); + Fmt.(pf stdout "%a" pp_usage usage); + Fmt.(pf stdout "%a@." pp_opt_docs (get_opt_docs ())); + exit 0 + end + +let parse_opts ?(doc = undocumented) ?usage () = + let usage = get_pp_usage ~pos:false usage in + maybe_help ~doc ~usage; + match get_parse () with + | Line [] -> () + | Line l -> + let opts, poss = partition_opt_pos l in + List.iter (fun o -> Fmt.epr "%s: @[%a@]@." exec err_unknown_opt o) opts; + if poss <> [] then (Fmt.epr "%s: @[%a@]@." exec err_too_many poss); + pp_usage_try_help Fmt.stderr usage; + exit 1 + | Done -> invalid_arg err_done + | Perror (`Msg e) -> parse_error ~usage e + +let parse_pos_args parse ps = + let rec loop acc = function + | p :: ps -> parse p >>= fun p -> loop (p :: acc) ps + | [] -> Ok (List.rev acc) + in + loop [] ps + +let parse ?(doc = undocumented) ?usage ~pos:c () = + let usage = get_pp_usage ~pos:true usage in + maybe_help ~doc ~usage; + match get_parse () with + | Done -> invalid_arg err_done + | Perror (`Msg e) -> parse_error ~usage e + | Line l -> + let opts, poss = partition_opt_pos l in + if opts <> [] then begin + List.iter (fun o -> Fmt.epr "%s: @[%a@]@." exec err_unknown_opt o) opts; + pp_usage_try_help Fmt.stderr usage; + exit 1 + end; + match parse_pos_args c.parse poss with + | Error (`Msg e) -> parse_error ~usage e + | Ok poss -> poss + +(* Predefined argument converters *) + +let kconv ?docv ~kind k_of_string print = + let parse = parser_of_kind_of_string ~kind k_of_string in + conv ?docv parse print + +let string = conv ~docv:"STRING" (fun s -> Ok s) Fmt.string +let path = + let parse s = R.to_option (Fpath.of_string s) in + kconv ~docv:"PATH" ~kind:"a path" parse Fpath.pp + +let bin = conv ~docv:"EXEC" (fun s -> Ok (Bos_cmd.v s)) Bos_cmd.pp +let cmd = + let parse s = match Bos_cmd.of_string s with + | Error _ -> None + | Ok cmd when Bos_cmd.is_empty cmd -> None + | Ok cmd -> Some cmd + in + kconv ~docv:"CMD" ~kind:"a command line" parse Bos_cmd.pp + +let char = + kconv ~docv:"CHAR" ~kind:"a character" String.to_char Fmt.char + +let bool = + kconv ~docv:"BOOL" ~kind:"`true' or `false'" String.to_bool Fmt.bool + +let int = + kconv ~docv:"INT" ~kind:"an integer" String.to_int Fmt.int + +let nativeint = + kconv ~docv:"INT" ~kind:"a native integer" String.to_nativeint Fmt.nativeint + +let int32 = + kconv ~docv:"INT32" ~kind:"a 32-bit integer" String.to_int32 Fmt.int32 + +let int64 = + kconv ~docv:"INT64" ~kind:"a 64-bit integer" String.to_int64 Fmt.int64 + +let float = + kconv ~docv:"FLOAT" ~kind:"a float" String.to_float Fmt.float + +let enum enum = + if enum = [] then invalid_arg "empty enumeration" else + let parse s = try Ok (List.assoc s enum) with + | Not_found -> + let alts = List.map (fun (a, _) -> strf "%a" (quote Fmt.string) a) enum in + Error (err_invalid s (strf "one of %s" (String.concat ~sep:", " alts))) + in + let print ppf v = + let enum_inv = List.rev_map (fun (s, v) -> (v, s)) enum in + let to_string v = try List.assoc v enum_inv with + | Not_found -> + invalid_arg "Bos.Arg.enum: incomplete enumeration for the type" + in + Fmt.(using to_string string) ppf v + in + conv ~docv:"ENUM" parse print + +let parse_split ?(sep = ",") s parse = + let rec loop acc = function + | s :: ss -> parse s >>= fun v -> loop (v :: acc) ss + | [] -> Ok (List.rev acc) + in + loop [] (String.cuts ~sep:"," s) + +let list ?sep c = + let parse s = parse_split ?sep s c.parse in + let print = Fmt.list ~sep:(Fmt.any ",") c.print in + conv ~docv:(strf "LIST %s" c.docv) parse print + +let array ?sep c = + let parse s = match parse_split ?sep s c.parse with + | Error _ as e -> e + | Ok l -> Ok (Array.of_list l) + in + let print = Fmt.array ~sep:(Fmt.any ",") c.print in + conv ~docv:(strf "ARRAY %s" c.docv) parse print + +let pair ?(sep = ",") l r = + let parse s = match String.cut ~sep s with + | None -> Error (err_invalid s (strf "a separator `%s' in the string" sep)) + | Some (ls, rs) -> + l.parse ls >>= fun l -> + r.parse rs >>= fun r -> + Ok (l, r) + in + let print = Fmt.pair ~sep:Fmt.(const string sep) l.print r.print in + conv ~docv:(strf "%s%s%s" l.docv sep r.docv) parse print + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_cmd.ml b/unikernel/duniverse/bos/src/bos_os_cmd.ml new file mode 100644 index 00000000..6c824280 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_cmd.ml @@ -0,0 +1,611 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring +open Rresult + +let unix_buffer_size = 65536 (* UNIX_BUFFER_SIZE 4.0.0 *) + +(* Unix pretty printers *) + +let pp_unix_error ppf e = Fmt.string ppf (Unix.error_message e) +let pp_process_status ppf = function +| Unix.WEXITED c -> Fmt.pf ppf "exited with %d" c +| Unix.WSIGNALED s -> Fmt.pf ppf "killed by signal %a" Fmt.Dump.signal s +| Unix.WSTOPPED s -> Fmt.pf ppf "stopped by signal %a" Fmt.Dump.signal s + +(* Error messages *) + +let err_empty_line = "no command, empty command line" +let err_file f e = R.error_msgf "%a: %a" Fpath.pp f pp_unix_error e +let err_run cmd pp e = R.error_msgf "run %a: %a" Bos_cmd.dump cmd pp e + +(* Primitives from Unix *) + +let rec waitpid flags pid = try Unix.waitpid flags pid with +| Unix.Unix_error (Unix.EINTR, _, _) -> waitpid flags pid + +let rec create_process prog args stdin stdout stderr = + try Unix.create_process prog args stdin stdout stderr with + | Unix.Unix_error (Unix.EINTR, _, _) -> + create_process prog args stdin stdout stderr + +let rec create_process_env prog args env stdin stdout stderr = + try Unix.create_process_env prog args env stdin stdout stderr with + | Unix.Unix_error (Unix.EINTR, _, _) -> + create_process_env prog args env stdin stdout stderr + +let rec pipe () = try Unix.pipe () with +| Unix.Unix_error (Unix.EINTR, _, _) -> pipe () + +let rec set_close_on_exec fd = try Unix.set_close_on_exec fd with +| Unix.Unix_error (Unix.EINTR, _, _) -> set_close_on_exec fd + +let rec clear_close_on_exec fd = try Unix.clear_close_on_exec fd with +| Unix.Unix_error (Unix.EINTR, _, _) -> clear_close_on_exec fd + +let rec openfile fn mode perm = try Unix.openfile fn mode perm with +| Unix.Unix_error (Unix.EINTR, _, _) -> openfile fn mode perm + +let rec close fd = try Unix.close fd with +| Unix.Unix_error (Unix.EINTR, _, _) -> close fd + +let close_no_err fd = try close fd with e -> () + +let rec select r w e t = try Unix.select r w e t with +| Unix.Unix_error (Unix.EINTR, _, _) -> select r w e t + +(* Process creation primitive. *) + +let create_process cmd env ~stdin ~stdout ~stderr = + let log_header pid = "EXEC:" ^ String.of_int pid in + let line = Bos_cmd.to_list cmd in + let prog = try List.hd line with Failure _ -> failwith err_empty_line in + let line = Array.of_list line in + match env with + | None -> + let pid = create_process prog line stdin stdout stderr in + Bos_log.debug + (fun m -> m ~header:(log_header pid) "@[<1>%a@]" Bos_cmd.dump cmd); + pid + | Some env -> + let env = Bos_os_env.to_array env in + let pid = create_process_env prog line env stdin stdout stderr in + Bos_log.debug + (fun m -> m ~header:(log_header pid) "@[%a@,%a@]" + Fmt.Dump.(array String.dump) env Bos_cmd.dump cmd); + pid + +(* Tool existence and search *) + +let default_path_sep = if Sys.win32 then ";" else ":" +let dir_sep = Fpath.dir_sep.[0] +let exe_is_path t = String.exists (Char.equal dir_sep) t + +let tool_file ~dir tool = match dir.[String.length dir - 1] with +| c when c = dir_sep -> dir ^ tool +| _ -> String.concat ~sep:Fpath.dir_sep [dir; tool] + +let search_in_path tool = + let rec loop tool = function + | "" -> None + | p -> + let dir, p = match String.cut ~sep:default_path_sep p with + | None -> p, "" + | Some (dir, p) -> dir, p + in + if dir = "" then loop tool p else + let tool_file = tool_file ~dir tool in + match Bos_os_file._is_executable tool_file with + | false -> loop tool p + | true -> Some (Fpath.v tool_file) + in + try loop tool (Unix.getenv "PATH") with + | Not_found -> None + +let search_in_dirs ~dirs tool = + let rec loop tool = function + | [] -> None + | d :: dirs -> + let tool_file = tool_file ~dir:(Fpath.to_string d) tool in + match Bos_os_file._is_executable tool_file with + | false -> loop tool dirs + | true -> Some (Fpath.v tool_file) + in + loop tool dirs + +let ensure_exe_suffix_if_win32 = match Sys.win32 with +| false -> fun t -> t +| true -> + fun t -> match String.is_suffix ~affix:".exe" t with + | true -> t + | false -> t ^ ".exe" + +let _find_tool ?search tool = match tool with +| "" -> Ok None +| tool -> + let tool = ensure_exe_suffix_if_win32 tool in + match exe_is_path tool with + | true -> + begin match Fpath.of_string tool with + | Ok t -> Ok (Some t) + | Error (`Msg _) as e -> e + end + | false -> + match search with + | None -> Ok (search_in_path tool) + | Some dirs -> Ok (search_in_dirs ~dirs tool) + +let find_tool ?search cmd = match Bos_cmd.to_list cmd with +| [] -> Ok None +| c :: _ -> _find_tool ?search c + +let err_not_found ?search cmd = match Bos_cmd.is_empty cmd with +| true -> R.error_msg err_empty_line +| false -> + let pp_search ppf = function + | None -> Fmt.string ppf "PATH" + | Some dirs -> + let pp_dir ppf d = Fmt.string ppf (Filename.quote @@ Fpath.to_string d) + in + Fmt.(list ~sep:(Fmt.any ",@ ") pp_dir) ppf dirs + in + let tool = List.hd @@ Bos_cmd.to_list cmd in + R.error_msgf "%s: no such command in %a" tool pp_search search + +let get_tool ?search cmd = match find_tool ?search cmd with +| Ok (Some t) -> Ok t +| Ok None -> err_not_found ?search cmd +| Error _ as e -> e + +let exists ?search cmd = match find_tool ?search cmd with +| Ok (Some _) -> Ok true +| Ok None -> Ok false +| Error _ as e -> e + +let must_exist ?search cmd = match find_tool ?search cmd with +| Ok (Some _) -> Ok cmd +| Ok None -> err_not_found ?search cmd +| Error _ as e -> e + +let resolve ?search cmd = match find_tool ?search cmd with +| Ok (Some t) -> + let t = Fpath.to_string t in + Ok (Bos_cmd.of_list (t :: List.tl (Bos_cmd.to_list cmd))) +| Ok None -> err_not_found ?search cmd +| Error _ as e -> e + +let search_path_dirs ?(sep = default_path_sep) path = + let rec loop acc = function + | "" -> Ok (List.rev acc) + | p -> + let dir, p = match String.cut ~sep p with + | None -> p, "" + | Some (dir, p) -> dir, p + in + if dir = "" then loop acc p else + match Fpath.of_string dir with + | Error (`Msg m) -> R.error_msgf "search path value %S: %s" path m + | Ok d -> loop (d :: acc) p + in + loop [] path + +(* Fd utils *) + +module Fds = struct + + (* Maintains a set of fds to close, standard fds are never in the set. *) + + module Fd = struct + type t = Unix.file_descr + let compare : t -> t -> int = compare + end + module S = Set.Make (Fd) + + type t = S.t ref + let empty () = ref S.empty + let rem fd s = s := S.remove fd !s + let add fd s = + if fd = Unix.stdin || fd = Unix.stdout || fd = Unix.stderr then () else + (s := S.add fd !s) + + let close_all s = S.iter close_no_err !s; s := S.empty + let close fd s = if S.mem fd !s then (close_no_err fd; s := S.remove fd !s) +end + +let write_fd_for_file ~append f = + try + let flags = Unix.([O_WRONLY; O_CREAT]) in + let flags = (if append then Unix.O_APPEND else Unix.O_TRUNC) :: flags in + Ok (openfile (Fpath.to_string f) flags 0o644) + with Unix.Unix_error (e, _, _) -> err_file f e + +let read_fd_for_file f = + try Ok (openfile (Fpath.to_string f) [Unix.O_RDONLY] 0o644) + with Unix.Unix_error (e, _, _) -> err_file f e + +let string_of_fd_async fd = + let len = unix_buffer_size in + let buf = Buffer.create len in + let b = Bytes.create len in + let rec step fd store b () = + try match Unix.read fd b 0 len with + | 0 -> `Ok (Buffer.contents buf) + | n -> + (* FIXME After 4.01 Buffer.add_subbytes buf b 0 n; step fd store b () *) + Buffer.add_substring buf (Bytes.unsafe_to_string b) 0 n; + step fd store b () + with + | Unix.Unix_error (Unix.EPIPE, _, _) when Sys.win32 -> + (* That's the Windows way to say end, see + https://msdn.microsoft.com/en-us/library/windows/\ + desktop/aa365467(v=vs.85).aspx *) + `Ok (Buffer.contents buf) + | Unix.Unix_error (Unix.EINTR, _, _) -> step fd buf b () + | Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.EAGAIN), _, _) -> + `Await (step fd buf b) + in + step fd buf b + +let string_of_fd fd = + let rec loop = function `Ok s -> s | `Await step -> loop (step ()) in + loop (string_of_fd_async fd ()) + +let string_to_fd_async s fd = + let rec step fd s first len () = +(* FIXME After 4.01 try match Unix.single_write_substring fd s first len with *) + let b = Bytes.unsafe_of_string s in + try match Unix.single_write fd b first len with + | c when c = len -> `Ok () + | c -> step fd s (first + c) (len - c) () + with + | Unix.Unix_error (Unix.EINTR, _, _) -> step fd s first len () + | Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.EAGAIN), _, _) -> + `Await (step fd s first len) + in + step fd s 0 (String.length s) + +let string_to_fd s fd = + let rec loop = function `Ok () -> () | `Await step -> loop (step ()) in + loop (string_to_fd_async s fd ()) + +let string_to_of_fd s ~to_fd ~of_fd = + let never () = assert false in + let wset, write = [to_fd], string_to_fd_async s to_fd in + let rset, read = [of_fd], string_of_fd_async of_fd in + let ret = ref "" in + let rec loop rset read wset write = + let rable, wable, _ = select rset wset [] (-1.) in + let rset, read = match rable with + | [] -> rset, read + | _ -> + match read () with + | `Ok s -> ret := s; [], never + | `Await step -> rset, step + in + let wset, write = match wable with + | [] -> wset, write + | _ -> + match write () with + | `Ok () -> close_no_err to_fd; [], never + | `Await step -> wset, step + in + if rset = [] && wset = [] then !ret else + loop rset read wset write + in + let sigpipe = + if Sys.win32 then None else + Some (Sys.signal Sys.sigpipe Sys.Signal_ignore) + in + let restore () = match sigpipe with + | None -> () + | Some sigpipe -> Sys.set_signal Sys.sigpipe sigpipe + in + try let ret = loop rset read wset write in restore (); ret + with e -> restore (); raise e + +(* Command runs *) + +(* Run statuses *) + +type status = [ `Exited of int | `Signaled of int ] + +type run_info = Bos_cmd.t +let run_info_cmd ri = ri + +let pp_status ppf = function +| `Exited c -> Fmt.pf ppf "exited with %d" c +| `Signaled s -> Fmt.pf ppf "killed by signal %a" Fmt.Dump.signal s + +type run_status = run_info * status + +let success = function +| Ok (v, (_, `Exited 0)) -> Ok v +| Ok (_, (cmd, s)) -> err_run cmd pp_status s +| Error _ as e -> e + +(* Run standard errors *) + +type run_err = +| Err_file of Fpath.t * bool +| Err_fd of Unix.file_descr +| Err_run_out +| Err_stderr + +let err_file ?(append = false) f = Err_file (f, append) +let err_null = err_file Bos_os_file.null +let err_run_out = Err_run_out +let err_stderr = Err_stderr + +let fd_for_run_err out_fd = function +| Err_file (f, append) -> write_fd_for_file ~append f +| Err_fd fd -> Ok fd +| Err_run_out -> Ok out_fd +| Err_stderr -> Ok Unix.stderr + +(* Run standard inputs *) + +type pipeline = + { write : (string * Unix.file_descr) option; + read : Unix.file_descr; + pids : (Bos_cmd.t * int) list } + +type run_in = +| In_string of string +| In_file of Fpath.t +| In_run_out of pipeline +| In_fd of Unix.file_descr + +let in_string s = In_string s +let in_file f = In_file f +let in_null = in_file Bos_os_file.null +let in_stdin = In_fd Unix.stdin + +(* Run standard outputs *) + +type _ _run_out = +| To_string : (string * run_status) _run_out +| To_file : Fpath.t * bool -> (unit * run_status) _run_out +| To_run_in : run_in _run_out +| To_fd : Unix.file_descr -> (unit * run_status) _run_out + +type run_out = + { env : Bos_os_env.t option; + cmd : Bos_cmd.t; + run_err : run_err; + run_in : run_in; } + +(* Waiting for processes *) + +let rec wait_pids rev_pids = (* On failure returns the first failure *) + let rec loop ret = function + | (cmd, pid) :: pids -> + let s = snd (waitpid [] pid) in + if ret <> None then loop ret pids else + begin match s with + | Unix.WEXITED 0 -> loop ret pids + | Unix.WEXITED c -> loop (Some (cmd, `Exited c)) pids + | Unix.WSIGNALED s -> loop (Some (cmd, `Signaled s)) pids + | Unix.WSTOPPED _ -> assert false + end + | [] -> + match ret with + | None -> (fst (List.hd rev_pids), `Exited 0) + | Some s -> s + in + loop None (List.rev rev_pids) + +(* Running *) + +let do_in_fd_read_stdout stdin o pids do_read = + let fds = Fds.empty () in + try + Fds.add stdin fds; + let read_stdout, stdout = pipe () in + Fds.add read_stdout fds; + Fds.add stdout fds; + match fd_for_run_err stdout o.run_err with + | Error _ as e -> Fds.close_all fds; e + | Ok stderr -> + Fds.add stderr fds; + set_close_on_exec read_stdout; (* child close *) + let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in + clear_close_on_exec read_stdout; (* not in further childs (pipes) *) + Fds.close stdin fds; + Fds.close stdout fds; + do_read fds read_stdout ((o.cmd, pid) :: pids) + with + | Failure msg -> Error (`Msg msg) + | Unix.Unix_error (e, _, _) -> + Fds.close_all fds; err_run o.cmd pp_unix_error e + +let do_in_fd_out_string stdin o pids = + do_in_fd_read_stdout stdin o pids + begin fun fds read_stdout pids -> + let res = string_of_fd read_stdout in + let ret = wait_pids pids in + Fds.close_all fds; + Ok (res, ret) + end + +let do_in_fd_out_run_in stdin o pids = + do_in_fd_read_stdout stdin o pids + begin fun fds read_stdout pids -> + Fds.rem read_stdout fds; + Fds.close_all fds; + Ok (In_run_out { write = None; read = read_stdout; pids }) + end + +let do_in_fd_out_fd stdin stdout o pids = + let fds = Fds.empty () in + try + Fds.add stdin fds; + Fds.add stdout fds; + match fd_for_run_err stdout o.run_err with + | Error _ as e -> Fds.close_all fds; e + | Ok stderr -> + Fds.add stderr fds; + let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in + let ret = wait_pids ((o.cmd, pid) :: pids) in + Fds.close_all fds; + Ok ((), ret) + with + | Failure msg -> Error (`Msg msg) + | Unix.Unix_error (e, _, _) -> + Fds.close_all fds; err_run o.cmd pp_unix_error e + +let do_in_run_out_string p o = do_in_fd_out_string p.read o p.pids +let do_in_run_out_run_in p o = do_in_fd_out_run_in p.read o p.pids +let do_in_run_out_fd p out_fd o = do_in_fd_out_fd p.read out_fd o p.pids + +let do_in_string_read_stdout s o do_read = + let fds = Fds.empty () in + try + let stdin, write_stdin = pipe () in + Fds.add stdin fds; + Fds.add write_stdin fds; + let read_stdout, stdout = pipe () in + Fds.add read_stdout fds; + Fds.add stdout fds; + match fd_for_run_err stdout o.run_err with + | Error _ as e -> Fds.close_all fds; e + | Ok stderr -> + Fds.add stderr fds; + set_close_on_exec read_stdout; (* child close *) + set_close_on_exec write_stdin; (* child close *) + let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in + Fds.close stdin fds; + Fds.close stdout fds; + do_read fds write_stdin read_stdout pid + with + | Failure msg -> Error (`Msg msg) + | Unix.Unix_error (e, _, _) -> + Fds.close_all fds; err_run o.cmd pp_unix_error e + +let do_in_string_out_string s o = + do_in_string_read_stdout s o + begin fun fds write_stdin read_stdout pid -> + let res = string_to_of_fd s ~to_fd:write_stdin ~of_fd:read_stdout in + Fds.close write_stdin fds; (* signal EOF *) + let ret = wait_pids [(o.cmd, pid)] in + Fds.close_all fds; + Ok (res, ret) + end + +let do_in_string_out_run_in s o = + do_in_string_read_stdout s o + begin fun fds write_stdin read_stdout pid -> + Fds.rem read_stdout fds; + Fds.close_all fds; + Ok (In_run_out { write = Some (s, write_stdin); + read = read_stdout; pids = [o.cmd, pid] }) + end + +let do_in_string_out_fd s stdout o = + let fds = Fds.empty () in + try + Fds.add stdout fds; + let stdin, write_stdin = pipe () in + Fds.add stdin fds; + Fds.add write_stdin fds; + match fd_for_run_err stdout o.run_err with + | Error _ as e -> Fds.close_all fds; e + | Ok stderr -> + Fds.add stderr fds; + set_close_on_exec write_stdin; (* child close *) + let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in + string_to_fd s write_stdin; + Fds.close write_stdin fds; (* signal EOF *) + let ret = wait_pids [(o.cmd, pid)] in + Fds.close_all fds; + Ok ((), ret) + with + | Failure msg -> Error (`Msg msg) + | Unix.Unix_error (e, _, _) -> + Fds.close_all fds; err_run o.cmd pp_unix_error e + +let do_in_fd : + type a. Unix.file_descr -> run_out -> a _run_out -> (a, [> R.msg]) result = +fun in_fd o ret -> match ret with +| To_string -> do_in_fd_out_string in_fd o [] +| To_run_in -> do_in_fd_out_run_in in_fd o [] +| To_fd out_fd -> do_in_fd_out_fd in_fd out_fd o [] +| To_file (f, append) -> + write_fd_for_file ~append f >>= fun fd -> do_in_fd_out_fd in_fd fd o [] + +let run_cmd : type a. run_out -> a _run_out -> (a, [> R.msg]) result = +fun o ret -> match o.run_in with +| In_string s -> + begin match ret with + | To_string -> do_in_string_out_string s o + | To_run_in -> do_in_string_out_run_in s o + | To_fd out_fd -> do_in_string_out_fd s out_fd o + | To_file (f, append) -> + write_fd_for_file ~append f >>= fun fd -> do_in_string_out_fd s fd o + end +| In_run_out p -> + begin match ret with + | To_string -> do_in_run_out_string p o + | To_run_in -> do_in_run_out_run_in p o + | To_fd out_fd -> do_in_run_out_fd p out_fd o + | To_file (f, append) -> + write_fd_for_file ~append f >>= fun fd -> do_in_run_out_fd p fd o + end +| In_fd fd -> do_in_fd fd o ret +| In_file f -> read_fd_for_file f >>= fun fd -> do_in_fd fd o ret + +let out_string ?(trim = true) o = match run_cmd o To_string with +| Ok (s, st) when trim -> Ok (String.trim s, st) +| r -> r + +let out_lines ?trim o = + out_string ?trim o >>= fun (s, st) -> + Ok ((if s = "" then [] else String.cuts ~sep:"\n" s), st) + +let out_file ?(append = false) f o = run_cmd o (To_file (f, append)) +let out_run_in o = run_cmd o To_run_in +let out_null o = out_file Bos_os_file.null o +let out_stdout o = run_cmd o (To_fd Unix.stdout) + +let to_string ?trim o = out_string ?trim o |> success +let to_lines ?trim o = out_lines ?trim o |> success +let to_file ?append f o = out_file ?append f o |> success +let to_null o = out_null o |> success +let to_stdout o = out_stdout o |> success + +let run_io ?env ?err:(run_err = Err_stderr) cmd run_in = + { env; cmd; run_err; run_in } + +let run_out ?env ?err cmd = run_io ?env ?err cmd in_stdin +let run_in ?env ?err cmd i = run_io ?env ?err cmd i |> to_stdout +let run ?env ?err cmd = run_io ?env ?err cmd in_stdin |> to_stdout +let run_status ?env ?err ?(quiet = false) cmd = + let err = match err with + | None -> if quiet then err_null else err_stderr + | Some err -> err + in + let ret = match quiet with + | true -> in_null |> run_io ?env ~err cmd |> out_null + | false -> in_stdin |> run_io ?env ~err cmd |> out_stdout + in + match ret with + | Ok ((), (_, status)) -> Ok status + | Error _ as e -> e + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_dir.ml b/unikernel/duniverse/bos/src/bos_os_dir.ml new file mode 100644 index 00000000..f4f515a7 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_dir.ml @@ -0,0 +1,189 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring +open Rresult + +let uerror = Unix.error_message + +(* Existence, creation, deletion, contents *) + +let exists = Bos_os_path.dir_exists +let must_exist = Bos_os_path.dir_must_exist +let delete = Bos_os_path.delete_dir + +let create ?(path = true) ?(mode = 0o755) dir = + let rec mkdir d mode = try Ok (Unix.mkdir (Fpath.to_string d) mode) with + | Unix.Unix_error (Unix.EEXIST, _, _) -> Ok () + | Unix.Unix_error (e, _, _) -> + if d = dir + then R.error_msgf "create directory %a: %s" Fpath.pp d (uerror e) + else R.error_msgf "create directory %a: %a: %s" + Fpath.pp dir Fpath.pp d (uerror e) + in + Bos_os_path.exists dir >>= function + | true -> must_exist dir >>= fun _ -> Ok false + | false -> + match path with + | false -> mkdir dir mode >>= fun () -> Ok true + | true -> + let rec dirs_to_create p acc = exists p >>= function + | true -> Ok acc + | false -> dirs_to_create (Fpath.parent p) (p :: acc) + in + let rec create_them dirs () = match dirs with + | dir :: dirs -> mkdir dir mode >>= create_them dirs + | [] -> Ok () + in + dirs_to_create dir [] + >>= fun dirs -> create_them dirs () + >>= fun () -> Ok true + +let rec contents ?(dotfiles = false) ?(rel = false) dir = + let rec readdir dh acc = + match (try Some (Unix.readdir dh) with End_of_file -> None) with + | None -> Ok acc + | Some (".." | ".") -> readdir dh acc + | Some f when dotfiles || not (String.is_prefix "." f) -> + begin match Fpath.of_string f with + | Ok f -> + readdir dh ((if rel then f else Fpath.(dir // f)) :: acc) + | Error (`Msg m) -> + R.error_msgf + "directory contents %a: cannot parse element to a path (%a)" + Fpath.pp dir String.dump f + end + | Some _ -> readdir dh acc + in + try + let dh = Unix.opendir (Fpath.to_string dir) in + Bos_base.apply (readdir dh) [] ~finally:Unix.closedir dh + with + | Unix.Unix_error (Unix.EINTR, _, _) -> contents ~rel dir + | Unix.Unix_error (e, _, _) -> + R.error_msgf "directory contents %a: %s" Fpath.pp dir (uerror e) + +let fold_contents ?err ?dotfiles ?elements ?traverse f acc d = + contents d >>= Bos_os_path.fold ?err ?dotfiles ?elements ?traverse f acc + +(* User and current working directory *) + +let user () = + let debug err = Bos_log.debug (fun m -> m "OS.Dir.user: %s" err) in + let env_var_fallback () = + Bos_os_env.(parse "HOME" (some path) ~absent:None) >>= function + | Some p -> Ok p + | None -> R.error_msgf "cannot determine user home directory: \ + HOME environment variable is undefined" + in + if Sys.os_type = "Win32" then env_var_fallback () else + try + let uid = Unix.getuid () in + let home = (Unix.getpwuid uid).Unix.pw_dir in + match Fpath.of_string home with + | Ok p -> Ok p + | Error _ -> + debug (strf "could not parse path (%a) from passwd entry" + String.dump home); + env_var_fallback () + with + | Unix.Unix_error (e, _, _) -> (* should not happen *) + debug (uerror e); env_var_fallback () + | Not_found -> + env_var_fallback () + +let rec current () = + try + let p = Unix.getcwd () in + match Fpath.of_string p with + | Ok dir -> + if Fpath.is_abs dir then Ok dir else + R.error_msgf "getcwd(3) returned a relative path: (%a)" Fpath.pp dir + | Error _ -> + R.error_msgf + "get current working directory: cannot parse it to a path (%a)" + String.dump p + with + | Unix.Unix_error (Unix.EINTR, _, _) -> current () + | Unix.Unix_error (e, _, _) -> + R.error_msgf "get current working directory: %s" (uerror e) + +let rec set_current dir = try Ok (Unix.chdir (Fpath.to_string dir)) with +| Unix.Unix_error (Unix.EINTR, _, _) -> set_current dir +| Unix.Unix_error (e, _, _) -> + R.error_msgf "set current working directory to %a: %s" + Fpath.pp dir (uerror e) + +let with_current dir f v = + current () >>= fun old -> + try + set_current dir >>= fun () -> + let ret = f v in + set_current old >>= fun () -> Ok ret + with + | exn -> ignore (set_current old); raise exn + +(* Temporary directories *) + +type tmp_name_pat = (string -> string, Format.formatter, unit, string) format4 + +let delete_tmp dir = ignore (delete ~recurse:true dir) +let tmps = ref Fpath.Set.empty +let tmps_add file = tmps := Fpath.Set.add file !tmps +let tmps_rem file = delete_tmp file; tmps := Fpath.Set.remove file !tmps +let delete_tmps () = Fpath.Set.iter delete_tmp !tmps +let () = at_exit delete_tmps + +let default_tmp_mode = 0o700 + +let tmp ?(mode = default_tmp_mode) ?dir pat = + let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in + let err () = + R.error_msgf "create temporary directory %s in %a: \ + too many failing attempts" + (strf pat "XXXXXX") Fpath.pp dir + in + let rec loop count = + if count < 0 then err () else + let dir = Bos_os_tmp.rand_path dir pat in + try Ok (Unix.mkdir (Fpath.to_string dir) mode; dir) with + | Unix.Unix_error (Unix.EEXIST, _, _) -> loop (count - 1) + | Unix.Unix_error (Unix.EINTR, _, _) -> loop count + | Unix.Unix_error (e, _, _) -> + R.error_msgf "create temporary directory %s in %a: %s" + (strf pat "XXXXXX") Fpath.pp dir (uerror e) + in + match loop 10000 with + | Ok dir as r -> tmps_add dir; r + | Error _ as e -> e + +let with_tmp ?mode ?dir pat f v = + tmp ?mode ?dir pat >>= fun dir -> + try + let ret = f dir v in + tmps_rem dir; + Ok ret + with e -> tmps_rem dir; raise e + +(* Default temporary directory *) + +let default_tmp = Bos_os_tmp.default_dir +let set_default_tmp = Bos_os_tmp.set_default_dir + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_env.ml b/unikernel/duniverse/bos/src/bos_os_env.ml new file mode 100644 index 00000000..9be2af36 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_env.ml @@ -0,0 +1,98 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Rresult +open Astring + +(* Process environment *) + +type t = string String.map + +let current () = + try + let env = Unix.environment () in + let add acc assign = match acc with + | Error _ as e -> e + | Ok m -> + match String.cut ~sep:"=" assign with + | Some (var, value) -> R.ok (String.Map.add var value m) + | None -> + R.error_msgf + "could not parse process environment variable (%S)" assign + in + Array.fold_left add (R.ok String.Map.empty) env + with + | Unix.Unix_error (e, _, _) -> + R.error_msgf + "could not get process environment: %s" (Unix.error_message e) + +let to_array env = + let add_var name value acc = String.concat [name; "="; value] :: acc in + Array.of_list (String.Map.fold add_var env []) + +(* Variables *) + +let var name = try Some (Unix.getenv name) with Not_found -> None +let set_var name v = + let v = match v with None -> "" | Some v -> v in + try R.ok (Unix.putenv name v) with + | Unix.Unix_error (e, _, _) -> + R.error_msgf "set environment variable %s: %s" name (Unix.error_message e) + +let opt_var name ~absent = try Unix.getenv name with Not_found -> absent +let req_var name = try Ok (Unix.getenv name) with +| Not_found -> R.error_msgf "environment variable %s: undefined" name + +(* Typed lookup *) + +type 'a parser = string -> ('a, R.msg) result + +let parser kind k_of_string = + fun s -> match k_of_string s with + | None -> R.error_msgf "could not parse %s value from %a" kind String.dump s + | Some v -> Ok v + +let bool = + let of_string s = match String.Ascii.lowercase s with + | "" | "false" | "no" | "n" | "0" -> Some false + | "true" | "yes" | "y" | "1" -> Some true + | _ -> None + in + parser "bool" of_string + +let string = fun s -> Ok s +let path = Fpath.of_string +let cmd = fun s -> match Bos_cmd.of_string s with +| Error _ as err -> err +| Ok cmd when Bos_cmd.is_empty cmd -> R.error_msgf "command line is empty" +| Ok _ as cmd -> cmd + +let some p = fun s -> match p s with Ok v -> Ok (Some v) | Error _ as e -> e + +let parse name p ~absent = match var name with +| None -> Ok absent +| Some s -> + p s + |> R.reword_error_msg ~replace:true + (fun err -> R.msgf "environment variable %s: %s" name err) + +let value ?(log = Logs.Error) name p ~absent = + Bos_log.on_error_msg ~level:log ~use:(fun () -> absent) (parse name p ~absent) + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_file.ml b/unikernel/duniverse/bos/src/bos_os_file.ml new file mode 100644 index 00000000..1e6a91eb --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_file.ml @@ -0,0 +1,293 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring +open Rresult + +(* Error messages *) + +let err_empty_buf = "buffer size can't be 0" +let err_invalid_input = "input no longer valid, did it escape its scope ?" +let err_invalid_output = "output no longer valid, did it escape its scope ?" +let uerror = Unix.error_message + +(* Famous file paths *) + +let null = Fpath.v (if Sys.os_type = "Win32" then "NUL" else "/dev/null") +let dash = Fpath.v "-" +let is_dash = Fpath.equal dash + +(* Existence and deletion *) + +let exists = Bos_os_path.file_exists +let must_exist = Bos_os_path.file_must_exist +let delete = Bos_os_path.delete_file + +let rec truncate p size = + try Ok (Unix.truncate (Fpath.to_string p) size) with + | Unix.Unix_error (Unix.EINTR, _, _) -> truncate p size + | Unix.Unix_error (e, _, _) -> + R.error_msgf "truncate file %a: %s" Fpath.pp p (uerror e) + +(* Executability *) + +let _is_executable file = try Unix.access file [Unix.X_OK]; true with +| Unix.Unix_error _ -> false + +let is_executable file = _is_executable (Fpath.to_string file) + +(* Bytes buffers *) + +let io_buffer_size = 65536 (* IO_BUFFER_SIZE 4.0.0 *) +let bytes_buf = function +| None -> Bytes.create io_buffer_size +| Some bytes -> + if Bytes.length bytes <> 0 then bytes else + invalid_arg err_empty_buf + +(* Input *) + +type input = unit -> (Bytes.t * int * int) option + +let with_input ?bytes file f v = + try + let ic = if is_dash file then stdin else open_in_bin (Fpath.to_string file) + in + let ic_valid = ref true in + let close ic = + ic_valid := false; if is_dash file then () else close_in ic + in + let b = bytes_buf bytes in + let bsize = Bytes.length b in + let input () = + if not !ic_valid then invalid_arg err_invalid_input else + let rc = input ic b 0 bsize in + if rc = 0 then None else Some (b, 0, rc) + in + try Ok (Bos_base.apply (f input) v ~finally:close ic) with + | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e + with + | Sys_error e -> R.error_msg e + +let with_ic file f v = + try + let ic = if is_dash file then stdin else open_in_bin (Fpath.to_string file) + in + let close ic = if is_dash file then () else close_in ic in + try Ok (Bos_base.apply (f ic) v ~finally:close ic) with + | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e + with + | End_of_file -> R.error_msgf "%a: unexpected end of file" Fpath.pp file + | Sys_error e -> R.error_msg e + +let read file = + let is_stream ic = + let fd = Unix.descr_of_in_channel ic in + try Unix.lseek fd 0 Unix.SEEK_END = 0 with + | Unix.Unix_error (Unix.ESPIPE, _, _) -> true + in + let input_stream ic = + let bsize = 65536 (* IO_BUFFER_SIZE *) in + let buf = Buffer.create bsize in + let b = Bytes.create bsize in + let rec loop () = + let rc = input ic b 0 bsize in + if rc = 0 then Ok (Buffer.contents buf) else +(* FIXME After 4.01 (Buffer.add_subbytes buf b 0 rc; loop ()) *) + (Buffer.add_substring buf (Bytes.unsafe_to_string b) 0 rc; loop ()) + in + loop () + in + let input ic () = + if is_stream ic then input_stream ic else + let len = in_channel_length ic in + if len <= Sys.max_string_length then begin + let s = Bytes.create len in + really_input ic s 0 len; + Ok (Bytes.unsafe_to_string s) + end else begin + R.error_msgf "read %a: file too large (%a, max supported size: %a)" + Fpath.pp file Fmt.byte_size len Fmt.byte_size Sys.max_string_length + end + in + match with_ic file input () with + | Ok (Ok _ as v) -> v + | Ok (Error _ as e) -> e + | Error _ as e -> e + +let fold_lines f acc file = + let input ic acc = + let rec loop acc = + match try Some (input_line ic) with End_of_file -> None with + | None -> acc + | Some line -> loop (f acc line) + in + loop acc + in + with_ic file input acc + +let read_lines file = fold_lines (fun acc l -> l :: acc) [] file >>| List.rev + +(* Temporary files *) + +type tmp_name_pat = (string -> string, Format.formatter, unit, string) format4 + +let rec unlink_tmp file = try Unix.unlink (Fpath.to_string file) with +| Unix.Unix_error (Unix.EINTR, _, _) -> unlink_tmp file +| Unix.Unix_error (e, _, _) -> () + +let tmps = ref Fpath.Set.empty +let tmps_add file = tmps := Fpath.Set.add file !tmps +let tmps_rem file = unlink_tmp file; tmps := Fpath.Set.remove file !tmps +let unlink_tmps () = Fpath.Set.iter unlink_tmp !tmps + +let () = at_exit unlink_tmps + +let create_tmp_path mode dir pat = + let err () = + R.error_msgf "create temporary file %s in %a: too many failing attempts" + (strf pat "XXXXXX") Fpath.pp dir + in + let rec loop count = + if count < 0 then err () else + let file = Bos_os_tmp.rand_path dir pat in + let sfile = Fpath.to_string file in + let open_flags = Unix.([O_WRONLY; O_CREAT; O_EXCL; O_SHARE_DELETE]) in + try Ok (file, Unix.(openfile sfile open_flags mode)) with + | Unix.Unix_error (Unix.EEXIST, _, _) -> loop (count - 1) + | Unix.Unix_error (Unix.EINTR, _, _) -> loop count + | Unix.Unix_error (e, _, _) -> + R.error_msgf "create temporary file %a: %s" Fpath.pp file (uerror e) + in + loop 10000 + +let default_tmp_mode = 0o600 + +let tmp ?(mode = default_tmp_mode) ?dir pat = + let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in + create_tmp_path mode dir pat >>= fun (file, fd) -> + let rec close fd = try Unix.close fd with + | Unix.Unix_error (Unix.EINTR, _, _) -> close fd + | Unix.Unix_error (e, _, _) -> () + in + close fd; tmps_add file; Ok file + +let with_tmp_oc ?(mode = default_tmp_mode) ?dir pat f v = + try + let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in + create_tmp_path mode dir pat >>= fun (file, fd) -> + let oc = Unix.out_channel_of_descr fd in + let delete_close oc = tmps_rem file; close_out oc in + tmps_add file; + try Ok (Bos_base.apply (f file oc) v ~finally:delete_close oc) with + | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e + with Sys_error e -> R.error_msg e + +let with_tmp_output ?(mode = default_tmp_mode) ?dir pat f v = + try + let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in + create_tmp_path mode dir pat >>= fun (file, fd) -> + let oc = Unix.out_channel_of_descr fd in + let oc_valid = ref true in + let delete_close oc = oc_valid := false; tmps_rem file; close_out oc in + let output b = + if not !oc_valid then invalid_arg err_invalid_output else + match b with + | Some (b, pos, len) -> output oc b pos len + | None -> flush oc + in + tmps_add file; + try Ok (Bos_base.apply (f file output) v ~finally:delete_close oc) with + | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e + with Sys_error e -> R.error_msg e + +(* Output *) + +type output = (Bytes.t * int * int) option -> unit + +let default_mode = 0o644 + +let rec rename src dst = + try Unix.rename (Fpath.to_string src) (Fpath.to_string dst); Ok () with + | Unix.Unix_error (Unix.EINTR, _, _) -> rename src dst + | Unix.Unix_error (e, _, _) -> + R.error_msgf "rename %a to %a: %s" + Fpath.pp src Fpath.pp dst (uerror e) + +let stdout_with_output f v = + try + let output_valid = ref true in + let close () = output_valid := false in + let output b = + if not !output_valid then invalid_arg err_invalid_output else + match b with + | Some (b, pos, len) -> output stdout b pos len + | None -> flush stdout + in + Ok (Bos_base.apply (f output) v ~finally:close ()) + with Sys_error e -> R.error_msg e + +let with_output ?(mode = default_mode) file f v = + if is_dash file then stdout_with_output f v else + let do_write tmp tmp_out v = match f tmp_out v with + | Error _ as v -> Ok v + | Ok _ as v -> + match rename tmp file with + | Error _ as e -> e + | Ok () -> Ok v + in + match with_tmp_output ~mode ~dir:(Fpath.parent file) "bos-%s.tmp" do_write v + with + | Ok (Ok _ as r) -> r + | Ok (Error _ as e) -> e + | Error _ as e -> e + +let with_oc ?(mode = default_mode) file f v = + if is_dash file + then Ok (Bos_base.apply (f stdout) v ~finally:(fun () -> ()) ()) + else + let do_write tmp tmp_oc v = match f tmp_oc v with + | Error _ as v -> Ok v + | Ok _ as v -> + match rename tmp file with + | Error _ as e -> e + | Ok () -> Ok v + in + match with_tmp_oc ~mode ~dir:(Fpath.parent file) "bos-%s.tmp" do_write v with + | Ok (Ok _ as r) -> r + | Ok (Error _ as e) -> e + | Error _ as e -> e + +let write ?mode file contents = + let write oc contents = output_string oc contents; Ok () in + R.join @@ with_oc ?mode file write contents + +let writef ?mode file fmt = (* FIXME avoid the kstrf *) + Fmt.kstr (fun content -> write ?mode file content) fmt + +let write_lines ?mode file lines = + let rec write oc = function + | [] -> Ok () + | l :: ls -> + output_string oc l; + if ls <> [] then (output_char oc '\n'; write oc ls) else Ok () + in + R.join @@ with_oc ?mode file write lines + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_path.ml b/unikernel/duniverse/bos/src/bos_os_path.ml new file mode 100644 index 00000000..bd76d1c2 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_path.ml @@ -0,0 +1,467 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring +open Rresult + +let uerror = Unix.error_message + +(* Existence *) + +let rec file_exists file = + try Ok (Unix.((stat @@ Fpath.to_string file).st_kind = S_REG)) with + | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok false + | Unix.Unix_error (Unix.EINTR, _, _) -> file_exists file + | Unix.Unix_error (e, _, _) -> + R.error_msgf "file %a exists: %s" Fpath.pp file (uerror e) + +let rec dir_exists dir = + try Ok (Unix.((stat @@ Fpath.to_string dir).st_kind = S_DIR)) with + | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok false + | Unix.Unix_error (Unix.EINTR, _, _) -> dir_exists dir + | Unix.Unix_error (e, _, _) -> + R.error_msgf "directory %a exists: %s" Fpath.pp dir (uerror e) + +let rec exists path = + try Ok (ignore @@ Unix.stat (Fpath.to_string path); true) with + | Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> Ok false + | Unix.Unix_error (Unix.EINTR, _, _) -> exists path + | Unix.Unix_error (e, _, _) -> + R.error_msgf "path %a exists: %s" Fpath.pp path (uerror e) + +let rec file_must_exist file = + try match Unix.((stat @@ Fpath.to_string file).st_kind) with + | Unix.S_REG -> Ok file + | _ -> R.error_msgf "%a: Not a file" Fpath.pp file + with + | Unix.Unix_error (Unix.ENOENT, _, _) -> + R.error_msgf "%a: No such file" Fpath.pp file + | Unix.Unix_error (Unix.EINTR, _, _) -> file_must_exist file + | Unix.Unix_error (e, _, _) -> + R.error_msgf "file %a must exist: %s" Fpath.pp file (uerror e) + +let rec dir_must_exist dir = + try match Unix.((stat @@ Fpath.to_string dir).st_kind) with + | Unix.S_DIR -> Ok dir + | _ -> R.error_msgf "%a: Not a directory" Fpath.pp dir + with + | Unix.Unix_error (Unix.ENOENT, _, _) -> + R.error_msgf "%a: No such directory" Fpath.pp dir + | Unix.Unix_error (Unix.EINTR, _, _) -> dir_must_exist dir + | Unix.Unix_error (e, _, _) -> + R.error_msgf "directory %a must exist: %s" Fpath.pp dir (uerror e) + +let rec must_exist path = + try ignore @@ Unix.stat (Fpath.to_string path); Ok path with + | Unix.Unix_error (Unix.ENOENT, _, _) -> + R.error_msgf "%a: No such path" Fpath.pp path + | Unix.Unix_error (Unix.EINTR, _, _) -> must_exist path + | Unix.Unix_error (e, _, _) -> + R.error_msgf "path %a must exist: %s" Fpath.pp path (uerror e) + +(* Delete *) + +let delete_file ?(must_exist = false) file = + let rec unlink file = try Ok (Unix.unlink @@ Fpath.to_string file) with + | Unix.Unix_error (Unix.ENOENT, _, _) -> + if not must_exist then Ok () else + R.error_msgf "delete file %a: No such file" Fpath.pp file + | Unix.Unix_error (Unix.EINTR, _, _) -> unlink file + | Unix.Unix_error (e, _, _) -> + R.error_msgf "delete file %a: %s" Fpath.pp file (uerror e) + in + unlink file + +let delete_dir ?must_exist:(must = false) ?(recurse = false) dir = + let rec delete_files to_rmdir dirs = match dirs with + | [] -> Ok to_rmdir + | dir :: todo -> + let rec delete_dir_files dh dirs = + match (try Some (Unix.readdir dh) with End_of_file -> None) with + | None -> Ok dirs + | Some (".." | ".") -> delete_dir_files dh dirs + | Some file -> + let rec try_unlink file = + try (Unix.unlink (Fpath.to_string file); Ok dirs) with + | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok dirs + | Unix.Unix_error ((Unix.EISDIR (* Linux *) + |Unix.EPERM), _, _) -> Ok (file :: dirs) + | Unix.Unix_error ((Unix.EACCES, _, _)) when Sys.win32 -> + (* That's what Unix uses on Windows + https://msdn.microsoft.com/en-us/library/1c3tczd6.aspx + and it's rather unhelpful w.r.t. error codes. *) + Ok (file :: dirs) + | Unix.Unix_error (Unix.EINTR, _, _) -> try_unlink file + | Unix.Unix_error (e, _, _) -> + R.error_msgf "%a: %s" Fpath.pp file (uerror e) + in + match try_unlink Fpath.(dir / file) with + | Ok dirs -> delete_dir_files dh dirs + | Error _ as e -> e + in + try + let dh = Unix.opendir (Fpath.to_string dir) in + match Bos_base.apply (delete_dir_files dh) [] ~finally:Unix.closedir dh + with + | Ok dirs -> delete_files (dir :: to_rmdir) (List.rev_append dirs todo) + | Error _ as e -> e + with + | Unix.Unix_error (Unix.ENOENT, _, _) -> delete_files to_rmdir todo + | Unix.Unix_error (Unix.EINTR, _, _) -> delete_files to_rmdir dirs + | Unix.Unix_error (e, _, _) -> + R.error_msgf "%a: %s" Fpath.pp dir (uerror e) + in + let rec delete_dirs = function + | [] -> Ok () + | dir :: dirs -> + let rec rmdir dir = try Ok (Unix.rmdir (Fpath.to_string dir)) with + | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok () + | Unix.Unix_error (Unix.EINTR, _, _) -> rmdir dir + | Unix.Unix_error (e, _, _) -> + R.error_msgf "%a: %s" Fpath.pp dir (uerror e) + in + match rmdir dir with + | Ok () -> delete_dirs dirs + | Error _ as e -> e + in + let delete recurse dir = + if not recurse then + let rec rmdir dir = try Ok (Unix.rmdir (Fpath.to_string dir)) with + | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok () + | Unix.Unix_error (Unix.EINTR, _, _) -> rmdir dir + | Unix.Unix_error (e, _, _) -> R.error_msgf "%s" (uerror e) + in + rmdir dir + else + delete_files [] [dir] >>= fun rmdirs -> + delete_dirs rmdirs + in + begin + (if must then dir_must_exist dir else Ok dir) + >>= fun dir -> delete recurse dir + end + |> R.reword_error_msg ~replace:true + (fun msg -> R.msgf "delete directory %a: %s" Fpath.pp dir msg) + +let rec delete ?(must_exist = false) ?(recurse = false) path = + try match Unix.((stat (Fpath.to_string path)).st_kind) with + | Unix.S_DIR -> delete_dir ~must_exist ~recurse path + | _ -> delete_file ~must_exist path + with + | Unix.Unix_error (Unix.ENOENT, _, _) -> + if not must_exist then Ok () else + R.error_msgf "delete path %a: No such path" Fpath.pp path + | Unix.Unix_error (Unix.EINTR, _, _) -> delete ~must_exist ~recurse path + | Unix.Unix_error (e, _, _) -> + R.error_msgf "delete path %a: %s" Fpath.pp path (uerror e) + +(* Move, stat and mode *) + +let move ?(force = false) src dst = + let rename src dst = + try Ok (Unix.rename (Fpath.to_string src) (Fpath.to_string dst)) with + | Unix.Unix_error (e, _, _) -> + R.error_msgf "move %a to %a: %s" + Fpath.pp src Fpath.pp dst (uerror e) + in + if force then rename src dst else + exists dst >>= function + | false -> rename src dst + | true -> + R.error_msgf "move %a to %a: Destination exists" + Fpath.pp src Fpath.pp dst + +let rec stat p = try Ok (Unix.stat (Fpath.to_string p)) with +| Unix.Unix_error (Unix.EINTR, _, _) -> stat p +| Unix.Unix_error (e, _, _) -> + R.error_msgf "stat %a: %s" Fpath.pp p (uerror e) + +module Mode = struct + type t = int + + let rec get p = try Ok (Unix.((stat (Fpath.to_string p)).st_perm)) with + | Unix.Unix_error (Unix.EINTR, _, _) -> get p + | Unix.Unix_error (e, _, _) -> + R.error_msgf "get mode %a: %s" Fpath.pp p (uerror e) + + let rec set p m = try Ok (Unix.chmod (Fpath.to_string p) m) with + | Unix.Unix_error (Unix.EINTR, _, _) -> set p m + | Unix.Unix_error (e, _, _) -> + R.error_msgf "set mode %a: %s" Fpath.pp p (uerror e) +end + +(* Path links *) + +let rec force_remove op target p = + let sp = Fpath.to_string p in + try match Unix.((lstat sp).st_kind) with + | Unix.S_DIR -> Ok (Unix.rmdir sp) + | _ -> Ok (Unix.unlink sp) + with + | Unix.Unix_error (Unix.EINTR, _, _) -> force_remove op target p + | Unix.Unix_error (e, _, _) -> + R.error_msgf "force %s %a to %a: %s" op Fpath.pp target Fpath.pp p + (uerror e) + +let rec link ?(force = false) ~target p = + try Ok (Unix.link (Fpath.to_string target) (Fpath.to_string p)) with + | Unix.Unix_error (Unix.EEXIST, _, _) when force -> + force_remove "link" target p >>= fun () -> link ~force ~target p + | Unix.Unix_error (Unix.EINTR, _, _) -> link ~force ~target p + | Unix.Unix_error (e, _, _) -> + R.error_msgf "link %a to %a: %s" + Fpath.pp target Fpath.pp p (uerror e) + +let rec symlink ?(force = false) ~target p = + try Ok (Unix.symlink (Fpath.to_string target) (Fpath.to_string p)) with + | Unix.Unix_error (Unix.EEXIST, _, _) when force -> + force_remove "symlink" target p >>= fun () -> symlink ~force ~target p + | Unix.Unix_error (Unix.EINTR, _, _) -> symlink ~force ~target p + | Unix.Unix_error (e, _, _) -> + R.error_msgf "symlink %a to %a: %s" + Fpath.pp target Fpath.pp p (uerror e) + +let rec symlink_target p = + try + let l = Unix.readlink (Fpath.to_string p) in + match Fpath.of_string l with + | Ok l -> Ok l + | Error _ -> + R.error_msgf "target of %a: could not read a path from %a" + Fpath.pp p String.dump l + with + | Unix.Unix_error (Unix.EINVAL, _, _) -> + R.error_msgf "target of %a: Not a symbolic link" Fpath.pp p + | Unix.Unix_error (Unix.EINTR, _, _) -> symlink_target p + | Unix.Unix_error (e, _, _) -> + R.error_msgf "target of %a: %s" Fpath.pp p (uerror e) + +let rec symlink_stat p = try Ok (Unix.lstat (Fpath.to_string p)) with +| Unix.Unix_error (Unix.EINTR, _, _) -> symlink_stat p +| Unix.Unix_error (e, _, _) -> + R.error_msgf "symlink stat %a: %s" Fpath.pp p (uerror e) + +(* Matching paths. *) + +(* The following code is horribly messy mainly due to volume + handling. Could certainly be improved. *) + +let rec match_segment dotfiles ~env acc path seg = + (* N.B. path can be empty, usually for relative patterns without volume. *) + let var_start = match seg with Bos_pat.Var _ :: _ -> true | _ -> false in + let rec readdir dh acc = + match (try Some (Unix.readdir dh) with End_of_file -> None) with + | None -> Ok acc + | Some (".." | ".") -> readdir dh acc + | Some e when String.length e > 1 && e.[0] = '.' && not dotfiles && + var_start -> + readdir dh acc + | Some e -> + match Fpath.is_seg e with + | true -> + begin match Bos_pat.match_pat ~env 0 e seg with + | None -> readdir dh acc + | Some _ as m -> + let p = + if path = "" then e else + Fpath.(to_string (add_seg (Fpath.v path) e)) + in + readdir dh ((p, m) :: acc) + end + | false -> + R.error_msgf + "directory %a: cannot parse element to a path (%a)" + Fpath.pp (Fpath.v path) String.dump e + in + try + let path = if path = "" then "." else path in + let dh = Unix.opendir path in + Bos_base.apply (readdir dh) acc ~finally:Unix.closedir dh + with + | Unix.Unix_error (Unix.ENOTDIR, _, _) -> Ok acc + | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok acc + | Unix.Unix_error (Unix.EINTR, _, _) -> + match_segment dotfiles ~env acc path seg + | Unix.Unix_error (e, _, _) -> + R.error_msgf "directory %a: %s" Fpath.pp (Fpath.v path) (uerror e) + +let match_path ?(dotfiles = false) ~env p = + let err _ = + R.msgf "Unexpected error while matching `%a'" Fpath.pp p + in + let vol, start, segs = + let vol, segs = Fpath.split_volume p in + match Fpath.segs segs with + | "" :: "" :: [] (* root *) -> vol, Fpath.dir_sep, [] + | "" :: ss -> vol, Fpath.dir_sep, ss + | ss -> vol, "", ss (* N.B. ss is non empty. *) + in + let rec match_segs acc = function + | [] -> Ok acc + | "" :: [] -> (* final empty segment "", keep only directories. *) + let rec loop acc = function + | [] -> Ok acc + | (p, env) :: matches -> + let r = try Ok (Unix.((stat p).st_kind = Unix.S_DIR)) with + | Unix.Unix_error (e, _, _) -> R.error_msgf "%s: %s" p (uerror e) + in + match r with + | Error _ as e -> e + | Ok false -> loop acc matches + | Ok true -> + let acc' = Fpath.(to_string (add_seg (v p) ""), env) :: acc in + loop acc' matches + in + loop [] acc + | (".." | "." as e) :: segs -> + (* We simply add the segment to current matches. No need + to test if the resulting path exists. We can always go up (root + absorbs) or stay at the same level. *) + let rec loop acc = function + | [] -> acc + | (p, env) :: matches -> + let p = + if p = vol then p ^ e (* C:.. *) else + Fpath.(to_string (add_seg (v p) e)) + in + loop ((p, env) :: acc) matches + in + match_segs (loop [] acc) segs + | seg :: segs -> + match Bos_pat.of_string seg with + | Error _ as e -> e + | Ok seg -> + let rec loop acc = function + | [] -> Ok acc + | (p, env) :: matches -> + match match_segment dotfiles ~env acc p seg with + | Error _ as e -> e + | Ok acc -> loop acc matches + in + match loop [] acc with + | Error _ as e -> e + | Ok acc -> match_segs acc segs + in + let start_exists vol start = + let start = if start = "" then "." else start in + exists (Fpath.v (vol ^ start)) + in + start_exists vol start >>= function + | false -> Ok [] + | true -> + let start = if start = "" then vol else vol ^ start in + R.reword_error_msg err @@ match_segs [start, env] segs + +let matches ?dotfiles p = + let get_path acc (p, _) = (Fpath.v p) :: acc in + match_path ?dotfiles ~env:None p >>| List.fold_left get_path [] + +let query ?dotfiles ?(init = String.Map.empty) p = + let env = Some init in + let unopt_map acc (p, map) = match map with + | None -> assert false + | Some map -> (Fpath.v p, map) :: acc + in + match_path ?dotfiles ~env p >>| List.fold_left unopt_map [] + +(* Folding over file system hierarchies *) + +type 'a res = ('a, R.msg) result +type traverse = [ `Any | `None | `Sat of Fpath.t -> bool res ] +type elements = [ `Any | `Files | `Dirs | `Sat of Fpath.t -> bool res ] +type 'a fold_error = Fpath.t -> 'a res -> unit res + +let log_fold_error ~level = + fun p -> function + | Error (`Msg e) -> Bos_log.msg level (fun m -> m "%s" e); Ok () + | Ok _ -> assert false + +exception Fold_stop of R.msg + +let err_fun err f ~backup_value = (* handles path function errors in folds *) + fun p -> match f p with + | Ok v -> v + | Error _ as e -> + match err p e with + | Ok () -> backup_value (* use backup value and continue the fold. *) + | Error m -> raise (Fold_stop m) (* the fold stops. *) + +let err_predicate_fun err p = err_fun err p ~backup_value:false + +let do_traverse_fun err = function +| `Any -> fun _ -> true +| `None -> fun _ -> false +| `Sat sat -> err_predicate_fun err sat + +let is_element_fun err = function +| `Any -> err_predicate_fun err exists +| `Files -> err_predicate_fun err file_exists +| `Dirs -> err_predicate_fun err dir_exists +| `Sat sat -> err_predicate_fun err sat + +let is_dir_fun err = + let is_dir p = try Ok (Sys.is_directory (Fpath.to_string p)) with + | Sys_error e -> R.error_msg e + in + err_predicate_fun err is_dir + +let readdir_fun err = + let readdir d = try Ok (Sys.readdir (Fpath.to_string d)) with + | Sys_error e -> R.error_msg e + in + err_fun err readdir ~backup_value:[||] + +let fold + ?(err = log_fold_error ~level:Logs.Error) + ?(dotfiles = false) + ?(elements = `Any) ?(traverse = `Any) + f acc paths + = + try + let do_traverse = do_traverse_fun err traverse in + let is_element = is_element_fun err elements in + let is_dir = is_dir_fun err in + let readdir = readdir_fun err in + let process_path p (acc, to_traverse) = + (if is_element p then (f p acc) else acc), + (if is_dir p && do_traverse p then p :: to_traverse else to_traverse) + in + let dir_child d acc bname = + if not dotfiles && String.is_prefix "." bname then acc else + process_path Fpath.(d / bname) acc + in + let rec loop acc = function + | (d :: ds) :: up -> + let childs = readdir d in + let acc, to_traverse = Array.fold_left (dir_child d) (acc, []) childs in + loop acc (to_traverse :: ds :: up) + | [] :: [] -> acc + | [] :: up -> loop acc up + | _ -> assert false + in + let init acc p = + let base = Fpath.(basename @@ normalize p) in + if not dotfiles && String.is_prefix "." base then acc else + process_path p acc + in + let acc, to_traverse = List.fold_left init (acc, []) paths in + (Ok (loop acc (to_traverse :: []))) + with Fold_stop (`Msg _ as e) -> Error e + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_tmp.ml b/unikernel/duniverse/bos/src/bos_os_tmp.ml new file mode 100644 index 00000000..1f2b204a --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_tmp.ml @@ -0,0 +1,46 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Astring + +(* Base functions for handling temporary file and directories. *) + +let default_dir_init = + let from_env var ~absent = + match try Some (Sys.getenv var) with Not_found -> None with + | None -> absent + | Some v -> + match Fpath.of_string v with + | Error _ -> absent (* FIXME log something ? *) + | Ok v -> v + in + if Sys.os_type = "Win32" then from_env "TEMP" ~absent:Fpath.(v "./") else + from_env "TMPDIR" ~absent:(Fpath.v "/tmp") + +let default_dir = ref default_dir_init +let set_default_dir p = default_dir := p +let default_dir () = !default_dir + +let rand_gen = lazy (Random.State.make_self_init ()) + +let rand_path dir pat = + let rand = Random.State.bits (Lazy.force rand_gen) land 0xFFFFFF in + Fpath.(dir / strf pat (strf "%06x" rand)) + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_os_u.ml b/unikernel/duniverse/bos/src/bos_os_u.ml new file mode 100644 index 00000000..9005a9d5 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_os_u.ml @@ -0,0 +1,55 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Rresult + +type 'a result = ('a, [`Unix of Unix.error]) Rresult.result +let pp_error ppf (`Unix e ) = Fmt.string ppf (Unix.error_message e) +let open_error = function Ok _ as r -> r | Error (`Unix _) as r -> r +let error_to_msg r = R.error_to_msg ~pp_error r + +let rec call f v = try Ok (f v) with +| Unix.Unix_error (Unix.EINTR, _, _) -> call f v +| Unix.Unix_error (e, _, _) -> Error (`Unix e) + +let mkdir p m = try Ok (Unix.mkdir (Fpath.to_string p) m) with +| Unix.Unix_error (e, _, _) -> Error (`Unix e) + +let link p p' = + try Ok (Unix.link (Fpath.to_string p) (Fpath.to_string p')) with + | Unix.Unix_error (e, _, _) -> Error (`Unix e) + +let unlink p = try Ok (Unix.unlink (Fpath.to_string p)) with +| Unix.Unix_error (e, _, _) -> Error (`Unix e) + +let rename p p' = + try Ok (Unix.rename (Fpath.to_string p) (Fpath.to_string p')) with + | Unix.Unix_error (e, _, _) -> Error (`Unix e) + +let stat p = try Ok (Unix.stat (Fpath.to_string p)) with +| Unix.Unix_error (e, _, _) -> Error (`Unix e) + +let lstat p = try Ok (Unix.lstat (Fpath.to_string p)) with +| Unix.Unix_error (e, _, _) -> Error (`Unix e) + +let rec truncate p size = try Ok (Unix.truncate (Fpath.to_string p) size) with +| Unix.Unix_error (Unix.EINTR, _, _) -> truncate p size +| Unix.Unix_error (e, _, _) -> Error (`Unix e) + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_pat.ml b/unikernel/duniverse/bos/src/bos_pat.ml new file mode 100644 index 00000000..793c1350 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_pat.ml @@ -0,0 +1,206 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Rresult +open Astring + +(* Errors *) + +let err_malformed_pat s = + strf "malformed named string pattern: %a" String.dump s + +(* Patterns *) + +type lexeme = Lit of string | Var of string +type t = lexeme list + +let empty = [] +let dom p = + let add acc = function Lit _ -> acc | Var v -> String.Set.add v acc in + List.fold_left add String.Set.empty p + +let equal p p' = p = p' +let compare p p' = Stdlib.compare p p' + +type parse_state = S_lit | S_dollar | S_var + +let of_string s = + let b = Buffer.create 255 in + let flush b = let s = Buffer.contents b in (Buffer.clear b; s) in + let err () = R.error_msg (err_malformed_pat s) in + let push_lit b acc = + if Buffer.length b <> 0 then Lit (flush b) :: acc else acc + in + let max_i = String.length s - 1 in + let rec loop acc state i = + if i > max_i then + if state <> S_lit then err () else (Ok (List.rev (push_lit b acc))) + else match state with + | S_lit -> + begin match s.[i] with + | '$' -> loop acc S_dollar (i + 1) + | c -> Buffer.add_char b c; loop acc S_lit (i + 1) + end + | S_dollar -> + begin match s.[i] with + | '$' -> Buffer.add_char b '$'; loop acc S_lit (i + 1) + | '(' -> loop (push_lit b acc) S_var (i + 1) + | _ -> err () + end + | S_var -> + begin match s.[i] with + | ')' -> loop (Var (flush b) :: acc) S_lit (i + 1); + | ',' -> err () + | c -> Buffer.add_char b c; loop acc S_var (i + 1) + end + in + loop [] S_lit 0 + +let v s = R.error_msg_to_invalid_arg (of_string s) + +let to_string p = + let b = Buffer.create 255 in + let add = function + | Lit l -> + let max_i = String.length l - 1 in + let rec loop start i = + if i > max_i then Buffer.add_substring b l start (i - start) else + if l.[i] <> '$' then loop start (i + 1) else + begin + Buffer.add_substring b l start (i - start + 1); + Buffer.add_char b '$'; + let next = i + 1 in loop next next + end + in + loop 0 0 + | Var v -> Buffer.(add_string b "$("; add_string b v; add_char b ')') + in + List.iter add p; + Buffer.contents b + +let escape_dollar s = + let len = String.length s in + let max_idx = len - 1 in + let rec escaped_len i l = + if i > max_idx then l else + match String.unsafe_get s i with + | '$' -> escaped_len (i + 1) (l + 2) + | _ -> escaped_len (i + 1) (l + 1) + in + let escaped_len = escaped_len 0 0 in + if escaped_len = len then s else + let b = Bytes.create escaped_len in + let rec loop i k = + if i > max_idx then Bytes.unsafe_to_string b else + match String.unsafe_get s i with + | '$' -> + Bytes.unsafe_set b k '$'; Bytes.unsafe_set b (k + 1) '$'; + loop (i + 1) (k + 2) + | c -> + Bytes.unsafe_set b k c; + loop (i + 1) (k + 1) + in + loop 0 0 + +let rec pp ppf = function +| [] -> () +| Lit l :: p -> Fmt.string ppf (escape_dollar l); pp ppf p +| Var v :: p -> Fmt.pf ppf "$(%s)" v; pp ppf p + +let dump ppf p = + let rec dump ppf = function + | [] -> () + | Lit l :: p -> + Fmt.string ppf (String.Ascii.escape_string (escape_dollar l)); pp ppf p + | Var v :: p -> + Fmt.pf ppf "$(%s)" v; pp ppf p + in + Fmt.pf ppf "\"%a\"" dump p + +(* Substitution *) + +type defs = string String.map + +let subst ?(undef = fun _ -> None) defs p = + let subst acc = function + | Lit _ as l -> l :: acc + | Var v as var -> + match String.Map.find v defs with + | Some lit -> (Lit lit) :: acc + | None -> + match undef v with + | Some lit -> (Lit lit) :: acc + | None -> var :: acc + in + List.(rev (fold_left subst [] p)) + +let format ?(undef = fun _ -> "") defs p = + let b = Buffer.create 255 in + let add = function + | Lit l -> Buffer.add_string b l + | Var v -> + match String.Map.find v defs with + | Some s -> Buffer.add_string b s + | None -> Buffer.add_string b (undef v) + in + List.iter add p; + Buffer.contents b + +(* Matching + N.B. matching is not t.r. but stack is bounded by number of variables. *) + +let match_literal pos s lit = (* matches [lit] at [pos] in [s]. *) + let l_len = String.length lit in + let s_len = String.length s - pos in + if l_len > s_len then None else + try + for i = 0 to l_len - 1 do if lit.[i] <> s.[pos + i] then raise Exit done; + Some (pos + l_len) + with Exit -> None + +let match_pat ~env pos s pat = + let init, no_env = match env with + | None -> Some String.Map.empty, true + | Some m as init -> init, false + in + let rec loop pos = function + | [] -> if pos = String.length s then init else None + | Lit lit :: p -> + begin match (match_literal pos s lit) with + | None -> None + | Some pos -> loop pos p + end + | Var n :: p -> + let rec try_match next_pos = + if next_pos < pos then None else + match loop next_pos p with + | None -> try_match (next_pos - 1) + | Some m as r -> + if no_env then r else + Some (String.Map.add n + (String.with_index_range s ~first:pos ~last:(next_pos - 1)) m) + in + try_match (String.length s) (* Longest match first. *) + in + loop pos pat + +let matches p s = (match_pat ~env:None 0 s p) <> None +let query ?(init = String.Map.empty) p s = match_pat ~env:(Some init) 0 s p + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_setup.ml b/unikernel/duniverse/bos/src/bos_setup.ml new file mode 100644 index 00000000..0d7523ee --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_setup.ml @@ -0,0 +1,44 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2016 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +module R = Rresult.R +include R.Infix +type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b + +let strf = Astring.strf +let (^) = Astring.(^) + +module Char = Astring.Char +module String = Astring.String + +module Pat = Bos.Pat +module Cmd = Bos.Cmd +module OS = Bos.OS + +module Fmt = Fmt +module Logs = Logs + +let setup () = + Fmt_tty.setup_std_outputs (); + Logs.set_reporter (Logs_fmt.reporter ()); + () + +let () = setup () + +(*--------------------------------------------------------------------------- + Copyright (c) 2016 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_setup.mli b/unikernel/duniverse/bos/src/bos_setup.mli new file mode 100644 index 00000000..9a78ab96 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_setup.mli @@ -0,0 +1,103 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2016 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Quick setup for simple programs. + + Linking against this module setups {!Logs} and issuing: +{[ +open Bos_setup +]} + in a module is sufficient to bring {!Rresult}, {!Astring} and + {!Bos} in scope. See also how to use this for + {{!interpreted}interpreted programs}. *) + +(** {1:interpreted Interpreted programs} + +To use {!Bos} and this setup in an interpreted program, start the +file with: +{[ +#!/usr/bin/env ocaml +#use "topfind" +#require "bos.setup" +open Bos_setup +]} +To allow {{:https://github.com/the-lambda-church/merlin}merlin} to function +correctly issue [M-x merlin-use bos.setup] in [emacs] or +[:MerlinUse bos.setup] in [vim]. *) + +(** {1 Results} *) + +(** The type for results. *) +type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b + +val ( >>= ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result +(** [(>>=)] is {!R.(>>=)}. *) + +val ( >>| ) : ('a, 'b) result -> ('a -> 'c) -> ('c, 'b) result +(** [(>>|)] is {!R.(>>|)}. *) + +module R : sig + include module type of struct include Rresult.R end +end + +(** {1 Astring} *) + +val strf : ('a, Format.formatter, unit, string) Stdlib.format4 -> 'a +(** [strf] is {!Astring.strf}. *) + +val (^) : string -> string -> string +(** [^] is {!Astring.(^)}. *) + +module Char : sig + include module type of struct include Astring.Char end +end + +module String : sig + include module type of struct include Astring.String end +end + +(** {1 Bos} *) + +module Pat : sig + include module type of struct include Bos.Pat end +end + +module Cmd : sig + include module type of struct include Bos.Cmd end +end + +module OS : sig + include module type of struct include Bos.OS end +end + +(** {1 Fmt & Logs} + + {b Note.} The following aliases are strictly speaking not needed but they + allow to end-users to use them by expressing a single dependency towards + [bos.setup]. *) + +module Fmt : sig + include module type of struct include Fmt end +end + +module Logs : sig + include module type of struct include Logs end +end + +(*--------------------------------------------------------------------------- + Copyright (c) 2016 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_setup.mllib b/unikernel/duniverse/bos/src/bos_setup.mllib new file mode 100644 index 00000000..d64d4c3b --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_setup.mllib @@ -0,0 +1 @@ +Bos_setup diff --git a/unikernel/duniverse/bos/src/bos_top.ml b/unikernel/duniverse/bos/src/bos_top.ml new file mode 100644 index 00000000..a7c24b08 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_top.ml @@ -0,0 +1,22 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let () = ignore (Toploop.use_file Format.err_formatter "bos_top_init.ml") + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/bos_top.mllib b/unikernel/duniverse/bos/src/bos_top.mllib new file mode 100644 index 00000000..e8f177e9 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_top.mllib @@ -0,0 +1 @@ +Bos_top \ No newline at end of file diff --git a/unikernel/duniverse/bos/src/bos_top_init.ml b/unikernel/duniverse/bos/src/bos_top_init.ml new file mode 100644 index 00000000..77063c44 --- /dev/null +++ b/unikernel/duniverse/bos/src/bos_top_init.ml @@ -0,0 +1,24 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Bos;; + +#install_printer Pat.dump;; + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/src/dune b/unikernel/duniverse/bos/src/dune new file mode 100644 index 00000000..cb674a8e --- /dev/null +++ b/unikernel/duniverse/bos/src/dune @@ -0,0 +1,23 @@ +(library + (name bos) + (public_name bos) + (libraries rresult astring fpath fmt unix logs) + (modules bos bos_base bos_cmd bos_log bos_os_arg bos_os_cmd bos_os_dir + bos_os_env bos_os_file bos_os_path bos_os_tmp bos_os_u bos_pat) + (flags :standard -w -6-27-33-39) + (wrapped false)) + +(library + (name bos_top) + (public_name bos.top) + (libraries compiler-libs.toplevel rresult.top astring.top fpath.top fmt.top + logs.top bos) + (modules bos_top) + (wrapped false)) + +(library + (name bos_setup) + (public_name bos.setup) + (libraries fmt.tty logs.fmt bos) + (modules bos_setup) + (wrapped false)) diff --git a/unikernel/duniverse/bos/test/test.ml b/unikernel/duniverse/bos/test/test.ml new file mode 100644 index 00000000..650536fd --- /dev/null +++ b/unikernel/duniverse/bos/test/test.ml @@ -0,0 +1,29 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let tests () = Testing.run + [ Test_pat.suite; + Test_cmd.suite; + Test_os_cmd.suite; ] + +let run () = tests (); Testing.log_results () + +let () = if run () then exit 0 else exit 1 + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/test_arg.ml b/unikernel/duniverse/bos/test/test_arg.ml new file mode 100644 index 00000000..2f5d89fe --- /dev/null +++ b/unikernel/duniverse/bos/test/test_arg.ml @@ -0,0 +1,39 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Bos + +let debug = OS.Arg.(flag ["g"; "debug"] ~env:"DEBUG" ~doc:"Debug mode.") +let count = OS.Arg.(flag_all ["c"] ~doc:"Count me.") + +let print_parse () = + Logs.app (fun m -> m "debug: %b" debug); + Logs.app (fun m -> m "count: %d" count); + () + +let main () = + Logs.set_reporter (Logs_fmt.reporter ()); + OS.Arg.parse_opts (); + print_parse (); + () + +let () = main () + + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/test_arg_pos.ml b/unikernel/duniverse/bos/test/test_arg_pos.ml new file mode 100644 index 00000000..33ad15a3 --- /dev/null +++ b/unikernel/duniverse/bos/test/test_arg_pos.ml @@ -0,0 +1,44 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Bos + +let debug = OS.Arg.(flag ["g"; "debug"] ~env:"DEBUG" ~doc:"Debug mode.") + +let () = Fmt.(set_style_renderer stdout `Ansi_tty) + +let print_parse depth ints = + Logs.app (fun m -> m "debug: %b" debug); + Logs.app (fun m -> m "depth: %d" depth); + Logs.app (fun m -> m "pos: @[%a@]" Fmt.(list ~sep:sp int) ints); + () + +let main () = + Logs.set_reporter (Logs_fmt.reporter ()); + let depth = + OS.Arg.(opt ["d"; "depth"] int ~absent:2 + ~doc:"Specifies depth of $(docv) iterations.") + in + let doc = "Testing the OS.Arg module." in + print_parse depth (OS.Arg.(parse ~doc ~pos:int ())) + +let () = main () + + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/test_cmd.ml b/unikernel/duniverse/bos/test/test_cmd.ml new file mode 100644 index 00000000..aac8d854 --- /dev/null +++ b/unikernel/duniverse/bos/test/test_cmd.ml @@ -0,0 +1,47 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Testing +open Rresult +open Astring +open Bos + +let of_string = test "Cmd.of_string" @@ fun () -> + let eq cmd l = match Cmd.of_string cmd with + | Error (`Msg msg) -> fail "%s" msg + | Ok l' -> eq_list ~eq:(=) ~pp:pp_str (Cmd.to_list l') l + in + eq "" []; + eq "bla" ["bla"]; + eq " bla bli" ["bla"; "bli"]; + eq " bla bli " ["bla"; "bli"]; + eq " bla b\\li " ["bla"; "b\\li"]; + eq " b'haha'la bli " ["bhahala"; "bli"]; + eq " b\"haha\"la bli " ["bhahala"; "bli"]; + eq " b\"'\"la bli " ["b'la"; "bli"]; + eq " b''''la bli " ["bla"; "bli"]; + eq " b'u'\"'\"'i'la bli " ["bu'ila"; "bli"]; + eq " b\"\\\"\"ila bli " ["b\"ila"; "bli"]; + eq " b\"\\\n\"ila bli " ["bila"; "bli"]; + () + +let suite = suite "Cmd module" + [ of_string; ] + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/test_os_cmd.ml b/unikernel/duniverse/bos/test/test_os_cmd.ml new file mode 100644 index 00000000..b803461e --- /dev/null +++ b/unikernel/duniverse/bos/test/test_os_cmd.ml @@ -0,0 +1,76 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Testing +open Astring +open Rresult +open Bos + +let eqb = eq_result_msg ~eq_ok:(=) ~pp_ok:pp_bool +let eqs = eq_result_msg ~eq_ok:(=) ~pp_ok:pp_str +let equ = eq_result_msg ~eq_ok:(=) ~pp_ok:pp_unit +let eql = eq_result_msg ~eq_ok:(=) ~pp_ok:(pp_list pp_str) + +let cat = Cmd.(v "cat") +let cat_stdin = Cmd.(cat % "-") +let unlikely = Cmd.v "6AC0E501-4E30-4CBC-AD03-F880F885BC18" + +let exists = test "OS.Cmd.exists" @@ fun () -> + eqb (OS.Cmd.exists cat) (Ok true); + eqb (OS.Cmd.exists unlikely) (Ok false); + () + +let must_exist = test "OS.Cmd.must_exist" @@ fun () -> + begin match (OS.Cmd.must_exist cat) with + | Error (`Msg err) -> fail "%s" err + | Ok _ -> () + end; + begin match (OS.Cmd.must_exist unlikely) with + | Ok _ -> fail "%a exists" Cmd.dump unlikely + | Error _ -> () + end; + () + +let run_io = test "OS.Cmd.run_io" @@ fun () -> + let in_hey = OS.Cmd.in_string "hey" in + let tmp () = OS.File.tmp "bos_test_%s" in + eqs OS.Cmd.(in_hey |> run_io cat_stdin |> to_string) (Ok "hey"); + eql OS.Cmd.(in_string "hey\nho\n" |> run_io cat_stdin |> to_lines) + (Ok ["hey";"ho"]); + equ OS.Cmd.(in_hey |> run_io cat_stdin |> to_null) (Ok ()); + eqs (tmp () + >>= fun tmp -> OS.Cmd.(in_hey |> run_io cat_stdin |> to_file tmp) + >>= fun () -> OS.Cmd.(in_hey |> run_io cat |> to_file tmp ~append:true) + >>= fun () -> OS.Cmd.(in_file tmp |> run_io Cmd.(cat_stdin % p tmp) |> + to_string)) + (Ok "heyheyheyhey"); + eqs (tmp () + >>= fun tmp1 -> tmp() + >>= fun tmp2 -> OS.Cmd.(in_hey |> run_io cat_stdin |> to_file tmp1) + >>= fun () -> OS.Cmd.(in_file tmp1 |> run_io cat_stdin |> out_run_in) + >>= fun pipe -> OS.Cmd.(pipe |> run_io cat_stdin |> to_file tmp2) + >>= fun () -> OS.Cmd.(in_file tmp2 |> run_io cat_stdin |> to_string)) + (Ok "hey"); + () + +let suite = suite "OS command run functions" + [ exists; + run_io; ] + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/test_pat.ml b/unikernel/duniverse/bos/test/test_pat.ml new file mode 100644 index 00000000..12cf0fc8 --- /dev/null +++ b/unikernel/duniverse/bos/test/test_pat.ml @@ -0,0 +1,116 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Testing +open Astring +open Bos + +let eqp = eq ~eq:Pat.equal ~pp:Pat.pp +let v = Fpath.v + +let string_conv = test "Pat.{v,of_string,to_string}" @@ fun () -> + let trip p = eq_str p Pat.(to_string (v p)) in + app_invalid ~pp:Pat.pp Pat.v "$("; + app_invalid ~pp:Pat.pp Pat.v "$(a"; + app_invalid ~pp:Pat.pp Pat.v "$$$("; + app_invalid ~pp:Pat.pp Pat.v "$$$"; + app_invalid ~pp:Pat.pp Pat.v "$(bla,)"; + app_invalid ~pp:Pat.pp Pat.v "$(b,la)"; + trip "Hey $(ho)"; + trip "Hey $(ho) $(hu)"; + trip "Hey $(ho) $(h$u)"; + trip "Hey mo $$(hu)"; + trip "Hey mo $$30"; + trip "Hey mo $$$$"; + () + +let dom = test "Pat.dom" @@ fun () -> + let eq s l = + eq ~eq:String.Set.equal ~pp:String.Set.dump + (Pat.(dom @@ v s)) (String.Set.of_list l) + in + eq "bla" []; + eq "bla ha $$" []; + eq "hey $(bla)" ["bla"]; + eq "hey $(bla) $()" ["bla"; ""]; + eq "hey $(bla) $$(ha) $()" ["bla"; ""]; + eq "hey $(bla) $(bli) $()" ["bla"; "bli"; ""]; + () + +let subst = test "Pat.subst" @@ fun () -> + let eq ?undef defs p s = + eq_str Pat.(to_string @@ subst ?undef defs (v p)) s + in + let defs = String.Map.of_list ["bli", "bla"] in + let undef = function "blu" -> Some "bla$" | _ -> None in + eq ~undef defs "hey $$ $(bli) $(bla) $(blu)" "hey $$ bla $(bla) bla$$"; + eq defs "hey $(blo) $(bla) $(blu)" "hey $(blo) $(bla) $(blu)"; + () + +let format = test "Pat.format" @@ fun () -> + let eq ?undef defs p s = eq_str (Pat.(format ?undef defs (v p))) s in + let defs = String.Map.of_list ["hey", "ho"; "hi", "ha$"] in + let undef = fun _ -> "undef" in + eq ~undef defs "a $$ $(hu)" "a $ undef"; + eq ~undef defs "a $(hey) $(hi)" "a ho ha$"; + eq defs "a $$(hey) $$(hi) $(ha)" "a $(hey) $(hi) "; + () + +let matches = test "Pat.matches" @@ fun () -> + let m p s = Pat.(matches (v p) s) in + eq_bool (m "$(mod).mli" "string.mli") true; + eq_bool (m "$(mod).mli" "string.mli ") false; + eq_bool (m "$(mod).mli" ".mli") true; + eq_bool (m "$(mod).mli" ".mli ") false; + eq_bool (m "$(mod).$(suff)" "string.mli") true; + eq_bool (m "$(mod).$(suff)" "string.mli ") true; + eq_bool (m "$()aaa" "aaa") true; + eq_bool (m "aaa$()" "aaa") true; + eq_bool (m "$()a$()aa$()" "aaa") true; + () + +let query = test "Pat.query" @@ fun () -> + let u ?init p s = Pat.(query ?init (v p) s) in + let eq = eq_option + ~eq:(String.Map.equal String.equal) ~pp:(String.Map.dump String.dump) + in + let eq ?init p s = function + | None -> eq (u ?init p s) None + | Some l -> eq (u ?init p s) (Some (String.Map.of_list l)) + in + let init = String.Map.of_list ["hey", "ho"] in + eq "$(mod).mli" "string.mli" (Some ["mod", "string"]); + eq ~init "$(mod).mli" "string.mli" (Some ["mod", "string"; "hey", "ho"]); + eq "$(mod).mli" "string.mli " None; + eq ~init "$(mod).mli" "string.mli " None; + eq "$(mod).mli" "string.mli " None; + eq "$(mod).$(suff)" "string.mli" (Some ["mod", "string"; "suff", "mli"]); + eq "$(mod).$(suff)" "string.mli" (Some ["mod", "string"; "suff", "mli"]); + eq "$(m).$(m)" "string.mli" (Some ["m", "string"]); + () + +let suite = suite "Pat module" + [ string_conv; + dom; + subst; + format; + matches; + query; ] + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/testing.ml b/unikernel/duniverse/bos/test/testing.ml new file mode 100644 index 00000000..d1070f3d --- /dev/null +++ b/unikernel/duniverse/bos/test/testing.ml @@ -0,0 +1,285 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Rresult + +(* Value equality and pretty printing *) + +type 'a eq = 'a -> 'a -> bool +type 'a pp = Format.formatter -> 'a -> unit + +(* Pretty printers *) + +let pp = Format.fprintf +let pp_unit ppf v = pp ppf "()" +let pp_exn ppf v = pp ppf "%s" (Printexc.to_string v) +let pp_bool ppf v = pp ppf "%b" v +let pp_char ppf v = pp ppf "%C" v +let pp_str ppf v = pp ppf "%S" v +let pp_int = Format.pp_print_int +let pp_float ppf v = pp ppf "%.10f" (* bof... *) v +let pp_int32 ppf v = pp ppf "%ld" v +let pp_int64 ppf v = pp ppf "%Ld" v +let pp_text = Format.pp_print_text +let pp_list pp_v ppf l = + let pp_sep ppf () = pp ppf ";@," in + pp ppf "@[<1>[%a]@]" (Format.pp_print_list ~pp_sep pp_v) l + +let pp_option pp_v ppf = function +| None -> Format.fprintf ppf "None" +| Some v -> Format.fprintf ppf "Some %a" pp_v v + +let pp_slot_loc ppf l = + pp ppf "%s:%d.%d-%d:" + l.Printexc.filename l.Printexc.line_number + l.Printexc.start_char l.Printexc.end_char + +let pp_bt ppf bt = match Printexc.backtrace_slots bt with +| None -> pp ppf "@,@[%a@]" pp_text "No backtrace. Did you compile with -g ?" +| Some slots -> + let rec loop = function + | [] -> assert false + | s :: ss -> + begin match Printexc.Slot.location s with + | None -> () + | Some l when l.Printexc.filename = "test/testing.ml" || + l.Printexc.filename = "test/test.ml" -> () + | Some l -> pp ppf "@,%a" pp_slot_loc l + end; + if ss <> [] then (loop ss) else () + in + loop (Array.to_list slots) + +(* Assertion counters *) + +let fail_count = ref 0 +let pass_count = ref 0 + +(* Logging *) + +let log_part fmt = Format.printf fmt +let log ?header fmt = match header with +| Some h -> Format.printf ("[%s] " ^^ fmt ^^ "@.") h +| None -> Format.printf (fmt ^^ "@.") + +let log_results () = + let total = !pass_count + !fail_count in + match !fail_count with + | 0 -> log ~header:"OK" "All %d assertions succeeded !@." total; true + | 1 -> log ~header:"FAIL" "1 failure out of %d assertions" total; false + | n -> log ~header:"FAIL" "%d failures out of %d assertions" + !fail_count total; false + +let log_fail msg bt = + log ~header:"FAIL" "@[@[%a@]%a@]" pp_text msg pp_bt bt + +let log_unexpected_exn ~header exn bt = + log ~header:"SUITE" "@[@[ABORTED: unexpected exception:@]@,%a%a@]" + pp_exn exn pp_bt bt + +(* Testing scopes *) + +exception Fail +exception Fail_handled + +let block f = try f () with +| Fail | Fail_handled -> () +| exn -> + let bt = Printexc.get_raw_backtrace () in + incr fail_count; + log_unexpected_exn ~header:"BLOCK" exn bt + +type test = string * (unit -> unit) + +let test n f = n, f +let run_test (n, f) = + log "* %s" n; + try f () with + | Fail | Fail_handled -> + log ~header:"TEST" "ABORTED: a test failure blew the test scope" + | exn -> + let bt = Printexc.get_raw_backtrace () in + incr fail_count; + log_unexpected_exn ~header:"TEST" exn bt + +type suite = string * test list +let suite n ts = n, ts +let run_suite (n, ts) = try log "%s" n; List.iter run_test ts with +| exn -> + let bt = Printexc.get_raw_backtrace () in + incr fail_count; + log_unexpected_exn ~header:"SUITE" exn bt + +let run suites = List.iter run_suite suites + +(* Passing and failing tests *) + +let pass () = incr pass_count +let fail fmt = + let bt = Printexc.get_callstack 10 in + let fail _ = log_fail (Format.flush_str_formatter ()) bt in + (incr fail_count; Format.kfprintf fail Format.str_formatter fmt) + +(* Checking values *) + +let pp_neq pp_v ppf (v, v') = pp ppf "@[%a@]@ <>@ @[%a@]@]" pp_v v pp_v v' + +let fail_eq pp v v' = fail "%a" (pp_neq pp) (v, v') + +let eq ~eq ~pp v v' = if eq v v' then pass () else fail_eq pp v v' +let eq_char = eq ~eq:(=) ~pp:pp_char +let eq_str = eq ~eq:(=) ~pp:pp_str +let eq_bool = eq ~eq:(=) ~pp:Format.pp_print_bool +let eq_int = eq ~eq:(=) ~pp:Format.pp_print_int +let eq_int32 = eq ~eq:(=) ~pp:pp_int32 +let eq_int64 = eq ~eq:(=) ~pp:pp_int64 +let eq_float = eq ~eq:(=) ~pp:pp_float +let eq_nan f = + if f <> f then pass () else fail "@[%a@]@ is@ not a NaN" pp_float f + +let eq_option ~eq:eq_v ~pp = + let eq_opt v v' = match v, v' with + | Some v, Some v' -> eq_v v v' + | None, None -> true + | _ -> false + in + let pp = pp_option pp in + fun v v' -> eq ~eq:eq_opt ~pp v v' + +let eq_some = function +| Some _ -> pass () +| None -> fail "None <> Some _" + +let eq_none ~pp = function +| None -> pass () +| Some v -> fail "@[%a <>@ None@]" pp v + +let eq_list ~eq:eq_v ~pp:pp_v = + let eql l l' = try List.for_all2 eq_v l l' with Invalid_argument _ -> false in + fun l l' -> eq ~eq:eql ~pp:(pp_list pp_v) l l' + +let eq_result ~eq_ok ~pp_ok ~eq_error ~pp_error = + let eqr v v' = match v, v' with + | Ok v, Ok v' -> eq_ok v v' + | Error e, Error e' -> eq_error e e' + | _ -> false + in + let pp ppf r = Rresult.R.pp ~ok:pp_ok ~error:pp_error ppf r in + fun v v' -> eq ~eq:eqr ~pp v v' + +let eq_result_msg ~eq_ok ~pp_ok = + let eq_error (`Msg e) (`Msg e') = (e = e') in + eq_result ~eq_ok ~pp_ok ~eq_error:eq_error ~pp_error:R.pp_msg + +let eq_ok ~eq:eq_v ~pp:pp_v = + let eq_ok v v' = match v, v' with + | Ok v, Ok v' -> eq_v v v' + | Error _, _-> false + | _ -> assert false + in + let pp ppf = function + | Ok v -> Format.fprintf ppf "@[Ok %a@]" pp_v v + | Error _ -> Format.fprintf ppf "@[Error _@]" + in + fun v v' -> eq ~eq:eq_ok ~pp v (Ok v') + +(* Tracing and checking function applications. *) + +type app = (* Gathers information about the application *) + { fail_count : int; (* fail_count checkpoint when the app starts *) + pp_args : Format.formatter -> unit -> unit; } + +let ctx () = { fail_count = -1; pp_args = fun ppf () -> (); } + +let log_app_raised app exn = + log "@[<2>@[%a@]==> raised %a" app.pp_args () pp_exn exn + +let pp_app app pp_v ppf v = + pp ppf "@[<2>@[%a@]==>@ @[%a@]@]" app.pp_args () pp_v v + +let log_app app pp_v v = log "%a" (pp_app app pp_v) v + +let ( $ ) f k = k (ctx ()) f + +let ( @-> ) (pp_v : 'a pp) k app f v = + let pp_args ppf () = app.pp_args ppf (); pp ppf "%a@ " pp_v v in + let fc = if app.fail_count = -1 then !fail_count else app.fail_count in + let app = { fail_count = fc; pp_args } in + try k app (f v) with + | Fail -> + log_app app pp_v v; + raise Fail_handled + | Fail_handled as e -> raise e + | exn -> + log_app_raised app exn; + fail "unexpected exception %a raised" pp_exn exn; + raise Fail_handled + +let ret pp app v = + if !fail_count <> app.fail_count then log_app app pp v; + v + +let ret_eq ~eq pp r app v = + if eq r v then (pass (); ret pp app v) else + (fail "@[%a@,%a@]" (pp_neq pp) (r, v) (pp_app app pp) v; + raise Fail_handled) + +let ret_none pp app v = match v with +| None -> pass (); ret (pp_option pp) app v +| Some _ -> ret_eq ~eq:(=) (pp_option pp) None app v + +let ret_some pp app v = match v with +| Some _ as v -> pass (); ret (pp_option pp) app v +| None as v -> + fail "@[Some _ <> None@,%a@]" (pp_app app (pp_option pp)) v; + raise Fail_handled + +let ret_get_option pp app v = match ret_some pp app v with +| Some v -> v +| None -> assert false + +(* I think we could handle the following functions on app traced ones + by enriching the app type and have alternate functions to $ for + handling these cases. Note that the only place were we can check + for these things are in the @-> combinator *) + +let app_invalid ~pp f v = + try + let r = f v in + fail "%a <> exception Invalid_arg _" pp r + with + | Invalid_argument _ -> pass () + | exn -> fail "exception %a <> exception Invalid_arg _" pp_exn exn + +let app_exn ~pp e f v = + try + let r = f v in + fail "%a <> exception %a" pp r pp_exn e + with + | exn when exn = e -> pass () + | exn -> fail "exception %a <> exception %a_" pp_exn exn pp_exn e + +let app_raises ~pp f v = + try + let r = f v in + fail "%a <> exception _ " pp r + with + | exn -> pass () + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/testing.mli b/unikernel/duniverse/bos/test/testing.mli new file mode 100644 index 00000000..0b6dcb4c --- /dev/null +++ b/unikernel/duniverse/bos/test/testing.mli @@ -0,0 +1,104 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Rresult + +(* {1 Value equality and pretty printing} *) + +type 'a eq = 'a -> 'a -> bool +type 'a pp = Format.formatter -> 'a -> unit + +(* {1 Pretty printers} *) + +val pp_unit : unit pp +val pp_int : int pp +val pp_bool : bool pp +val pp_float : float pp +val pp_char : char pp +val pp_str : string pp +val pp_list : 'a pp -> 'a list pp +val pp_option : 'a pp -> 'a option pp + +(* {1 Logging} *) + +val log_part : ('a, Format.formatter, unit) format -> 'a +val log : ?header:string -> ('a, Format.formatter, unit) format -> 'a +val log_results : unit -> bool + +(* {1 Testing scopes} *) + +type test +type suite + +val block : (unit -> unit) -> unit +val test : string -> (unit -> unit) -> test +val suite : string -> test list -> suite + +val run : suite list -> unit + +(* {1 Passing and failing tests} *) + +val pass : unit -> unit +val fail : ('a, Format.formatter, unit, unit) format4 -> 'a + +(* {1 Checking values} *) + +val eq : eq:'a eq -> pp:'a pp -> 'a -> 'a -> unit +val eq_char : char -> char -> unit +val eq_str : string -> string -> unit +val eq_bool : bool -> bool -> unit +val eq_int : int -> int -> unit +val eq_int32 : int32 -> int32 -> unit +val eq_int64 : int64 -> int64 -> unit +val eq_float : float -> float -> unit +val eq_nan : float -> unit + +val eq_option : eq:'a eq -> pp:'a pp -> 'a option -> 'a option -> unit +val eq_some : 'a option -> unit +val eq_none : pp:'a pp -> 'a option -> unit +val eq_list : eq:'a eq -> pp:'a pp -> 'a list -> 'a list -> unit + +val eq_result : eq_ok:'a eq -> pp_ok:'a pp -> eq_error:'b eq -> + pp_error:'b pp -> ('a, 'b) result -> ('a, 'b) result -> unit + +val eq_result_msg : eq_ok:'a eq -> pp_ok:'a pp -> + ('a, [`Msg of string]) result -> ('a, [`Msg of string]) result -> unit + + +val eq_ok : eq:'a eq -> pp:'a pp -> ('a, 'b) result -> 'a -> unit + + +(* {1 Tracing and checking function applications} *) + +type app (* holds information about the application *) + +val ( $ ) : 'a -> (app -> 'a -> 'b) -> 'b +val ( @-> ) : 'a pp -> (app -> 'b -> 'c) -> app -> ('a -> 'b) -> 'a -> 'c + +val ret : 'a pp -> app -> 'a -> 'a +val ret_eq : eq:'a eq -> 'a pp -> 'a -> app -> 'a -> 'a +val ret_some : 'a pp -> app -> 'a option -> 'a option +val ret_none : 'a pp -> app -> 'a option -> 'a option +val ret_get_option : 'a pp -> app -> 'a option -> 'a + +val app_invalid : pp:'b pp -> ('a -> 'b) -> 'a -> unit +val app_exn : pp:'b pp -> exn -> ('a -> 'b) -> 'a -> unit +val app_raises : pp:'b pp -> ('a -> 'b) -> 'a -> unit + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bos/test/watch.ml b/unikernel/duniverse/bos/test/watch.ml new file mode 100644 index 00000000..2945b57e --- /dev/null +++ b/unikernel/duniverse/bos/test/watch.ml @@ -0,0 +1,78 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Bos_setup + +(* Watch a directory for changes. First run will create a database + watchdb in the directory with modification times. Subsquent runs + will check files against that database. *) + +module Db = struct + let db_file = Fpath.v "watchdb" + let exists () = OS.File.exists db_file + let scan () = (* returns list of (path, modification time) *) + let add p acc = + (OS.Path.stat p >>= fun stats -> + if stats.Unix.st_kind <> Unix.S_REG then Ok acc else + Ok ((p, stats.Unix.st_mtime) :: acc)) + |> Logs.on_error_msg ~use:(fun _ -> acc) + in + Logs.app (fun m -> m "Scanning files"); + OS.Dir.current () >>= fun dir -> + OS.Dir.fold_contents ~dotfiles:true ~elements:`Files add [] dir + + let dump oc db = Ok (Marshal.(to_channel oc db [No_sharing; Compat_32])) + let slurp ic () = (Marshal.from_channel ic : float Fpath.Map.t) + + let create files = + Logs.app (fun m -> m "Writing modification time database %a" + Fpath.pp db_file); + let count = ref 0 in + let add acc (f, time) = incr count; Fpath.Map.add f time acc in + let db = List.fold_left add Fpath.Map.empty files in + R.join @@ OS.File.with_oc db_file dump db >>= fun () -> Ok !count + + let check files = + let count = ref 0 in + let changes db (f, time) = match (incr count; Fpath.Map.find f db) with + | None -> + Logs.app (fun m -> m "New file: %a" Fpath.pp f) + | Some stamp when stamp <> time -> + Logs.app (fun m -> m "File changed: %a" Fpath.pp f) + | _ -> () + in + Logs.app (fun m -> m "Checking against %a" Fpath.pp db_file); + OS.File.with_ic db_file slurp () + >>= fun db -> List.iter (changes db) files; Ok !count +end + +let watch () = + Db.scan () + >>= fun files -> Db.exists () + >>= fun exists -> if exists then Db.check files else Db.create files + +let main () = + let c = Mtime_clock.counter () in + let count = watch () |> Logs.on_error_msg ~use:(fun _ -> 0) in + Logs.app (fun m -> m "Watch completed for %d files in %a" + count Mtime.Span.pp (Mtime_clock.count c)) + +let () = main () + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The bos programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/unikernel/duniverse/bstr/.gitignore b/unikernel/duniverse/bstr/.gitignore new file mode 100644 index 00000000..9893a3b2 --- /dev/null +++ b/unikernel/duniverse/bstr/.gitignore @@ -0,0 +1,16 @@ +_build +setup.data +setup.log +doc/*.html +*.native +*.byte +*.so +lib/decompress_conf.ml +*.tar.gz +_tests +lib_test/files +zpipe +c/dpipe +*.merlin +*.install +.depend diff --git a/unikernel/duniverse/bstr/.ocamlformat b/unikernel/duniverse/bstr/.ocamlformat new file mode 100644 index 00000000..36f2c597 --- /dev/null +++ b/unikernel/duniverse/bstr/.ocamlformat @@ -0,0 +1,12 @@ +version=0.27.0 +exp-grouping=preserve +break-infix=wrap-or-vertical +break-collection-expressions=wrap +break-sequences=false +break-infix-before-func=false +dock-collection-brackets=true +break-separators=before +field-space=tight +if-then-else=compact +break-sequences=false +sequence-blank-line=compact diff --git a/unikernel/duniverse/bstr/CHANGES.md b/unikernel/duniverse/bstr/CHANGES.md new file mode 100644 index 00000000..2a482d07 --- /dev/null +++ b/unikernel/duniverse/bstr/CHANGES.md @@ -0,0 +1,7 @@ +### v0.0.2 (2025-06-23) + +- Fix SIGSEGV when we use `memmove` + +### v0.0.1 (2025-04-28) + +- First release of `bstr`, `slice` & `bin` diff --git a/unikernel/duniverse/bstr/GNUmakefile b/unikernel/duniverse/bstr/GNUmakefile new file mode 100644 index 00000000..e347c1ae --- /dev/null +++ b/unikernel/duniverse/bstr/GNUmakefile @@ -0,0 +1,54 @@ +OCAMLC=ocamlc +OCAMLOPT=ocamlopt +OCAMLDEP=ocamldep +OCAMLMKLIB=ocamlmklib + +SRCS=lib/bstr.ml lib/slice.ml lib/bin.ml bin/generate.ml +OBJS=$(SRCS:.ml=.cmo) +OPTOBJS=$(SRCS:.ml=.cmx) + +OCAMLCFLAGS=-I lib -w "@1..3@5..28@30..39@43@46..47@49..57@61..62-40" \ + -strict-sequence -strict-formats -short-paths -keep-locs -g -bin-annot-occurrences \ + -no-alias-deps -opaque + +CFLAGS=-Wcast-align + +.SUFFIXES: .ml .mli .cmo .cmi .cmx .cma .cmxa + +.ml.cmo: + @echo "OCAMLC $<" + @$(OCAMLC) $(OCAMLCFLAGS) -c $< + +.mli.cmi: + @echo "OCAMLC $<" + @$(OCAMLC) $(OCAMLCFLAGS) -c $< + +.ml.cmx: + @echo "OCAMLOPT $<" + @$(OCAMLOPT) $(OCAMLCFLAGS) -c $< + +.cmo.cma: + @echo "OCAMLC -a $<" + @$(OCAMLC) -a $< $@ + +.c.o: + @echo "CC $<" + @$(OCAMLC) -ccopt "$(CFLAGS)" $< -o $@ + +.depend: $(SRCS) + @echo "OCAMLDEP **/*.mli **/*.ml" + @$(OCAMLDEP) **/*.mli **/*.ml > .depend + @echo "lib/bstr.o: lib/bstr.c" >> .depend + @echo "lib/bstr.cmxa: lib/bstr.cmx lib/bstr.o" >> .depend + @echo "lib/bstr.cma: lib/bstr.cmo lib/bstr.o" >> .depend + +include .depend + +lib/dllbstr.so lib/libbstr.a lib/bstr.cmxa lib/bstr.cma: lib/bstr.mllib + @echo "OCAMLMKLIB $^" + @$(OCAMLMKLIB) -o lib/bstr -oc lib/bstr -args $< + +.PHONY: clean +clean: + rm -rf lib/*.cm{o,x,i,a,xa} + rm -rf lib/*.{o,a} diff --git a/unikernel/duniverse/bstr/LICENSE.md b/unikernel/duniverse/bstr/LICENSE.md new file mode 100644 index 00000000..7064c1b5 --- /dev/null +++ b/unikernel/duniverse/bstr/LICENSE.md @@ -0,0 +1,20 @@ +The MIT License (MIT) + +Copyright (c) 2024 Romain Calascibetta + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/unikernel/duniverse/bstr/README.md b/unikernel/duniverse/bstr/README.md new file mode 100644 index 00000000..ae8bed03 --- /dev/null +++ b/unikernel/duniverse/bstr/README.md @@ -0,0 +1,122 @@ +# Bstr, Slice & Bin + +This small set of libraries offers a homogeneous API between 2 types and their +derivations with the slice type, as well as a small DSL for decoding "packets" +(such as ARP or DNS) without too much difficulty. + +The aim is to homogenize the 2 types bytes and bigstring and to derive them +with a slice type, giving the user all the levers needed to manipulate byte +sequences, whether in the form of a bigstring or bytes. The slice view avoids +copying when it comes to decoding a packet and extracting a sub-part. The slice +also applies to bigstrings, whose `Bigarray.Array1.sub` is more expensive. + +This set of libraries is a synthesis of [astring][astring] (which offers a range +of useful functions as well as slice), [cstruct][cstruct] (which offers a +similar API for bigstrings), [bigstringaf][bigstringaf] (which offers some other +useful functions), the standard OCaml library and [repr][repr] for +decoding/encoding these values into OCaml records/variants. + +## About API + +Here is an overview of the functions offered by `bstr` compared to other +libraries: + +| | bstr | cstruct | bigstringaf | slice.bstr | +|-----------------|------|---------|-------------|------------| +| `overlap` | ✅ | ❌ | ❌ | ✅ | +| `memcpy` | ✅ | ❌ | ✅ | ✅ | +| `memmove` | ✅ | ✅ | ✅ | ✅ | +| fast `sub` | ❌ | ❌ | ❌ | ✅ | +| fast `blit` | ✅ | ❌ | ❌ | ✅ | +| release GC lock | ✅ | ❌ | ❌ | ✅ | +| fast `contains` | ✅ | ❌ | ✅ | ✅ | + +### Fast `sub` + +`sub` is perhaps the most useful operation for a bigarray. In fact, unlike bytes +and strings, sub offers a view (equivalent or smaller) of a bigarray without +making a copy. If, for example, you need to decode[^1] a large sequence of bytes +(without having the notion of a "stream"), it may be useful to use the `sub` +operation to decode the information byte by byte and avoid copying throughout +the decoding process. + +The implementation of `sub` proposed by `Bstr` is a little different from that +of the standard OCaml library. In fact, it is specialized for a bigarray of +dimension 1 containing bytes. In fact, the `Bigarray.Array1.sub` function is a +little more generic and `Bstr` takes the opportunity to "specialize" the +function according to our type. + +However, according to the representation proposed by `Cstruct`, `Cstruct.sub` +remains **the fastest** operation compared to `Bstr` and `Bigstringaf`. If you +want to have the same performance as `Cstruct`, the specialized `Slice` module +for `Bstr.t` values is equivalent. + +Here is a comparative table of the `sub` function between all implementations +(AMD Ryzen 9 7950X 16-Core Processor): + +| | bigstringaf | bstr | cstruct | slice | +|-------|-------------|--------|---------|-------| +| `sub` | 20.0 ns | 17.8ns | 2.8ns | 2.4ns | + +### Fast `blit` + +`blit` from a string or a bytes is a little faster than `Bigstringaf` and +`Cstruct`. The difference basically lies in the fact that `Bstr.t` uses other +"tags" to describe the FFI with the C `memcpy` function (specifically the +[\[@untagged\]][untagged] tag). + +Here is a comparative table of the `blit_from_string` function between all the +implementations: + +| | bigstringaf | bstr | cstruct | +|--------------------|-------------|-------|---------| +| `blit_from_string` | 5.1ns | 4.3ns | 4.7ns | + +#### _mmaped_ or not? (GC lock) + +There are 2 ways to copy bytes between two bigarrays: +- the "mmaped" version (`{memcpy,memmove}_mmaped`) +- the simple version (`{memcpy,memmove}`) + +The first is quite specific because it releases the GC lock after a certain +number of bytes (4096) have been copied. This can be advantageous if you want +to make a large copy between two bigarrays in parallel in a `Thread`. + +If we specify _mmaped_, it is because the copy between two bigarrays, one of +which **may** come from `Unix.map_file`, can also take time (and we may want to +do it in parallel in a `Thread`) since it involves reading/writing on the disk. + +```ocaml +let copy_to_file bstr filename () = + let len = Bstr.length bstr in + let fd = Unix.openfile filename Unix.[ O_WRONLY ] 0o644 in + let dst = Unix.map_file fd Bigarray.char Bigarray.c_layout false [| len |] in + let dst = Bigarray.array1_of_genarray dst in + Bstr.memcpy_mmaped bstr ~src_off:0 dst ~dst_off:0 ~len + +let () = + let th = Thread.create (copy_to_file bstr filename) () in + (* do something else in true parallel of [copy_to_file]. *) + (* the GC will not interrupt [th] during the copy. *) + Thread.join th +``` + +The simple version does **not** release the GC lock and only applies the +desired function (`memmove` or `memcpy`). + +#### `memmove` or `memcpy`? + +`Bstr.blit` **always** uses the `memmove` function. However, it can be +advantageous to use `memcpy` in a fairly specific case: when you know that the +source refers to a memory area that is not shared with the destination. + +To find out, you can use the `Bstr.overlap` function, which checks whether or +not the two bigarrays given have a common memory area. + +[^1]: `Bin` is currently being designed with this in mind. + +[astring]: https://github.com/dbuenzli/astring +[cstruct]: https://github.com/mirage/ocaml-cstruct +[repr]: https://github.com/mirage/repr +[bigstringaf]: https://github.com/inhabitedtype/bigstringaf +[untagged]: https://ocaml.org/manual/5.3/attributes.html diff --git a/unikernel/duniverse/bstr/bench/blit.ml b/unikernel/duniverse/bstr/bench/blit.ml new file mode 100644 index 00000000..57a9f79b --- /dev/null +++ b/unikernel/duniverse/bstr/bench/blit.ml @@ -0,0 +1,50 @@ +open Bechamel +open Toolkit + +let src = String.make 256 '\x10' +let cs = Cstruct.create 512 +let bstr = Bstr.create 512 +let bigstringaf = Bigstringaf.create 512 +let cstruct_blit () = Cstruct.blit_from_string src 0 cs 0 256 +let bstr_blit () = Bstr.blit_from_string src ~src_off:0 bstr ~dst_off:0 ~len:256 + +let bigstringaf_blit () = + Bigstringaf.blit_from_string src ~src_off:0 bigstringaf ~dst_off:0 ~len:256 + +let cstruct_blit = Staged.stage cstruct_blit +let bstr_blit = Staged.stage bstr_blit +let bigstringaf_blit = Staged.stage bigstringaf_blit +let test0 = Test.make ~name:"Cstruct" cstruct_blit +let test1 = Test.make ~name:"Bstr" bstr_blit +let test2 = Test.make ~name:"Bigstringaf" bigstringaf_blit + +let benchmark () = + let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in + let ols = Analyze.ols ~bootstrap ~r_square ~predictors in + let instances = Instance.[ monotonic_clock ] in + let limit = 2000 + and stabilize = true + and quota = Time.second 1.0 + and kde = Some 1000 in + let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in + let tests = + Test.make_grouped ~name:"blit" ~fmt:"%s %s" [ test0; test1; test2 ] + in + let raw = Benchmark.all cfg instances tests in + let res = List.map (fun i -> Analyze.all ols i raw) instances in + let res = Analyze.merge ols instances res in + (res, raw) + +let nothing _ = Ok () +let compare = String.compare + +let () = + let res = benchmark () in + let res = + let open Bechamel_js in + let dst = Channel stdout + and x_label = Measure.run + and y_label = Measure.label Instance.monotonic_clock in + emit ~dst nothing ~compare ~x_label ~y_label res + in + match res with Ok () -> () | Error (`Msg msg) -> failwith msg diff --git a/unikernel/duniverse/bstr/bench/contains.ml b/unikernel/duniverse/bstr/bench/contains.ml new file mode 100644 index 00000000..6928e78d --- /dev/null +++ b/unikernel/duniverse/bstr/bench/contains.ml @@ -0,0 +1,75 @@ +let seed = "4EygbdYh+v35vvrmD9YYP4byT5E3H7lTeXJiIj+dQnc=" +let seed = Base64.decode_exn seed + +let seed = + let res = Array.make (String.length seed / 2) 0 in + for i = 0 to (String.length seed / 2) - 1 do + res.(i) <- (Char.code seed.[i * 2] lsl 8) lor Char.code seed.[(i * 2) + 1] + done; + res + +let random length = + let get _ = + match Random.int (10 + 26 + 26) with + | n when n < 10 -> Char.(chr (code '0' + n)) + | n when n < 10 + 26 -> Char.(chr (code 'a' + n - 10)) + | n -> Char.(chr (code 'A' + n - 10 - 26)) + in + String.init length get + +let str = random 4096 +let chr_into_str = str.[Random.int 4096] + +open Bechamel +open Toolkit + +let bstr_contains = + let bstr = Bstr.of_string str in + Test.make ~name:"bstr" + @@ Staged.stage + @@ fun () -> ignore (Bstr.contains bstr chr_into_str) + +let bigstringaf_contains = + let bstr = Bigstringaf.of_string str ~off:0 ~len:4096 in + Test.make ~name:"bigstringaf" + @@ Staged.stage + @@ fun () -> ignore (Bigstringaf.memchr bstr 0 chr_into_str 4096) + +let cstruct_contains = + let cs = Cstruct.of_string str in + let fn chr = chr == chr_into_str in + Test.make ~name:"cstruct" + @@ Staged.stage + @@ fun () -> ignore (Cstruct.exists fn cs) + +let tests = + Test.make_grouped ~name:"contains" ~fmt:"%s %s" + [ bstr_contains; bigstringaf_contains; cstruct_contains ] + +let benchmark () = + let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in + let ols = Analyze.ols ~bootstrap ~r_square ~predictors in + let instances = Instance.[ monotonic_clock ] in + let limit = 2000 + and stabilize = true + and quota = Time.second 1.0 + and kde = Some 1000 in + let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in + let raw = Benchmark.all cfg instances tests in + let res = List.map (fun i -> Analyze.all ols i raw) instances in + let res = Analyze.merge ols instances res in + (res, raw) + +let nothing _ = Ok () +let compare = String.compare + +let () = + let res = benchmark () in + let res = + let open Bechamel_js in + let dst = Channel stdout + and x_label = Measure.run + and y_label = Measure.label Instance.monotonic_clock in + emit ~dst nothing ~compare ~x_label ~y_label res + in + match res with Ok () -> () | Error (`Msg msg) -> failwith msg diff --git a/unikernel/duniverse/bstr/bench/dune b/unikernel/duniverse/bstr/bench/dune new file mode 100644 index 00000000..38550bc5 --- /dev/null +++ b/unikernel/duniverse/bstr/bench/dune @@ -0,0 +1,87 @@ +(executable + (name sub) + (enabled_if + (= %{profile} benchmark)) + (libraries slice.bstr bstr cstruct bechamel bechamel-js)) + +(rule + (targets sub.json) + (enabled_if + (= %{profile} benchmark)) + (action + (with-stdout-to + %{targets} + (run ./sub.exe)))) + +(rule + (targets sub.html) + (enabled_if + (= %{profile} benchmark)) + (action + (system "%{bin:bechamel-html} < %{dep:sub.json} > %{targets}"))) + +(executable + (name blit) + (enabled_if + (= %{profile} benchmark)) + (libraries bstr cstruct bechamel bechamel-js)) + +(rule + (targets blit.json) + (enabled_if + (= %{profile} benchmark)) + (action + (with-stdout-to + %{targets} + (run ./blit.exe)))) + +(rule + (targets blit.html) + (enabled_if + (= %{profile} benchmark)) + (action + (system "%{bin:bechamel-html} < %{dep:blit.json} > %{targets}"))) + +(executable + (name equal) + (enabled_if + (= %{profile} benchmark)) + (libraries base64 slice.bstr bstr cstruct bigstringaf bechamel bechamel-js)) + +(rule + (targets equal.json) + (enabled_if + (= %{profile} benchmark)) + (action + (with-stdout-to + %{targets} + (run ./equal.exe)))) + +(rule + (targets equal.html) + (enabled_if + (= %{profile} benchmark)) + (action + (system "%{bin:bechamel-html} < %{dep:equal.json} > %{targets}"))) + +(executable + (name contains) + (enabled_if + (= %{profile} benchmark)) + (libraries slice.bstr base64 bigstringaf bstr cstruct bechamel bechamel-js)) + +(rule + (targets contains.json) + (enabled_if + (= %{profile} benchmark)) + (action + (with-stdout-to + %{targets} + (run ./contains.exe)))) + +(rule + (targets contains.html) + (enabled_if + (= %{profile} benchmark)) + (action + (system "%{bin:bechamel-html} < %{dep:contains.json} > %{targets}"))) diff --git a/unikernel/duniverse/bstr/bench/equal.ml b/unikernel/duniverse/bstr/bench/equal.ml new file mode 100644 index 00000000..eac883e6 --- /dev/null +++ b/unikernel/duniverse/bstr/bench/equal.ml @@ -0,0 +1,77 @@ +let seed = "4EygbdYh+v35vvrmD9YYP4byT5E3H7lTeXJiIj+dQnc=" +let seed = Base64.decode_exn seed + +let seed = + let res = Array.make (String.length seed / 2) 0 in + for i = 0 to (String.length seed / 2) - 1 do + res.(i) <- (Char.code seed.[i * 2] lsl 8) lor Char.code seed.[(i * 2) + 1] + done; + res + +let random length = + let get _ = + match Random.int (10 + 26 + 26) with + | n when n < 10 -> Char.(chr (code '0' + n)) + | n when n < 10 + 26 -> Char.(chr (code 'a' + n - 10)) + | n -> Char.(chr (code 'A' + n - 10 - 26)) + in + String.init length get + +let hash_eq_0 = random 4096 +let hash_eq_1 = Bytes.to_string (Bytes.of_string hash_eq_0) + +open Bechamel +open Toolkit + +let bstr_equal = + let hash_eq_0 = Bstr.of_string hash_eq_0 in + let hash_eq_1 = Bstr.of_string hash_eq_1 in + Test.make ~name:"bstr" + @@ Staged.stage + @@ fun () -> Bstr.equal hash_eq_0 hash_eq_1 + +let bigstringaf_equal = + let hash_eq_0 = Bigstringaf.of_string hash_eq_0 ~off:0 ~len:4096 in + let hash_eq_1 = Bigstringaf.of_string hash_eq_1 ~off:0 ~len:4096 in + Test.make ~name:"bigstringaf" + @@ Staged.stage + @@ fun () -> Bigstringaf.memcmp hash_eq_0 0 hash_eq_1 0 4096 + +let cstruct_equal = + let hash_eq_0 = Cstruct.of_string hash_eq_0 in + let hash_eq_1 = Cstruct.of_string hash_eq_1 in + Test.make ~name:"cstruct" + @@ Staged.stage + @@ fun () -> Cstruct.equal hash_eq_0 hash_eq_1 + +let tests = + Test.make_grouped ~name:"equal" ~fmt:"%s %s" + [ bstr_equal; bigstringaf_equal; cstruct_equal ] + +let benchmark () = + let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in + let ols = Analyze.ols ~bootstrap ~r_square ~predictors in + let instances = Instance.[ monotonic_clock ] in + let limit = 2000 + and stabilize = true + and quota = Time.second 1.0 + and kde = Some 1000 in + let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in + let raw = Benchmark.all cfg instances tests in + let res = List.map (fun i -> Analyze.all ols i raw) instances in + let res = Analyze.merge ols instances res in + (res, raw) + +let nothing _ = Ok () +let compare = String.compare + +let () = + let res = benchmark () in + let res = + let open Bechamel_js in + let dst = Channel stdout + and x_label = Measure.run + and y_label = Measure.label Instance.monotonic_clock in + emit ~dst nothing ~compare ~x_label ~y_label res + in + match res with Ok () -> () | Error (`Msg msg) -> failwith msg diff --git a/unikernel/duniverse/bstr/bench/sub.ml b/unikernel/duniverse/bstr/bench/sub.ml new file mode 100644 index 00000000..590d58b6 --- /dev/null +++ b/unikernel/duniverse/bstr/bench/sub.ml @@ -0,0 +1,49 @@ +open Bechamel +open Toolkit + +let cs = Cstruct.create 32 +let bstr = Bstr.create 32 +let slice : Slice_bstr.t = Slice_bstr.make bstr +let cstruct_sub () = Cstruct.sub cs 8 8 +let bstr_sub () = Bstr.sub bstr ~off:8 ~len:8 +let bigstringaf_sub () = Bigstringaf.sub bstr ~off:8 ~len:8 +let slice_sub () = Slice.sub slice ~off:8 ~len:8 +let cstruct_sub = Staged.stage cstruct_sub +let bstr_sub = Staged.stage bstr_sub +let bigstringaf_sub = Staged.stage bigstringaf_sub +let slice_sub = Staged.stage slice_sub +let test0 = Test.make ~name:"Cstruct" cstruct_sub +let test1 = Test.make ~name:"Bstr" bstr_sub +let test2 = Test.make ~name:"Bigstringaf" bigstringaf_sub +let test3 = Test.make ~name:"Slice" slice_sub + +let benchmark () = + let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in + let ols = Analyze.ols ~bootstrap ~r_square ~predictors in + let instances = Instance.[ monotonic_clock ] in + let limit = 2000 + and stabilize = true + and quota = Time.second 1.0 + and kde = Some 1000 in + let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in + let tests = + Test.make_grouped ~name:"sub" ~fmt:"%s %s" [ test0; test1; test2; test3 ] + in + let raw = Benchmark.all cfg instances tests in + let res = List.map (fun i -> Analyze.all ols i raw) instances in + let res = Analyze.merge ols instances res in + (res, raw) + +let nothing _ = Ok () +let compare = String.compare + +let () = + let res = benchmark () in + let res = + let open Bechamel_js in + let dst = Channel stdout + and x_label = Measure.run + and y_label = Measure.label Instance.monotonic_clock in + emit ~dst nothing ~compare ~x_label ~y_label res + in + match res with Ok () -> () | Error (`Msg msg) -> failwith msg diff --git a/unikernel/duniverse/bstr/bin.opam b/unikernel/duniverse/bstr/bin.opam new file mode 100644 index 00000000..4c5ae031 --- /dev/null +++ b/unikernel/duniverse/bstr/bin.opam @@ -0,0 +1,21 @@ +version: "0.0.2" +opam-version: "2.0" +name: "bin" +maintainer: [ "Romain Calascibetta " ] +authors: [ "Romain Calascibetta " ] +homepage: "https://git.robur.coop/robur/bstr" +bug-reports: "https://git.robur.coop/robur/bstr" +dev-repo: "git+https://github.com/robur-coop/bstr" +doc: "https://robur-coop.github.io/bstr/" +license: "MIT" +synopsis: "A DSL to describe binary formats" + +build: [ "dune" "build" "-p" name "-j" jobs ] +run-test: [ "dune" "runtest" "-p" name "-j" jobs ] + +depends: [ + "ocaml" {>= "4.14.0"} + "dune" {>= "3.5.0"} + "slice" {= version} +] +x-maintenance-intent: [ "(latest)" ] \ No newline at end of file diff --git a/unikernel/duniverse/bstr/bin/dune b/unikernel/duniverse/bstr/bin/dune new file mode 100644 index 00000000..b9849dc4 --- /dev/null +++ b/unikernel/duniverse/bstr/bin/dune @@ -0,0 +1,2 @@ +(executable + (name generate)) diff --git a/unikernel/duniverse/bstr/bin/generate.ml b/unikernel/duniverse/bstr/bin/generate.ml new file mode 100644 index 00000000..5302382e --- /dev/null +++ b/unikernel/duniverse/bstr/bin/generate.ml @@ -0,0 +1,88 @@ +let module_to_be_replaced = ref "S" +let new_module = ref "String" +let input = ref None +let output = ref None + +let splits ~sep str = + let sep_len = String.length sep in + if sep_len = 0 then invalid_arg "splits: empty separator not allowed"; + let str_len = String.length str in + let max_sep_idx = sep_len - 1 in + let max_str_idx = str_len - sep_len in + let add_sub str ~start ~stop acc = + if start = stop then "" :: acc + else String.sub str start (stop - start) :: acc + in + let rec check_sep start i k acc = + if k > max_sep_idx then + let new_start = i + sep_len in + scan new_start new_start (add_sub str ~start ~stop:i acc) + else if str.[i + k] = sep.[k] then check_sep start i (k + 1) acc + else scan start (i + 1) acc + and scan start i acc = + if i > max_str_idx then + if start = 0 then [ str ] + else List.rev (add_sub str ~start ~stop:str_len acc) + else if str.[i] = sep.[0] then check_sep start i 1 acc + else scan start (i + 1) acc + in + scan 0 0 [] + +let replace line module_to_be_replaced new_module = + let line = splits ~sep:(module_to_be_replaced ^ ".") line in + String.concat (new_module ^ ".") line + +let run () = + let ic, ic_finally = + match !input with + | Some filename -> + let ic = open_in_bin filename in + let finally () = close_in ic in + (ic, finally) + | None -> (stdin, ignore) + in + let oc, oc_finally = + match !output with + | Some filename -> + let oc = open_out filename in + let finally () = close_out oc in + (oc, finally) + | None -> (stdout, ignore) + in + Fun.protect ~finally:ic_finally @@ fun () -> + Fun.protect ~finally:oc_finally @@ fun () -> + let rec go () = + match input_line ic with + | line -> + let line = replace line !module_to_be_replaced !new_module in + output_string oc line; output_string oc "\n"; go () + | exception End_of_file -> () + in + go () + +let usage = + "generate [-m module_to_be_replaced] [-n new_module] [-i input] [-o output] \ + replaces all occurrences of [module_to_be_replaced] by [new_module] in \ + [input] to [output]." + +let failwith fmt = Format.kasprintf failwith fmt + +let to_existing_filename var str = + if Sys.file_exists str && Sys.is_directory str = false then var := Some str + else failwith "%S does not exist" str + +let to_non_existing_filename var str = + if Sys.file_exists str = false then var := Some str + else failwith "%S already exists" str + +let args = + [ + ("-m", Arg.Set_string module_to_be_replaced, "the module to be replaced") + ; ("-n", Arg.Set_string new_module, "the new module") + ; ("-i", Arg.String (to_existing_filename input), "the input") + ; ("-o", Arg.String (to_non_existing_filename output), "the output") + ] + +let () = + Arg.parse args ignore usage; + run () diff --git a/unikernel/duniverse/bstr/bstr.opam b/unikernel/duniverse/bstr/bstr.opam new file mode 100644 index 00000000..3d3257fc --- /dev/null +++ b/unikernel/duniverse/bstr/bstr.opam @@ -0,0 +1,20 @@ +version: "0.0.2" +opam-version: "2.0" +name: "bstr" +maintainer: [ "Romain Calascibetta " ] +authors: [ "Romain Calascibetta " ] +homepage: "https://git.robur.coop/robur/bstr" +bug-reports: "https://git.robur.coop/robur/bstr" +dev-repo: "git+https://github.com/robur-coop/bstr" +doc: "https://robur-coop.github.io/bstr/" +license: "MIT" +synopsis: "A simple library for bigstrings" + +build: [ "dune" "build" "-p" name "-j" jobs ] +run-test: [ "dune" "runtest" "-p" name "-j" jobs ] + +depends: [ + "ocaml" {>= "4.14.0"} + "dune" {>= "3.5.0"} +] +x-maintenance-intent: [ "(latest)" ] \ No newline at end of file diff --git a/unikernel/duniverse/bstr/dune-project b/unikernel/duniverse/bstr/dune-project new file mode 100644 index 00000000..09232c28 --- /dev/null +++ b/unikernel/duniverse/bstr/dune-project @@ -0,0 +1,3 @@ +(lang dune 2.7) +(name bstr) +(version v0.0.2) diff --git a/unikernel/duniverse/bstr/lib/bin.ml b/unikernel/duniverse/bstr/lib/bin.ml new file mode 100644 index 00000000..8946080b --- /dev/null +++ b/unikernel/duniverse/bstr/lib/bin.ml @@ -0,0 +1,1140 @@ +(* + * Copyright (c) 2024 Romain Calascibetta + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +module Witness = struct + type (_, _) eq = Refl : ('a, 'a) eq + type _ equality = .. + + module type Inst = sig + type t + type _ equality += Eq : t equality + end + + type 'a t = (module Inst with type t = 'a) + + let make : type a. unit -> a t = + fun () -> + let module Inst = struct + type t = a + type _ equality += Eq : t equality + end in + (module Inst) + + let eq : type a b. a t -> b t -> (a, b) eq option = + fun (module A) (module B) -> match A.Eq with B.Eq -> Some Refl | _ -> None + + let cast_exn : type a b. a t -> b t -> a -> b = + fun awit bwit a -> + match eq awit bwit with Some Refl -> a | None -> assert false +end + +type endianness = Big_endian | Little_endian | Native_endian + +type _ t = + | Primary : 'a primary -> 'a t + | Record : 'a record -> 'a t + | Variant : 'a variant -> 'a t + | Map : ('a, 'b) map -> 'b t + | Seq : 'a len_v -> 'a array t + +and _ primary = + | Char : char primary + | UInt8 : int primary + | Int8 : int primary + | UInt16 : endianness -> int primary + | Int16 : endianness -> int primary + | Int32 : endianness -> int32 primary + | Int64 : endianness -> int64 primary + | Var_int : int primary + | Bytes : int -> string primary + | CString : string primary + | Until : char -> string primary + | Bstr : int -> Bstr.t primary + | Const : 'a -> 'a primary + +and 'a len_v = { llen: int; lval: 'a t } +and _ a_case = C0 : 'a case0 -> 'a a_case | C1 : ('a, 'b) case1 -> 'a a_case + +and _ case_v = + | CV0 : 'a case0 -> 'a case_v + | CV1 : ('a, 'b) case1 * 'b -> 'a case_v + +and 'a case0 = { ctag0: int; c0: 'a } + +and ('a, 'b) case1 = { + ctag1: int + ; ctype1: 'b t + ; cwitn1: 'b Witness.t + ; c1: 'b -> 'a +} + +and 'a record = { rwit: 'a Witness.t; rfields: 'a fields_and_constr } + +and 'a fields_and_constr = + | Fields : ('a, 'b) fields * 'b -> 'a fields_and_constr + +and ('a, 'b) fields = + | F0 : ('a, 'a) fields + | F1 : ('a, 'b) field * ('a, 'c) fields -> ('a, 'b -> 'c) fields + +and ('a, 'b) field = { ftype: 'b t; fget: 'a -> 'b } + +and 'a variant = { + vwit: 'a Witness.t + ; vcases: 'a a_case array + ; vget: 'a -> 'a case_v +} + +and ('a, 'b) map = { x: 'a t; f: 'a -> 'b; g: 'b -> 'a; mwit: 'b Witness.t } +and _ a_field = Field : ('a, 'b) field -> 'a a_field + +let fields r = + let rec go : type a b. (a, b) fields -> a a_field list = function + | F0 -> [] + | F1 (x, r) -> Field x :: go r + in + match r.rfields with Fields (f, _) -> go f + +module Fields_folder (Acc : sig + type ('a, 'b) t +end) = +struct + type 'a t = { + nil: ('a, 'a) Acc.t + ; cons: 'b 'c. ('a, 'b) field -> ('a, 'c) Acc.t -> ('a, 'b -> 'c) Acc.t + } + + let rec fold : type a c. a t -> (a, c) fields -> (a, c) Acc.t = + fun folder -> function + | F0 -> folder.nil + | F1 (f, fs) -> folder.cons f (fold folder fs) +end + +(* sizer *) + +let bstr_decode_varint bstr pos = + let bits = ref 0 in + let res = ref 0 in + while + let cmd = Bstr.get_uint8 bstr !pos in + incr pos; + res := !res lor ((cmd land 0x7f) lsl !bits); + bits := !bits + 7; + cmd land 0x80 != 0 + do + () + done; + !res +[@@inline always] + +let string_decode_varint str pos = + let bits = ref 0 in + let res = ref 0 in + while + let cmd = String.get_uint8 str !pos in + incr pos; + res := !res lor ((cmd land 0x7f) lsl !bits); + bits := !bits + 7; + cmd land 0x80 != 0 + do + () + done; + !res +[@@inline always] + +module Size = struct + type 'a encoding = 'a t + type 'a t = Static of int | Dynamic of 'a | Unknown + + let map : type a b. (a -> b) -> a t -> b t = + fun fn -> function + | Unknown -> Unknown + | Static n -> Static n + | Dynamic a -> Dynamic (fn a) + + let ( let+ ) x f = map f x + + module Offset = struct + type t = Offset of int [@@unboxed] + + let ( +> ) : t -> int -> t = fun (Offset n) m -> Offset (n + m) + end + + module Sizer = struct + type 'a size = 'a t + + type 'a t = { + of_value: ('a -> int) size + ; of_encoding: (Bstr.t -> Offset.t -> Offset.t) size + } + + let ( <+> ) : type a. a t -> a t -> a t = + let add_of_value (a : _ size) (b : _ size) : _ size = + match (a, b) with + | Unknown, _ | _, Unknown -> Unknown + | Static a, Static b -> Static (a + b) + | Static 0, other | other, Static 0 -> other + | Static n, Dynamic f | Dynamic f, Static n -> + Dynamic (fun a -> n + f a) + | Dynamic f, Dynamic g -> Dynamic (fun a -> f a + g a) + in + let add_of_encoding (a : _ size) (b : _ size) : _ size = + match (a, b) with + | Unknown, _ | _, Unknown -> Unknown + | Static a, Static b -> Static (a + b) + | Static 0, other | other, Static 0 -> other + | Dynamic f, Dynamic g -> Dynamic (fun bstr off -> g bstr (f bstr off)) + | Static n, Dynamic f -> + Dynamic (fun bstr off -> f bstr Offset.(off +> n)) + | Dynamic f, Static n -> + Dynamic (fun bstr off -> Offset.(f bstr off +> n)) + in + fun a b -> + { + of_value= add_of_value a.of_value b.of_value + ; of_encoding= add_of_encoding a.of_encoding b.of_encoding + } + + let static n = { of_value= Static n; of_encoding= Static n } + + let dynamic ~of_value ~of_encoding = + { of_value= Dynamic of_value; of_encoding= Dynamic of_encoding } + + let using fn t = + let of_value = map (fun size_of x -> size_of (fn x)) t.of_value in + { t with of_value } + + let unknown = { of_value= Unknown; of_encoding= Unknown } + end + + type 'a size_of = 'a Sizer.t + + let of_scanning : type a. (a -> Offset.t -> Offset.t) -> a -> int -> int = + fun scan_fn bstr off -> + let (Offset.Offset off') = scan_fn bstr (Offset.Offset off) in + off' - off + + let of_encoding : 'a size_of -> (Bstr.t -> int -> int) t = + fun { of_encoding; _ } -> map of_scanning of_encoding + + let of_value : type a. a size_of -> (a -> int) t = + fun { of_value; _ } -> of_value + + let sizer_varint = + let of_value = + let rec go len n = + if n >= 0 && n < 128 then len else go (len + 1) (n lsr 7) + in + fun n -> go 1 n + in + let of_encoding bstr (Offset.Offset off) = + let pos = ref off in + while + let cmd = Bstr.get_uint8 bstr !pos in + incr pos; + cmd land 0x80 != 0 + do + () + done; + Offset.Offset !pos + in + Sizer.dynamic ~of_value ~of_encoding + + let sizer_cstring = + let of_value str = String.length str + 1 in + let of_encoding bstr (Offset.Offset off) = + let pos = ref off in + while Bstr.get_uint8 bstr !pos != 0 do + incr pos + done; + Offset.Offset (!pos + 1) + in + Sizer.dynamic ~of_value ~of_encoding + + let sizer_until byte = + let of_value str = String.length str in + let of_encoding bstr (Offset.Offset off) = + let pos = ref off in + while Bstr.get bstr !pos != byte do + incr pos + done; + Offset.Offset !pos + in + Sizer.dynamic ~of_value ~of_encoding + + let rec size_of : type a. a encoding -> a Sizer.t = function + | Primary p -> prim p + | Record r -> record r + | Variant v -> variant v + | Map m -> map m + | Seq { llen; lval } -> seq ~llen lval + + and seq : type a. llen:int -> a encoding -> a array Sizer.t = + fun ~llen lval -> + match size_of lval with + | { Sizer.of_value= Static len; _ } -> Sizer.static (llen * len) + | lsize -> + let of_value = + let+ len = lsize.Sizer.of_value in + Array.fold_left (fun acc x -> acc + len x) 0 + in + let of_encoding = + let+ len = lsize.Sizer.of_encoding in + let rec go buf off = function + | 0 -> off + | n -> go buf (len buf off) (n - 1) + in + fun buf off -> go buf off llen + in + { Sizer.of_value; of_encoding } + + and prim : type a. a primary -> a Sizer.t = function + | Char -> Sizer.static 1 + | UInt8 -> Sizer.static 1 + | Int8 -> Sizer.static 1 + | UInt16 _ -> Sizer.static 2 + | Int16 _ -> Sizer.static 2 + | Int32 _ -> Sizer.static 4 + | Int64 _ -> Sizer.static 8 + | Bytes len -> Sizer.static len + | Bstr len -> Sizer.static len + | Var_int -> sizer_varint + | CString -> sizer_cstring + | Until p -> sizer_until p + | Const _ -> Sizer.static 0 + + and record : type a. a record -> a Sizer.t = + fun r -> + fields r + |> List.map (fun (Field f) -> Sizer.using f.fget (size_of f.ftype)) + |> List.fold_left Sizer.( <+> ) (Sizer.static 0) + + and map : type a b. (a, b) map -> b Sizer.t = + fun { x; g; _ } -> Sizer.using g (size_of x) + + and variant : type a. a variant -> a Sizer.t = + fun v -> + let static_varint_size n = + let[@warning "-8"] (Dynamic fn) = sizer_varint.Sizer.of_value in + fn n + in + let case_lengths : (int * a Sizer.t) array = + let fn = function + | C0 { ctag0; _ } -> (static_varint_size ctag0, Sizer.static 0) + | C1 { ctag1; ctype1; cwitn1= expected; _ } -> + let tag_length = static_varint_size ctag1 in + let arg_length = + match size_of ctype1 with + | ({ of_value= Static _; _ } | { of_value= Unknown; _ }) as t -> t + | { of_value= Dynamic of_value; of_encoding } -> + let of_value a = + match v.vget a with + | CV0 _ -> assert false + | CV1 ({ cwitn1= received; _ }, args) -> + let v = Witness.cast_exn received expected args in + of_value v + in + { of_value= Dynamic of_value; of_encoding } + in + (tag_length, arg_length) + in + Array.map fn v.vcases + in + let non_dynamic_length = + let rec go static_so_far = function + | -1 -> Option.map Sizer.static static_so_far + | i -> begin + match case_lengths.(i) with + | _, { of_value= Unknown; _ } -> Some Sizer.unknown + | _, { of_value= Dynamic _; _ } -> None + | tag_len, { of_value= Static arg_len; _ } -> + let len = tag_len + arg_len in + begin + match static_so_far with + | None -> go (Some len) (i - 1) + | Some len' when len = len' -> go static_so_far (i - 1) + | Some _ -> None + end + end + in + go None (Array.length case_lengths - 1) + in + match non_dynamic_length with + | Some x -> x + | None -> + let of_value a = + let tag = + match v.vget a with + | CV0 { ctag0; _ } -> ctag0 + | CV1 ({ ctag1; _ }, _) -> ctag1 + in + let tag_length, arg_length = case_lengths.(tag) in + let arg_length = + match arg_length.of_value with + | Dynamic fn -> fn a + | Static n -> n + | Unknown -> assert false + in + tag_length + arg_length + in + let of_encoding buf (Offset.Offset off) = + let off = ref off in + let tag = bstr_decode_varint buf off in + match case_lengths.(tag) with + | _, { of_encoding= Static n; _ } -> Offset.Offset (!off + n) + | _, { of_encoding= Dynamic fn; _ } -> fn buf (Offset.Offset !off) + | _, { of_encoding= Unknown; _ } -> assert false + in + Sizer.dynamic ~of_value ~of_encoding +end + +module Dispatch = struct + type 'a t = + | Base : 'a -> 'a t + | Arrow : { arg_wit: 'b Witness.t; fn: 'b -> 'a } -> 'a t +end + +module Case_folder = struct + type ('a, 'r) t = { c0: 'a case0 -> 'r; c1: 'b. ('a, 'b) case1 -> 'b -> 'r } +end + +let fold_variant : type a r. (a, r) Case_folder.t -> a variant -> a -> r = + fun folder v_typ -> + let cases = + let fn = function + | C0 c0 -> Dispatch.Base (folder.c0 c0) + | C1 c1 -> Dispatch.Arrow { arg_wit= c1.cwitn1; fn= folder.c1 c1 } + in + Array.map fn v_typ.vcases + in + fun v -> + match v_typ.vget v with + | CV0 { ctag0; _ } -> begin + match cases.(ctag0) with Dispatch.Base x -> x | _ -> assert false + end + | CV1 ({ ctag1; cwitn1; _ }, v) -> begin + match cases.(ctag1) with + | Dispatch.Arrow { fn; arg_wit } -> + let v = Witness.cast_exn cwitn1 arg_wit v in + fn v + | _ -> assert false + end + +module Bytes = struct + type 'a encoder = 'a -> bytes -> int ref -> unit + + let encode_char chr buf off = + let pos = !off in + incr off; Bytes.set buf pos chr + [@@inline always] + + let encode_uint8 byte buf off = + let pos = !off in + incr off; + Bytes.set_uint8 buf pos byte + [@@inline always] + + let encode_int8 byte buf off = + let pos = !off in + incr off; + Bytes.set_int8 buf pos byte + [@@inline always] + + let encode_uint16 endian value buf off = + let pos = !off in + off := !off + 2; + match endian with + | Big_endian -> Bytes.set_uint16_be buf pos value + | Little_endian -> Bytes.set_uint16_le buf pos value + | Native_endian -> Bytes.set_uint16_ne buf pos value + [@@inline always] + + let encode_int16 endian value buf off = + let pos = !off in + off := !off + 2; + match endian with + | Big_endian -> Bytes.set_int16_be buf pos value + | Little_endian -> Bytes.set_int16_le buf pos value + | Native_endian -> Bytes.set_int16_ne buf pos value + [@@inline always] + + let encode_int32 endian value buf off = + let pos = !off in + off := !off + 4; + match endian with + | Big_endian -> Bytes.set_int32_be buf pos value + | Little_endian -> Bytes.set_int32_be buf pos value + | Native_endian -> Bytes.set_int32_be buf pos value + + let encode_int64 endian value buf off = + let pos = !off in + off := !off + 8; + match endian with + | Big_endian -> Bytes.set_int64_be buf pos value + | Little_endian -> Bytes.set_int64_be buf pos value + | Native_endian -> Bytes.set_int64_be buf pos value + + let encode_bytes len src buf off = + let pos = !off in + off := !off + len; + Bytes.blit_string src 0 buf pos len + + let encode_bstr len src buf off = + let dst_off = !off in + off := !off + len; + Bstr.blit_to_bytes src ~src_off:0 buf ~dst_off ~len + + let encode_varint value buf off = + let num = ref (value lsr 7) in + let cmd = ref (value land 0x7f) in + cmd := if !num != 0 then !cmd lor 0x80 else !cmd; + Bytes.set_uint8 buf !off !cmd; + incr off; + while !num != 0 do + cmd := !num land 0x7f; + num := !num lsr 7; + cmd := if !num != 0 then !cmd lor 0x80 else !cmd; + Bytes.set_uint8 buf !off !cmd; + incr off + done + + let encode_cstring src buf off = + let pos = !off in + let len = String.length src in + off := !off + len; + Bytes.blit_string src 0 buf pos len; + Bytes.set_uint8 buf !off 0; + incr off + + let encode_until src buf off = + let pos = !off in + let len = String.length src in + off := !off + len; + Bytes.blit_string src 0 buf pos len + + let rec encode : type a. a t -> a encoder = function + | Primary p -> prim p + | Map m -> map m + | Record r -> record r + | Variant v -> variant v + | Seq { llen; lval } -> seq ~len:llen lval + + and seq : type a. len:int -> a t -> a array encoder = + fun ~len t arr buf off -> + if Array.length arr != len then + invalid_arg "Impossible to encode such sequence: lengths mismatch"; + for i = 0 to len - 1 do + encode t (Array.unsafe_get arr i) buf off + done + + and prim : type a. a primary -> a encoder = function + | Char -> encode_char + | UInt8 -> encode_uint8 + | Int8 -> encode_int8 + | UInt16 e -> encode_uint16 e + | Int16 e -> encode_int16 e + | Int32 e -> encode_int32 e + | Int64 e -> encode_int64 e + | Bytes len -> encode_bytes len + | Var_int -> encode_varint + | CString -> encode_cstring + | Until _ -> encode_until + | Bstr len -> encode_bstr len + | Const _ -> fun _v _bstr _off -> () + + and record : type a. a record -> a encoder = + fun r -> + let fields_encoders : (a -> bytes -> int ref -> unit) list = + let fn (Field f) = fun v buf off -> (encode f.ftype) (f.fget v) buf off in + List.map fn (fields r) + in + fun v buf off -> List.iter (fun fn -> fn v buf off) fields_encoders + + and variant : type a. a variant -> a encoder = + let c0 { ctag0; _ } = encode_varint ctag0 in + let c1 c = + let arg = encode c.ctype1 in + fun v buf off -> + encode_varint c.ctag1 buf off; + arg v buf off + in + fun v -> fold_variant { c0; c1 } v + + and map : type a b. (a, b) map -> b encoder = + fun { x; g; _ } -> fun u buf off -> encode x (g u) buf off +end + +(* decoder for [string] *) + +module String = struct + module Record_decoder = Fields_folder (struct + type ('a, 'b) t = string -> int ref -> 'b -> 'a + end) + + type 'a decoder = string -> int ref -> 'a + + let decode_char str pos = + let idx = !pos in + incr pos; String.get str idx + [@@inline always] + + let decode_uint8 str pos = + let idx = !pos in + incr pos; String.get_uint8 str idx + [@@inline always] + + let decode_int8 str pos = + let idx = !pos in + incr pos; String.get_int8 str idx + [@@inline always] + + let decode_uint16 e str pos = + let idx = !pos in + pos := !pos + 2; + match e with + | Big_endian -> String.get_uint16_be str idx + | Little_endian -> String.get_uint16_le str idx + | Native_endian -> String.get_uint16_ne str idx + [@@inline always] + + let decode_int16 endian str pos = + let idx = !pos in + pos := !pos + 2; + match endian with + | Big_endian -> String.get_int16_be str idx + | Little_endian -> String.get_int16_le str idx + | Native_endian -> String.get_int16_ne str idx + [@@inline always] + + let decode_int32 endian str pos = + let idx = !pos in + pos := !pos + 4; + match endian with + | Big_endian -> String.get_int32_be str idx + | Little_endian -> String.get_int32_le str idx + | Native_endian -> String.get_int32_ne str idx + [@@inline always] + + let decode_int64 endian str pos = + let idx = !pos in + pos := !pos + 8; + match endian with + | Big_endian -> String.get_int64_be str idx + | Little_endian -> String.get_int64_le str idx + | Native_endian -> String.get_int64_ne str idx + [@@inline always] + + let decode_bytes len str pos = + let off = !pos in + pos := !pos + len; + String.sub str off len + [@@inline always] + + let decode_bstr len str pos = + if len == 0 then Bstr.empty + else begin + let src_off = !pos in + pos := !pos + len; + let bstr = Bstr.create len in + Bstr.blit_from_string str ~src_off bstr ~dst_off:0 ~len; + bstr + end + [@@inline always] + + let decode_cstring str pos = + let off = !pos in + while String.get_uint8 str !pos != 0 do + incr pos + done; + let len = !pos - off in + let str = String.sub str off len in + incr pos; str + [@@inline always] + + let decode_until byte str pos = + let predicate byte' = byte != byte' in + let off = !pos in + while predicate (String.get str !pos) == false do + incr pos + done; + let len = !pos - off in + String.sub str off len + [@@inline always] + + let rec decode : type a. a t -> a decoder = function + | Primary p -> prim p + | Record r -> record r + | Variant v -> variant v + | Map m -> map m + | Seq { llen; lval } -> seq ~len:llen lval + + and seq : type a. len:int -> a t -> a array decoder = + fun ~len t bstr pos -> + let fn _idx = decode t bstr pos in + Array.init len fn + + and prim : type a. a primary -> a decoder = function + | Char -> decode_char + | UInt8 -> decode_uint8 + | Int8 -> decode_int8 + | UInt16 e -> decode_uint16 e + | Int16 e -> decode_int16 e + | Int32 e -> decode_int32 e + | Int64 e -> decode_int64 e + | Bytes len -> decode_bytes len + | Var_int -> string_decode_varint + | CString -> decode_cstring + | Until p -> decode_until p + | Bstr len -> decode_bstr len + | Const v -> fun _bstr _off -> v + + and map : type a b. (a, b) map -> b decoder = + fun { x; f; _ } -> fun buf pos -> f (decode x buf pos) + + and record : type a. a record -> a decoder = + fun { rfields= Fields (fs, constr); _ } -> + let nil _bstr _pos fn = fn in + let cons { ftype; _ } k = + let decode = decode ftype in + fun bstr pos constr -> + let x = decode bstr pos in + let constr = constr x in + k bstr pos constr + in + let fn = Record_decoder.fold { nil; cons } fs in + fun bstr pos -> fn bstr pos constr + + and variant : type a. a variant -> a decoder = + fun v -> + let decoders : a decoder array = + let fn = function + | C0 c -> fun _ _ -> c.c0 + | C1 c -> + let decode_arg = decode c.ctype1 in + fun bstr pos -> c.c1 (decode_arg bstr pos) + in + Array.map fn v.vcases + in + fun str pos -> + let i = string_decode_varint str pos in + decoders.(i) str pos +end + +(* decoder & encoder for [bstr] *) + +module Bstr = struct + module Record_decoder = Fields_folder (struct + type ('a, 'b) t = Bstr.t -> int ref -> 'b -> 'a + end) + + type 'a decoder = Bstr.t -> int ref -> 'a + + let decode_char bstr pos = + let idx = !pos in + incr pos; Bstr.get bstr idx + [@@inline always] + + let decode_uint8 bstr pos = + let idx = !pos in + incr pos; Bstr.get_uint8 bstr idx + [@@inline always] + + let decode_int8 bstr pos = + let idx = !pos in + incr pos; Bstr.get_int8 bstr idx + [@@inline always] + + let decode_uint16 e bstr pos = + let idx = !pos in + pos := !pos + 2; + match e with + | Big_endian -> Bstr.get_uint16_be bstr idx + | Little_endian -> Bstr.get_uint16_le bstr idx + | Native_endian -> Bstr.get_uint16_ne bstr idx + [@@inline always] + + let decode_int16 endian bstr pos = + let idx = !pos in + pos := !pos + 2; + match endian with + | Big_endian -> Bstr.get_int16_be bstr idx + | Little_endian -> Bstr.get_int16_le bstr idx + | Native_endian -> Bstr.get_int16_ne bstr idx + [@@inline always] + + let decode_int32 endian bstr pos = + let idx = !pos in + pos := !pos + 4; + match endian with + | Big_endian -> Bstr.get_int32_be bstr idx + | Little_endian -> Bstr.get_int32_le bstr idx + | Native_endian -> Bstr.get_int32_ne bstr idx + [@@inline always] + + let decode_int64 endian bstr pos = + let idx = !pos in + pos := !pos + 8; + match endian with + | Big_endian -> Bstr.get_int64_be bstr idx + | Little_endian -> Bstr.get_int64_le bstr idx + | Native_endian -> Bstr.get_int64_ne bstr idx + [@@inline always] + + let decode_bytes len bstr pos = + let off = !pos in + pos := !pos + len; + Bstr.sub_string bstr ~off ~len + [@@inline always] + + let decode_bstr len bstr pos = + if len == 0 then Bstr.empty + else begin + let off = !pos in + pos := !pos + len; + Bstr.sub bstr ~off ~len + end + [@@inline always] + + let decode_cstring bstr pos = + let off = !pos in + while Bstr.get_uint8 bstr !pos != 0 do + incr pos + done; + let len = !pos - off in + let str = Bstr.sub_string bstr ~off ~len in + incr pos; str + [@@inline always] + + let decode_until byte bstr pos = + let predicate byte' = byte != byte' in + let off = !pos in + while predicate (Bstr.get bstr !pos) == false do + incr pos + done; + let len = !pos - off in + Bstr.sub_string bstr ~off ~len + [@@inline always] + + let rec decode : type a. a t -> a decoder = function + | Primary p -> prim p + | Record r -> record r + | Variant v -> variant v + | Map m -> map m + | Seq { llen; lval } -> seq ~len:llen lval + + and seq : type a. len:int -> a t -> a array decoder = + fun ~len t bstr pos -> + let fn _idx = decode t bstr pos in + Array.init len fn + + and prim : type a. a primary -> a decoder = function + | Char -> decode_char + | UInt8 -> decode_uint8 + | Int8 -> decode_int8 + | UInt16 e -> decode_uint16 e + | Int16 e -> decode_int16 e + | Int32 e -> decode_int32 e + | Int64 e -> decode_int64 e + | Bytes len -> decode_bytes len + | Var_int -> bstr_decode_varint + | CString -> decode_cstring + | Until p -> decode_until p + | Bstr len -> decode_bstr len + | Const v -> fun _bstr _off -> v + + and map : type a b. (a, b) map -> b decoder = + fun { x; f; _ } -> fun buf pos -> f (decode x buf pos) + + and record : type a. a record -> a decoder = + fun { rfields= Fields (fs, constr); _ } -> + let nil _bstr _pos fn = fn in + let cons { ftype; _ } k = + let decode = decode ftype in + fun bstr pos constr -> + let x = decode bstr pos in + let constr = constr x in + k bstr pos constr + in + let fn = Record_decoder.fold { nil; cons } fs in + fun bstr pos -> fn bstr pos constr + + and variant : type a. a variant -> a decoder = + fun v -> + let decoders : a decoder array = + let fn = function + | C0 c -> fun _ _ -> c.c0 + | C1 c -> + let decode_arg = decode c.ctype1 in + fun bstr pos -> c.c1 (decode_arg bstr pos) + in + Array.map fn v.vcases + in + fun bstr pos -> + let i = bstr_decode_varint bstr pos in + decoders.(i) bstr pos + + type 'a encoder = 'a -> Bstr.t -> int ref -> unit + + let encode_char chr bstr off = + let pos = !off in + incr off; Bstr.set bstr pos chr + [@@inline always] + + let encode_uint8 byte bstr off = + let pos = !off in + incr off; + Bstr.set_uint8 bstr pos byte + [@@inline always] + + let encode_int8 byte bstr off = + let pos = !off in + incr off; + Bstr.set_int8 bstr pos byte + [@@inline always] + + let encode_uint16 endian value bstr off = + let pos = !off in + off := !off + 2; + match endian with + | Big_endian -> Bstr.set_uint16_be bstr pos value + | Little_endian -> Bstr.set_uint16_le bstr pos value + | Native_endian -> Bstr.set_uint16_ne bstr pos value + [@@inline always] + + let encode_int16 endian value bstr off = + let pos = !off in + off := !off + 2; + match endian with + | Big_endian -> Bstr.set_int16_be bstr pos value + | Little_endian -> Bstr.set_int16_le bstr pos value + | Native_endian -> Bstr.set_int16_ne bstr pos value + [@@inline always] + + let encode_int32 endian value bstr off = + let pos = !off in + off := !off + 4; + match endian with + | Big_endian -> Bstr.set_int32_be bstr pos value + | Little_endian -> Bstr.set_int32_be bstr pos value + | Native_endian -> Bstr.set_int32_be bstr pos value + + let encode_int64 endian value bstr off = + let pos = !off in + off := !off + 8; + match endian with + | Big_endian -> Bstr.set_int64_be bstr pos value + | Little_endian -> Bstr.set_int64_be bstr pos value + | Native_endian -> Bstr.set_int64_be bstr pos value + + let encode_bytes len src bstr off = + let dst_off = !off in + off := !off + len; + Bstr.blit_from_string src ~src_off:0 bstr ~dst_off ~len + + let encode_bstr len src bstr off = + let dst_off = !off in + off := !off + len; + Bstr.blit src ~src_off:0 bstr ~dst_off ~len + + let encode_varint value bstr off = + let num = ref (value lsr 7) in + let cmd = ref (value land 0x7f) in + cmd := if !num != 0 then !cmd lor 0x80 else !cmd; + Bstr.set_uint8 bstr !off !cmd; + incr off; + while !num != 0 do + cmd := !num land 0x7f; + num := !num lsr 7; + cmd := if !num != 0 then !cmd lor 0x80 else !cmd; + Bstr.set_uint8 bstr !off !cmd; + incr off + done + + let encode_cstring src bstr off = + let pos = !off in + let len = Stdlib.String.length src in + off := !off + len; + Bstr.blit_from_string src ~src_off:0 bstr ~dst_off:pos ~len; + Bstr.set_uint8 bstr !off 0; + incr off + + let encode_until src bstr off = + let pos = !off in + let len = Stdlib.String.length src in + off := !off + len; + Bstr.blit_from_string src ~src_off:0 bstr ~dst_off:pos ~len + + let rec encode : type a. a t -> a encoder = function + | Primary p -> prim p + | Map m -> map m + | Record r -> record r + | Variant v -> variant v + | Seq { llen; lval } -> seq ~len:llen lval + + and seq : type a. len:int -> a t -> a array encoder = + fun ~len t arr buf off -> + if Array.length arr != len then + invalid_arg "Impossible to encode such sequence: lengths mismatch"; + for i = 0 to len - 1 do + encode t (Array.unsafe_get arr i) buf off + done + + and prim : type a. a primary -> a encoder = function + | Char -> encode_char + | UInt8 -> encode_uint8 + | Int8 -> encode_int8 + | UInt16 e -> encode_uint16 e + | Int16 e -> encode_int16 e + | Int32 e -> encode_int32 e + | Int64 e -> encode_int64 e + | Bytes len -> encode_bytes len + | Var_int -> encode_varint + | CString -> encode_cstring + | Until _ -> encode_until + | Bstr len -> encode_bstr len + | Const _ -> fun _v _bstr _off -> () + + and record : type a. a record -> a encoder = + fun r -> + let fields_encoders : (a -> Bstr.t -> int ref -> unit) list = + let fn (Field f) = fun v buf off -> (encode f.ftype) (f.fget v) buf off in + List.map fn (fields r) + in + fun v buf off -> List.iter (fun fn -> fn v buf off) fields_encoders + + and variant : type a. a variant -> a encoder = + let c0 { ctag0; _ } = encode_varint ctag0 in + let c1 c = + let arg = encode c.ctype1 in + fun v buf off -> + encode_varint c.ctag1 buf off; + arg v buf off + in + fun v -> fold_variant { c0; c1 } v + + and map : type a b. (a, b) map -> b encoder = + fun { x; g; _ } -> fun u buf off -> encode x (g u) buf off +end + +let decode_bstr = Bstr.decode +let encode_bstr = Bstr.encode +let decode = String.decode + +let size_of_value t value = + let sizer = Size.size_of t in + match Size.of_value sizer with + | Size.Static len -> Some len + | Size.Dynamic fn -> Some (fn value) + | Size.Unknown -> None + +let size_of_bstr ?(off = 0) t bstr = + let sizer = Size.size_of t in + match Size.of_encoding sizer with + | Size.Static len -> Some len + | Size.Dynamic fn -> Some (fn bstr off) + | Size.Unknown -> None + +let to_string t value = + match size_of_value t value with + | Some len -> + let buf = Stdlib.Bytes.create len in + Bytes.encode t value buf (ref 0); + Stdlib.Bytes.unsafe_to_string buf + | None -> assert false (* TODO(dinosaure): with [Buffer.t]. *) + +(* combinators *) + +let const v = Primary (Const v) +let char = Primary Char +let uint8 = Primary UInt8 +let int8 = Primary Int8 +let beuint16 = Primary (UInt16 Big_endian) +let leuint16 = Primary (UInt16 Little_endian) +let neuint16 = Primary (UInt16 Native_endian) +let beint16 = Primary (Int16 Big_endian) +let leint16 = Primary (Int16 Little_endian) +let neint16 = Primary (Int16 Native_endian) +let beint32 = Primary (Int32 Big_endian) +let leint32 = Primary (Int32 Little_endian) +let neint32 = Primary (Int32 Native_endian) +let beint64 = Primary (Int64 Big_endian) +let leint64 = Primary (Int64 Little_endian) +let neint64 = Primary (Int64 Native_endian) +let varint = Primary Var_int +let bytes len = Primary (Bytes len) +let bstr len = Primary (Bstr len) +let cstring = Primary CString +let until byte = Primary (Until byte) + +(* record *) + +type ('a, 'b, 'c) open_record = ('a, 'c) fields -> 'b * ('a, 'b) fields + +let field ftype fget = { ftype; fget } +let record : 'b -> ('a, 'b, 'b) open_record = fun c fs -> (c, fs) + +let app : type a b c d. + (a, b, c -> d) open_record -> (a, c) field -> (a, b, d) open_record = + fun r f fs -> r (F1 (f, fs)) + +let sealr : type a b. (a, b, a) open_record -> a t = + fun r -> + let c, fs = r F0 in + let rwit = Witness.make () in + let sealed = { rwit; rfields= Fields (fs, c) } in + Record sealed + +let ( |+ ) = app + +(* variant *) + +type 'a case_p = 'a case_v +type ('a, 'b) case = int -> 'a a_case * 'b + +let case0 c0 ctag0 = + let c = { ctag0; c0 } in + (C0 c, CV0 c) + +let case1 : type a b. b t -> (b -> a) -> (a, b -> a case_p) case = + fun ctype1 c1 ctag1 -> + let cwitn1 : b Witness.t = Witness.make () in + let c = { ctag1; ctype1; cwitn1; c1 } in + (C1 c, fun v -> CV1 (c, v)) + +type ('a, 'b, 'c) open_variant = 'a a_case list -> 'c * 'a a_case list + +let variant c vs = (c, vs) + +let app v c cs = + let fc, cs = v cs in + let c, f = c (List.length cs) in + (fc f, c :: cs) + +let sealv v = + let vget, vcases = v [] in + let vwit = Witness.make () in + let vcases = Array.of_list (List.rev vcases) in + Variant { vwit; vcases; vget } + +let ( |~ ) = app + +(* map *) + +let map x f g = Map { x; f; g; mwit= Witness.make () } + +let seq ~len:llen lval = + if llen <= 0 then invalid_arg "Bin.seq"; + Seq { llen; lval } diff --git a/unikernel/duniverse/bstr/lib/bin.mli b/unikernel/duniverse/bstr/lib/bin.mli new file mode 100644 index 00000000..73b395ef --- /dev/null +++ b/unikernel/duniverse/bstr/lib/bin.mli @@ -0,0 +1,295 @@ +(** [Bin] is a small library for encoding and decoding information from a buffer + (like a [bytes] or a [bigstring]). Unlike a {i parser combinator}, [Bin] + cannot decode a stream. + + [Bin] can be used to project values coming from a pre-allocated buffer such + as a "framebuffer" (video, ethernet, etc.) or to inject values into it. + [Bin] can be seen as a library for describing (fairly basic) "C-like" types + of values that can be injected/projected into/from a particular memory area: + + {[ + #define PROPTAG_GET_COMMAND_LINE 0x00050001 + #define VALUE_LENGTH_RESPONSE (1 << 31) + + struct __attribute__((packed)) cmdline { + uint32_t id; + uint32_t value_len; + uint32_t param_len; + uint8 str[2048]; + }; + + struct __attribute__((packed)) property_tag { + uint32_t id; + uint32_t value_len; + uint32_t param_len; + }; + + extern char _tags; + + char *get_cmdline() { + struct cmdline p; + p.id = PROPTAG_GET_COMMAND_LINE; + p.value_len = len - sizeof(struct property_tag); + p.param_len = 2048 & ~VALUE_LENGTH_RESPONSE; + memcpy(&_tags, &p, sizeof(struct cmdline)); // inject + ... + } + ]} + + [Bin] therefore allows you to describe a representation of a serialized + value in bytes and to associate with it a function that allows you to obtain + an OCaml value such as a record or a variant. + + {[ + open Bin + + type cmdline = { + id: int32 + ; value_len: int32 + ; param_len: int32 + ; cmdline: string + } + + let cmdline = + record (fun id value_len param_len -> { id; value_len; param_len }) + |+ field neint32 (Fun.const 0x00050001l) + |+ field neint32 (fun t -> t.value_len) + |+ field neint32 (fun t -> t.param_len) + |+ field cstring (fun t -> t.cmdline) + |> sealr + + let encode_into tags ?(off = 0) value = + let off = ref off in + Bin.encode_bstr cmdline value tags off (* inject *) + ]} + + Of course, it's not as fast as what we can do in C, but [Bin] has the + advantage of offering a small DSL that allows us to describe these types and + go directly to OCaml values, which is generally more pleasant to manipulate + with OCaml than to make C stubs. *) + +type 'a t + +(** {1:primitives Primitives.} *) + +val char : char t +(** [char] is a representation of the character type. *) + +val uint8 : int t +(** [uint8] is a representation of unsigned 8-bit integers. *) + +val int8 : int t +(** [int8] is a representation of 8-bit integers. *) + +val beuint16 : int t +(** [beint16] is a representation of big-endian unsigned 16-bit integers. *) + +val leuint16 : int t +(** [leint16] is a representation of little-endian unsigned 16-bit integers. *) + +val neuint16 : int t +(** [neint16] is a representation of native-endian unsigned 16-bit integers. *) + +val beint16 : int t +(** [beint16] is a representation of big-endian 16-bit integers. *) + +val leint16 : int t +(** [leint16] is a representation of little-endian 16-bit integers. *) + +val neint16 : int t +(** [neint16] is a representation of native-endian 16-bit integers. *) + +val beint32 : int32 t +(** [beint32] is a representation of big-endian 32-bit integers. *) + +val leint32 : int32 t +(** [leint32] is a representation of little-endian 32-bit integers. *) + +val neint32 : int32 t +(** [neint32] is a representation of native-endian 32-bit integers. *) + +val beint64 : int64 t +(** [beint64] is a representation of big-endian 64-bit integers. *) + +val leint64 : int64 t +(** [leint64] is a representation of little-endian 64-bit integers. *) + +val neint64 : int64 t +(** [neint64] is a representation of native-endian 64-bit integers. *) + +val varint : int t + +val bytes : int -> string t +(** [bytes n] is a representation of a bytes sequence of [n] byte(s). *) + +val bstr : int -> Bstr.t t +(** [bstr n] is a representation of a bigstring of [n] byte(s). *) + +val cstring : string t +val until : char -> string t + +val const : 'a -> 'a t +(** [const v] is [v] without a serialization mechanism. *) + +val seq : len:int -> 'a t -> 'a array t +(** [seq ~len v] is a representation of fixed-length arrays of values of type + [v]. *) + +val map : 'b t -> ('b -> 'a) -> ('a -> 'b) -> 'a t +(** This combinator allows defining a representative of one type in terms of + another by supplying coercions between them. *) + +(* {2:records Records.} + + {[ + type header = + { version : int32 + ; number : int32 } + + let _PACK = 0x5041434bl + + let header = + record (fun pack version number -> + if pack <> _PACK + then invalid_arg "Invalid PACK file"; + { version; number }) + |+ field beint32 (fun _ -> _PACK) + |+ field beint32 (fun t -> t.version) + |+ field beint32 (fun t -> t.number) + |> sealr + ]} *) + +type ('a, 'b, 'c) open_record +(** The type for representing open records of type ['a] with a constructor of + ['b]. ['c] represents the remaining fields to be described using the + {!val:(|+)} operator. An open record initially stisfies ['c = 'b] and can be + {{!val:sealr} sealed} once ['c = 'a]. *) + +val record : 'b -> ('a, 'b, 'b) open_record +(** [record f] is an incomplete representation of the record of type ['a] with + constructor [f]. To complete the representation, add fields with {!val:(|+)} + and then seal the record with {!val:sealr}. *) + +type ('a, 'b) field +(** The type for fields holding values of type ['b] and belonging to a record of + type ['a]. *) + +val field : 'a t -> ('b -> 'a) -> ('b, 'a) field +(** [field n t g] is the representation of the field called [n] of type [t] with + getter [g]. For instance: + + {[ + type t = { foo: string } + + let foo = field cstring (fun t -> t.foo) + ]} *) + +val ( |+ ) : + ('a, 'b, 'c -> 'd) open_record -> ('a, 'c) field -> ('a, 'b, 'd) open_record +(** [r |+ f] is the open record [r] augmented with the field [f]. *) + +val sealr : ('a, 'b, 'a) open_record -> 'a t +(** [sealr r] seals the open record [r]. *) + +(** {2:variants Variants.} + + {[ + type t = Foo | Bar of string + + let t = + variant (fun foo bar -> function Foo -> foo | Bar s -> bar s) + |~ case0 Foo + |~ case1 cstring (fun x -> Bar x) + |> sealv + ]} *) + +type ('a, 'b, 'c) open_variant +(** The type for representing open variants of type ['a] with pattern-matching + of type ['b]. ['c] represents the remaining constructors to be described + using the {!val:(|~)} operator. An open variant initially satisfies + ['c = 'b] and can be {{!val:sealv} sealed} once ['c = 'a]. *) + +val variant : 'b -> ('a, 'b, 'b) open_variant +(** [variant n p] is an incomplete representation of the variant type called [n] + of type ['a] using [p] to deconstruct values. To complete the + representation, add cases with {!val:(|~)} and then seal the variant with + {!val:sealv}. *) + +type ('a, 'b) case +(** The type for representing variant cases of type ['a] with patterns of type + ['b]. *) + +type 'a case_p +(** The type for representing patterns for a variant of type ['a]. *) + +val case0 : 'a -> ('a, 'a case_p) case +(** [case0 v] is a representation of a variant constructor [v] with no + arguments. For instance: + + {[ + type t = Foo + + let foo = case0 Foo + ]} *) + +val case1 : 'b t -> ('b -> 'a) -> ('a, 'b -> 'a case_p) case +(** [case1 n t c] is a representation of a variant constructor [c] with an + argument of type [t]. For instances: + + {[ + type t = Foo of string + + let foo = case1 cstring (fun s -> Foo s) + ]} *) + +val ( |~ ) : + ('a, 'b, 'c -> 'd) open_variant -> ('a, 'c) case -> ('a, 'b, 'd) open_variant +(** [v |~ c] is the open variant [v] augmented with the case [c]. *) + +val sealv : ('a, 'b, 'a -> 'a case_p) open_variant -> 'a t +(** [sealv v] seals the open variant [v]. *) + +(** {2:decoder Decoder.} *) + +val decode_bstr : 'a t -> Bstr.t -> int ref -> 'a +(** [decode_bstr repr] is the binary decoder for values of type [repr]. *) + +val decode : 'a t -> string -> int ref -> 'a + +(** {2:encoder Encoder.} *) + +val encode_bstr : 'a t -> 'a -> Bstr.t -> int ref -> unit +val to_string : 'a t -> 'a -> string + +module Size : sig + type -'a size_of + (** The type for size function related to binary encoder/decoder. *) + + val size_of : 'a t -> 'a size_of + + type 'a t = private + | Static of int + | Dynamic of 'a + | Unknown + (** A value representing information known about the length in bytes of + encodings produced by a particular binary codec: + - [Static n]: all encodings produced by this codec have length [n]; + - [Dynamic fn]: the length of binary encodings is dependent on the + specific value, but may be efficiently computed at run-time via + the function [fn]; + - [Unknown]: this codec may produce encodings that cannot be + efficiently pre-computed. *) + + val of_encoding : 'a size_of -> (Bstr.t -> int -> int) t + val of_value : 'a size_of -> ('a -> int) t +end + +val size_of_value : 'a t -> 'a -> int option +(** [size_of_value encoding value] attempts to calculate the number of bytes + needed to encode the given [value] according to the given encoding. *) + +val size_of_bstr : ?off:int -> 'a t -> Bstr.t -> int option +(** [size_of_encoding ?off encoding bstr] attempts to calculate the number of + bytes required to decode a value according to the given [encoding] and + according to what can be decoded in the given byte sequence [bstr] (at the + given offset [off], defaults to [0]). *) diff --git a/unikernel/duniverse/bstr/lib/bstr.c b/unikernel/duniverse/bstr/lib/bstr.c new file mode 100644 index 00000000..d98980cb --- /dev/null +++ b/unikernel/duniverse/bstr/lib/bstr.c @@ -0,0 +1,325 @@ +/* + * Copyright (c) 2024 Romain Calascibetta + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#include +#include +#include +#include +#include +#include +#include +#include + +#ifndef CAML_BA_SUBARRAY +#define CAML_BA_SUBARRAY 0x800 +#endif + +CAMLextern void caml_enter_blocking_section(void); +CAMLextern void caml_leave_blocking_section(void); + +CAMLprim value bstr_bytecode_ptr(value va) { + CAMLparam1(va); + CAMLlocal1(res); + + struct caml_ba_array *a = Caml_ba_array_val(va); + void *src_a = a->data; + res = caml_copy_nativeint((intnat)src_a); + + CAMLreturn(res); +} + +intnat bstr_native_ptr(value va) { + struct caml_ba_array *a = Caml_ba_array_val(va); + return ((intnat)a->data); +} + +#define bstr_uint8_off(ba, off) ((uint8_t *)Caml_ba_data_val(ba) + off) +#define bytes_uint8_off(buf, off) ((uint8_t *)Bytes_val(buf) + off) +#define LEAVE_RUNTIME_OP_CUTOFF 4096 +#define is_mmaped(ba) ((ba)->flags & CAML_BA_MAPPED_FILE) + +void bstr_native_memcpy_mmaped(value src, intnat src_off, value dst, + intnat dst_off, intnat len) { + int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long)); + + if (leave_runtime) + caml_enter_blocking_section(); + memcpy(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len); + if (leave_runtime) + caml_leave_blocking_section(); +} + +void bstr_native_memcpy(value src, intnat src_off, value dst, intnat dst_off, + intnat len) { + memcpy(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len); +} + +CAMLprim value bstr_bytecode_memcpy(value src, value src_off, value dst, + value dst_off, value len) { + CAMLparam5(src, src_off, dst, dst_off, len); + + if (is_mmaped(Caml_ba_array_val(src)) || is_mmaped(Caml_ba_array_val(dst))) + bstr_native_memcpy_mmaped(src, Unsigned_long_val(src_off), dst, + Unsigned_long_val(dst_off), + Unsigned_long_val(len)); + else + bstr_native_memcpy(src, Unsigned_long_val(src_off), dst, + Unsigned_long_val(dst_off), Unsigned_long_val(len)); + + CAMLreturn(Val_unit); +} + +CAMLprim value bstr_native_memmove_mmaped(value src, intnat src_off, value dst, + intnat dst_off, intnat len) { + CAMLparam2(src, dst); + int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long)) || + is_mmaped(Caml_ba_array_val(src)) || + is_mmaped(Caml_ba_array_val(dst)); + + if (leave_runtime) + caml_enter_blocking_section(); + memmove(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len); + if (leave_runtime) + caml_leave_blocking_section(); + CAMLreturn(Val_unit); +} + +CAMLprim value bstr_native_memmove(value src, intnat src_off, value dst, + intnat dst_off, intnat len) { + CAMLparam2(src, dst); + int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long)); + + if (leave_runtime) + caml_enter_blocking_section(); + memmove(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len); + if (leave_runtime) + caml_leave_blocking_section(); + CAMLreturn(Val_unit); +} + +CAMLprim value bstr_bytecode_memmove(value src, value src_off, value dst, + value dst_off, value len) { + CAMLparam5(src, src_off, dst, dst_off, len); + if (is_mmaped(Caml_ba_array_val(src)) || is_mmaped(Caml_ba_array_val(dst))) + bstr_native_memmove_mmaped(src, Unsigned_long_val(src_off), dst, + Unsigned_long_val(dst_off), + Unsigned_long_val(len)); + else + bstr_native_memmove(src, Unsigned_long_val(src_off), dst, + Unsigned_long_val(dst_off), Unsigned_long_val(len)); + CAMLreturn(Val_unit); +} + +intnat bstr_native_memcmp(value s1, intnat s1_off, value s2, intnat s2_off, + intnat len) { + intnat res; + res = memcmp(bstr_uint8_off(s1, s1_off), bstr_uint8_off(s2, s2_off), len); + return (res); +} + +CAMLprim value bstr_bytecode_memcmp(value s1, value s1_off, value s2, + value s2_off, value len) { + CAMLparam5(s1, s1_off, s2, s2_off, len); + intnat res; + res = bstr_native_memcmp(s1, Unsigned_long_val(s1_off), s2, + Unsigned_long_val(s2_off), Unsigned_long_val(len)); + CAMLreturn(Val_long(res)); +} + +#define __MEM1(name) \ + intnat bstr_native_##name(value src, intnat src_off, intnat src_len, \ + intnat va) { \ + uint8_t *res = name(bstr_uint8_off(src, src_off), va, src_len); \ + if (res == NULL) \ + return (-1); \ + \ + return ((intnat)(res - bstr_uint8_off(src, src_off))); \ + } \ + \ + CAMLprim value bstr_bytecode_##name(value src, value src_off, value src_len, \ + value va) { \ + CAMLparam4(src, src_off, src_len, va); \ + intnat res; \ + res = \ + bstr_native_##name(src, Unsigned_long_val(src_off), \ + Unsigned_long_val(src_len), Unsigned_long_val(va)); \ + CAMLreturn(Val_long(res)); \ + } + +__MEM1(memset) +__MEM1(memchr) + +void bstr_native_unsafe_blit_from_bytes(value src, intnat src_off, value dst, + intnat dst_off, intnat len) { + memcpy(bstr_uint8_off(dst, dst_off), bytes_uint8_off(src, src_off), len); +} + +CAMLprim value bstr_bytecode_unsafe_blit_from_bytes(value src, intnat src_off, + value dst, intnat dst_off, + intnat len) { + CAMLparam5(src, src_off, dst, dst_off, len); + memcpy(bstr_uint8_off(dst, Unsigned_long_val(dst_off)), + bytes_uint8_off(src, Unsigned_long_val(src_off)), + Unsigned_long_val(len)); + CAMLreturn(Val_unit); +} + +void bstr_native_unsafe_blit_to_bytes(value src, intnat src_off, value dst, + intnat dst_off, intnat len) { + memcpy(bytes_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len); +} + +CAMLprim value bstr_bytecode_unsafe_blit_to_bytes(value src, intnat src_off, + value dst, intnat dst_off, + intnat len) { + CAMLparam5(src, src_off, dst, dst_off, len); + memcpy(bytes_uint8_off(dst, Unsigned_long_val(dst_off)), + bstr_uint8_off(src, Unsigned_long_val(src_off)), + Unsigned_long_val(len)); + CAMLreturn(Val_unit); +} + +#include + +#define atomic_store_release(p, v) \ + atomic_store_explicit((p), (v), memory_order_release) + +CAMLextern struct custom_operations caml_ba_ops; + +static void caml_ba_update_proxy(struct caml_ba_array *b1, + struct caml_ba_array *b2) { + struct caml_ba_proxy *proxy; + /* Nothing to do for un-managed arrays */ + if ((b1->flags & CAML_BA_MANAGED_MASK) == CAML_BA_EXTERNAL) + return; + if (b1->proxy != NULL) { + /* If b1 is already a proxy for a larger array, increment refcount of + proxy */ + b2->proxy = b1->proxy; +#if OCAML_VERSION_MAJOR >= 5 + (void)atomic_fetch_add(&b1->proxy->refcount, 1); +#else + b1->proxy->refcount += 1; +#endif + } else { + /* Otherwise, create proxy and attach it to both b1 and b2 */ + proxy = malloc(sizeof(struct caml_ba_proxy)); + if (proxy == NULL) + caml_raise_out_of_memory(); +#if OCAML_VERSION_MAJOR >= 5 + atomic_store_release(&proxy->refcount, 2); +#else + proxy->refcount = 2; +#endif + /* initial refcount: 2 = original array + sub array */ + proxy->data = b1->data; + proxy->size = b1->flags & CAML_BA_MAPPED_FILE ? caml_ba_byte_size(b1) : 0; + b1->proxy = proxy; + b2->proxy = proxy; + } +} + +CAMLprim value bstr_native_unsafe_sub(value vbstr, intnat off, intnat len) { + CAMLparam1(vbstr); + CAMLlocal1(res); + + char *sub = Caml_ba_array_val(vbstr)->data + off; + res = + caml_alloc_custom_mem(&caml_ba_ops, SIZEOF_BA_ARRAY + sizeof(intnat), 0); + struct caml_ba_array *new; + new = Caml_ba_array_val(res); + new->data = sub; + new->num_dims = 1; + new->flags = Caml_ba_array_val(vbstr)->flags | CAML_BA_SUBARRAY; + new->proxy = NULL; + new->dim[0] = len; + Custom_ops_val(res) = Custom_ops_val(vbstr); + caml_ba_update_proxy(Caml_ba_array_val(vbstr), Caml_ba_array_val(res)); + CAMLreturn(res); +} + +CAMLprim value bstr_bytecode_unsafe_sub(value vbstr, value voff, value vlen) { + CAMLparam3(vbstr, voff, vlen); + CAMLlocal1(res); + + intnat off = Unsigned_long_val(voff); + intnat len = Unsigned_long_val(vlen); + char *sub = Caml_ba_array_val(vbstr)->data + off; + res = + caml_alloc_custom_mem(&caml_ba_ops, SIZEOF_BA_ARRAY + sizeof(intnat), 0); + struct caml_ba_array *new; + new = Caml_ba_array_val(res); + new->data = sub; + new->num_dims = 1; + new->flags = Caml_ba_array_val(vbstr)->flags | CAML_BA_SUBARRAY; + new->proxy = NULL; + new->dim[0] = len; + Custom_ops_val(res) = Custom_ops_val(vbstr); + caml_ba_update_proxy(Caml_ba_array_val(vbstr), Caml_ba_array_val(res)); + CAMLreturn(res); +} + +/* This function is **only** useful when accessing to a bigstring for an + * architecture requiring alignment **and** for an OCaml executable in + * bytecode. It concerns only 32-bits architectures. + */ + +uint64_t bstr_native_get64u(value va, intnat off) { +#ifdef ARCH_ALIGN_INT64 + char b0, b1, b2, b3, b4, b5, b6, b7; +#endif + struct caml_ba_array *a = Caml_ba_array_val(va); + void *addr = &((unsigned char *)a->data)[off]; + uint64_t res; + +#ifdef ARCH_ALIGN_INT64 + if (!((size_t)addr) & 0x7) + res = *((uint64_t *)addr); + else { + b0 = ((unsigned char *)a->data)[off]; + b1 = ((unsigned char *)a->data)[off + 1]; + b2 = ((unsigned char *)a->data)[off + 2]; + b3 = ((unsigned char *)a->data)[off + 3]; + b4 = ((unsigned char *)a->data)[off + 4]; + b5 = ((unsigned char *)a->data)[off + 5]; + b6 = ((unsigned char *)a->data)[off + 6]; + b7 = ((unsigned char *)a->data)[off + 7]; +#ifdef ARCH_BIG_ENDIAN + res = (uint64_t)b0 << 56 | (uint64_t)b1 << 48 | (uint64_t)b2 << 40 | + (uint64_t)b3 << 32 | (uint64_t)b4 << 24 | (uint64_t)b5 << 16 | + (uint64_t)b6 << 8 | (uint64_t)b7; +#else + res = (uint64_t)b7 << 56 | (uint64_t)b6 << 48 | (uint64_t)b5 << 40 | + (uint64_t)b4 << 32 | (uint64_t)b3 << 24 | (uint64_t)b2 << 16 | + (uint64_t)b1 << 8 | (uint64_t)b0; +#endif + } +#else + res = *((uint64_t *)addr); +#endif + + return (res); +} + +CAMLprim value bstr_bytecode_get64u(value va, value off) { + CAMLparam2(va, off); + CAMLlocal1(res); + + uint64_t val = bstr_native_get64u(va, Unsigned_long_val(off)); + res = caml_copy_int64(val); + + CAMLreturn(res); +} diff --git a/unikernel/duniverse/bstr/lib/bstr.ml b/unikernel/duniverse/bstr/lib/bstr.ml new file mode 100644 index 00000000..a22be06d --- /dev/null +++ b/unikernel/duniverse/bstr/lib/bstr.ml @@ -0,0 +1,787 @@ +(* + * Copyright (c) 2024 Romain Calascibetta + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +external length : t -> int = "%caml_ba_dim_1" + +external ptr : t -> (nativeint[@unboxed]) + = "bstr_bytecode_ptr" "bstr_native_ptr" +[@@noalloc] + +let overlap a b = + let src_a = ptr a in + let src_b = ptr b in + let len_a = Nativeint.of_int (length a) in + let len_b = Nativeint.of_int (length b) in + let len = + let ( + ) = Nativeint.add in + let ( - ) = Nativeint.sub in + Nativeint.max 0n (Nativeint.min (src_a + len_a) (src_b + len_b)) + - Nativeint.max src_a src_b + in + let len = Nativeint.to_int len in + if src_a >= src_b && src_a < Nativeint.add src_b len_b then + let offset = Nativeint.(to_int (sub src_a src_b)) in + Some (len, 0, offset) + else if src_b >= src_a && src_b < Nativeint.add src_a len_a then + let offset = Nativeint.(to_int (sub src_b src_a)) in + Some (len, offset, 0) + else None + +external ( < ) : 'a -> 'a -> bool = "%lessthan" + +let ( < ) (x : int) y = x < y [@@inline] + +external ( <= ) : 'a -> 'a -> bool = "%lessequal" + +let ( <= ) (x : int) y = x <= y [@@inline] + +external ( > ) : 'a -> 'a -> bool = "%greaterthan" + +let ( > ) (x : int) y = x > y [@@inline] + +external ( >= ) : 'a -> 'a -> bool = "%greaterequal" + +let ( >= ) (x : int) y = x >= y [@@inline] + +module Bytes = struct + include Bytes + + external _unsafe_get_uint8 : bytes -> int -> int = "%bytes_unsafe_get" + external _unsafe_set_uint8 : bytes -> int -> int -> unit = "%bytes_unsafe_set" + external _unsafe_get_int32_ne : bytes -> int -> int32 = "%caml_bytes_get32u" + + external _unsafe_set_int32_ne : bytes -> int -> int32 -> unit + = "%caml_bytes_set32u" +end + +external swap16 : int -> int = "%bswap16" +external swap32 : int32 -> int32 = "%bswap_int32" +external swap64 : int64 -> int64 = "%bswap_int64" +external get_uint8 : t -> int -> int = "%caml_ba_ref_1" +external unsafe_get_uint8 : t -> int -> int = "%caml_ba_unsafe_ref_1" +external set_uint8 : t -> int -> int -> unit = "%caml_ba_set_1" +external get_uint16_ne : t -> int -> int = "%caml_bigstring_get16" +external set_int16_ne : t -> int -> int -> unit = "%caml_bigstring_set16" +external get_int32_ne : t -> int -> int32 = "%caml_bigstring_get32" +external set_int32_ne : t -> int -> int32 -> unit = "%caml_bigstring_set32" +external set_int64_ne : t -> int -> int64 -> unit = "%caml_bigstring_set64" +external unsafe_get_uint16_ne : t -> int -> int = "%caml_bigstring_get16u" + +external unsafe_set_uint16_ne : t -> int -> int -> unit + = "%caml_bigstring_set16u" + +external unsafe_get_int64_ne : t -> (int[@untagged]) -> (int64[@unboxed]) + = "bstr_bytecode_get64u" "bstr_native_get64u" +[@@noalloc] + +external _unsafe_set_int64_ne : t -> int -> int64 -> unit + = "%caml_bigstring_set64u" + +external unsafe_memcmp : + t + -> (int[@untagged]) + -> t + -> (int[@untagged]) + -> (int[@untagged]) + -> (int[@untagged]) = "bstr_bytecode_memcmp" "bstr_native_memcmp" +[@@noalloc] + +external unsafe_memcpy : + t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit + = "bstr_bytecode_memcpy" "bstr_native_memcpy" +[@@noalloc] + +external unsafe_memcpy_mmaped : + t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit + = "bstr_bytecode_memcpy" "bstr_native_memcpy_mmaped" +[@@noalloc] + +external unsafe_memmove : + t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit + = "bstr_bytecode_memmove" "bstr_native_memmove" +[@@noalloc] + +external unsafe_memmove_mmaped : + t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit + = "bstr_bytecode_memmove" "bstr_native_memmove_mmaped" +[@@noalloc] + +external unsafe_memchr : + t + -> (int[@untagged]) + -> (int[@untagged]) + -> (int[@untagged]) + -> (int[@untagged]) = "bstr_bytecode_memchr" "bstr_native_memchr" +[@@noalloc] + +external unsafe_memset : + t + -> (int[@untagged]) + -> (int[@untagged]) + -> (int[@untagged]) + -> (int[@untagged]) = "bstr_bytecode_memset" "bstr_native_memset" +[@@noalloc] + +let memcmp src ~src_off dst ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > Bigarray.Array1.dim src - len + || dst_off < 0 + || dst_off > Bigarray.Array1.dim dst - len + then invalid_arg "Bstr.memcmp"; + unsafe_memcmp src src_off dst dst_off len + +let memcpy src ~src_off dst ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > Bigarray.Array1.dim src - len + || dst_off < 0 + || dst_off > Bigarray.Array1.dim dst - len + then invalid_arg "Bstr.memcpy"; + unsafe_memcpy src src_off dst dst_off len + +let memcpy_mmaped src ~src_off dst ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > Bigarray.Array1.dim src - len + || dst_off < 0 + || dst_off > Bigarray.Array1.dim dst - len + then invalid_arg "Bstr.memcpy"; + unsafe_memcpy_mmaped src src_off dst dst_off len + +let memmove src ~src_off dst ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > Bigarray.Array1.dim src - len + || dst_off < 0 + || dst_off > Bigarray.Array1.dim dst - len + then invalid_arg "Bstr.memmove"; + unsafe_memmove src src_off dst dst_off len + +let memmove_mmaped src ~src_off dst ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > Bigarray.Array1.dim src - len + || dst_off < 0 + || dst_off > Bigarray.Array1.dim dst - len + then invalid_arg "Bstr.memmove"; + unsafe_memmove_mmaped src src_off dst dst_off len + +let memchr src ~off ~len value = + if len < 0 || off < 0 || off > Bigarray.Array1.dim src - len then + invalid_arg "Bstr.memchr"; + unsafe_memchr src off len (Char.code value) + +let memset src ~off ~len value = + if len < 0 || off < 0 || off > Bigarray.Array1.dim src - len then + invalid_arg "Bstr.memset"; + ignore (unsafe_memset src off len (Char.code value)) + +let empty = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 0 +let create len = Bigarray.Array1.create Bigarray.char Bigarray.c_layout len + +external get : t -> int -> char = "%caml_ba_ref_1" +external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1" +external set : t -> int -> char -> unit = "%caml_ba_set_1" +external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1" + +let fill bstr ?(off = 0) ?len chr = + let len = match len with Some len -> len | None -> length bstr - off in + memset bstr ~off ~len chr + +let make len chr = + let bstr = create len in + ignore (unsafe_memset bstr 0 len (Char.code chr)); + (* [Obj.magic] instead of [Char.code]? *) + bstr + +let init len fn = + let bstr = create len in + for i = 0 to len - 1 do + unsafe_set bstr i (fn i) + done; + bstr + +let copy src = + let len = length src in + let bstr = create len in + unsafe_memcpy src 0 bstr 0 len; + bstr + +let chop ?(rev = false) bstr = + if length bstr == 0 then None + else if not rev then Some (unsafe_get bstr 0) + else Some (unsafe_get bstr (length bstr - 1)) + +let get_int64_ne bstr idx = + if idx < 0 || idx > length bstr - 8 then invalid_arg "Bstr.get_int64_ne"; + unsafe_get_int64_ne bstr idx + +let get_int8 bstr i = + (get_uint8 bstr i lsl (Sys.int_size - 8)) asr (Sys.int_size - 8) + +let get_uint16_le bstr i = + if Sys.big_endian then swap16 (get_uint16_ne bstr i) else get_uint16_ne bstr i + +let get_uint16_be bstr i = + if not Sys.big_endian then swap16 (get_uint16_ne bstr i) + else get_uint16_ne bstr i + +let[@coverage off] _unsafe_get_uint16_le bstr i = + (* TODO(dinosaure): for unicode. *) + if Sys.big_endian then swap16 (unsafe_get_uint16_ne bstr i) + else unsafe_get_uint16_ne bstr i + +let[@coverage off] _unsafe_get_uint16_be bstr i = + (* TODO(dinosaure): for unicode. *) + if not Sys.big_endian then swap16 (unsafe_get_uint16_ne bstr i) + else unsafe_get_uint16_ne bstr i + +let get_int16_ne bstr i = + (get_uint16_ne bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) + +let get_int16_le bstr i = + (get_uint16_le bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) + +let get_int16_be bstr i = + (get_uint16_be bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) + +let get_int32_le bstr i = + if Sys.big_endian then swap32 (get_int32_ne bstr i) else get_int32_ne bstr i + +let get_int32_be bstr i = + if not Sys.big_endian then swap32 (get_int32_ne bstr i) + else get_int32_ne bstr i + +let get_int64_le bstr i = + if Sys.big_endian then swap64 (get_int64_ne bstr i) else get_int64_ne bstr i + +let get_int64_be bstr i = + if not Sys.big_endian then swap64 (get_int64_ne bstr i) + else get_int64_ne bstr i + +let[@coverage off] _unsafe_set_uint16_le bstr i x = + (* TODO(dinosaure): for unicode. *) + if Sys.big_endian then unsafe_set_uint16_ne bstr i (swap16 x) + else unsafe_set_uint16_ne bstr i x + +let[@coverage off] _unsafe_set_uint16_be bstr i x = + (* TODO(dinosaure): for unicode. *) + if Sys.big_endian then unsafe_set_uint16_ne bstr i x + else unsafe_set_uint16_ne bstr i (swap16 x) + +let set_int16_le bstr i x = + if Sys.big_endian then set_int16_ne bstr i (swap16 x) + else set_int16_ne bstr i x + +let set_int16_be bstr i x = + if not Sys.big_endian then set_int16_ne bstr i (swap16 x) + else set_int16_ne bstr i x + +let set_int32_le bstr i x = + if Sys.big_endian then set_int32_ne bstr i (swap32 x) + else set_int32_ne bstr i x + +let set_int32_be bstr i x = + if not Sys.big_endian then set_int32_ne bstr i (swap32 x) + else set_int32_ne bstr i x + +let set_int64_le bstr i x = + if Sys.big_endian then set_int64_ne bstr i (swap64 x) + else set_int64_ne bstr i x + +let set_int64_be bstr i x = + if not Sys.big_endian then set_int64_ne bstr i (swap64 x) + else set_int64_ne bstr i x + +let set_int8 = set_uint8 +let set_uint16_ne = set_int16_ne +let set_uint16_be = set_int16_be +let set_uint16_le = set_int16_le + +external unsafe_sub : t -> (int[@untagged]) -> (int[@untagged]) -> t + = "bstr_bytecode_unsafe_sub" "bstr_native_unsafe_sub" + +let sub bstr ~off ~len = + if off < 0 || len < 0 || off > length bstr - len then invalid_arg "Bstr.sub"; + unsafe_sub bstr off len + +let[@inline always] unsafe_blit src ~src_off dst ~dst_off ~len = + unsafe_memmove src src_off dst dst_off len + +let blit src ~src_off dst ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > length src - len + || dst_off < 0 + || dst_off > length dst - len + then invalid_arg "Bstr.blit"; + unsafe_blit src ~src_off dst ~dst_off ~len + +external unsafe_blit_to_bytes : + t + -> src_off:(int[@untagged]) + -> bytes + -> dst_off:(int[@untagged]) + -> len:(int[@untagged]) + -> unit + = "bstr_bytecode_unsafe_blit_to_bytes" "bstr_native_unsafe_blit_to_bytes" +[@@noalloc] + +external unsafe_blit_from_bytes : + bytes + -> src_off:(int[@untagged]) + -> t + -> dst_off:(int[@untagged]) + -> len:(int[@untagged]) + -> unit + = "bstr_bytecode_unsafe_blit_from_bytes" "bstr_native_unsafe_blit_from_bytes" +[@@noalloc] + +let blit_from_bytes src ~src_off bstr ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > Bytes.length src - len + || dst_off < 0 + || dst_off > length bstr - len + then invalid_arg "Bstr.blit_from_bytes"; + unsafe_blit_from_bytes src ~src_off bstr ~dst_off ~len + +let blit_from_string src ~src_off bstr ~dst_off ~len = + blit_from_bytes (Bytes.unsafe_of_string src) ~src_off bstr ~dst_off ~len + +let blit_to_bytes bstr ~src_off dst ~dst_off ~len = + if + len < 0 + || src_off < 0 + || src_off > length bstr - len + || dst_off < 0 + || dst_off > Bytes.length dst - len + then invalid_arg "Bstr.blit_to_bytes"; + unsafe_blit_to_bytes bstr ~src_off dst ~dst_off ~len + +let of_string str = + let len = String.length str in + let bstr = create len in + unsafe_blit_from_bytes + (Bytes.unsafe_of_string str) + ~src_off:0 bstr ~dst_off:0 ~len; + bstr + +let string ?(off = 0) ?len str = + let len = + match len with Some len -> len | None -> String.length str - off + in + if off < 0 || len < 0 || off > String.length str - len then + invalid_arg "Bstr.string"; + let bstr = create len in + unsafe_blit_from_bytes + (Bytes.unsafe_of_string str) + ~src_off:off bstr ~dst_off:0 ~len; + bstr + +let unsafe_sub_string bstr src_off len = + let buf = Bytes.create len in + unsafe_blit_to_bytes bstr ~src_off buf ~dst_off:0 ~len; + Bytes.unsafe_to_string buf + +let sub_string bstr ~off ~len = + if len < 0 || off < 0 || off > length bstr - len then + invalid_arg "Bstr.sub_string"; + unsafe_sub_string bstr off len + +let to_string bstr = + if length bstr <= 0 then "" else unsafe_sub_string bstr 0 (length bstr) + +let is_empty bstr = length bstr == 0 + +let is_prefix ~affix bstr = + let len_affix = String.length affix in + let len_bstr = length bstr in + if len_affix > len_bstr then false + else + let max_idx_affix = len_affix - 1 in + let rec go idx = + if idx > max_idx_affix then true + else if String.unsafe_get affix idx != unsafe_get bstr idx then false + else go (idx + 1) + in + go 0 + +let starts_with ~prefix bstr = + let len_prefix = length prefix in + let len_bstr = length bstr in + if len_prefix > len_bstr then false + else + let max_idx_prefix = len_prefix - 1 in + let rec go idx = + if idx > max_idx_prefix then true + else if unsafe_get prefix idx != unsafe_get bstr idx then false + else go (idx + 1) + in + go 0 + +let is_infix ~affix bstr = + let len_affix = String.length affix in + let len_bstr = length bstr in + if len_affix > len_bstr then false + else + let max_idx_affix = len_affix - 1 in + let max_idx_bstr = len_bstr - len_affix in + let rec go idx k = + if idx > max_idx_bstr then false + else if k > max_idx_affix then true + else if k > 0 then + if affix.[k] == bstr.{idx + k} then go idx (succ k) else go (succ idx) 0 + else if affix.[0] = bstr.{idx} then go idx 1 + else go (idx + 1) 0 + in + go 0 0 + +let is_suffix ~affix bstr = + let max_idx_affix = String.length affix - 1 in + let max_idx_bstr = length bstr - 1 in + if max_idx_affix > max_idx_bstr then false + else + let rec go idx = + if idx > max_idx_affix then true + else if affix.[max_idx_affix - idx] != bstr.{max_idx_bstr - idx} then + false + else go (idx + 1) + in + go 0 + +let ends_with ~suffix bstr = + let max_idx_suffix = length suffix - 1 in + let max_idx_bstr = length bstr - 1 in + if max_idx_suffix > max_idx_bstr then false + else + let rec go idx = + if idx > max_idx_suffix then true + else if + unsafe_get suffix (max_idx_suffix - idx) + != unsafe_get bstr (max_idx_bstr - idx) + then false + else go (idx + 1) + in + go 0 + +exception Break + +let for_all sat bstr = + try + for idx = 0 to length bstr - 1 do + if sat (unsafe_get bstr idx) == false then raise_notrace Break + done; + true + with Break -> false + +let contains bstr ?(off = 0) ?len chr = + let len = match len with Some len -> len | None -> length bstr - off in + memchr bstr ~off ~len chr != -1 + +let index bstr ?(off = 0) ?len chr = + let len = match len with Some len -> len | None -> length bstr - off in + match memchr bstr ~off ~len chr with -1 -> None | value -> Some value + +let compare a b = + let len_a = length a and len_b = length b in + if len_a < len_b then -1 + else if len_a > len_b then 1 + else unsafe_memcmp a 0 b 0 len_a + +let equal a b = compare a b == 0 + +let constant_equal ~len a b = + let len1 = len asr 1 in + let r = ref 0 in + for i = 0 to pred len1 do + r := + !r lor (unsafe_get_uint16_ne a (i * 2) lxor unsafe_get_uint16_ne b (i * 2)) + done; + for _ = 1 to len land 1 do + r := !r lor (unsafe_get_uint8 a (len - 1) lxor unsafe_get_uint8 b (len - 1)) + done; + !r == 0 + +let constant_equal a b = + let al = length a in + let bl = length b in + if al != bl then false else constant_equal ~len:al a b + +let with_range ?(first = 0) ?(len = max_int) bstr = + if len < 0 then invalid_arg "Bstr.with_range"; + if len == 0 then empty + else + let bstr_len = length bstr in + let max_idx = bstr_len - 1 in + let last = + match len with + | len when len = max_int -> max_idx + | len -> + let last = first + len - 1 in + if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first = 0 && last = max_idx then bstr + else unsafe_sub bstr first (last + 1 - first) + +let with_index_range ?(first = 0) ?last bstr = + let bstr_len = length bstr in + let max_idx = bstr_len - 1 in + let last = + match last with + | None -> max_idx + | Some last -> if last > max_idx then max_idx else last + in + let first = if first < 0 then 0 else first in + if first > max_idx || last < 0 || first > last then empty + else if first == 0 && last == max_idx then bstr + else unsafe_sub bstr first (last + 1 - first) + +let is_white chr = chr == ' ' || chr == '\t' + +let trim ?(drop = is_white) bstr = + let len = length bstr in + if len == 0 then bstr + else + let max_idx = len - 1 in + let rec left_pos idx = + if idx > max_idx then len + else if drop bstr.{idx} then left_pos (succ idx) + else idx + in + let rec right_pos idx = + if idx < 0 then 0 + else if drop bstr.{idx} then right_pos (pred idx) + else succ idx + in + let left = left_pos 0 in + if left = len then empty + else + let right = right_pos max_idx in + if left == 0 && right == len then bstr + else unsafe_sub bstr left (right - left) + +let fspan ?(min = 0) ?(max = max_int) ?(sat = Fun.const true) bstr = + if min < 0 then invalid_arg "Bstr.fspan"; + if max < 0 then invalid_arg "Bstr.fspan"; + if min > max || max == 0 then (empty, bstr) + else + let len = length bstr in + let max_idx = len - 1 in + let max_idx = + let k = max - 1 in + if k > max_idx then max_idx else k + in + let need_idx = min in + let rec go idx = + if idx <= max_idx && sat bstr.{idx} then go (succ idx) + else if idx < need_idx || idx == 0 then (empty, bstr) + else if idx == len then (bstr, empty) + else + let a = unsafe_sub bstr 0 idx in + let b = unsafe_sub bstr idx (len - idx) in + (a, b) + in + go 0 + +let rspan ?(min = 0) ?(max = max_int) ?(sat = Fun.const true) bstr = + if min < 0 then invalid_arg "Bstr.rspan"; + if max < 0 then invalid_arg "Bstr.rspan"; + if min > max || max == 0 then (bstr, empty) + else + let len = length bstr in + let max_idx = len - 1 in + let min_idx = + let k = len - max in + if k < 0 then 0 else k + in + let need_idx = len - min - 1 in + let rec go idx = + if idx >= min_idx && sat (unsafe_get bstr idx) then go (idx - 1) + else if idx > need_idx || idx == max_idx then (bstr, empty) + else if idx < 0 then (empty, bstr) + else + let cut = idx + 1 in + let a = unsafe_sub bstr 0 cut in + let b = unsafe_sub bstr cut (len - cut) in + (a, b) + in + go max_idx + +let span ?(rev = false) ?min ?max ?sat bstr = + match rev with + | true -> rspan ?min ?max ?sat bstr + | false -> fspan ?min ?max ?sat bstr + +let take ?(rev = false) ?min ?max ?sat bstr = + let a, b = span ~rev ?min ?max ?sat bstr in + if rev then b else a + +let drop ?(rev = false) ?min ?max ?sat bstr = + let a, b = span ~rev ?min ?max ?sat bstr in + if rev then a else b + +let fcut ~sep bstr = + let sep_len = String.length sep in + let len = length bstr in + if sep_len == 0 then invalid_arg "cut: empty separator"; + let max_sep_zidx = sep_len - 1 in + let max_s_zidx = len - sep_len in + let rec check_sep i k = + if k > max_sep_zidx then + let a = unsafe_sub bstr 0 i in + let b = unsafe_sub bstr (i + sep_len) (len - i - sep_len) in + Some (a, b) + else if unsafe_get bstr (i + k) == String.unsafe_get sep k then + check_sep i (k + 1) + else scan (i + 1) + and scan i = + if i > max_s_zidx then None + else if unsafe_get bstr i == String.unsafe_get sep 0 then check_sep i 1 + else scan (i + 1) + in + scan 0 + +let rcut ~sep bstr = + let sep_len = String.length sep in + let len = length bstr in + if sep_len == 0 then invalid_arg "cut: empty separator"; + let max_sep_zidx = sep_len - 1 in + let max_s_zidx = len - 1 in + let rec check_sep i k = + if k > max_sep_zidx then + let a = sub ~off:0 ~len:i bstr in + let b = sub ~off:(i + sep_len) ~len:(len - i - sep_len) bstr in + Some (a, b) + else if unsafe_get bstr (i + k) == String.unsafe_get sep k then + check_sep i (k + 1) + else rscan (i - 1) + and rscan i = + if i < 0 then None + else if unsafe_get bstr i == String.unsafe_get sep 0 then check_sep i 1 + else rscan (i - 1) + in + rscan (max_s_zidx - max_sep_zidx) + +let cut ?(rev = false) ~sep bstr = + match rev with true -> rcut ~sep bstr | false -> fcut ~sep bstr + +let shift bstr off = + if off > length bstr || off < 0 then invalid_arg "Bstr.shift"; + let len = length bstr - off in + unsafe_sub bstr off len + +let split_on_char sep bstr = + let lst = ref [] in + let max = ref (length bstr) in + for idx = length bstr - 1 downto 0 do + if unsafe_get bstr idx == sep then begin + lst := sub bstr ~off:(idx + 1) ~len:(!max - idx - 1) :: !lst; + max := idx + end + done; + sub bstr ~off:0 ~len:!max :: !lst + +let concat sep = function + | [] -> empty + | x :: r as lst -> + let sep_len = String.length sep in + let fn acc bstr = acc + sep_len + length bstr in + let res_len = List.fold_left fn (length x) r in + let res = create res_len in + let first = ref true in + let dst_off = ref 0 in + let fn bstr = + let len = length bstr in + if !first then begin + blit bstr ~src_off:0 res ~dst_off:!dst_off ~len; + first := false; + dst_off := !dst_off + len + end + else begin + blit_from_string sep ~src_off:0 res ~dst_off:!dst_off ~len:sep_len; + dst_off := !dst_off + sep_len; + blit bstr ~src_off:0 res ~dst_off:!dst_off ~len; + dst_off := !dst_off + len + end + in + List.iter fn lst; res + +let ( ++ ) a b = + let c = a + b in + match (a < 0, b < 0, c < 0) with + | true, true, false | false, false, true -> invalid_arg "Bstr.extend" + | _ -> c + +let extend bstr left right = + let len = length bstr ++ left ++ right in + let res = make len '\000' in + let src_off, dst_off = if left < 0 then (-left, 0) else (0, left) in + let copy = Int.min (length bstr - src_off) (len - dst_off) in + if copy > 0 then unsafe_blit bstr ~src_off res ~dst_off ~len:copy; + res + +let iter fn t = + for i = 0 to length t - 1 do + fn (unsafe_get t i) + done + +let to_seq bstr = + let rec go idx () = + if idx == length bstr then Seq.Nil + else + let chr = unsafe_get bstr idx in + Seq.Cons (chr, go (idx + 1)) + in + go 0 + +let to_seqi bstr = + let rec go idx () = + if idx == length bstr then Seq.Nil + else + let chr = unsafe_get bstr idx in + Seq.Cons ((idx, chr), go (idx + 1)) + in + go 0 + +let of_seq seq = + let n = ref 0 in + let buf = ref (make 0x7ff '\000') in + let resize () = + let new_len = min (2 * length !buf) Sys.max_string_length in + (* TODO(dinosaure): should we keep this limit? *) + if length !buf == new_len then failwith "Bstr.of_seq: cannot grow bigstring"; + let new_buf = make new_len '\000' in + Bigarray.Array1.blit !buf (sub new_buf ~off:0 ~len:(length !buf)); + buf := new_buf + in + let fn chr = + if !n == length !buf then resize (); + unsafe_set !buf !n chr; + incr n + in + Seq.iter fn seq; sub !buf ~off:0 ~len:!n diff --git a/unikernel/duniverse/bstr/lib/bstr.mli b/unikernel/duniverse/bstr/lib/bstr.mli new file mode 100644 index 00000000..aee69650 --- /dev/null +++ b/unikernel/duniverse/bstr/lib/bstr.mli @@ -0,0 +1,605 @@ +(** A small library for manipulating bigstrings. + + A bigstring is a mutable data structure that contains a fixed-length + sequence of bytes. Each byte can be indexed in constant time for reading and + writing. + + Given a byte sequence [bstr] of length [len], we can access each of the + [len] bytes of [bstr] via its index in the sequence. Indexes start at [0], + and will call an index valid in [bstr] if it falls within the range + [[0...len-1]] (inclusive). A position is the point between two bytes or at + the beginning or end of the sequence. We call a position valid in [bstr] if + it falls within the range [[0...len]] (inclusive). Note that byte at index + [n] is between positions [n] and [n+1]. + + Two parameters [off] and [len] are said to designate a valid range of [bstr] + if [len >= 0] and [off] and [off+len] are valid positions in [bstr]. + + Byte sequences can be modified in place, for instance via the {!val:set} and + {!val:blit} functions described below. + + {1:bigarray Bigstrings & Bigarrays.} + + Bigstring is a specialised version of {!module:Bigarray} that not only + handles bytes in the form of {!module:Char}acter but also imposes a "C-like" + (see {!val:Bigarray.c_layout}) view as described above and allows common + functions such as [memcpy(3)] or [memmove(3)] to be offered. + + For more details about Bigstrings and Bigarrays, we invite you to read the + {!module:Bigarray} documentation, which offers more general functions that + can be applied to Bigstrings. + + {1:bytes Bigstrings & Bytes.} + + Like bytes, a bigstring is a mutable data structure that contains a + fixed-length sequence of bytes. However, a bigstring has a few special + features that can make it more interesting to use than bytes. + + {2:location Bigstrings and the Garbage Collector.} + + A bigstring is not allocated in the same way as a standard OCaml value. In + fact, the byte sequence that the bigstring refers to is found in the + {i C heap} (rather than the OCaml heap). This means that the byte sequence + can come from a [malloc(3)] or a function requesting a particular memory + area from the system such as [Unix.map_file]. + + This particularity has an implication with the GC: the byte sequence is + {b not relocatable}. That is to say that during the cycle of the Garbage + Collector, this byte sequence does not move — in contrast, a [bytes] can be + moved by the GC (typically, from the minor heap to the major heap). + + Thus, bigstrings have advantages and disadvantages compared to bytes due to + this particularity: + - Creating a bigstring can be expensive. Whether it is with + [malloc(3)]/{!val:create} or [Unix.map_file], creating a bigstring will + always be more expensive than creating bytes with OCaml. For small byte + sequences, it is therefore preferable to use bytes. + - Since a bigstring cannot be moved, its position can be shared by [Thread]s + and/or [Domain]s without interacting with the GC. An example is being able + to perform a complex computation in parallel from the bytes of this + sequence without {i blocking} the Garbage Collector during this + computation. + + Depending on these characteristics, it may be more advantageous to use a + bigstring rather than [bytes]. This basically depends on your usage, and the + special features of bigstrings can unlock opportunities to outperform byte + calculations or analysis. + + {2:sub Bigstring and slice.} + + Another advantage of bigstrings is that copying is avoided when extracting + part of a larger bigstring. This is because the {!val:sub} function returns + a "proxy" of the original bigstring. + + In this respect, and to be very precise, {!val:sub} avoids copying but the + creation of this "proxy" {b remains} costly. In addition, this library is + distributed with a new {!module:Slice_bstr} module. The latter offers a new + type whose {!val:Slice_bstr.sub} function is much less costly than + {!val:sub}. + + {1 Bigstrings.} *) + +type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +(** {2 Constructors.} *) + +val empty : t +(** [empty] is an empty bigstring. *) + +val create : int -> t +(** [create len] returns a new byte sequence of length [len]. The sequence + {b is unitialized} and contains arbitrary bytes. *) + +val make : int -> char -> t +(** [make len chr] is {!type:t} of length [len] with each index holding the + character [chr]. *) + +val copy : t -> t +(** [copy t] returns a new byte sequence that contains the same bytes as the + argument. *) + +val init : int -> (int -> char) -> t +(** [init len fn] returns a fresh byte sequence of length [len], with character + [idx] initialized to the result of [fn idx] (in increasing index order). *) + +(** {2 Memory-safe Operations.} *) + +val of_string : string -> t +(** [of_string str] returns a new {!type:t} that contains the contents of the + given string [str]. *) + +val string : ?off:int -> ?len:int -> string -> t +(** [string ~off ~len str] is the sub-buffer of [str] that starts at position + [off] (defaults to [0]) and stops at position [off + len] (defaults to + [String.length str]). [str] is fully-replaced by a fresh allocated + {!type:t}. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [str]. *) + +val sub_string : t -> off:int -> len:int -> string +(** [sub_string bstr ~off ~len] returns a string of length [len] containing the + bytes of [bstr] starting at [off]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [t]. *) + +val to_string : t -> string +(** [to_string bstr] is equivalent to + [sub_string bstr ~off:0 ~len:(length bstr)]. *) + +val length : t -> int +(** [length bstr] is the number of bytes in [bstr]. *) + +val get : t -> int -> char +(** [get bstr i] is the byte of [bstr]' at index [i]. This is equivalent to the + [bstr.{i}] notation. + + @raise Invalid_argument if [i] is not an index of [bstr]. *) + +val set : t -> int -> char -> unit +(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with + [chr]. + + @raise Invalid_argument if [i] is not a valid index in [t]. *) + +val unsafe_get : t -> int -> char +(** [unsafe_get t idx] is like {!val:get} except no bounds checking is + performed. *) + +val unsafe_set : t -> int -> char -> unit +(** [unsafe_set t idx chr] is like {!val:set} except no bounds checking is + performed. *) + +val chop : ?rev:bool -> t -> char option +(** [chop bstr] returns the first element of [bstr] or the last element if + [rev = true]. If [bstr] is empty, it returns [None]. *) + +val concat : string -> t list -> t +(** [concat sep ts] concatenates the list of bigstrings [ts], inserting the + separator string [sep] between each. *) + +val extend : t -> int -> int -> t +(** [extend bstr left right] returns a new bigstring that contains the bytes of + [bstr], with [left] zero bytes prepended and [right] zero byte appended to + it. If [left] or [right] is negative, then bytes are removed (instead of + appended) from the corresponding side of [bstr]. + + @raise Invalid_argument if the result length is negative *) + +(** {2 Copy operation from one byte sequence to another.} *) + +val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +(** [blit src ~src_off dst ~dst_off ~len] copies [len] bytes from byte sequence + [src], starting at index [src_off], to byte sequence [dst], starting at + index [dst_off]. It works correctly even if [src] and [dst] are (physically) + the same byte sequence, and the source and destination intervals overlap. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val blit_from_string : + string -> src_off:int -> t -> dst_off:int -> len:int -> unit +(** Just like {!val:blit}, but with a string as source one. + + {b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy} + is used to do the copy. + + @raise Invalid_argument + if [src_pos] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val blit_from_bytes : + bytes -> src_off:int -> t -> dst_off:int -> len:int -> unit +(** Just like {!val:blit}, but with a bytes as source one. + + {b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy} + is used to do the copy. + + @raise Invalid_argument + if [src_pos] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val blit_to_bytes : t -> src_off:int -> bytes -> dst_off:int -> len:int -> unit +(** [blit_to_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from + [src], starting at index [src_off], to byte sequence [dst], starting at + index [dst_off]. + + {b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy} + is used to do the copy. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val memcpy : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +(** [memcpy src ~src_off dst ~dst_off ~len] copies [len] bytes from [src] to + [dst]. [src] {b must not} overlap [dst]. Use {!val:memmove} if [src] & [dst] + do overlap. + + You can check whether two buffers overlap using {!val:overlap}. If this + returns [None], the two values do not refer to a common memory area — and it + is safe to use memcpy. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val memcpy_mmaped : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +(** [memcpy_mmaped] is like {!val:memcpy} but [src] and [dst] can be a + {i mmaped} bigarray (from [Unix.map_file]). In this specific case, copying + from one to the other can take some time because it involves reading/writing + to disk. The operation can take longer than if the two bigarrays were + allocated via [malloc()]/{!val:Bigarray.Array1.create}. + + It may therefore be worthwhile to release the GC lock so that this specific + operation can be carried out in parallel (in a [Thread]) without + interruption by the GC. + + Note that the bigarrays do not necessarily need to be {i mmaped}. This + function also applies to "normal" bigarrays. It may also be worthwhile to + use this function if you know that you are copying a large area and would + like to do it in parallel (in a [Thread]). *) + +val memmove : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +(** [memmove src ~src_off dst ~dst_off ~len] copies [len] bytes from [src] to + [dst]. [src] and [dst] may overlap: copying takes place as though the bytes + in [src] are first copied into a temporary array that does not overlap [src] + or [dst], and the bytes are then copied from the temporary array to [dst]. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val memmove_mmaped : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +(** [memmove_mmaped] is like {!val:memmove} but [src] and [dst] can be a + {i mmaped} bigarray (from [Unix.map_file]). In this specific case, copying + from one to the other can take some time because it involves reading/writing + to disk. The operation can take longer than if the two bigarrays were + allocated via [malloc()]/{!val:Bigarray.Array1.create}. + + It may therefore be worthwhile to release the GC lock so that this specific + operation can be carried out in parallel (in a [Thread]) without + interruption by the GC. + + Note that the bigarrays do not necessarily need to be {i mmaped}. This + function also applies to "normal" bigarrays. It may also be worthwhile to + use this function if you know that you are copying a large area and would + like to do it in parallel (in a [Thread]). *) + +val memcmp : t -> src_off:int -> t -> dst_off:int -> len:int -> int +(** [memcmp s1 ~src_off s2 ~dst_off ~len] compares the first [len] bytes of the + memory areas [s1] (starting at [src_off]) and [s2] (starting at [dst_off]). + + [memcmp] returns [0] is [s1] and [s2] don't match. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val memset : t -> off:int -> len:int -> char -> unit +(** [memset t ~off ~len chr] fills [len] bytes (starting at [off]) into [t] with + the constant byte [chr]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [t]. *) + +val fill : t -> ?off:int -> ?len:int -> char -> unit +(** [fill t off len chr] modifies [t] in place, replacing [len] characters with + [chr], starting at [off]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [t]. *) + +(** {2 Decode integers from a byte sequence.} *) + +val get_int8 : t -> int -> int +(** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index + [i]. *) + +val get_uint8 : t -> int -> int +(** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte index + [i]. *) + +val get_uint16_ne : t -> int -> int +(** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_uint16_le : t -> int -> int +(** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_uint16_be : t -> int -> int +(** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_int16_ne : t -> int -> int +(** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int16_le : t -> int -> int +(** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int16_be : t -> int -> int +(** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer starting + at byte index [i]. *) + +val get_int32_ne : t -> int -> int32 +(** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at + byte index [i]. *) + +val get_int32_le : t -> int -> int32 +(** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at + byte index [i]. *) + +val get_int32_be : t -> int -> int32 +(** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at byte + index [i]. *) + +val get_int64_ne : t -> int -> int64 +(** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at + byte index [i]. *) + +val get_int64_le : t -> int -> int64 +(** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at + byte index [i]. *) + +val get_int64_be : t -> int -> int64 +(** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at byte + index [i]. *) + +val set_int8 : t -> int -> int -> unit +(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i] + to [v]. *) + +val set_uint8 : t -> int -> int -> unit +(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index + [i] to [v]. *) + +val set_uint16_ne : t -> int -> int -> unit +(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer + starting at byte index [i] to [v]. *) + +val set_uint16_le : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer + starting at byte index [i] to [v]. *) + +val set_uint16_be : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting + at byte index [i] to [v]. *) + +val set_int16_ne : t -> int -> int -> unit +(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer + starting at byte index [i] to [v]. *) + +val set_int16_le : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer + starting at byte index [i] to [v]. *) + +val set_int16_be : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting + at byte index [i] to [v]. *) + +val set_int32_ne : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at + byte index [i] to [v]. *) + +val set_int32_le : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at + byte index [i] to [v]. *) + +val set_int32_be : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte + index [i] to [v]. *) + +val set_int64_ne : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at + byte index [i] to [v]. *) + +val set_int64_le : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at + byte index [i] to [v]. *) + +val set_int64_be : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte + index [i] to [v]. *) + +val sub : t -> off:int -> len:int -> t +(** [sub bstr ~off ~len] does not allocate a bigstring, but instead returns a + new view into [bstr] starting at [off], and with length [len]. + + {b Note} [sub] does not allocate a new buffer, but instead shares the memory + area of [bstr] with the newly-returned bigstring. This means that the + changes ([set{,_*}] functions) made to the returned bigstring will also be + reflected in the [bstr] bigstring given. + + {b Note} [sub] is more expensive than a [Slice.sub] (about 8 times slower). + If you want to focus on performance while avoiding copying, it's best to use + a [Slice]. *) + +val shift : t -> int -> t +(** [shift bstr n] is [sub bstr n (length bstr - n)] (see {!val:sub} for more + details). *) + +val overlap : t -> t -> (int * int * int) option +(** [overlap x y] returns the size (in bytes) of what is physically common + between [x] and [y], as well as the position of [y] in [x] and the position + of [x] in [y]. *) + +(** {2 Predicates and comparaisons.} *) + +val is_empty : t -> bool +(** [is_empty bstr] is [length bstr = 0]. *) + +val is_prefix : affix:string -> t -> bool +(** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all + indices [idx] of [affix]. *) + +val starts_with : prefix:t -> t -> bool +(** [starts_with ~prefix t] is like {!val:is_prefix} but the prefix is a + {!type:t} (instead of a [string]). *) + +val is_infix : affix:string -> t -> bool +(** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr] + such that for all indices [i] of [affix] we have [affix.[i] = bstr.{j + i}]. +*) + +val is_suffix : affix:string -> t -> bool +(** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}] for + all indices [idx] of [affix] with [n = String.length affix - 1] and + [m = length bstr - 1]. *) + +val ends_with : suffix:t -> t -> bool +(** [ends_with ~suffix t] is like {!val:is_suffix} but the suffix is a {!type:t} + (instead of a [string]. *) + +val for_all : (char -> bool) -> t -> bool +(** [for_all p bstr] is [true] iff for all indices [idx] of [bstr], + [p bstr.{idx} = true]. *) + +val contains : t -> ?off:int -> ?len:int -> char -> bool +(** [contains bstr ?off ?len chr] is [true] if and only if [chr] appears in + [len] byte(s)'s [bstr] after position [off] (defaults to [0]). *) + +val equal : t -> t -> bool +(** [equal a b] is [a = b]. *) + +val constant_equal : t -> t -> bool +(** [constant_equal] gives the same result as {!val:equal} but the execution + time of the function, whether or not the two values are equivalent (as long + as they have the {b same} size) is the same. + + Indeed, the {!val:equal} function ends as soon as a difference exists. This + function continues even if a difference exists. This function is useful when + comparing passwords — and avoiding an {i timing attack}. *) + +val compare : t -> t -> int +(** [compare bstr0 bstr1] sorts [bstr0] and [bstr1] in lexicographical order. *) + +val index : t -> ?off:int -> ?len:int -> char -> int option +(** [index bstr ?off ?len chr] is the index of the first occurrence of [chr] in + [len] byte(s)'s [bstr] after position [off] (defaults to [0]). If [chr] does + not occur in given range of [bstr], we return [None]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [bstr]. *) + +val memchr : t -> off:int -> len:int -> char -> int +(** [memchr t ~off ~len chr] scans [len] bytes (starting at [off]) of [t] for + the first instance of [chr]. It returns the position in [t] where the first + occurrence of [chr] is found. Otherwise, it returns [-1]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [t]. *) + +(** {2 Extracting substrings.} *) + +val with_range : ?first:int -> ?len:int -> t -> t +(** [with_range ~first ~len bstr] are the consecutive bytes of [bstr] whose + indices exist in the range \[[first];[first + len - 1]\]. + + [first] defaults to [0] and [len] to [max_int]. Note that [first] can be any + integer and [len] any positive integer. *) + +val with_index_range : ?first:int -> ?last:int -> t -> t +(** [with_index_range ~first ~last bstr] are the consecutive bytes of [bstr] + whose indices exists in the range \[[first];[last]\]. + + [first] defaults to [0] and [last] to [length bstr - 1]. + + Note that both [first] and [last] can be any integer. If [first > last] the + interval is empty and the empty bigstring is returned. *) + +val trim : ?drop:(char -> bool) -> t -> t +(** [trim ~drop bstr] is [bstr] with prefix and suffix bytes satisfying [drop] + in [bstr] removed. [drop] defaults to [fun chr -> chr = ' ']. *) + +val span : + ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t +(** [span ~rev ~min ~max ~sat bstr] is [(l, r)] where: + - if [rev] is [false] (default), [l] is at least [min] and at most [max] + consecutive [sat] satisfying initial bytes of [bstr] or {!empty} if there + are no such bytes. [r] are the remaining bytes of [bstr]. + - if [rev] is [true], [r] is at least [min] and at most [max] consecutive + [sat] satisfying final bytes of [bstr] or {!empty} if there are no such + bytes. [l] are the remaining bytes of [bstr]. + + If [max] is unspecified the span is unlimited. If [min] is unspecified it + defaults to [0]. If [min > max] the condition can't be satisfied and the + left or right span, depending on [rev], is always empty. [sat] defaults to + [Fun.const true]. + + @raise Invalid_argument if [max] or [min] is negative. *) + +val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t +(** [take ~rev ~min ~max ~sat bstr] is the matching span of {!span} without the + remaining one. In other words: + + {[ + (if rev then snd else fst) (span ~rev ~min ~max ~sat bstr) + ]} *) + +val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t +(** [drop ~rev ~min ~max ~sat bstr] is the remaining span of {!span} without the + matching span. In other words: + + {[ + (if rev then fst else snd) (span ~rev ~min ~max ~sat bstr) + ]} *) + +val cut : ?rev:bool -> sep:string -> t -> (t * t) option +(** [cut ~sep bstr] is either the pair [Some (l, r)] of the two (possibly empty) + sub-buffers of [bstr] that are delimited by the first match of the non empty + separator string [sep] or [None] if [sep] can't be matched in [bstr]. + Matching starts from the beginning of [bstr] ([rev] is [false], default) or + the end ([rev] is [true]). + + The invariant [l ^ sep ^ r = s] holds. + + For instance, the {i ABNF} expression: + + {v + field_name := *PRINT + field_value := *ASCII + field := field_name ":" field_value + v} + + can be translated to: + + {[ + match Bstr.cut ~sep:":" value with + | Some (field_name, field_value) -> ... + | None -> invalid_arg "Invalid field" + ]} + + @raise Invalid_argument if [sep] is the empty buffer. *) + +val split_on_char : char -> t -> t list +(** [split_on_char sep t] is the list of all (possibly empty) + {!val:sub}-bigstrings of [t] that are delimited by the character [sep]. If + [t] is empty, the result is the singleton list [[empty]]. + + The function's result is specified by the following invariant: + - the list is not empty. + - concatenating its elements using [sep] as a separator returns a bigstring + equal to the input. + - no bigstring in the result contains the [sep] character. *) + +(** {2 Traversing strings.} *) + +val iter : (char -> unit) -> t -> unit +(** [iter fn t] applies function [fn] in turn to all the characters of [t]. It + is equivalent to [fn t.{0}; fn t.{1}; ...; fn t.{length t - 1}; ()]. *) + +val to_seq : t -> char Seq.t +(** Iterate on the bigstring, in increasing index order. Modifications of the + bigstring during iteration will be reflected in the sequence. *) + +val to_seqi : t -> (int * char) Seq.t +(** Iterate on the bigstring, in increasing order, yielding indices along chars. +*) + +val of_seq : char Seq.t -> t +(** Create a bigstring from the generator. *) diff --git a/unikernel/duniverse/bstr/lib/bstr.mllib b/unikernel/duniverse/bstr/lib/bstr.mllib new file mode 100644 index 00000000..b39eee21 --- /dev/null +++ b/unikernel/duniverse/bstr/lib/bstr.mllib @@ -0,0 +1,2 @@ +lib/bstr.o +lib/bstr.cmx diff --git a/unikernel/duniverse/bstr/lib/bytes_labels.ml b/unikernel/duniverse/bstr/lib/bytes_labels.ml new file mode 100644 index 00000000..67e33614 --- /dev/null +++ b/unikernel/duniverse/bstr/lib/bytes_labels.ml @@ -0,0 +1,40 @@ +(* + * Copyright (c) 2024 Romain Calascibetta + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +include Bytes + +let[@inline always] blit src ~src_off dst ~dst_off ~len = + Bytes.blit src src_off dst dst_off len + +let[@inline always] fill t ~off ~len chr = Bytes.fill t off len chr + +let[@inline always] blit_to_bytes src ~src_off dst ~dst_off ~len = + Bytes.blit src src_off dst dst_off len + +let string ?(off = 0) ?len str = + let len = + match len with Some len -> len | None -> String.length str - off + in + if len < 0 || off < 0 || off > String.length str - len then + invalid_arg "Bytes.string"; + let buf = String.sub str off len in + Bytes.unsafe_of_string buf + +let overlap a b = if a == b then Some (Bytes.length a, 0, 0) else None +let sub t ~off ~len = Bytes.sub t off len + +let blit_from_bytes src ~src_off dst ~dst_off ~len = + Bytes.blit src src_off dst dst_off len diff --git a/unikernel/duniverse/bstr/lib/dune b/unikernel/duniverse/bstr/lib/dune new file mode 100644 index 00000000..7bc8926a --- /dev/null +++ b/unikernel/duniverse/bstr/lib/dune @@ -0,0 +1,54 @@ +(library + (name bstr) + (modules bstr) + (public_name bstr) + (foreign_stubs + (language c) + (names bstr) + (flags + (:standard -Wcast-align))) + (instrumentation + (backend bisect_ppx)) + (wrapped false)) + +(library + (name slice) + (modules slice) + (public_name slice) + (instrumentation + (backend bisect_ppx)) + (wrapped false)) + +(library + (name slice_bytes) + (modules bytes_labels slice_bytes) + (public_name slice.bytes) + (libraries slice) + (wrapped false)) + +(library + (name slice_bstr) + (modules slice_bstr) + (public_name slice.bstr) + (libraries bstr slice) + (wrapped false)) + +(rule + (target slice_bytes.ml) + (action + (run ./../bin/generate.exe -m S -n Bytes_labels -i %{dep:slice.ml.in} -o + %{target}))) + +(rule + (target slice_bstr.ml) + (action + (run ./../bin/generate.exe -m S -n Bstr -i %{dep:slice.ml.in} -o %{target}))) + +(library + (name bin) + (modules bin) + (public_name bin) + (libraries bstr slice) + (instrumentation + (backend bisect_ppx)) + (wrapped false)) diff --git a/unikernel/duniverse/bstr/lib/slice.ml b/unikernel/duniverse/bstr/lib/slice.ml new file mode 100644 index 00000000..f4ea88dd --- /dev/null +++ b/unikernel/duniverse/bstr/lib/slice.ml @@ -0,0 +1,183 @@ +(* + * Copyright (c) 2024 Romain Calascibetta + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +type 'a t = { buf: 'a; off: int; len: int } + +let unsafe_make ~off ~len buf = { off; len; buf } +let unsafe_sub { off; buf; _ } off' len' = { off= off + off'; len= len'; buf } + +let pp ppf { off; len; _ } = + Format.fprintf ppf "@[{ off=@ %d;@ len=@ %d;@ }@]" off len + +let length { len; _ } = len +let is_empty { len; _ } = len == 0 + +let sub t ~off ~len = + let off' = t.off + off in + let top = off' + len in + let old = t.off + t.len in + if off' >= t.off && top <= old && off' <= top then { t with off= off'; len } + else invalid_arg "Slice.sub" + +let shift t off = + if off > length t || off < 0 then invalid_arg "Slice.shift"; + let len = length t - off in + unsafe_sub t off len + +module type R = sig + type t + + val make : int -> char -> t + val init : int -> (int -> char) -> t + val empty : t + val length : t -> int + val is_empty : t -> bool + val chop : ?rev:bool -> t -> char option + val hash : t -> int + val equal : t -> t -> bool + val compare : t -> t -> int + val get : t -> int -> char + val unsafe_get : t -> int -> char + + val get_int8 : t -> int -> int + (** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index + [i]. *) + + val get_uint8 : t -> int -> int + (** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte + index [i]. *) + + val get_uint16_ne : t -> int -> int + (** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer + starting at byte index [i]. *) + + val get_uint16_le : t -> int -> int + (** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer + starting at byte index [i]. *) + + val get_uint16_be : t -> int -> int + (** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer + starting at byte index [i]. *) + + val get_int16_ne : t -> int -> int + (** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer + starting at byte index [i]. *) + + val get_int16_le : t -> int -> int + (** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer + starting at byte index [i]. *) + + val get_int16_be : t -> int -> int + (** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer + starting at byte index [i]. *) + + val get_int32_ne : t -> int -> int32 + (** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at + byte index [i]. *) + + val get_int32_le : t -> int -> int32 + (** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at + byte index [i]. *) + + val get_int32_be : t -> int -> int32 + (** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at + byte index [i]. *) + + val get_int64_ne : t -> int -> int64 + (** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at + byte index [i]. *) + + val get_int64_le : t -> int -> int64 + (** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at + byte index [i]. *) + + val get_int64_be : t -> int -> int64 + (** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at + byte index [i]. *) + + val filter : (char -> bool) -> t -> t + val filter_map : (char -> char option) -> t -> t + val map : (char -> char) -> t -> t + val mapi : (int -> char -> char) -> t -> t + val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a + val fold_right : (char -> 'a -> 'a) -> t -> 'a -> 'a + val iter : (char -> unit) -> t -> unit + val iteri : (int -> char -> unit) -> t -> unit + val hex : t -> string + val overlap : t -> t -> (int * int * int) option + val append : t -> t -> t + val starts_with : prefix:string -> t -> bool + + val is_prefix : affix:string -> t -> bool + (** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all + indices [idx] of [affix]. *) + + val ends_with : suffix:string -> t -> bool + + val is_suffix : affix:string -> t -> bool + (** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}] + for all indices [idx] of [affix] with [n = String.length affix - 1] and + [m = length bstr - 1]. *) + + val is_infix : affix:string -> t -> bool + (** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr] + such that for all indices [i] of [affix] we have + [affix.[i] = bstr.{j + i}]. *) + + val for_all : (char -> bool) -> t -> bool + val exists : (char -> bool) -> t -> bool + val trim : ?drop:(char -> bool) -> t -> t + + val span : + ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t + + val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t + val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t + val shift : t -> int -> t + val sub : t -> off:int -> len:int -> t + val split_on_char : char -> t -> t list + val cut : ?rev:bool -> sep:string -> t -> (t * t) option + val cuts : ?rev:bool -> ?empty:bool -> sep:string -> t -> t list + val index : t -> ?rev:bool -> ?from:int -> char -> int + val contains : t -> ?rev:bool -> ?from:int -> char -> bool + val concat : t -> t list -> t + val copy : t -> t + val sub_string : t -> off:int -> len:int -> string + val to_string : t -> string +end + +module type W = sig + type t + + val set : t -> int -> char -> unit + val unsafe_set : t -> int -> char -> unit + val set_int8 : t -> int -> int -> unit + val set_uint8 : t -> int -> int -> unit + val set_uint16_ne : t -> int -> int -> unit + val set_uint16_le : t -> int -> int -> unit + val set_uint16_be : t -> int -> int -> unit + val set_int16_ne : t -> int -> int -> unit + val set_int16_le : t -> int -> int -> unit + val set_int16_be : t -> int -> int -> unit + val set_int32_ne : t -> int -> int32 -> unit + val set_int32_le : t -> int -> int32 -> unit + val set_int32_be : t -> int -> int32 -> unit + val set_int64_ne : t -> int -> int64 -> unit + val set_int64_le : t -> int -> int64 -> unit + val set_int64_be : t -> int -> int64 -> unit + val fill : t -> off:int -> len:int -> char -> unit + val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +end diff --git a/unikernel/duniverse/bstr/lib/slice.ml.in b/unikernel/duniverse/bstr/lib/slice.ml.in new file mode 100644 index 00000000..fb6c6ece --- /dev/null +++ b/unikernel/duniverse/bstr/lib/slice.ml.in @@ -0,0 +1,148 @@ +(* + * Copyright (c) 2024 Romain Calascibetta + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +type t = S.t Slice.t + +external ( < ) : 'a -> 'a -> bool = "%lessthan" +external ( <= ) : 'a -> 'a -> bool = "%lessequal" +external ( >= ) : 'a -> 'a -> bool = "%greaterequal" +external ( > ) : 'a -> 'a -> bool = "%greaterthan" + +let ( > ) (x : int) y = x > y [@@inline] +let ( < ) (x : int) y = x < y [@@inline] +let ( <= ) (x : int) y = x <= y [@@inline] +let ( >= ) (x : int) y = x >= y [@@inline] +let min (a : int) b = if a <= b then a else b [@@inline] +let max (a : int) b = if a >= b then a else b [@@inline] + +open Slice + +let make ?(off= 0) ?len buf = + let len = match len with + | Some len -> len + | None -> S.length buf - off in + if len < 0 + || off < 0 + || off > S.length buf - len + then invalid_arg "Slice.make"; + Slice.unsafe_make ~off ~len buf + +let empty = unsafe_make ~off:0 ~len:0 S.empty +let length { len; _ } = len +let get { off; buf; _ } idx = S.get buf (off + idx) +let get_int8 { off; buf; _ } idx = S.get_int8 buf (off + idx) +let get_uint8 { off; buf; _ } idx = S.get_uint8 buf (off + idx) +let get_uint16_ne { off; buf; _ } idx = S.get_uint16_ne buf (off + idx) +let get_uint16_le { off; buf; _ } idx = S.get_uint16_le buf (off + idx) +let get_uint16_be { off; buf; _ } idx = S.get_uint16_be buf (off + idx) +let get_int16_ne { off; buf; _ } idx = S.get_int16_ne buf (off + idx) +let get_int16_le { off; buf; _ } idx = S.get_int16_ne buf (off + idx) +let get_int16_be { off; buf; _ } idx = S.get_int16_be buf (off + idx) +let get_int32_ne { off; buf; _ } idx = S.get_int32_ne buf (off + idx) +let get_int32_le { off; buf; _ } idx = S.get_int32_le buf (off + idx) +let get_int32_be { off; buf; _ } idx = S.get_int32_be buf (off + idx) +let get_int64_ne { off; buf; _ } idx = S.get_int64_ne buf (off + idx) +let get_int64_le { off; buf; _ } idx = S.get_int64_le buf (off + idx) +let get_int64_be { off; buf; _ } idx = S.get_int64_be buf (off + idx) +let set { off; buf; _ } idx v = S.set buf (off + idx) v +let set_int8 { off; buf; _ } idx v = S.set_int8 buf (off + idx) v +let set_uint8 { off; buf; _ } idx v = S.set_uint8 buf (off + idx) v +let set_uint16_ne { off; buf; _ } idx v = S.set_uint16_ne buf (off + idx) v +let set_uint16_le { off; buf; _ } idx v = S.set_uint16_le buf (off + idx) v +let set_uint16_be { off; buf; _ } idx v = S.set_uint16_be buf (off + idx) v +let set_int16_ne { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v +let set_int16_le { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v +let set_int16_be { off; buf; _ } idx v = S.set_int16_be buf (off + idx) v +let set_int32_ne { off; buf; _ } idx v = S.set_int32_ne buf (off + idx) v +let set_int32_le { off; buf; _ } idx v = S.set_int32_le buf (off + idx) v +let set_int32_be { off; buf; _ } idx v = S.set_int32_be buf (off + idx) v +let set_int64_ne { off; buf; _ } idx v = S.set_int64_ne buf (off + idx) v +let set_int64_le { off; buf; _ } idx v = S.set_int64_le buf (off + idx) v +let set_int64_be { off; buf; _ } idx v = S.set_int64_be buf (off + idx) v + +let blit a b = + let len = Int.min a.len b.len in + S.blit a.buf ~src_off:a.off b.buf ~dst_off:b.off ~len:len + +let blit_from_bytes src ~src_off { Slice.buf; off; _ } ?dst_off len = + let dst_off = match dst_off with + | Some dst_off -> dst_off + off + | None -> off in + if len < 0 + || dst_off < 0 + || dst_off > S.length buf - len + then invalid_arg "Slice.blit_from_bytes"; + S.blit_from_bytes src ~src_off buf ~dst_off ~len + +let blit_to_bytes { Slice.buf; off; _ } ?src_off dst ~dst_off ~len = + let src_off = match src_off with + | Some src_off -> src_off + off + | None -> off in + if len < 0 + || src_off < 0 + || src_off > S.length buf - len + then invalid_arg "Slice.blit_to_bytes"; + S.blit_to_bytes buf ~src_off dst ~dst_off ~len + +let fill { off; len; buf; } ?off:(off'= 0) ?len:len' chr = + let len' = match len' with + | Some len' -> len' + | None -> len - off' in + S.fill buf ~off:(off + off') ~len:len' chr + +let sub t ~off ~len = Slice.sub t ~off ~len +let shift t n = Slice.shift t n +let is_empty t = Slice.is_empty t + +let sub_string { Slice.buf; off; _ } ~off:off' ~len = + let dst = Bytes.create len in + S.blit_to_bytes buf ~src_off:(off + off') dst ~dst_off:0 ~len; + Bytes.unsafe_to_string dst + +let to_string { Slice.buf; off= src_off; len } = + let dst = Bytes.create len in + S.blit_to_bytes buf ~src_off dst ~dst_off:0 ~len; + Bytes.unsafe_to_string dst + +let of_string str = + let off = 0 and len = String.length str in + Slice.unsafe_make ~off ~len (S.of_string str) + +let string ?(off= 0) ?len str = + let len = match len with + | None -> String.length str - off + | Some len -> len in + Slice.unsafe_make ~off:0 ~len (S.string ~off ~len str) + +let overlap ({ buf= buf0; _ } as a) ({ buf= buf1; _ } as b) = + match S.overlap buf0 buf1 with + | None -> None + | Some (_, 0, 0) -> + let len = + max 0 (min (a.off + a.len) (b.off + b.len)) - max a.off b.off in + if a.off >= b.off && a.off < b.off + b.len + then + let offset = a.off - b.off in Some (len, 0, offset) + else if b.off >= a.off && b.off < a.off + a.len + then + let offset = b.off + a.off in Some (len, offset, 0) + else None + | Some _ -> + let a = S.sub buf0 ~off:a.off ~len:a.len + and b = S.sub buf1 ~off:b.off ~len:b.len in + S.overlap a b + (* TODO(dinosaure): this case appears only for bigstrings, but we could + optimize it and avoid [S.sub]. *) diff --git a/unikernel/duniverse/bstr/lib/slice.mli b/unikernel/duniverse/bstr/lib/slice.mli new file mode 100644 index 00000000..d85f845f --- /dev/null +++ b/unikernel/duniverse/bstr/lib/slice.mli @@ -0,0 +1,175 @@ +type 'buf t = private { buf: 'buf; off: int; len: int } + +val unsafe_make : off:int -> len:int -> 'buf -> 'buf t +val pp : Format.formatter -> 'a t -> unit +val length : 'a t -> int +val sub : 'a t -> off:int -> len:int -> 'a t +val shift : 'a t -> int -> 'a t +val is_empty : 'a t -> bool + +module type R = sig + type t + + val make : int -> char -> t + (** [make len chr] is {!type:t} of length [len] with each index holding the + character [chr]. *) + + val init : int -> (int -> char) -> t + (** [init len fn] is {!type:t} of length [len] with index [idx] holding the + character [fn idx] (called in increasing index order). *) + + val empty : t + (** An empty {!type:t}. *) + + val length : t -> int + (** [length t] is the length (number of bytes/characters) of [t]. *) + + val is_empty : t -> bool + (** [is_empty t] is [length t = 0]. *) + + val chop : ?rev:bool -> t -> char option + (** [chop t] is [Some (get t idx)] with [idx = 0] if [rev = false] (default) + or [idx = length t - 1] if [rev = true]. [None] is returned if [t] is + empty. *) + + val hash : t -> int + val equal : t -> t -> bool + val compare : t -> t -> int + val get : t -> int -> char + val unsafe_get : t -> int -> char + + val get_int8 : t -> int -> int + (** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index + [i]. *) + + val get_uint8 : t -> int -> int + (** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte + index [i]. *) + + val get_uint16_ne : t -> int -> int + (** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer + starting at byte index [i]. *) + + val get_uint16_le : t -> int -> int + (** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer + starting at byte index [i]. *) + + val get_uint16_be : t -> int -> int + (** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer + starting at byte index [i]. *) + + val get_int16_ne : t -> int -> int + (** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer + starting at byte index [i]. *) + + val get_int16_le : t -> int -> int + (** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer + starting at byte index [i]. *) + + val get_int16_be : t -> int -> int + (** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer + starting at byte index [i]. *) + + val get_int32_ne : t -> int -> int32 + (** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at + byte index [i]. *) + + val get_int32_le : t -> int -> int32 + (** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at + byte index [i]. *) + + val get_int32_be : t -> int -> int32 + (** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at + byte index [i]. *) + + val get_int64_ne : t -> int -> int64 + (** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at + byte index [i]. *) + + val get_int64_le : t -> int -> int64 + (** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at + byte index [i]. *) + + val get_int64_be : t -> int -> int64 + (** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at + byte index [i]. *) + + val filter : (char -> bool) -> t -> t + (** [filter sat t] is a new {!type:t} made of the bytes of [t] that satisfy + [sat], in the same order. *) + + val filter_map : (char -> char option) -> t -> t + (** [filter_map fn t] is a new {!type:t} made of the bytes of [t] as mapped by + [fn], in the same order. *) + + val map : (char -> char) -> t -> t + val mapi : (int -> char -> char) -> t -> t + val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a + val fold_right : (char -> 'a -> 'a) -> t -> 'a -> 'a + val iter : (char -> unit) -> t -> unit + val iteri : (int -> char -> unit) -> t -> unit + val hex : t -> string + val overlap : t -> t -> (int * int * int) option + val append : t -> t -> t + val starts_with : prefix:string -> t -> bool + + val is_prefix : affix:string -> t -> bool + (** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all + indices [idx] of [affix]. *) + + val ends_with : suffix:string -> t -> bool + + val is_suffix : affix:string -> t -> bool + (** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}] + for all indices [idx] of [affix] with [n = String.length affix - 1] and + [m = length bstr - 1]. *) + + val is_infix : affix:string -> t -> bool + (** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr] + such that for all indices [i] of [affix] we have + [affix.[i] = bstr.{j + i}]. *) + + val for_all : (char -> bool) -> t -> bool + val exists : (char -> bool) -> t -> bool + val trim : ?drop:(char -> bool) -> t -> t + + val span : + ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t + + val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t + val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t + val shift : t -> int -> t + val sub : t -> off:int -> len:int -> t + val split_on_char : char -> t -> t list + val cut : ?rev:bool -> sep:string -> t -> (t * t) option + val cuts : ?rev:bool -> ?empty:bool -> sep:string -> t -> t list + val index : t -> ?rev:bool -> ?from:int -> char -> int + val contains : t -> ?rev:bool -> ?from:int -> char -> bool + val concat : t -> t list -> t + val copy : t -> t + val sub_string : t -> off:int -> len:int -> string + val to_string : t -> string +end + +module type W = sig + type t + + val set : t -> int -> char -> unit + val unsafe_set : t -> int -> char -> unit + val set_int8 : t -> int -> int -> unit + val set_uint8 : t -> int -> int -> unit + val set_uint16_ne : t -> int -> int -> unit + val set_uint16_le : t -> int -> int -> unit + val set_uint16_be : t -> int -> int -> unit + val set_int16_ne : t -> int -> int -> unit + val set_int16_le : t -> int -> int -> unit + val set_int16_be : t -> int -> int -> unit + val set_int32_ne : t -> int -> int32 -> unit + val set_int32_le : t -> int -> int32 -> unit + val set_int32_be : t -> int -> int32 -> unit + val set_int64_ne : t -> int -> int64 -> unit + val set_int64_le : t -> int -> int64 -> unit + val set_int64_be : t -> int -> int64 -> unit + val fill : t -> off:int -> len:int -> char -> unit + val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit +end diff --git a/unikernel/duniverse/bstr/lib/slice_bstr.mli b/unikernel/duniverse/bstr/lib/slice_bstr.mli new file mode 100644 index 00000000..4d368ec1 --- /dev/null +++ b/unikernel/duniverse/bstr/lib/slice_bstr.mli @@ -0,0 +1,202 @@ +type t = Bstr.t Slice.t + +val make : ?off:int -> ?len:int -> Bstr.t -> t + +val empty : t +(** [empty] is an empty slice. *) + +val length : t -> int +(** [length slice] is the number of bytes in [slice]. *) + +val get : t -> int -> char +(** [get slice i] is the byte of [slice]' at index [i]. + + @raise Invalid_argument if [i] is not an index of [slice]. *) + +val get_int8 : t -> int -> int +(** [get_int8 slice i] is [slice]'s signed 8-bit integer starting at byte index + [i]. *) + +val get_uint8 : t -> int -> int +(** [get_uint8 slice i] is [slice]'s unsigned 8-bit integer starting at byte + index [i]. *) + +val get_uint16_ne : t -> int -> int +(** [get_int16_ne slice i] is [slice]'s native-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_uint16_le : t -> int -> int +(** [get_int16_le slice i] is [slice]'s little-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_uint16_be : t -> int -> int +(** [get_int16_be slice i] is [slice]'s big-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_int16_ne : t -> int -> int +(** [get_int16_ne slice i] is [slice]'s native-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int16_le : t -> int -> int +(** [get_int16_le slice i] is [slice]'s little-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int16_be : t -> int -> int +(** [get_int16_be slice i] is [slice]'s big-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int32_ne : t -> int -> int32 +(** [get_int32_ne slice i] is [slice]'s native-endian 32-bit integer starting at + byte index [i]. *) + +val get_int32_le : t -> int -> int32 +(** [get_int32_le slice i] is [slice]'s little-endian 32-bit integer starting at + byte index [i]. *) + +val get_int32_be : t -> int -> int32 +(** [get_int32_be slice i] is [slice]'s big-endian 32-bit integer starting at + byte index [i]. *) + +val get_int64_ne : t -> int -> int64 +(** [get_int64_ne slice i] is [slice]'s native-endian 64-bit integer starting at + byte index [i]. *) + +val get_int64_le : t -> int -> int64 +(** [get_int64_le slice i] is [slice]'s little-endian 64-bit integer starting at + byte index [i]. *) + +val get_int64_be : t -> int -> int64 +(** [get_int64_be slice i] is [slice]'s big-endian 64-bit integer starting at + byte index [i]. *) + +val set : t -> int -> char -> unit +(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with + [chr]. + + @raise Invalid_argument if [i] is not a valid index in [t]. *) + +val set_int8 : t -> int -> int -> unit +(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i] + to [v]. *) + +val set_uint8 : t -> int -> int -> unit +(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index + [i] to [v]. *) + +val set_uint16_ne : t -> int -> int -> unit +(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer + starting at byte index [i] to [v]. *) + +val set_uint16_le : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer + starting at byte index [i] to [v]. *) + +val set_uint16_be : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting + at byte index [i] to [v]. *) + +val set_int16_ne : t -> int -> int -> unit +(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer + starting at byte index [i] to [v]. *) + +val set_int16_le : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer + starting at byte index [i] to [v]. *) + +val set_int16_be : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting + at byte index [i] to [v]. *) + +val set_int32_ne : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at + byte index [i] to [v]. *) + +val set_int32_le : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at + byte index [i] to [v]. *) + +val set_int32_be : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte + index [i] to [v]. *) + +val set_int64_ne : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at + byte index [i] to [v]. *) + +val set_int64_le : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at + byte index [i] to [v]. *) + +val set_int64_be : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte + index [i] to [v]. *) + +val blit : t -> t -> unit +(** [blit src dst] copies all bytes of [src] into [dst]. *) + +val blit_from_bytes : bytes -> src_off:int -> t -> ?dst_off:int -> int -> unit +(** [blit_from_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from + byte sequence [src], starting at index [src_off], to slice [dst], starting + at index [dst_off]. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val blit_to_bytes : t -> ?src_off:int -> bytes -> dst_off:int -> len:int -> unit +(** Just like {!val:blit_from_bytes}, but the source is a slice and the + destination is a [byte]s sequence. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val fill : t -> ?off:int -> ?len:int -> char -> unit +(** [fill t off len chr] modifies [t] in place, replacing [len] characters with + [chr], starting at [off]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [t]. *) + +val sub : t -> off:int -> len:int -> t +(** [sub slice ~off ~len] does not allocate a new [bigstring], but instead + returns a new view into [t.buf] starting at [off], and with length [len]. + + {b Note} that this does not allocate a new buffer, but instead shares the + buffer of [t.buf] with the newly-returned slice. *) + +val shift : t -> int -> t +(** [shift slice n] is [sub slice n (length slice - n)] (see {!val:sub} for more + details). *) + +val sub_string : t -> off:int -> len:int -> string +(** [sub_string slice ~off ~len] returns a string of length [len] containing the + bytes of [slice] starting at [off]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [t]. *) + +val to_string : t -> string +(** [to_string slice] is equivalent to + [sub_string slice ~off:0 ~len:(length slice)]. *) + +val is_empty : t -> bool +(** [is_empty bstr] is [length bstr = 0]. *) + +val of_string : string -> t +(** [of_string str] returns a new {!type:t} that contains the contents of the + given string [str]. *) + +val string : ?off:int -> ?len:int -> string -> t +(** [string ~off ~len str] is the sub-buffer of [str] that starts at position + [off] (defaults to [0]) and stops at position [off + len] (defaults to + [String.length str]). [str] is fully-replaced by a fresh allocated + {!type:t}. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [str]. *) + +val overlap : t -> t -> (int * int * int) option +(** [overlap x y] returns the size (in bytes) of what is physically common + between [x] and [y], as well as the position of [y] in [x] and the position + of [x] in [y]. *) diff --git a/unikernel/duniverse/bstr/lib/slice_bytes.mli b/unikernel/duniverse/bstr/lib/slice_bytes.mli new file mode 100644 index 00000000..6d686a32 --- /dev/null +++ b/unikernel/duniverse/bstr/lib/slice_bytes.mli @@ -0,0 +1,196 @@ +type t = bytes Slice.t + +val make : ?off:int -> ?len:int -> bytes -> t + +val empty : t +(** [empty] is an empty slice. *) + +val length : t -> int +(** [length slice] is the number of bytes in [slice]. *) + +val get : t -> int -> char +(** [get slice i] is the byte of [slice]' at index [i]. + + @raise Invalid_argument if [i] is not an index of [slice]. *) + +val get_int8 : t -> int -> int +(** [get_int8 slice i] is [slice]'s signed 8-bit integer starting at byte index + [i]. *) + +val get_uint8 : t -> int -> int +(** [get_uint8 slice i] is [slice]'s unsigned 8-bit integer starting at byte + index [i]. *) + +val get_uint16_ne : t -> int -> int +(** [get_int16_ne slice i] is [slice]'s native-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_uint16_le : t -> int -> int +(** [get_int16_le slice i] is [slice]'s little-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_uint16_be : t -> int -> int +(** [get_int16_be slice i] is [slice]'s big-endian unsigned 16-bit integer + starting at byte index [i]. *) + +val get_int16_ne : t -> int -> int +(** [get_int16_ne slice i] is [slice]'s native-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int16_le : t -> int -> int +(** [get_int16_le slice i] is [slice]'s little-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int16_be : t -> int -> int +(** [get_int16_be slice i] is [slice]'s big-endian signed 16-bit integer + starting at byte index [i]. *) + +val get_int32_ne : t -> int -> int32 +(** [get_int32_ne slice i] is [slice]'s native-endian 32-bit integer starting at + byte index [i]. *) + +val get_int32_le : t -> int -> int32 +(** [get_int32_le slice i] is [slice]'s little-endian 32-bit integer starting at + byte index [i]. *) + +val get_int32_be : t -> int -> int32 +(** [get_int32_be slice i] is [slice]'s big-endian 32-bit integer starting at + byte index [i]. *) + +val get_int64_ne : t -> int -> int64 +(** [get_int64_ne slice i] is [slice]'s native-endian 64-bit integer starting at + byte index [i]. *) + +val get_int64_le : t -> int -> int64 +(** [get_int64_le slice i] is [slice]'s little-endian 64-bit integer starting at + byte index [i]. *) + +val get_int64_be : t -> int -> int64 +(** [get_int64_be slice i] is [slice]'s big-endian 64-bit integer starting at + byte index [i]. *) + +val set : t -> int -> char -> unit +(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with + [chr]. + + @raise Invalid_argument if [i] is not a valid index in [t]. *) + +val set_int8 : t -> int -> int -> unit +(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i] + to [v]. *) + +val set_uint8 : t -> int -> int -> unit +(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index + [i] to [v]. *) + +val set_uint16_ne : t -> int -> int -> unit +(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer + starting at byte index [i] to [v]. *) + +val set_uint16_le : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer + starting at byte index [i] to [v]. *) + +val set_uint16_be : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting + at byte index [i] to [v]. *) + +val set_int16_ne : t -> int -> int -> unit +(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer + starting at byte index [i] to [v]. *) + +val set_int16_le : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer + starting at byte index [i] to [v]. *) + +val set_int16_be : t -> int -> int -> unit +(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting + at byte index [i] to [v]. *) + +val set_int32_ne : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at + byte index [i] to [v]. *) + +val set_int32_le : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at + byte index [i] to [v]. *) + +val set_int32_be : t -> int -> int32 -> unit +(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte + index [i] to [v]. *) + +val set_int64_ne : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at + byte index [i] to [v]. *) + +val set_int64_le : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at + byte index [i] to [v]. *) + +val set_int64_be : t -> int -> int64 -> unit +(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte + index [i] to [v]. *) + +val blit : t -> t -> unit +(** [blit src dst] copies all bytes of [src] into [dst]. *) + +val blit_from_bytes : bytes -> src_off:int -> t -> ?dst_off:int -> int -> unit +(** [blit_from_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from + byte sequence [src], starting at index [src_off], to slice [dst], starting + at index [dst_off]. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val blit_to_bytes : t -> ?src_off:int -> bytes -> dst_off:int -> len:int -> unit +(** Just like {!val:blit_from_bytes}, but the source is a slice and the + destination is a [byte]s sequence. + + @raise Invalid_argument + if [src_off] and [len] do not designate a valid range of [src], or if + [dst_off] and [len] do not designate a valid range of [dst]. *) + +val fill : t -> ?off:int -> ?len:int -> char -> unit +(** [fill t off len chr] modifies [t] in place, replacing [len] characters with + [chr], starting at [off]. + + @raise Invalid_argument + if [off] and [len] do not designate a valid range of [t]. *) + +val sub : t -> off:int -> len:int -> t +(** [sub slice ~off ~len] does not allocate a new [bytes], but instead returns a + new view into [t.buf] starting at [off], and with length [len]. + + {b Note} that this does not allocate a new buffer, but instead shares the + buffer of [t.buf] with the newly-returned slice. *) + +val shift : t -> int -> t +(** [shift slice n] is [sub slice n (length slice - n)] (see {!val:sub} for more + details). *) + +val sub_string : t -> off:int -> len:int -> string +(** [sub_string slice ~off ~len] returns a string of length [len] containing the + bytes of [slice] starting at [off]. *) + +val to_string : t -> string +(** [to_string slice] is equivalent to + [sub_string slice ~off:0 ~len:(length slice)]. *) + +val is_empty : t -> bool +(** [is_empty bstr] is [length bstr = 0]. *) + +val of_string : string -> t +(** [of_string str] returns a new {!type:t} that contains the contents of the + given string [str]. *) + +val string : ?off:int -> ?len:int -> string -> t +(** [string ~off ~len str] is the sub-buffer of [str] that starts at position + [off] (defaults to [0]) and stops at position [off + len] (defaults to + [String.length str]). [str] is fully-replaced by a fresh allocated + {!type:t}. *) + +val overlap : t -> t -> (int * int * int) option +(** [overlap x y] returns the size (in bytes) of what is physically common + between [x] and [y], as well as the position of [y] in [x] and the position + of [x] in [y]. *) diff --git a/unikernel/duniverse/bstr/slice.opam b/unikernel/duniverse/bstr/slice.opam new file mode 100644 index 00000000..fc52cb5b --- /dev/null +++ b/unikernel/duniverse/bstr/slice.opam @@ -0,0 +1,21 @@ +version: "0.0.2" +opam-version: "2.0" +name: "slice" +maintainer: [ "Romain Calascibetta " ] +authors: [ "Romain Calascibetta " ] +homepage: "https://git.robur.coop/robur/bstr" +bug-reports: "https://git.robur.coop/robur/bstr" +dev-repo: "git+https://github.com/robur-coop/bstr" +doc: "https://robur-coop.github.io/bstr/" +license: "MIT" +synopsis: "A Slice type for bigstrings and bytes" + +build: [ "dune" "build" "-p" name "-j" jobs ] +run-test: [ "dune" "runtest" "-p" name "-j" jobs ] + +depends: [ + "ocaml" {>= "4.14.0"} + "dune" {>= "3.5.0"} + "bstr" {= version} +] +x-maintenance-intent: [ "(latest)" ] \ No newline at end of file diff --git a/unikernel/duniverse/bstr/test/b.ml b/unikernel/duniverse/bstr/test/b.ml new file mode 100644 index 00000000..6755f129 --- /dev/null +++ b/unikernel/duniverse/bstr/test/b.ml @@ -0,0 +1,53 @@ +open Test + +let test01 = + let descr = {text|cstring|text} in + Test.test ~title:"cstring" ~descr @@ fun () -> + let buf = Bstr.create 0x7ff in + let test str = + let pos = ref 0 in + let len = String.length str in + Bin.encode_bstr Bin.cstring str buf pos; + check (!pos == len + 1); + check (Bstr.get_uint8 buf len == 0); + check (Bstr.sub_string buf ~off:0 ~len = str); + pos := 0; + let str' = Bin.decode_bstr Bin.cstring buf pos in + check (!pos == len + 1); + check (str = str') + in + test "foo"; test "bar" + +let test02 = + let descr = {text|varint|text} in + Test.test ~title:"varint" ~descr @@ fun () -> + let buf = Bstr.create 0x7ff in + let test value expected = + let pos = ref 0 in + Bin.encode_bstr Bin.varint value buf pos; + let len = String.length expected in + check (!pos == len); + check (Bstr.sub_string buf ~off:0 ~len = expected); + pos := 0; + let value' = Bin.decode_bstr Bin.varint buf pos in + check (!pos == len); + check (value == value') + in + test 0 "\000"; + test 127 "\127"; + test 128 "\128\001"; + test 16384 "\128\128\001"; + test 88080384 "\128\128\128\042" + +let ( / ) = Filename.concat + +let () = + let tests = [ test01; test02 ] in + let ({ Test.directory } as runner) = Test.runner (Sys.getcwd () / "_tests") in + let run idx test = + Format.printf "test%03d: %!" (succ idx); + Test.run runner test; + Format.printf "ok\n%!" + in + Format.printf "Run tests into %s\n%!" directory; + List.iteri run tests diff --git a/unikernel/duniverse/bstr/test/dune b/unikernel/duniverse/bstr/test/dune new file mode 100644 index 00000000..6071c237 --- /dev/null +++ b/unikernel/duniverse/bstr/test/dune @@ -0,0 +1,22 @@ +(library + (name test) + (modules test) + (libraries unix)) + +(test + (name t) + (modules t) + (package bstr) + (libraries bstr test)) + +(test + (name b) + (modules b) + (package bin) + (libraries bin bstr test)) + +(test + (name s) + (modules s) + (package slice) + (libraries slice.bstr test)) diff --git a/unikernel/duniverse/bstr/test/s.ml b/unikernel/duniverse/bstr/test/s.ml new file mode 100644 index 00000000..ba820115 --- /dev/null +++ b/unikernel/duniverse/bstr/test/s.ml @@ -0,0 +1,83 @@ +open Test +module S = Slice_bstr + +let test01 = + let descr = {text|String.Sub misc. base functions|text} in + Test.test ~title:"misc" ~descr @@ fun () -> + let eq sbstr str = String.equal (S.to_string sbstr) str |> check in + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + eq S.empty ""; + eq (S.of_string "abc") "abc"; + eq (S.string "abc" ~off:0 ~len:1) "a"; + eq (S.string "abc" ~off:1 ~len:1) "b"; + eq (S.string "abc" ~off:1 ~len:2) "bc"; + eq (S.string "abc" ~off:2 ~len:1) "c"; + eq (S.string "abc" ~off:2 ~len:0) ""; + let v = S.string "abc" ~off:2 ~len:1 in + lazy (S.get v 3) |> err; + lazy (S.get v 2) |> err; + lazy (S.get v 1) |> err; + check (S.get v 0 == 'c') + +let test02 = + let descr = {text|overlap|text} in + Test.test ~title:"overlap" ~descr @@ fun () -> + let test value expected = + match (value, expected) with + | None, None -> check true + | Some (len, a, b), Some (len', x, y) -> + Format.eprintf "len:%d, a:%d, b:%d\n%!" len a b; + check (a == x && b == y && len == len') + | _ -> check false + in + let t = S.string (String.make 10 '\000') in + let ab = S.sub t ~off:5 ~len:5 in + let cd = S.sub t ~off:0 ~len:5 in + test (S.overlap ab cd) None; + let ab = S.sub t ~off:0 ~len:5 in + let cd = S.sub t ~off:5 ~len:5 in + test (S.overlap ab cd) None; + let ab = S.sub t ~off:0 ~len:6 in + let cd = S.sub t ~off:5 ~len:5 in + test (S.overlap ab cd) (Some (1, 5, 0)); + let ab = S.sub t ~off:5 ~len:5 in + let cd = S.sub t ~off:0 ~len:6 in + test (S.overlap ab cd) (Some (1, 0, 5)); + let ab = S.sub t ~off:0 ~len:8 in + let cd = S.sub t ~off:2 ~len:8 in + test (S.overlap ab cd) (Some (6, 2, 0)); + let ab = S.sub t ~off:0 ~len:10 in + let cd = S.sub t ~off:2 ~len:8 in + test (S.overlap ab cd) (Some (8, 2, 0)); + let ab = S.sub t ~off:0 ~len:10 in + let cd = S.sub t ~off:2 ~len:6 in + test (S.overlap ab cd) (Some (6, 2, 0)); + let ab = S.sub t ~off:0 ~len:8 in + let cd = S.sub t ~off:0 ~len:10 in + test (S.overlap ab cd) (Some (8, 0, 0)); + let ab = S.sub t ~off:2 ~len:6 in + let cd = S.sub t ~off:0 ~len:10 in + test (S.overlap ab cd) (Some (6, 0, 2)); + let ab = S.sub t ~off:2 ~len:8 in + let cd = S.sub t ~off:0 ~len:10 in + test (S.overlap ab cd) (Some (8, 0, 2)); + let ab = S.sub t ~off:2 ~len:8 in + let cd = S.sub t ~off:0 ~len:8 in + test (S.overlap ab cd) (Some (6, 0, 2)) + +let ( / ) = Filename.concat + +let () = + let tests = [ test01; test02 ] in + let ({ Test.directory } as runner) = Test.runner (Sys.getcwd () / "_tests") in + let run idx test = + Format.printf "test%03d: %!" (succ idx); + Test.run runner test; + Format.printf "ok\n%!" + in + Format.printf "Run tests into %s\n%!" directory; + List.iteri run tests diff --git a/unikernel/duniverse/bstr/test/t.ml b/unikernel/duniverse/bstr/test/t.ml new file mode 100644 index 00000000..dc106bd6 --- /dev/null +++ b/unikernel/duniverse/bstr/test/t.ml @@ -0,0 +1,1499 @@ +open Test + +let test01 = + let descr = {text|"empty bstr"|text} in + Test.test ~title:"empty bstr" ~descr @@ fun () -> + let x = Bstr.create 0 in + check (0 = Bstr.length x); + let y = Bstr.to_string x in + check ("" = y) + +let test02 = + let descr = {text|negative length|text} in + Test.test ~title:"negative bstr" ~descr @@ fun () -> + try + let _ = Bstr.create (-1) in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test03 = + let descr = {text|positive shift|text} in + Test.test ~title:"positive shift" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.shift x 1 in + check (0 = Bstr.length y) + +let test04 = + let descr = {text|negative shift|text} in + Test.test ~title:"negative shift" ~descr @@ fun () -> + let x = Bstr.create 2 in + let y = Bstr.sub x ~off:1 ~len:1 in + begin + try + let _ = Bstr.shift x (-1) in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + end; + begin + try + let _ = Bstr.shift y (-1) in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + end + +let test05 = + let descr = {text|bad positive shift|text} in + Test.test ~title:"bad positive shift" ~descr @@ fun () -> + let x = Bstr.create 10 in + try + let _ = Bstr.shift x 11 in + check false + with Invalid_argument _ -> check true + +let test06 = + let descr = {text|sub|text} in + Test.test ~title:"sub" ~descr @@ fun () -> + let x = Bstr.create 100 in + let y = Bstr.sub x ~off:10 ~len:80 in + begin + match Bstr.overlap x y with + | Some (len, x_off, _) -> + check (len = 80); + check (x_off = 10) + | None -> check false + end; + let z = Bstr.sub y ~off:20 ~len:60 in + begin + match Bstr.overlap x z with + | Some (len, x_off, _) -> + check (len = 60); + check (x_off = 30) + | None -> check false + end + +let test07 = + let descr = {text|negative sub|text} in + Test.test ~title:"negative sub" ~descr @@ fun () -> + let x = Bstr.create 2 in + let y = Bstr.sub ~off:1 ~len:1 x in + begin + try + let _ = Bstr.sub x ~off:(-1) ~len:0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + end; + begin + try + let _ = Bstr.sub y ~off:(-1) ~len:0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + end + +let test08 = + let descr = {text|sub len too big|text} in + Test.test ~title:"sub len too big" ~descr @@ fun () -> + let x = Bstr.create 0 in + try + let _ = Bstr.sub x ~off:0 ~len:1 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test09 = + let descr = {text|sub len too small|text} in + Test.test ~title:"sub len too small" ~descr @@ fun () -> + let x = Bstr.create 0 in + try + let _ = Bstr.sub x ~off:0 ~len:(-1) in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test10 = + let descr = {text|sub offset too big|text} in + Test.test ~title:"sub offset too big" ~descr @@ fun () -> + let x = Bstr.create 10 in + begin + try + let _ = Bstr.sub x ~off:11 ~len:0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + end; + let y = Bstr.sub x ~off:1 ~len:9 in + begin + try + let _ = Bstr.sub y ~off:10 ~len:0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + end + +let test11 = + let descr = {text|blit offset too big|text} in + Test.test ~title:"blit offset too big" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.create 1 in + try + Bstr.blit x ~src_off:2 y ~dst_off:1 ~len:1; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test12 = + let descr = {text|blit offset too small|text} in + Test.test ~title:"blit offset too small" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.create 1 in + try + Bstr.blit x ~src_off:(-1) y ~dst_off:1 ~len:1; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test13 = + let descr = {text|blit dst offset too big|text} in + Test.test ~title:"blit dst offset too big" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.create 1 in + try + Bstr.blit x ~src_off:1 y ~dst_off:2 ~len:1; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test14 = + let descr = {text|blit dst offset too small|text} in + Test.test ~title:"blit dst offset too small" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.create 1 in + try + Bstr.blit x ~src_off:1 y ~dst_off:(-1) ~len:1; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test15 = + let descr = {text|blit dst offset negative|text} in + Test.test ~title:"blit dst offset negative" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.create 1 in + try + Bstr.blit x ~src_off:0 y ~dst_off:(-1) ~len:1; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test16 = + let descr = {text|blit len too big|text} in + Test.test ~title:"blit len too big" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.create 2 in + try + Bstr.blit x ~src_off:0 y ~dst_off:0 ~len:2; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test17 = + let descr = {text|blit len too big (2)|text} in + Test.test ~title:"blit len too big (2)" ~descr @@ fun () -> + let x = Bstr.create 2 in + let y = Bstr.create 1 in + try + Bstr.blit x ~src_off:0 y ~dst_off:0 ~len:2; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test18 = + let descr = {text|blit len too small|text} in + Test.test ~title:"blit len too small" ~descr @@ fun () -> + let x = Bstr.create 1 in + let y = Bstr.create 1 in + try + Bstr.blit x ~src_off:0 y ~dst_off:0 ~len:(-1); + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test19 = + let descr = {text|view bounds too small|text} in + Test.test ~title:"view bounds too small" ~descr @@ fun () -> + let x = Bstr.create 4 in + let y = Bstr.create 4 in + let z = Bstr.sub y ~off:0 ~len:2 in + try + Bstr.blit x ~src_off:0 z ~dst_off:0 ~len:3; + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test20 = + let descr = {text|view bounds too small get_uint8|text} in + Test.test ~title:"view bounds too small get_uint8" ~descr @@ fun () -> + let x = Bstr.create 2 in + let y = Bstr.sub x ~off:0 ~len:1 in + try + let _ = Bstr.get_uint8 y 1 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test21 = + let descr = {text|view bounds too small get_char|text} in + Test.test ~title:"view bounds too small get_char" ~descr @@ fun () -> + let x = Bstr.create 2 in + let y = Bstr.sub x ~off:0 ~len:1 in + try + let _ = Bstr.get y 1 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test22 = + let descr = {text|view bounds too small get_uint16_be|text} in + Test.test ~title:"view bounds too small get_uint16_be" ~descr @@ fun () -> + let x = Bstr.create 4 in + let y = Bstr.sub x ~off:0 ~len:1 in + try + let _ = Bstr.get_uint16_be y 0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test23 = + let descr = {text|view bounds too small get_int32_be|text} in + Test.test ~title:"view bounds too small get_int32_be" ~descr @@ fun () -> + let x = Bstr.create 8 in + let y = Bstr.sub x ~off:2 ~len:5 in + try + let _ = Bstr.get_int32_be y 2 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test24 = + let descr = {text|view bounds too small get_int64_be|text} in + Test.test ~title:"view bounds too small get_int64_be" ~descr @@ fun () -> + let x = Bstr.create 9 in + let y = Bstr.sub x ~off:1 ~len:5 in + try + let _ = Bstr.get_int64_be y 0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test25 = + let descr = {text|view bounds too small get_uint16_le|text} in + Test.test ~title:"view bounds too small get_uint16_le" ~descr @@ fun () -> + let x = Bstr.create 4 in + let y = Bstr.sub x ~off:0 ~len:1 in + try + let _ = Bstr.get_uint16_le y 0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test26 = + let descr = {text|view bounds too small get_int32_le|text} in + Test.test ~title:"view bounds too small get_int32_le" ~descr @@ fun () -> + let x = Bstr.create 8 in + let y = Bstr.sub x ~off:2 ~len:5 in + try + let _ = Bstr.get_int32_le y 2 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test27 = + let descr = {text|view bounds too small get_int64_le|text} in + Test.test ~title:"view bounds too small get_int64_le" ~descr @@ fun () -> + let x = Bstr.create 9 in + let y = Bstr.sub x ~off:1 ~len:5 in + try + let _ = Bstr.get_int64_le y 0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test28 = + let descr = {text|view bounds too small get_uint16_ne|text} in + Test.test ~title:"view bounds too small get_uint16_ne" ~descr @@ fun () -> + let x = Bstr.create 4 in + let y = Bstr.sub x ~off:0 ~len:1 in + try + let _ = Bstr.get_uint16_ne y 0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test29 = + let descr = {text|view bounds too small get_int32_ne|text} in + Test.test ~title:"view bounds too small get_int32_ne" ~descr @@ fun () -> + let x = Bstr.create 8 in + let y = Bstr.sub x ~off:2 ~len:5 in + try + let _ = Bstr.get_int32_ne y 2 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let test30 = + let descr = {text|view bounds too small get_int64_ne|text} in + Test.test ~title:"view bounds too small get_int64_ne" ~descr @@ fun () -> + let x = Bstr.create 9 in + let y = Bstr.sub x ~off:1 ~len:5 in + try + let _ = Bstr.get_int64_ne y 0 in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + +let ( test31 + , test32 + , test33 + , test34 + , test35 + , test36 + , test37 + , test38 + , test39 + , test40 + , test41 ) = + let test get zero = + let descr = "subview containment get" + and title = "subview containment get" in + Test.test ~title ~descr @@ fun () -> + let x = Bstr.create 32 in + let y = Bstr.sub x ~off:8 ~len:16 in + for i = 0 to Bstr.length x - 1 do + Bstr.set_uint8 x i 0xff + done; + for i = 0 to Bstr.length y - 1 do + Bstr.set_uint8 y i 0x00 + done; + for i = -8 to 7 do + try + let v = get y i in + if v <> zero then check false; + check (i >= 0) + with + | Invalid_argument _ -> check (i < 0) + | _exn -> check false + done + in + ( test Bstr.get '\000' + , test Bstr.get_uint8 0 + , test Bstr.get_uint16_be 0 + , test Bstr.get_uint16_le 0 + , test Bstr.get_uint16_ne 0 + , test Bstr.get_int32_be 0l + , test Bstr.get_int32_le 0l + , test Bstr.get_int32_ne 0l + , test Bstr.get_int64_be 0L + , test Bstr.get_int64_le 0L + , test Bstr.get_int64_ne 0L ) + +let ( test42 + , test43 + , test44 + , test45 + , test46 + , test47 + , test48 + , test49 + , test50 + , test51 + , test52 ) = + let test set ff = + let descr = "subview containment set" + and title = "subview containment set" in + Test.test ~title ~descr @@ fun () -> + let x = Bstr.create 32 in + let y = Bstr.sub x ~off:8 ~len:16 in + for i = 0 to Bstr.length x - 1 do + Bstr.set_uint8 x i 0x00 + done; + for i = -8 to 7 do + try + set y i ff; + check (i >= 0) + with + | Invalid_argument _ -> check (i < 0) + | _exn -> check false + done; + let acc = ref 0 in + for i = 0 to Bstr.length x - 1 do + acc := !acc + Bstr.get_uint8 x i + done; + check (!acc >= 8 * 0xff) + in + ( test Bstr.set '\xff' + , test Bstr.set_uint8 0xff + , test Bstr.set_uint16_be 0xffff + , test Bstr.set_uint16_le 0xffff + , test Bstr.set_uint16_ne 0xffff + , test Bstr.set_int32_be 0xffffffffl + , test Bstr.set_int32_le 0xffffffffl + , test Bstr.set_int32_ne 0xffffffffl + , test Bstr.set_int64_be 0xffffffffffffffffL + , test Bstr.set_int64_le 0xffffffffffffffffL + , test Bstr.set_int64_ne 0xffffffffffffffffL ) + +let check_bstr a b = check (Bstr.equal a b) +let check_raise exn fn = try fn (); check false with exn' -> check (exn = exn') + +let test53 = + let descr = {text|Miscellaneous tests|text} in + Test.test ~title:"Miscellaneous tests" ~descr @@ fun () -> + let x = Bstr.create 0 in + check_bstr x Bstr.empty; + check_bstr (Bstr.string "abc") (Bstr.of_string "abc"); + check_bstr (Bstr.string ~off:0 ~len:1 "abc") (Bstr.of_string "a"); + check_bstr (Bstr.string ~off:1 ~len:1 "abc") (Bstr.of_string "b"); + check_bstr (Bstr.string ~off:1 ~len:2 "abc") (Bstr.of_string "bc"); + check_bstr (Bstr.string ~off:3 ~len:0 "abc") (Bstr.of_string ""); + let x = Bstr.string ~off:2 ~len:1 "abc" in + check (Bstr.length x = 1); + let exn = Invalid_argument "index out of bounds" in + check_raise exn (fun () -> ignore (Bstr.get x 3)); + check_raise exn (fun () -> ignore (Bstr.get x 2)); + check_raise exn (fun () -> ignore (Bstr.get x 1)); + check (Bstr.get x 0 = 'c'); + check (Bstr.get_uint8 x 0 = 0x63); + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + lazy (Bstr.string ~off:(-1) ~len:0 "") |> err; + lazy (Bstr.string ~off:0 ~len:(-1) "") |> err; + lazy (Bstr.string ~off:1 ~len:1 "\x00") |> err + +let test54 = + let descr = {text|chop|text} in + Test.test ~title:"chop" ~descr @@ fun () -> + let x = Bstr.of_string "abc" in + let y = Bstr.sub ~off:2 ~len:0 x in + let z = Bstr.sub ~off:1 ~len:2 x in + check (Bstr.chop y = None); + check (Bstr.chop ~rev:true y = None); + check (Bstr.chop z = Some 'b'); + check (Bstr.chop ~rev:true z = Some 'c') + +let test55 = + let descr = {text|is_empty|text} in + Test.test ~title:"is_empty" ~descr @@ fun () -> + let abcd = Bstr.of_string "abcd" in + let huyi = Bstr.of_string "huyi" in + check (Bstr.is_empty (Bstr.sub ~off:4 ~len:0 abcd)); + check (Bstr.is_empty (Bstr.sub ~off:0 ~len:0 huyi)); + check (Bstr.is_empty (Bstr.sub ~off:0 ~len:1 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:0 ~len:2 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:0 ~len:3 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:0 ~len:4 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:1 ~len:0 abcd)); + check (Bstr.is_empty (Bstr.sub ~off:1 ~len:1 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:1 ~len:2 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:1 ~len:3 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:2 ~len:0 abcd)); + check (Bstr.is_empty (Bstr.sub ~off:2 ~len:1 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:2 ~len:2 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:3 ~len:0 abcd)); + check (Bstr.is_empty (Bstr.sub ~off:3 ~len:1 huyi) == false); + check (Bstr.is_empty (Bstr.sub ~off:4 ~len:0 huyi)) + +let test56 = + let descr = {text|is_prefix & starts_with|text} in + Test.test ~title:"is_prefix" ~descr @@ fun () -> + let ugoadfj = Bstr.of_string "ugoadfj" in + let dfkdjf = Bstr.of_string "dfkdjf" in + let abhablablu = Bstr.of_string "abhablablu" in + let hadfdffdf = Bstr.of_string "hadfdffdf" in + let hadhabfdffdf = Bstr.of_string "hadhabfdffdf" in + let iabla = Bstr.of_string "iabla" in + let empty0 = Bstr.sub ~off:3 ~len:0 ugoadfj in + let empty1 = Bstr.sub ~off:4 ~len:0 dfkdjf in + let habla = Bstr.sub ~off:2 ~len:5 abhablablu in + let h = Bstr.sub ~off:0 ~len:1 hadfdffdf in + let ha = Bstr.sub ~off:0 ~len:2 hadfdffdf in + let hab = Bstr.sub ~off:3 ~len:3 hadhabfdffdf in + let abla = Bstr.sub ~off:1 ~len:4 iabla in + check (Bstr.is_empty empty0); + check (Bstr.is_empty empty1); + check (Bstr.equal habla (Bstr.of_string "habla")); + check (Bstr.equal h (Bstr.of_string "h")); + check (Bstr.equal ha (Bstr.of_string "ha")); + check (Bstr.equal hab (Bstr.of_string "hab")); + check (Bstr.equal abla (Bstr.of_string "abla")); + check (Bstr.is_prefix ~affix:"" empty1); + check (Bstr.starts_with ~prefix:empty0 empty1); + check (Bstr.is_prefix ~affix:"" habla); + check (Bstr.starts_with ~prefix:empty0 habla); + check (Bstr.is_prefix ~affix:"ha" empty1 == false); + check (Bstr.starts_with ~prefix:ha empty1 == false); + check (Bstr.is_prefix ~affix:"ha" h == false); + check (Bstr.starts_with ~prefix:ha h == false); + check (Bstr.is_prefix ~affix:"ha" hab); + check (Bstr.starts_with ~prefix:ha hab); + check (Bstr.is_prefix ~affix:"ha" habla); + check (Bstr.starts_with ~prefix:ha habla); + check (Bstr.is_prefix ~affix:"ha" abla == false); + check (Bstr.starts_with ~prefix:ha abla == false) + +let test57 = + let descr = {text|is_infix|text} in + Test.test ~title:"is_infix" ~descr @@ fun () -> + let dfkdjf = Bstr.of_string "dfkdjf" in + let aasdflablu = Bstr.of_string "aasdflablu" in + let cda = Bstr.of_string "cda" in + let h = Bstr.of_string "h" in + let uhadfdffdf = Bstr.of_string "uhadfdffdf" in + let ah = Bstr.of_string "ah" in + let aaaha = Bstr.of_string "aaaha" in + let ahaha = Bstr.of_string "ahaha" in + let hahbdfdf = Bstr.of_string "hahbdfdf" in + let blhahbdfdf = Bstr.of_string "blhahbdfdf" in + let fblhahbdfdfl = Bstr.of_string "fblhahbdfdfl" in + let empty = Bstr.sub dfkdjf ~off:2 ~len:0 in + let asdf = Bstr.sub aasdflablu ~off:1 ~len:4 in + let a = Bstr.sub cda ~off:2 ~len:1 in + let h = Bstr.sub h ~off:0 ~len:1 in + let ha = Bstr.sub uhadfdffdf ~off:1 ~len:2 in + let ah = Bstr.sub ah ~off:0 ~len:2 in + let aha = Bstr.sub aaaha ~off:2 ~len:3 in + let haha = Bstr.sub ahaha ~off:1 ~len:4 in + let hahb = Bstr.sub hahbdfdf ~off:0 ~len:4 in + let blhahb = Bstr.sub blhahbdfdf ~off:0 ~len:6 in + let blha = Bstr.sub fblhahbdfdfl ~off:1 ~len:4 in + let blh = Bstr.sub fblhahbdfdfl ~off:1 ~len:3 in + check (Bstr.to_string asdf = "asdf"); + check (Bstr.to_string ha = "ha"); + check (Bstr.to_string h = "h"); + check (Bstr.to_string a = "a"); + check (Bstr.to_string aha = "aha"); + check (Bstr.to_string haha = "haha"); + check (Bstr.to_string hahb = "hahb"); + check (Bstr.to_string blhahb = "blhahb"); + check (Bstr.to_string blha = "blha"); + check (Bstr.to_string blh = "blh"); + check (Bstr.is_infix ~affix:"" empty); + check (Bstr.is_infix ~affix:"" asdf); + check (Bstr.is_infix ~affix:"" ha); + check (Bstr.is_infix ~affix:"ha" empty == false); + check (Bstr.is_infix ~affix:"ha" a == false); + check (Bstr.is_infix ~affix:"ha" h == false); + check (Bstr.is_infix ~affix:"ha" ah == false); + check (Bstr.is_infix ~affix:"ha" ha); + check (Bstr.is_infix ~affix:"ha" aha); + check (Bstr.is_infix ~affix:"ha" haha); + check (Bstr.is_infix ~affix:"ha" hahb); + check (Bstr.is_infix ~affix:"ha" blhahb); + check (Bstr.is_infix ~affix:"ha" blha); + check (Bstr.is_infix ~affix:"ha" blh == false) + +let test58 = + let descr = {text|is_suffix & ends_with|text} in + Test.test ~title:"is_suffix" ~descr @@ fun () -> + let ugoadfj = Bstr.of_string "ugoadfj" in + let dfkdjf = Bstr.of_string "dfkdjf" in + let aasdflablu = Bstr.of_string "aasdflablu" in + let cda = Bstr.of_string "cda" in + let h = Bstr.of_string "h" in + let uhadfdffdf = Bstr.of_string "uhadfdffdf" in + let ah = Bstr.of_string "ah" in + let aaaha = Bstr.of_string "aaaha" in + let ahaha = Bstr.of_string "ahaha" in + let hahbdfdf = Bstr.of_string "hahbdfdf" in + let empty0 = Bstr.sub ugoadfj ~off:1 ~len:0 in + let empty1 = Bstr.sub dfkdjf ~off:2 ~len:0 in + let asdf = Bstr.sub aasdflablu ~off:1 ~len:4 in + let a = Bstr.sub cda ~off:2 ~len:1 in + let h = Bstr.sub h ~off:0 ~len:1 in + let ha = Bstr.sub uhadfdffdf ~off:1 ~len:2 in + let ah = Bstr.sub ah ~off:0 ~len:2 in + let aha = Bstr.sub aaaha ~off:2 ~len:3 in + let haha = Bstr.sub ahaha ~off:1 ~len:4 in + let hahb = Bstr.sub hahbdfdf ~off:0 ~len:4 in + check (Bstr.to_string asdf = "asdf"); + check (Bstr.to_string ha = "ha"); + check (Bstr.to_string h = "h"); + check (Bstr.to_string a = "a"); + check (Bstr.to_string aha = "aha"); + check (Bstr.to_string haha = "haha"); + check (Bstr.to_string hahb = "hahb"); + check (Bstr.is_suffix ~affix:"" empty1); + check (Bstr.ends_with ~suffix:empty0 empty1); + check (Bstr.is_suffix ~affix:"" asdf); + check (Bstr.ends_with ~suffix:empty0 asdf); + check (Bstr.is_suffix ~affix:"ha" empty1 == false); + check (Bstr.ends_with ~suffix:ha empty1 == false); + check (Bstr.is_suffix ~affix:"ha" a == false); + check (Bstr.ends_with ~suffix:ha a == false); + check (Bstr.is_suffix ~affix:"ha" h == false); + check (Bstr.ends_with ~suffix:ha h == false); + check (Bstr.is_suffix ~affix:"ha" ah == false); + check (Bstr.ends_with ~suffix:ha ah == false); + check (Bstr.is_suffix ~affix:"ha" ha); + check (Bstr.ends_with ~suffix:ha ha); + check (Bstr.is_suffix ~affix:"ha" aha); + check (Bstr.ends_with ~suffix:ha aha); + check (Bstr.is_suffix ~affix:"ha" haha); + check (Bstr.ends_with ~suffix:ha haha); + check (Bstr.is_suffix ~affix:"ha" hahb == false); + check (Bstr.ends_with ~suffix:ha hahb == false) + +let test59 = + let descr = {text|for_all|text} in + Test.test ~title:"for_all" ~descr @@ fun () -> + let asldfksaf = Bstr.of_string "asldfksaf" in + let sf123df = Bstr.of_string "sf123df" in + let _412 = Bstr.of_string "412" in + let aaa142 = Bstr.of_string "aaa142" in + let aad124 = Bstr.of_string "aad124" in + let empty = Bstr.sub ~off:3 ~len:0 asldfksaf in + let s123 = Bstr.sub ~off:2 ~len:3 sf123df in + let s412 = Bstr.sub ~off:0 ~len:3 _412 in + let s142 = Bstr.sub ~off:3 ~len:3 aaa142 in + let s124 = Bstr.sub ~off:3 ~len:3 aad124 in + check (Bstr.to_string empty = ""); + check (Bstr.to_string s123 = "123"); + check (Bstr.to_string s412 = "412"); + check (Bstr.to_string s142 = "142"); + check (Bstr.to_string s124 = "124"); + check (Bstr.for_all (fun _ -> false) empty); + check (Bstr.for_all (fun _ -> true) empty); + check (Bstr.for_all (fun c -> Char.code c < 0x34) s123); + check (Bstr.for_all (fun c -> Char.code c < 0x34) s412 == false); + check (Bstr.for_all (fun c -> Char.code c < 0x34) s142 == false); + check (Bstr.for_all (fun c -> Char.code c < 0x34) s124 == false) + +let test60 = + let descr = {text|trim|text} in + Test.test ~title:"trim" ~descr @@ fun () -> + let base = Bstr.of_string "00aaaabcdaaaa00" in + let aaaabcdaaaa = Bstr.sub ~off:2 ~len:11 base in + let aaaabcd = Bstr.sub ~off:2 ~len:7 base in + let bcdaaaa = Bstr.sub ~off:6 ~len:7 base in + let aaaa = Bstr.sub ~off:2 ~len:4 base in + check (Bstr.(to_string (trim (of_string "\t abcd \t"))) = "abcd"); + check (Bstr.(to_string (trim aaaabcdaaaa)) = "aaaabcdaaaa"); + let drop_a = ( = ) 'a' in + check (Bstr.(to_string (trim ~drop:drop_a aaaabcdaaaa)) = "bcd"); + check (Bstr.(to_string (trim ~drop:drop_a aaaabcd)) = "bcd"); + check (Bstr.(to_string (trim ~drop:drop_a bcdaaaa)) = "bcd"); + check Bstr.(is_empty (trim ~drop:drop_a aaaa)); + check Bstr.(is_empty (trim (of_string " "))) + +let is_white = function ' ' | '\t' -> true | _ -> false +let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false + +let test61 = + let descr = {text|span|text} in + Test.test ~title:"span" ~descr @@ fun () -> + let test ?rev ?min ?max ?sat bstr (cl, cr) = + let rl, rr = Bstr.span ?rev ?min ?max ?sat bstr in + let t = Bstr.take ?rev ?min ?max ?sat bstr in + let d = Bstr.drop ?rev ?min ?max ?sat bstr in + let rev = Option.value ~default:false rev in + let result = + Bstr.equal cl rl + && Bstr.equal cr rr + && Bstr.equal (if rev then cr else cl) t + && Bstr.equal (if rev then cl else cr) d + in + check result + in + let invalid ?rev ?min ?max ?sat bstr = + try + let _ = Bstr.span ?rev ?min ?max ?sat bstr in + check false + with + | Invalid_argument _ -> check true + | _exn -> check false + in + let base = Bstr.of_string "0ab cd0" in + let ab_cd = Bstr.sub ~off:1 ~len:5 base in + let ab = Bstr.sub ~off:1 ~len:2 base in + let _cd = Bstr.sub ~off:3 ~len:3 base in + let cd = Bstr.sub ~off:4 ~len:2 base in + let ab_ = Bstr.sub ~off:1 ~len:3 base in + let a = Bstr.sub ~off:1 ~len:1 base in + let b_cd = Bstr.sub ~off:2 ~len:4 base in + let b = Bstr.sub ~off:2 ~len:1 base in + let d = Bstr.sub ~off:5 ~len:1 base in + let ab_c = Bstr.sub ~off:1 ~len:4 base in + test ~rev:false ~min:1 ~max:0 ab_cd (Bstr.sub ab_cd ~off:0 ~len:0, ab_cd); + test ~rev:true ~min:1 ~max:0 ab_cd (ab_cd, Bstr.sub ab_cd ~off:5 ~len:0); + test ~sat:is_white ab_cd (Bstr.sub ab_cd ~off:0 ~len:0, ab_cd); + test ~sat:is_letter ab_cd (ab, _cd); + test ~max:1 ~sat:is_letter ab_cd (a, b_cd); + test ~max:0 ~sat:is_letter ab_cd (Bstr.sub ab_cd ~off:5 ~len:0, ab_cd); + test ~rev:true ~sat:is_white ab_cd (ab_cd, Bstr.sub ab_cd ~off:5 ~len:0); + test ~rev:true ~sat:is_letter ab_cd (ab_, cd); + test ~rev:true ~max:1 ~sat:is_letter ab_cd (ab_c, d); + test ~rev:true ~max:0 ~sat:is_letter ab_cd + (ab_cd, Bstr.sub ab_cd ~off:5 ~len:0); + test ~sat:is_letter ab (ab, Bstr.sub ab ~off:2 ~len:0); + test ~max:1 ~sat:is_letter ab (a, b); + test ~rev:true ~max:1 ~sat:is_letter ab (a, b); + test ~max:1 ~sat:is_white ab (Bstr.sub ~off:0 ~len:0 ab, ab); + test ~rev:true ~sat:is_white Bstr.empty (Bstr.empty, Bstr.empty); + test ~sat:is_white Bstr.empty (Bstr.empty, Bstr.empty); + invalid ~rev:false ~min:(-1) Bstr.empty; + invalid ~rev:true ~min:(-1) Bstr.empty; + invalid ~rev:false ~max:(-1) Bstr.empty; + invalid ~rev:true ~max:(-1) Bstr.empty; + test ~rev:false Bstr.empty (Bstr.empty, Bstr.empty); + test ~rev:true Bstr.empty (Bstr.empty, Bstr.empty); + test ~rev:false ~min:0 ~max:0 Bstr.empty (Bstr.empty, Bstr.empty); + test ~rev:true ~min:0 ~max:0 Bstr.empty (Bstr.empty, Bstr.empty); + test ~rev:false ~min:1 ~max:0 Bstr.empty (Bstr.empty, Bstr.empty); + test ~rev:true ~min:1 ~max:0 Bstr.empty (Bstr.empty, Bstr.empty); + test ~rev:false ~max:0 ab_cd (Bstr.sub ~off:0 ~len:0 ab_cd, ab_cd); + test ~rev:true ~max:0 ab_cd (ab_cd, Bstr.sub ~off:5 ~len:0 ab_cd); + test ~rev:false ~max:2 ab_cd (ab, _cd); + test ~rev:true ~max:2 ab_cd (ab_, cd); + test ~rev:false ~min:6 ab_cd (Bstr.sub ab_cd ~off:0 ~len:0, ab_cd); + test ~rev:true ~min:6 ab_cd (ab_cd, Bstr.sub ab_cd ~off:5 ~len:0); + test ~rev:false ab_cd (ab_cd, Bstr.sub ~off:5 ~len:0 ab_cd); + test ~rev:true ab_cd (Bstr.sub ab_cd ~off:0 ~len:0, ab_cd); + test ~rev:false ~max:30 ab_cd (ab_cd, Bstr.sub ~off:5 ~len:0 ab_cd); + test ~rev:true ~max:30 ab_cd (Bstr.sub ab_cd ~off:0 ~len:0, ab_cd); + test ~rev:false ~sat:is_white ab_cd (Bstr.sub ~off:0 ~len:0 ab_cd, ab_cd); + test ~rev:true ~sat:is_white ab_cd (ab_cd, Bstr.sub ~off:5 ~len:0 ab_cd); + test ~rev:false ~sat:is_letter ab_cd (ab, _cd); + test ~rev:true ~sat:is_letter ab_cd (ab_, cd); + test ~rev:false ~sat:is_letter ~max:0 ab_cd + (Bstr.sub ~off:0 ~len:0 ab_cd, ab_cd); + test ~rev:true ~sat:is_letter ~max:0 ab_cd + (ab_cd, Bstr.sub ~off:5 ~len:0 ab_cd); + test ~rev:false ~sat:is_letter ~max:1 ab_cd (a, b_cd); + test ~rev:true ~sat:is_letter ~max:1 ab_cd (ab_c, d); + test ~rev:false ~sat:is_letter ~min:2 ~max:1 ab_cd + (Bstr.sub ~off:0 ~len:0 ab_cd, ab_cd); + test ~rev:true ~sat:is_letter ~min:2 ~max:1 ab_cd + (ab_cd, Bstr.sub ~off:5 ~len:0 ab_cd); + test ~rev:false ~sat:is_letter ~min:3 ab_cd + (Bstr.sub ~off:0 ~len:0 ab_cd, ab_cd); + test ~rev:true ~sat:is_letter ~min:3 ab_cd + (ab_cd, Bstr.sub ~off:5 ~len:0 ab_cd) + +let test62 = + let descr = {text|cut|text} in + Test.test ~title:"cut" ~descr @@ fun () -> + let test a b = + match (a, b) with + | None, None -> check true + | Some (a, b), Some (u, v) -> check (Bstr.equal a u && Bstr.equal b v) + | _ -> check false + in + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + let open Bstr in + test (cut ~sep:"," empty) None; + test (cut ~sep:"," (string ",")) (Some (string "", string "")); + test (cut ~sep:"," (string ",,")) (Some (string "", string ",")); + test (cut ~sep:"," (string ",,,")) (Some (string "", string ",,")); + test (cut ~sep:"," (string "123")) None; + test (cut ~sep:"," (string ",123")) (Some (string "", string "123")); + test (cut ~sep:"," (string "123,")) (Some (string "123", string "")); + test (cut ~sep:"," (string "1,2,3")) (Some (string "1", string "2,3")); + test (cut ~sep:"," (string " 1,2,3")) (Some (string " 1", string "2,3")); + test (cut ~sep:"<>" empty) None; + test (cut ~sep:"<>" (string "<>")) (Some (string "", string "")); + test (cut ~sep:"<>" (string "<><>")) (Some (string "", string "<>")); + test (cut ~sep:"<>" (string "<><><>")) (Some (string "", string "<><>")); + test (cut ~rev:true ~sep:"<>" (string "1")) None; + test (cut ~sep:"<>" (string "123")) None; + test (cut ~sep:"<>" (string "<>123")) (Some (string "", string "123")); + test (cut ~sep:"<>" (string "123<>")) (Some (string "123", string "")); + test (cut ~sep:"<>" (string "1<>2<>3")) (Some (string "1", string "2<>3")); + test + (cut ~sep:"<>" (string ">>><>>>><>>>><>>>>")) + (Some (string ">>>", string ">>><>>>><>>>>")); + test (cut ~sep:"<->" (string "<->>->")) (Some (string "", string ">->")); + test (cut ~rev:true ~sep:"<->" (string "<-")) None; + test (cut ~sep:"aa" (string "aa")) (Some (string "", string "")); + test (cut ~sep:"aa" (string "aaa")) (Some (string "", string "a")); + test (cut ~sep:"aa" (string "aaaa")) (Some (string "", string "aa")); + test (cut ~sep:"aa" (string "aaaaa")) (Some (string "", string "aaa")); + test (cut ~sep:"aa" (string "aaaaaa")) (Some (string "", string "aaaa")); + test (cut ~sep:"ab" (string "faaaa")) None; + lazy (cut ~sep:"" (string "a")) |> err + +let test63 = + let descr = {text|cut ~rev:true|text} in + Test.test ~title:"cut ~rev:true" ~descr @@ fun () -> + let test a b = + match (a, b) with + | None, None -> check true + | Some (a, b), Some (u, v) -> check (Bstr.equal a u && Bstr.equal b v) + | _ -> check false + in + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + let open Bstr in + let rev = true in + test (cut ~rev ~sep:"," (string "")) None; + test (cut ~rev ~sep:"," (string ",")) (Some (string "", string "")); + test (cut ~rev ~sep:"," (string ",,")) (Some (string ",", string "")); + test (cut ~rev ~sep:"," (string ",,,")) (Some (string ",,", string "")); + test (cut ~rev ~sep:"," (string "123")) None; + test (cut ~rev ~sep:"," (string ",123")) (Some (string "", string "123")); + test (cut ~rev ~sep:"," (string "123,")) (Some (string "123", string "")); + test (cut ~rev ~sep:"," (string "1,2,3")) (Some (string "1,2", string "3")); + test (cut ~rev ~sep:"," (string "1,2,3 ")) (Some (string "1,2", string "3 ")); + test (cut ~rev ~sep:"<>" empty) None; + test (cut ~rev ~sep:"<>" (string "<>")) (Some (string "", string "")); + test (cut ~rev ~sep:"<>" (string "<><>")) (Some (string "<>", string "")); + test (cut ~rev ~sep:"<>" (string "<><><>")) (Some (string "<><>", string "")); + test (cut ~rev ~sep:"<>" (string "1")) None; + test (cut ~rev ~sep:"<>" (string "123")) None; + test (cut ~rev ~sep:"<>" (string "<>123")) (Some (string "", string "123")); + test (cut ~rev ~sep:"<>" (string "123<>")) (Some (string "123", string "")); + test + (cut ~rev ~sep:"<>" (string "1<>2<>3")) + (Some (string "1<>2", string "3")); + test + (cut ~rev ~sep:"<>" (string "1<>2<>3 ")) + (Some (string "1<>2", string "3 ")); + test + (cut ~rev ~sep:"<>" (string ">>><>>>><>>>><>>>>")) + (Some (string ">>><>>>><>>>>", string ">>>")); + test (cut ~rev ~sep:"<->" (string "<->>->")) (Some (string "", string ">->")); + test (cut ~rev ~sep:"<->" (string "<-")) None; + test (cut ~rev ~sep:"aa" (string "aa")) (Some (string "", string "")); + test (cut ~rev ~sep:"aa" (string "aaa")) (Some (string "a", string "")); + test (cut ~rev ~sep:"aa" (string "aaaa")) (Some (string "aa", string "")); + test (cut ~rev ~sep:"aa" (string "aaaaa")) (Some (string "aaa", string "")); + test (cut ~rev ~sep:"aa" (string "aaaaaa")) (Some (string "aaaa", string "")); + test (cut ~rev ~sep:"ab" (string "afaaaa")) None; + lazy (cut ~rev ~sep:"" (string "a")) |> err + +let test64 = + let descr = {text|binary {u,}int8|text} in + Test.test ~title:"binary" ~descr @@ fun () -> + let t = Bstr.create 5 in + Bstr.set_int8 t 3 260; + Bstr.set_int8 t 2 1; + Bstr.set_int8 t 1 2; + Bstr.set_int8 t 0 3; + Bstr.set_int8 t 4 (-1); + check (Bstr.to_string t = "\003\002\001\004\255"); + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + lazy (Bstr.set_int8 t 5 0) |> err; + lazy (Bstr.get_int8 t 5) |> err; + lazy (Bstr.set_uint8 t 5 0) |> err; + lazy (Bstr.get_uint8 t 5) |> err; + check (Bstr.get_int8 t 0 = 3); + check (Bstr.get_int8 t 1 = 2); + check (Bstr.get_int8 t 2 = 1); + check (Bstr.get_int8 t 3 = 4); + check (Bstr.get_int8 t 4 = -1); + check (Bstr.get_uint8 t 0 = 3); + check (Bstr.get_uint8 t 1 = 2); + check (Bstr.get_uint8 t 2 = 1); + check (Bstr.get_uint8 t 3 = 4); + check (Bstr.get_uint8 t 4 = 255); + let result = ref true in + for i = 0 to 255 do + Bstr.set_uint8 t 0 i; + result := !result || Bstr.get_uint8 t 0 = i + done; + for i = -128 to 127 do + Bstr.set_int8 t 0 i; + result := !result || Bstr.get_int8 t 0 = i + done; + check !result + +let test65 = + let descr = {text|binary {be,le,ne}{u,}int16|text} in + Test.test ~title:"binary {be,le,ne}{u,}int16" ~descr @@ fun () -> + let t = Bstr.create 3 in + Bstr.set_int16_le t 1 0x1234; + Bstr.set_int16_le t 0 0xabcd; + check (Bstr.to_string t = "\xcd\xab\x12"); + check (Bstr.get_uint16_le t 0 = 0xabcd); + check (Bstr.get_uint16_le t 1 = 0x12ab); + check (Bstr.get_int16_le t 0 = 0xabcd - 0x10000); + check (Bstr.get_int16_le t 1 = 0x12ab); + check (Bstr.get_uint16_be t 1 = 0xab12); + check (Bstr.get_int16_be t 1 = 0xab12 - 0x10000); + let result = ref true in + for i = 0 to Bstr.length t - 2 do + let x = Bstr.get_int16_ne t i in + let fn = if Sys.big_endian then Bstr.get_int16_be else Bstr.get_int16_le in + result := !result || x = fn t i; + let x = Bstr.get_uint16_ne t i in + let fn = + if Sys.big_endian then Bstr.get_uint16_be else Bstr.get_uint16_le + in + result := !result || x = fn t i + done; + check !result; + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + lazy (Bstr.set_int16_le t 2 0) |> err; + lazy (Bstr.set_int16_ne t 2 0) |> err; + lazy (Bstr.set_int16_be t 2 0) |> err; + lazy (Bstr.get_int16_le t 2) |> err; + lazy (Bstr.get_int16_ne t 2) |> err; + lazy (Bstr.get_int16_be t 2) |> err; + lazy (Bstr.set_uint16_le t 2 0) |> err; + lazy (Bstr.set_uint16_ne t 2 0) |> err; + lazy (Bstr.set_uint16_be t 2 0) |> err; + lazy (Bstr.get_uint16_le t 2) |> err; + lazy (Bstr.get_uint16_ne t 2) |> err; + lazy (Bstr.get_uint16_be t 2) |> err; + let result = ref true in + for i = 0 to 0xffff do + Bstr.set_uint16_le t 0 i; + result := !result || Bstr.get_uint16_le t 0 = i; + Bstr.set_uint16_be t 0 i; + result := !result || Bstr.get_uint16_be t 0 = i; + Bstr.set_uint16_ne t 0 i; + result := !result || Bstr.get_uint16_ne t 0 = i; + let fn = if Sys.big_endian then Bstr.get_int16_be else Bstr.get_int16_le in + result := !result || fn t 0 = i + done; + check !result + +let test66 = + let descr = {text|binary {be,le,ne}int32|text} in + Test.test ~title:"binary {be,le,ne}int32" ~descr @@ fun () -> + let t = Bstr.make 6 '\000' in + Bstr.set_int32_le t 1 0x01234567l; + Bstr.set_int32_le t 0 0x89abcdefl; + check (Bstr.to_string t = "\xef\xcd\xab\x89\x01\x00"); + check (Bstr.get_int32_le t 0 = 0x89abcdefl); + check (Bstr.get_int32_be t 0 = 0xefcdab89l); + check (Bstr.get_int32_le t 1 = 0x0189abcdl); + check (Bstr.get_int32_be t 1 = 0xcdab8901l); + Bstr.set_int32_be t 1 0x01234567l; + Bstr.set_int32_be t 0 0x89abcdefl; + check (Bstr.to_string t = "\x89\xab\xcd\xef\x67\x00"); + Bstr.set_int32_ne t 0 0x01234567l; + check (Bstr.get_int32_ne t 0 = 0x01234567l); + let str = + if Sys.big_endian then "\x01\x23\x45\x67\x67\x00" + else "\x67\x45\x23\x01\x67\x00" + in + check (Bstr.to_string t = str); + Bstr.set_int32_ne t 0 0xffffffffl; + check (Bstr.get_int32_ne t 0 = 0xffffffffl); + let result = ref true in + for i = 0 to Bstr.length t - 4 do + let x = Bstr.get_int32_ne t i in + let fn = if Sys.big_endian then Bstr.get_int32_be else Bstr.get_int32_le in + result := !result || x = fn t i + done; + check !result; + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + lazy (Bstr.set_int32_le t 3 0l) |> err; + lazy (Bstr.set_int32_ne t 3 0l) |> err; + lazy (Bstr.set_int32_be t 3 0l) |> err; + lazy (Bstr.get_int32_le t 3) |> err; + lazy (Bstr.get_int32_ne t 3) |> err; + lazy (Bstr.get_int32_be t 3) |> err + +let test67 = + let descr = {text|binary {be,le,ne}int64|text} in + Test.test ~title:"binary {be,le,ne}int64" ~descr @@ fun () -> + let t = Bstr.make 10 '\000' in + Bstr.set_int64_le t 1 0x0123456789abcdefL; + Bstr.set_int64_le t 0 0x1032547698badcfeL; + check (Bstr.to_string t = "\xfe\xdc\xba\x98\x76\x54\x32\x10\x01\x00"); + check (Bstr.get_int64_le t 0 = 0x1032547698badcfeL); + check (Bstr.get_int64_be t 0 = 0xfedcba9876543210L); + check (Bstr.get_int64_le t 1 = 0x011032547698badcL); + check (Bstr.get_int64_be t 1 = 0xdcba987654321001L); + Bstr.set_int64_be t 1 0x0123456789abcdefL; + Bstr.set_int64_be t 0 0x1032547698badcfeL; + check (Bstr.to_string t = "\x10\x32\x54\x76\x98\xba\xdc\xfe\xef\x00"); + Bstr.set_int64_ne t 0 0x0123456789abcdefL; + check (Bstr.get_int64_ne t 0 = 0x0123456789abcdefL); + let str = + if Sys.big_endian then "\x01\x23\x45\x67\x89\xab\xcd\xef\xef\x00" + else "\xef\xcd\xab\x89\x67\x45\x23\x01\xef\x00" + in + check (Bstr.to_string t = str); + Bstr.set_int64_ne t 0 0xffffffffffffffffL; + check (Bstr.get_int64_ne t 0 = 0xffffffffffffffffL); + let result = ref true in + for i = 0 to Bstr.length t - 8 do + let x = Bstr.get_int64_ne t i in + let fn = if Sys.big_endian then Bstr.get_int64_be else Bstr.get_int64_le in + result := !result || x = fn t i + done; + check !result; + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + lazy (Bstr.set_int64_le t 3 0L) |> err; + lazy (Bstr.set_int64_ne t 3 0L) |> err; + lazy (Bstr.set_int64_be t 3 0L) |> err; + lazy (Bstr.get_int64_le t 3) |> err; + lazy (Bstr.get_int64_ne t 3) |> err; + lazy (Bstr.get_int64_be t 3) |> err + +let test68 = + let descr = {text|split_on_char|text} in + Test.test ~title:"split_on_char" ~descr @@ fun () -> + let t = Bstr.of_string " abc def " in + let check_split sep t = + let lst = Bstr.split_on_char sep t in + check (List.length lst > 0); + check (Bstr.equal (Bstr.concat (String.make 1 sep) lst) t); + List.iter (Bstr.iter (fun chr -> check (chr <> sep))) lst + in + for i = 0 to Bstr.length t do + check_split ' ' (Bstr.sub t ~off:0 ~len:i) + done + +let test69 = + let descr = {text|blit|text} in + Test.test ~title:"blit" ~descr @@ fun () -> + let str0 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" in + let str1 = "abcdefghijklmnopqrstuvwxyz" in + let with_bufs fn = + let buf0 = Bstr.of_string str0 in + let buf1 = Bstr.of_string str1 in + fn buf0 buf1 + in + let fn0 buf0 buf1 = + Bstr.blit buf0 ~src_off:0 buf1 ~dst_off:0 ~len:0; + check (Bstr.to_string buf1 = str1) + in + let fn1 buf0 buf1 = + Bstr.blit buf0 ~src_off:0 buf1 ~dst_off:0 ~len:(Bstr.length buf1); + check (Bstr.to_string buf1 = str0) + in + let fn2 buf0 _ = + Bstr.blit buf0 ~src_off:0 buf0 ~dst_off:0 ~len:(Bstr.length buf0); + check (Bstr.to_string buf0 = str0) + in + let fn3 buf0 buf1 = + Bstr.blit buf0 ~src_off:0 buf1 ~dst_off:4 ~len:8; + check (Bstr.to_string buf1 = "abcdABCDEFGHmnopqrstuvwxyz") + in + let fn4 buf0 _ = + Bstr.blit buf0 ~src_off:0 buf0 ~dst_off:4 ~len:8; + check (Bstr.to_string buf0 = "ABCDABCDEFGHMNOPQRSTUVWXYZ") + in + with_bufs fn0; with_bufs fn1; with_bufs fn2; with_bufs fn3; with_bufs fn4 + +let test70 = + let descr = {text|overlap|text} in + Test.test ~title:"overlap" ~descr @@ fun () -> + let test value expected = + match (value, expected) with + | None, None -> check true + | Some (len, a, b), Some (len', x, y) -> + check (a == x && b == y && len == len') + | _ -> check false + in + let t = Bstr.create 10 in + let ab = Bstr.sub t ~off:5 ~len:5 in + let cd = Bstr.sub t ~off:0 ~len:5 in + test (Bstr.overlap ab cd) None; + let ab = Bstr.sub t ~off:0 ~len:5 in + let cd = Bstr.sub t ~off:5 ~len:5 in + test (Bstr.overlap ab cd) None; + let ab = Bstr.sub t ~off:0 ~len:6 in + let cd = Bstr.sub t ~off:5 ~len:5 in + test (Bstr.overlap ab cd) (Some (1, 5, 0)); + let ab = Bstr.sub t ~off:5 ~len:5 in + let cd = Bstr.sub t ~off:0 ~len:6 in + test (Bstr.overlap ab cd) (Some (1, 0, 5)); + let ab = Bstr.sub t ~off:0 ~len:8 in + let cd = Bstr.sub t ~off:2 ~len:8 in + test (Bstr.overlap ab cd) (Some (6, 2, 0)); + let ab = Bstr.sub t ~off:0 ~len:10 in + let cd = Bstr.sub t ~off:2 ~len:8 in + test (Bstr.overlap ab cd) (Some (8, 2, 0)); + let ab = Bstr.sub t ~off:0 ~len:10 in + let cd = Bstr.sub t ~off:2 ~len:6 in + test (Bstr.overlap ab cd) (Some (6, 2, 0)); + let ab = Bstr.sub t ~off:0 ~len:8 in + let cd = Bstr.sub t ~off:0 ~len:10 in + test (Bstr.overlap ab cd) (Some (8, 0, 0)); + let ab = Bstr.sub t ~off:0 ~len:10 in + let cd = Bstr.sub t ~off:0 ~len:10 in + test (Bstr.overlap ab cd) (Some (10, 0, 0)); + let ab = Bstr.sub t ~off:0 ~len:10 in + let cd = Bstr.sub t ~off:0 ~len:8 in + test (Bstr.overlap ab cd) (Some (8, 0, 0)); + let ab = Bstr.sub t ~off:2 ~len:6 in + let cd = Bstr.sub t ~off:0 ~len:10 in + test (Bstr.overlap ab cd) (Some (6, 0, 2)); + let ab = Bstr.sub t ~off:2 ~len:8 in + let cd = Bstr.sub t ~off:0 ~len:10 in + test (Bstr.overlap ab cd) (Some (8, 0, 2)); + let ab = Bstr.sub t ~off:2 ~len:8 in + let cd = Bstr.sub t ~off:0 ~len:8 in + test (Bstr.overlap ab cd) (Some (6, 0, 2)) + +let test71 = + let descr = {text|with_range|text} in + Test.test ~title:"with_range" ~descr @@ fun () -> + let base = Bstr.of_string "00abc1234" in + let abc = Bstr.sub ~off:2 ~len:3 base in + let a = Bstr.sub ~off:2 ~len:1 base in + let empty = Bstr.sub ~off:2 ~len:0 base in + let eq a b = check (Bstr.to_string a = Bstr.to_string b) in + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + eq (Bstr.with_range ~first:1 ~len:0 empty) Bstr.empty; + eq (Bstr.with_range ~first:1 ~len:0 empty) Bstr.empty; + eq (Bstr.with_range ~first:0 ~len:1 empty) Bstr.empty; + eq (Bstr.with_range ~first:(-1) ~len:1 empty) Bstr.empty; + lazy (Bstr.with_range ~first:0 ~len:(-1) empty) |> err; + eq (Bstr.with_range ~first:0 ~len:0 a) Bstr.empty; + eq (Bstr.with_range a ~first:1 ~len:0) Bstr.empty; + eq (Bstr.with_range a ~first:1 ~len:1) Bstr.empty; + eq (Bstr.with_range a ~first:(-1) ~len:1) Bstr.empty; + eq (Bstr.with_range ~first:1 abc) (Bstr.of_string "bc"); + eq (Bstr.with_range ~first:2 abc) (Bstr.of_string "c"); + eq (Bstr.with_range ~first:3 abc) Bstr.empty; + eq (Bstr.with_range ~first:4 abc) Bstr.empty; + eq (Bstr.with_range abc ~first:0 ~len:0) (Bstr.of_string ""); + eq (Bstr.with_range abc ~first:0 ~len:1) (Bstr.of_string "a"); + eq (Bstr.with_range abc ~first:0 ~len:2) (Bstr.of_string "ab"); + eq (Bstr.with_range abc ~first:0 ~len:4) (Bstr.of_string "abc"); + eq (Bstr.with_range abc ~first:1 ~len:0) (Bstr.of_string ""); + eq (Bstr.with_range abc ~first:1 ~len:1) (Bstr.of_string "b"); + eq (Bstr.with_range abc ~first:1 ~len:2) (Bstr.of_string "bc"); + eq (Bstr.with_range abc ~first:1 ~len:3) (Bstr.of_string "bc"); + eq (Bstr.with_range abc ~first:2 ~len:0) (Bstr.of_string ""); + eq (Bstr.with_range abc ~first:2 ~len:1) (Bstr.of_string "c"); + eq (Bstr.with_range abc ~first:2 ~len:2) (Bstr.of_string "c"); + eq (Bstr.with_range abc ~first:3 ~len:0) (Bstr.of_string ""); + eq (Bstr.with_range abc ~first:1 ~len:4) (Bstr.of_string "bc"); + eq (Bstr.with_range abc ~first:(-1) ~len:1) Bstr.empty + +let test72 = + let descr = {text|blit & fill|text} in + Test.test ~title:"blit & fill" ~descr @@ fun () -> + let test str off flen v = + let len = String.length str in + let a = Bstr.of_string str in + let b = Bstr.create len in + let c = Bstr.create len in + Bstr.memmove a ~src_off:0 b ~dst_off:0 ~len; + Bstr.memcpy b ~src_off:0 c ~dst_off:0 ~len; + Bstr.fill c ~off ~len:flen v; + let rec verify idx = + if idx >= len then true + else + let expected = + if idx >= off && idx < off + flen then v else str.[idx] + in + c.{idx} == expected && verify (idx + 1) + in + check (Bstr.equal a b && verify 0) + in + test "\x01\x02\x05\x08\x9c\x7f" 3 2 '\x07'; + test "\x01\x02\x05\x08\x9c\xd4" 3 2 '\x07'; + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + let a = Bstr.of_string "foobarfoo" in + let b = Bstr.create 0 in + lazy (Bstr.memmove a ~src_off:0 b ~dst_off:0 ~len:1) |> err; + lazy (Bstr.memmove a ~src_off:0 b ~dst_off:(-1) ~len:0) |> err; + lazy (Bstr.memmove a ~src_off:10 b ~dst_off:0 ~len:0) |> err; + lazy (Bstr.memmove a ~src_off:(-1) b ~dst_off:0 ~len:0) |> err; + lazy (Bstr.memmove a ~src_off:0 b ~dst_off:0 ~len:(-1)) |> err; + lazy (Bstr.memcpy a ~src_off:0 b ~dst_off:0 ~len:1) |> err; + lazy (Bstr.memcpy a ~src_off:0 b ~dst_off:(-1) ~len:0) |> err; + lazy (Bstr.memcpy a ~src_off:10 b ~dst_off:0 ~len:0) |> err; + lazy (Bstr.memcpy a ~src_off:(-1) b ~dst_off:0 ~len:0) |> err; + lazy (Bstr.memcpy a ~src_off:0 b ~dst_off:0 ~len:(-1)) |> err; + lazy (Bstr.fill a '\000' ~off:(-1) ~len:0) |> err; + lazy (Bstr.fill a '\000' ~len:(-1)) |> err; + lazy (Bstr.fill a '\000' ~off:10) |> err; + lazy (Bstr.fill a '\000' ~off:0 ~len:10) |> err + +let test73 = + let descr = {text|copy|text} in + Test.test ~title:"copy" ~descr @@ fun () -> + let eq a b = check (Bstr.to_string a = Bstr.to_string b) in + let test arr = eq (Bstr.copy arr) arr in + test (Bstr.of_string "\x01\x02\x03\x04\x05"); + test (Bstr.of_string "un deux trois"); + test (Bstr.init 256 Char.unsafe_chr) + +let test74 = + let descr = {text|with_index_range (no allocation)|text} in + Test.test ~title:"with_index_range (no allocation)" ~descr @@ fun () -> + let no_alloc ?first ?last bstr = + check (Bstr.with_index_range bstr ?first ?last == bstr || Bstr.is_empty bstr) + in + let is_empty ?first ?last bstr = + let bstr' = Bstr.with_index_range bstr ?first ?last in + check (Bstr.is_empty bstr') + in + let eq_range bstr ?first ?last str = + let bstr' = Bstr.with_index_range bstr ?first ?last in + check (Bstr.to_string bstr' = str) + in + no_alloc Bstr.empty; + no_alloc ~first:(-1) Bstr.empty; + no_alloc ~first:0 Bstr.empty; + no_alloc ~first:1 Bstr.empty; + no_alloc ~first:2 Bstr.empty; + no_alloc ~last:(-1) Bstr.empty; + no_alloc ~last:0 Bstr.empty; + no_alloc ~last:1 Bstr.empty; + no_alloc ~last:2 Bstr.empty; + no_alloc ~first:(-1) ~last:(-1) Bstr.empty; + no_alloc ~first:(-1) ~last:0 Bstr.empty; + no_alloc ~first:(-1) ~last:1 Bstr.empty; + no_alloc ~first:0 ~last:(-1) Bstr.empty; + no_alloc ~first:0 ~last:0 Bstr.empty; + no_alloc ~first:0 ~last:1 Bstr.empty; + no_alloc ~first:1 ~last:(-1) Bstr.empty; + no_alloc ~first:1 ~last:0 Bstr.empty; + no_alloc ~first:1 ~last:1 Bstr.empty; + let abc = Bstr.string "abc" in + no_alloc abc ~first:(-1); + no_alloc abc ~first:0; + eq_range abc ~first:1 "bc"; + eq_range abc ~first:2 "c"; + is_empty abc ~first:3; + is_empty abc ~last:(-1); + eq_range abc ~last:0 "a"; + eq_range abc ~last:1 "ab"; + no_alloc abc ~last:2 + +let test75 = + let descr = {text|with_index_range|text} in + Test.test ~title:"with_index_range" ~descr @@ fun () -> + let no_alloc ?first ?last bstr = + check (Bstr.with_index_range bstr ?first ?last == bstr || Bstr.is_empty bstr) + in + let is_empty ?first ?last bstr = + check (Bstr.is_empty (Bstr.with_index_range bstr ?first ?last)) + in + let a = Bstr.of_string "a" in + no_alloc a; + no_alloc a ~first:(-1); + no_alloc a ~first:0; + is_empty a ~first:1; + is_empty a ~first:2; + is_empty a ~last:(-1); + no_alloc a ~last:0; + no_alloc a ~last:1; + no_alloc a ~last:2; + is_empty a ~first:(-1) ~last:(-1); + no_alloc a ~first:(-1) ~last:0; + no_alloc a ~first:(-1) ~last:1; + no_alloc a ~first:(-1) ~last:2; + no_alloc a ~first:(-1) ~last:3 + +let test76 = + let descr = {text|blit_to_bytes|text} in + Test.test ~title:"blit_to_bytes" ~descr @@ fun () -> + let buf = Bytes.create 256 in + let bstr = Bstr.init 256 Char.unsafe_chr in + Bstr.blit_to_bytes bstr ~src_off:0 buf ~dst_off:0 ~len:256; + check (String.init 256 Char.unsafe_chr = Bytes.unsafe_to_string buf); + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + lazy (Bstr.blit_to_bytes bstr ~src_off:(-1) buf ~dst_off:0 ~len:0) |> err; + lazy (Bstr.blit_to_bytes bstr ~src_off:0 buf ~dst_off:(-1) ~len:0) |> err; + lazy (Bstr.blit_to_bytes bstr ~src_off:0 buf ~dst_off:0 ~len:(-1)) |> err; + lazy (Bstr.blit_to_bytes bstr ~src_off:0 buf ~dst_off:0 ~len:512) |> err; + lazy (Bstr.blit_to_bytes bstr ~src_off:0 buf ~dst_off:256 ~len:256) |> err + +let test77 = + let descr = {text|compare|text} in + Test.test ~title:"compare" ~descr @@ fun () -> + let ( % ) f g = fun x -> f (g x) in + let from_list lst = + Bstr.init (List.length lst) (Char.unsafe_chr % List.nth lst) + in + let norm expect a b = + let result = Bstr.compare a b in + Format.eprintf ">>> res:%d\n%!" result; + if result == 0 then check (expect == 0) + else if result < 0 then check (expect == -1) + else check (expect == 1) + in + norm 0 + (from_list [ 1; 2; 3; -4; 127; -128 ]) + (from_list [ 1; 2; 3; -4; 127; -128 ]); + norm 1 + (from_list [ 1; 2; 3; -4; 127; -128 ]) + (from_list [ 1; 2; 3; 4; 127; -128 ]); + norm 1 + (from_list [ 1; 2; 3; -4; 127; -128 ]) + (from_list [ 1; 2; 3; -4; 42; -128 ]); + norm (-1) (from_list []) (from_list [ 1 ]); + norm 1 (from_list [ 1 ]) (from_list []) + +let test78 = + let descr = {text|blit_from_bytes (error)|text} in + Test.test ~title:"blit_from_bytes (error)" ~descr @@ fun () -> + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + let buf = Bytes.make 1 '\x00' in + let bstr = Bstr.string "\x00" in + lazy (Bstr.blit_from_bytes buf ~src_off:(-1) bstr ~dst_off:0 ~len:0) |> err; + lazy (Bstr.blit_from_bytes buf ~src_off:0 bstr ~dst_off:(-1) ~len:0) |> err; + lazy (Bstr.blit_from_bytes buf ~src_off:0 bstr ~dst_off:0 ~len:(-1)) |> err; + lazy (Bstr.blit_from_bytes buf ~src_off:0 bstr ~dst_off:1 ~len:1) |> err; + lazy (Bstr.blit_from_bytes buf ~src_off:1 bstr ~dst_off:0 ~len:1) |> err + +let test79 = + let descr = {text|sub_string (error)|text} in + Test.test ~title:"sub_string (error)" ~descr @@ fun () -> + let err v = + match Lazy.force v with + | exception Invalid_argument _ -> check true + | _ -> check false + in + lazy (Bstr.sub_string ~off:(-1) ~len:0 Bstr.empty) |> err; + lazy (Bstr.sub_string ~off:0 ~len:(-1) Bstr.empty) |> err; + let buf = Bstr.string "\x00" in + lazy (Bstr.sub_string ~off:1 ~len:1 buf) |> err + +let test80 = + let descr = {text|contains|text} in + Test.test ~title:"contains" ~descr @@ fun () -> + let abc = Bstr.string "abc" in + check (Bstr.contains abc 'a'); + check (Bstr.contains abc 'b'); + check (Bstr.contains abc 'c'); + check (Bstr.contains abc '0' == false); + check (Bstr.contains abc ~off:3 'a' == false); + check (Bstr.contains abc ~len:0 'a' == false) + +let test81 = + let descr = {text|constant_equal|text} in + Test.test ~title:"constant_equal" ~descr @@ fun () -> + let open Bstr in + check (constant_equal (string "a") empty == false); + check (constant_equal empty (string "a") == false); + check (constant_equal (string "a") (string "a")); + let foo = string "foo" in + let bar = string "bar" in + check (constant_equal foo foo); + check (constant_equal foo bar == false) + +let test82 = + let descr = {text|extend|text} in + Test.test ~title:"extend" ~descr @@ fun () -> + let abcde = Bstr.string "abcde" in + check (Bstr.extend abcde 7 (-7) |> Bstr.length == 5); + check (Bstr.extend abcde (-7) 7 |> Bstr.length == 5); + let test ~off ~len str left right = + let v = Bstr.extend abcde left right in + check + begin + Bstr.length v == len + && abcde != v + && Bstr.sub_string ~off ~len:(String.length str) v = str + end + in + test ~off:0 ~len:5 "abcde" 0 0; + test ~off:2 ~len:5 "abc" 2 (-2); + test ~off:0 ~len:3 "bcd" (-1) (-1); + test ~off:0 ~len:4 "de" (-3) 2; + test ~off:0 ~len:3 "abc" 0 (-2); + test ~off:0 ~len:3 "cde" (-2) 0; + test ~off:0 ~len:7 "abcde" 0 2; + test ~off:2 ~len:7 "abcde" 2 0; + test ~off:1 ~len:7 "abcde" 1 1 + +let ( / ) = Filename.concat + +let () = + let tests = + [ + test01; test02; test03; test04; test05; test06; test07; test08; test09 + ; test10; test11; test12; test13; test14; test15; test16; test17; test18 + ; test19; test20; test21; test22; test23; test24; test25; test26; test27 + ; test28; test29; test30; test31; test32; test33; test34; test35; test36 + ; test37; test38; test39; test40; test41; test42; test43; test44; test45 + ; test46; test47; test48; test49; test50; test51; test52; test53; test54 + ; test55; test56; test57; test58; test59; test60; test61; test62; test63 + ; test64; test65; test66; test67; test68; test69; test70; test71; test72 + ; test73; test74; test75; test76; test77; test78; test79; test80; test81 + ; test82 + ] + in + let ({ Test.directory } as runner) = Test.runner (Sys.getcwd () / "_tests") in + let run idx test = + Format.printf "test%03d: %!" (succ idx); + Test.run runner test; + Format.printf "ok\n%!" + in + Format.printf "Run tests into %s\n%!" directory; + List.iteri run tests diff --git a/unikernel/duniverse/bstr/test/test.ml b/unikernel/duniverse/bstr/test/test.ml new file mode 100644 index 00000000..61fa00af --- /dev/null +++ b/unikernel/duniverse/bstr/test/test.ml @@ -0,0 +1,75 @@ +let strf fmt = Format.asprintf fmt +let ( / ) = Filename.concat + +let check test = + let bt = Printexc.get_callstack max_int in + try + assert test; + print_string "."; + flush stdout + with exn -> + print_string "x"; + flush stdout; + Printexc.raise_with_backtrace exn bt + +type t = { title: string; descr: string; fn: unit -> unit } + +let test ~title ~descr fn = { title; descr; fn } + +type runner = { directory: string } + +let rec mkdir_p path perm = + if path <> "" then begin + try Unix.mkdir path perm with + | Unix.Unix_error (EEXIST, _, _) when Sys.is_directory path -> () + | Unix.Unix_error (ENOENT, _, _) -> + mkdir_p (Filename.dirname path) perm; + Unix.mkdir path perm + end + +let mkdir ({ directory } as runner) = mkdir_p directory 0o755; runner + +type ('a, 'b) str = ('a -> 'b, Format.formatter, unit, string) format4 + +let runner ?(g = Random.State.make_self_init ()) + ?(fmt : ('a, 'b) str = "run-%s") root = + let random_string len = + let res = Bytes.create len in + for i = 0 to len - 1 do + let chr = + match Random.State.int g (26 + 26 + 10) with + | n when n < 26 -> Char.chr (Char.code 'a' + n) + | n when n < 26 + 26 -> Char.chr (Char.code 'A' + n - 26) + | n -> Char.chr (Char.code '0' + n - 26 - 26) + in + Bytes.set res i chr + done; + Bytes.unsafe_to_string res + in + let rec go retry = + if retry >= 10 then failwith "Impossible to create a test directory"; + let directory = root / strf fmt (random_string 4) in + if Sys.file_exists directory then go (succ retry) else mkdir { directory } + in + go 0 + +let run { directory= dir } { title; fn; _ } = + let old_stderr = Unix.dup Unix.stderr in + let new_stderr = open_out_bin (dir / strf "%s.stderr" title) in + Unix.dup2 (Unix.descr_of_out_channel new_stderr) Unix.stderr; + let finally () = + flush stderr; + Unix.dup2 old_stderr Unix.stderr; + Unix.close old_stderr; + close_out new_stderr + in + Format.eprintf "*** %s ***\n%!" title; + try Fun.protect ~finally fn + with exn -> + let ic = open_in_bin (dir / strf "%s.stderr" title) in + let ln = in_channel_length ic in + let rs = Bytes.create ln in + really_input ic rs 0 ln; + Format.printf "Terminated with: %S\n%!" (Printexc.to_string exn); + Format.printf "%s\n%!" (Bytes.unsafe_to_string rs); + exit 1 diff --git a/unikernel/duniverse/bstr/test/test.mli b/unikernel/duniverse/bstr/test/test.mli new file mode 100644 index 00000000..b4033a87 --- /dev/null +++ b/unikernel/duniverse/bstr/test/test.mli @@ -0,0 +1,8 @@ +type t +type runner = private { directory: string } +type ('a, 'b) str = ('a -> 'b, Format.formatter, unit, string) format4 + +val check : bool -> unit +val test : title:string -> descr:string -> (unit -> unit) -> t +val runner : ?g:Random.State.t -> ?fmt:(string, string) str -> string -> runner +val run : runner -> t -> unit diff --git a/unikernel/duniverse/bytes/.gitignore b/unikernel/duniverse/bytes/.gitignore new file mode 100644 index 00000000..59286b4b --- /dev/null +++ b/unikernel/duniverse/bytes/.gitignore @@ -0,0 +1,2 @@ +/_build +/*.install diff --git a/unikernel/duniverse/bytes/LICENSE.txt b/unikernel/duniverse/bytes/LICENSE.txt new file mode 100644 index 00000000..dd746720 --- /dev/null +++ b/unikernel/duniverse/bytes/LICENSE.txt @@ -0,0 +1,18 @@ +Copyright (c) 2022 Kate + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/unikernel/duniverse/bytes/bytes.opam b/unikernel/duniverse/bytes/bytes.opam new file mode 100644 index 00000000..ed0ea212 --- /dev/null +++ b/unikernel/duniverse/bytes/bytes.opam @@ -0,0 +1,14 @@ +opam-version: "2.0" +version: "0.1.0" +license: "MIT" +synopsis: "Bytes library distributed with the OCaml compiler" +maintainer: "Kate " +authors: "Kate " +homepage: "https://github.com/kit-ty-kate/bytes" +bug-reports: "https://github.com/kit-ty-kate/bytes/issues" +dev-repo: "git+https://github.com/kit-ty-kate/bytes" +depends: [ + "ocaml" {>= "4.02"} + "dune" {>= "1.0"} +] +build: ["dune" "build" "-p" name "-j" jobs] diff --git a/unikernel/duniverse/bytes/dune b/unikernel/duniverse/bytes/dune new file mode 100644 index 00000000..60896943 --- /dev/null +++ b/unikernel/duniverse/bytes/dune @@ -0,0 +1,4 @@ +(library + (name bytes) + (public_name bytes) + (wrapped false)) diff --git a/unikernel/duniverse/bytes/dune-project b/unikernel/duniverse/bytes/dune-project new file mode 100644 index 00000000..77d913c4 --- /dev/null +++ b/unikernel/duniverse/bytes/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.0) +(name bytes) +(version 0.1.0) diff --git a/unikernel/duniverse/ca-certs-nss/.gitignore b/unikernel/duniverse/ca-certs-nss/.gitignore new file mode 100644 index 00000000..80918715 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/.gitignore @@ -0,0 +1,3 @@ +_build +_opam +.merlin diff --git a/unikernel/duniverse/ca-certs-nss/.ocamlformat b/unikernel/duniverse/ca-certs-nss/.ocamlformat new file mode 100644 index 00000000..8429a75b --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/.ocamlformat @@ -0,0 +1,2 @@ +version = 0.27.0 +profile=conventional diff --git a/unikernel/duniverse/ca-certs-nss/CHANGES.md b/unikernel/duniverse/ca-certs-nss/CHANGES.md new file mode 100644 index 00000000..5394e648 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/CHANGES.md @@ -0,0 +1,125 @@ +# v3.117 (2025-10-13) + +* Update to NSS 3.117 (2025-10-03) + +# v3.115 (2025-08-15) + +* Update to NSS 3.115 (2025-08-15) + +# v3.114 (2025-07-24) + +* Update to NSS 3.114 (2025-07-17) + +# v3.113.1 (2025-07-02) + +* Update to NSS 3.113.1 (2025-07-01) +* Provide the function `trust_anchors` + +# v3.108-1 (2025-02-05) + +* Use mirage-ptime instead of functorising over PCLOCK (#11 @hannesm) + +# v3.108 (2025-02-04) + +* Update to NSS 3.108 (Feb 3rd 2025) + +# v3.107 (2024-11-27) + +* Update to NSS 3.107 (Nov 21st 2024) + +# v3.104 (2024-09-02) + +* Update to NSS 3.104 (Aug 30th 2024) + +# v3.103 (2024-08-13) + +* Update to NSS 3.103 (Aug 1st 2024) + +# v3.101-1 (2024-07-24) + +* Delete cstruct and replace it by string (@dinosaure, #9) + +# v3.101 (2024-06-11) + +* Update to NSS 3.101 (June 7th 2024) + +# v3.98 (2024-02-26) + +* Update to NSS 3.98 (Feb 15th 2024) + +# v3.95 (2023-11-28) + +* Update to NSS 3.95 (Nov 16th 2023) + +# v3.92 (2023-08-03) + +* Update to NSS 3.92 (July 27th 2023) + +# v3.89.1 (2023-05-06) + +* Update to NSS 3.89.1 (May 5th 2023) + +# v3.86 (2022-12-12) + +* Update to NSS 3.86 (Dec 8th 2022) + +# v3.83 (2022-09-16) + +* Update to NSS 3.83 (Sep 15th 2022) + +# v3.80 (2022-07-04) + +* Update to NSS 3.80 (Jun 23rd 2022) + +# v3.77 (2022-04-22) + +* Update to NSS 3.77 (Mar 31th 2022) +* Update to cmdliner 1.1.0 (#6) + +# v3.74 (2022-01-07) + +* Update to NSS 3.74 (Jan 6th 2022) +* Update to NSS 3.73.1, 3.73, 3.72 (no changes in certdata.txt) + +# v3.71.0.1 (2021-10-07) + +* Adapt to X509 0.15.0 API changes + +# v3.71 (2021-10-06) + +* Update to NSS 3.71 (Sep 30th 2021) +* Remove rresult and hex dependencies + +# v3.66 (2021-06-01) + +* Update to NSS 3.66 (May 27th 2021) + +# v3.64.0.1 (2021-04-22) + +* Update to X509 0.13.0 API (still using NSS 3.64) + +# v3.64 (2021-04-18) + +* Update to NSS 3.64 (Apr 15th 2021) + +# v3.63.1 (2021-04-14) + +* Update to NSS 3.63.1 (Apr 9th 2021) + +# v3.63 (2021-03-18) + +* Update to NSS 3.63 (Mar 18th 2021) +* Update to NSS 3.62 (Feb 19th 2021), no changes in certdata.txt +* Update to NSS 3.61 (Jan 22th 2021), no changes in certdata.txt + +# v3.60 (2020-12-20) + +* Update to NSS 3.60 release (Dec 11th 2020) + +# v3.59 (2020-11-15) + +* Update to NSS 3.59 release (Nov 13th 2020) + +# v3.57 (2020-10-13) + +* Initial public release (version numbers meet NSS releases) diff --git a/unikernel/duniverse/ca-certs-nss/LICENSE.md b/unikernel/duniverse/ca-certs-nss/LICENSE.md new file mode 100644 index 00000000..c642c8ac --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/LICENSE.md @@ -0,0 +1,15 @@ +## ISC License + +Copyright (c) 2020, The MirageOS contributors + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/unikernel/duniverse/ca-certs-nss/README.md b/unikernel/duniverse/ca-certs-nss/README.md new file mode 100644 index 00000000..c82e513f --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/README.md @@ -0,0 +1,7 @@ +# ca-root-nss + +Trust anchors extracted from Mozilla's NSS certdata.txt package, to be used +in MirageOS unikernels. + +To update trust anchors, please adjust the commit hash to the latest NSS +release in `lib/dune`, remove `certdata.txt`, and run dune build. diff --git a/unikernel/duniverse/ca-certs-nss/bin/dune b/unikernel/duniverse/ca-certs-nss/bin/dune new file mode 100644 index 00000000..dcf2989d --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/bin/dune @@ -0,0 +1,4 @@ +(executable + (name extract_from_certdata) + (public_name extract-from-certdata) + (libraries logs logs.fmt logs.cli fmt fmt.tty fmt.cli bos cmdliner x509)) diff --git a/unikernel/duniverse/ca-certs-nss/bin/extract_from_certdata.ml b/unikernel/duniverse/ca-certs-nss/bin/extract_from_certdata.ml new file mode 100644 index 00000000..44a562c4 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/bin/extract_from_certdata.ml @@ -0,0 +1,290 @@ +(* input is a certdata.txt from nss, output is a ml file with the trust anchors *) + +(* ideas from FreeBSD's security/ca-root-nss perl script, available at: + https://github.com/freebsd/freebsd-ports/blob/master/security/ca_root_nss/files/MAca-bundle.pl.in *) +let until_end data = + let rec go acc = function + | [] -> invalid_arg "unexpected end of input (expected END)" + | "END" :: tl -> (List.rev acc, tl) + | x :: tl -> go (x :: acc) tl + in + go [] data + +let decode_octal data = + let nums = String.split_on_char '\\' data in + let nums = List.filter (fun s -> String.length s = 3) nums in + let numbers = List.map (fun s -> int_of_string ("0o" ^ s)) nums in + let out = Bytes.create (List.length nums) in + List.iteri (fun i x -> Bytes.set out i (char_of_int x)) numbers; + Bytes.unsafe_to_string out + +let label_token = "CKA_LABEL UTF8 " +let serial_token = "CKA_SERIAL_NUMBER MULTILINE_OCTAL" + +let is_prefix token x = + let tl = String.length token in + String.length x >= tl && String.(equal (sub x 0 tl) token) + +let is_suffix token x = + let tl = String.length token in + let xl = String.length x in + xl >= tl && String.(equal (sub x (xl - tl) tl) token) + +let strip_prefix token x = + let tl = String.length token in + let xl = String.length x in + String.sub x tl (xl - tl) + +let label_serial id serial = function + | [] -> assert false + | x :: tl -> + if is_prefix label_token x then + let id = strip_prefix label_token x in + (Some id, serial, tl) + else if String.equal x serial_token then + let serial, rest = until_end tl in + let serial = decode_octal (String.concat "" serial) in + (id, Some serial, rest) + else (id, serial, tl) + +let get_id_serial id serial = + let id = match id with None -> invalid_arg "no ID" | Some id -> id + and serial = + match serial with None -> invalid_arg "no serial" | Some s -> s + in + (id, serial) + +let grab_cert input = + let rec go id serial cert = function + | [] -> ( + let id, serial = get_id_serial id serial in + match cert with + | None -> invalid_arg "missing certificate" + | Some x -> (id, serial, x)) + | "CKA_VALUE MULTILINE_OCTAL" :: tl -> + let cert, tl = until_end tl in + go id serial (Some cert) tl + | tl -> + let id, serial, tl = label_serial id serial tl in + go id serial cert tl + in + go None None None input + +let trust_ok_token = "CKT_NSS_TRUSTED_DELEGATOR" +and not_trusted_token = "CKT_NSS_NOT_TRUSTED" +and verify_token = "CKT_NSS_MUST_VERIFY_TRUST" + +let web_server_token = "CKA_TRUST_SERVER_AUTH" +and email_token = "CKA_TRUST_EMAIL_PROTECTION" +and code_signing_token = "CKA_TRUST_CODE_SIGNING" + +let ck_trust_token = " CK_TRUST " + +let extract_trust x = + let is_trusted x = + if is_suffix trust_ok_token x then `Trusted + else if is_suffix not_trusted_token x then `Not_trusted + else if is_suffix verify_token x then `Must_verify + else invalid_arg "unknown trust setting" + in + if is_prefix (web_server_token ^ ck_trust_token) x then + Some (`Web, is_trusted x) + else if is_prefix (email_token ^ ck_trust_token) x then + Some (`Email, is_trusted x) + else if is_prefix (code_signing_token ^ ck_trust_token) x then + Some (`Code_signing, is_trusted x) + else None + +let grab_trust input = + let rec go id serial trust = function + | [] -> + let id, serial = get_id_serial id serial in + (id, serial, trust) + | x :: tl -> ( + match extract_trust x with + | None -> + let id, serial, tl = label_serial id serial (x :: tl) in + go id serial trust tl + | Some y -> go id serial (y :: trust) tl) + in + go None None [] input + +let add (certs, trust) mode acc = + match mode with + | Some `Cert -> (List.rev acc :: certs, trust) + | Some `Trust -> (certs, List.rev acc :: trust) + | None -> (certs, trust) + +let rec split_into_certs_and_trust dbs mode acc = function + | [] -> + let certs, trust = add dbs mode acc in + (List.rev certs, List.rev trust) + | "CKA_CLASS CK_OBJECT_CLASS CKO_CERTIFICATE" :: tl -> + let dbs = add dbs mode acc in + split_into_certs_and_trust dbs (Some `Cert) [] tl + | "CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST" :: tl -> + let dbs = add dbs mode acc in + split_into_certs_and_trust dbs (Some `Trust) [] tl + | x :: tl -> split_into_certs_and_trust dbs mode (x :: acc) tl + +module M = Map.Make (struct + type t = string * string + + let compare (lbl, serial) (lbl', serial') = + match String.compare lbl lbl' with + | 0 -> String.compare serial serial' + | y -> y +end) + +let to_hex s = + let char_hex n = + Char.unsafe_chr (n + if n < 10 then Char.code '0' else Char.code 'a' - 10) + in + let slen = String.length s in + let out = Bytes.create (slen * 2) in + for i = 0 to pred slen do + let c = Char.code s.[i] in + Bytes.unsafe_set out (i * 2) (char_hex (c lsr 4)); + Bytes.unsafe_set out ((i * 2) + 1) (char_hex (c land 0x0f)) + done; + Bytes.unsafe_to_string out + +let decode data = + let certs, trust = split_into_certs_and_trust ([], []) None [] data in + let db = + List.fold_left + (fun db data -> + let id, serial, cert = grab_cert data in + let db = + M.update (id, serial) + (function + | None -> Some (Some cert, None) + | Some (None, x) -> Some (Some cert, x) + | Some (Some _, _) -> + Logs.warn (fun m -> + m "cert with %s (serial %s) already present" id + (to_hex serial)); + invalid_arg "duplicate certificate") + db + in + db) + M.empty certs + in + List.fold_left + (fun db data -> + let id, serial, trust = grab_trust data in + let db = + M.update (id, serial) + (function + | None -> Some (None, Some trust) + | Some (x, None) -> Some (x, Some trust) + | Some (_, Some _) -> + Logs.warn (fun m -> + m "trust with %s (serial %s) already present" id + (to_hex serial)); + invalid_arg "duplicate trust") + db + in + db) + db trust + +let filter_trusted ?(purpose = fun (_, _) -> true) db = + let is_trusted ys = + let y = List.filter purpose ys in + List.exists (function _, `Trusted -> true | _ -> false) y + && List.for_all (function _, `Not_trusted -> false | _ -> true) ys + in + M.fold + (fun (id, serial) (cert, trust) (acc, untrusted) -> + match (cert, trust) with + | None, _ -> + Logs.debug (fun m -> + m "ignoring %s (serial %s), no corresponding certificate" id + (to_hex serial)); + (acc, untrusted) + | Some _, None -> + Logs.warn (fun m -> + m "ignoring %s (serial %s), no corresponding trust" id + (to_hex serial)); + (acc, succ untrusted) + | Some cert, Some t -> + if is_trusted t then (M.add (id, serial) cert acc, untrusted) + else ( + Logs.warn (fun m -> + m "Untrusted certificate %s (serial %s)" id (to_hex serial)); + (acc, succ untrusted))) + db (M.empty, 0) + +let header = + "(* automatically extracted from certdata.txt by ca-certs-nss v3.117. *)" + +let stats ucount tcount dcount = + Fmt.str "(* processed %d certificates, %d untrusted, %d trusted. *)%s" + (ucount + tcount + dcount) + ucount tcount + (if dcount > 0 then + "\n(* Omitted " ^ string_of_int dcount ^ " certificates (decoding). *)" + else "") + +let to_ml untrusted db = + let certs, decoding_issues = + M.fold + (fun (lbl, _) cert (acc, dec) -> + let der = decode_octal (String.concat "" cert) in + match X509.Certificate.decode_der der with + | Ok _cert -> + (("(* " ^ lbl ^ " *) \"" ^ String.escaped der ^ "\"") :: acc, dec) + | Error (`Msg msg) -> + Logs.warn (fun m -> m "failed to decode certificate: %s" msg); + (acc, succ dec)) + db ([], 0) + in + String.concat "\n" + [ + header; + stats untrusted (List.length certs) decoding_issues; + ""; + "let certificates = ["; + " " ^ String.concat ";\n " (List.rev certs); + "]"; + ""; + ] + +let jump () filename output = + Result.bind + (Bos.OS.File.read_lines (Fpath.v filename)) + (fun data -> + let certs = decode data in + let trusted_certs, untrusted = filter_trusted certs in + Logs.debug (fun m -> + m "found %d certificates (%d total):" (M.cardinal trusted_certs) + (M.cardinal certs)); + let out = to_ml untrusted trusted_certs in + let fn = match output with None -> "-" | Some filename -> filename in + Bos.OS.File.write (Fpath.v fn) out) + +let setup_log style_renderer level = + Fmt_tty.setup_std_outputs ?style_renderer (); + Logs.set_level level; + Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ()) + +open Cmdliner + +let setup_log = + Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ()) + +let input = + let doc = "Full path to certdata.txt." in + Arg.(required & pos 0 (some file) None & info [] ~doc ~docv:"CERTDATA.TXT") + +let output = + let doc = "Output filename (defaults to stdout)." in + Arg.(value & opt (some string) None & info [ "output" ] ~doc) + +let cmd = + let doc = "Extract NSS certdata.txt into OCaml code" in + let term = Term.(term_result (const jump $ setup_log $ input $ output)) + and info = Cmd.info "extract-from-certdata" ~version:"3.117" ~doc in + Cmd.v info term + +let () = exit (Cmd.eval cmd) diff --git a/unikernel/duniverse/ca-certs-nss/ca-certs-nss.opam b/unikernel/duniverse/ca-certs-nss/ca-certs-nss.opam new file mode 100644 index 00000000..ab290bbd --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/ca-certs-nss.opam @@ -0,0 +1,46 @@ +version: "3.117" +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "X.509 trust anchors extracted from Mozilla's NSS" +description: """ +Trust anchors extracted from Mozilla's NSS certdata.txt package, +to be used in MirageOS unikernels. +""" +maintainer: ["Hannes Mehnert "] +authors: ["Hannes Mehnert "] +license: "ISC" +homepage: "https://github.com/mirage/ca-certs-nss" +doc: "https://mirage.github.io/ca-certs-nss/doc" +bug-reports: "https://github.com/mirage/ca-certs-nss/issues" +depends: [ + "dune" {>= "2.7"} + "mirage-ptime" {>= "4.0.0"} + "x509" {>= "1.0.0"} + "ocaml" {>= "4.13.0"} + "digestif" {>= "1.2.0"} + "logs" {build} + "fmt" {build & >= "0.8.7"} + "bos" {build} + "cmdliner" {build & >= "1.1.0"} + "alcotest" {with-test} + "odoc" {with-doc} +] +conflicts: [ + "result" {< "1.5"} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/mirage/ca-certs-nss.git" +tags: ["org:mirage"] \ No newline at end of file diff --git a/unikernel/duniverse/ca-certs-nss/ca-certs-nss.opam.template b/unikernel/duniverse/ca-certs-nss/ca-certs-nss.opam.template new file mode 100644 index 00000000..6bf78121 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/ca-certs-nss.opam.template @@ -0,0 +1 @@ +tags: ["org:mirage"] diff --git a/unikernel/duniverse/ca-certs-nss/dune-project b/unikernel/duniverse/ca-certs-nss/dune-project new file mode 100644 index 00000000..39b67be5 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/dune-project @@ -0,0 +1,32 @@ +(lang dune 2.7) +(name ca-certs-nss) +(version v3.117) + +(generate_opam_files true) +(source (github mirage/ca-certs-nss)) +(documentation "https://mirage.github.io/ca-certs-nss/doc") +(license ISC) +(maintainers "Hannes Mehnert ") +(authors "Hannes Mehnert ") + +(package + (name ca-certs-nss) + (depends + (mirage-ptime (>= 4.0.0)) + (x509 (>= 1.0.0)) + (ocaml (>= 4.13.0)) + (digestif (>= 1.2.0)) + (logs :build) + (fmt (and :build (>= 0.8.7))) + (bos :build) + (cmdliner (and :build (>= 1.1.0))) + (alcotest :with-test)) + (conflicts (result (< 1.5))) + (synopsis "X.509 trust anchors extracted from Mozilla's NSS") + (description + "\> Trust anchors extracted from Mozilla's NSS certdata.txt package, + "\> to be used in MirageOS unikernels. + ) + ; tags are not included before (lang dune 2.0) + ; so an opam template is necessary until then + (tags (org:mirage))) diff --git a/unikernel/duniverse/ca-certs-nss/lib/ca_certs_nss.ml b/unikernel/duniverse/ca-certs-nss/lib/ca_certs_nss.ml new file mode 100644 index 00000000..54dd96c1 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/lib/ca_certs_nss.ml @@ -0,0 +1,15 @@ +let trust_anchors = + List.fold_left + (fun acc data -> + Result.bind acc (fun acc -> + Result.map + (fun cert -> cert :: acc) + (X509.Certificate.decode_der data))) + (Ok []) Trust_anchor.certificates + +let authenticator = + let time () = Some (Mirage_ptime.now ()) in + fun ?crls ?allowed_hashes () -> + Result.map + (X509.Authenticator.chain_of_trust ~time ?crls ?allowed_hashes) + trust_anchors diff --git a/unikernel/duniverse/ca-certs-nss/lib/ca_certs_nss.mli b/unikernel/duniverse/ca-certs-nss/lib/ca_certs_nss.mli new file mode 100644 index 00000000..995b5c12 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/lib/ca_certs_nss.mli @@ -0,0 +1,11 @@ +val trust_anchors : (X509.Certificate.t list, [> `Msg of string ]) result +(** [trust_anchors] are the trust anchors extracted from NSS certdata.txt. *) + +val authenticator : + ?crls:X509.CRL.t list -> + ?allowed_hashes:Digestif.hash' list -> + unit -> + (X509.Authenticator.t, [> `Msg of string ]) result +(** [authenticator ~crls ~hash_whitelist ()] is an authenticator with the + provided revocation lists, and allowed_hashes. The trust anchors are based + on the extraction from NSS' certdata.txt. *) diff --git a/unikernel/duniverse/ca-certs-nss/lib/dune b/unikernel/duniverse/ca-certs-nss/lib/dune new file mode 100644 index 00000000..c1dafd75 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/lib/dune @@ -0,0 +1,22 @@ +; to update, browse to https://hg.mozilla.org/projects/nss/tags +; find the last release (click on the tag, find the "changeset .. ID" line) +; rm -f lib/certdata.txt +; dune build lib/certdata.txt +; mv _build/default/lib/certdata.txt lib +;(rule +; (targets certdata.txt) +; (action +; (bash +; "wget https://hg.mozilla.org/projects/nss/raw-file/6f5cf4984f6b0873cb689dd0c1f50a9264741b93/lib/ckfw/builtins/certdata.txt -O %{targets}"))) + +(rule + (targets trust_anchor.ml) + (deps certdata.txt) + (action + (run %{bin:extract-from-certdata} certdata.txt --output trust_anchor.ml))) + +(library + (name ca_certs_nss) + (public_name ca-certs-nss) + (modules ca_certs_nss trust_anchor) + (libraries x509 mirage-ptime digestif)) diff --git a/unikernel/duniverse/ca-certs-nss/test/dune b/unikernel/duniverse/ca-certs-nss/test/dune new file mode 100644 index 00000000..bff21cf4 --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/test/dune @@ -0,0 +1,3 @@ +(test + (name tests) + (libraries ca-certs-nss alcotest mirage-ptime.mock mirage-ptime.set)) diff --git a/unikernel/duniverse/ca-certs-nss/test/tests.ml b/unikernel/duniverse/ca-certs-nss/test/tests.ml new file mode 100644 index 00000000..16f0089e --- /dev/null +++ b/unikernel/duniverse/ca-certs-nss/test/tests.ml @@ -0,0 +1,1041 @@ +(* How to add a new test? + Execute for a host of interest h: + "echo foo | openssl s_client -connect h:443 -showcerts -no_ticket > out.txt" + let h_data = {|M-x insert-file out.txt|} + Add either to ok_tests or to err_tests (the expected error is required) + + Please note: + - now is set to a static date (below, can be set to other dates in individual tests) + - there's no revocation checks +*) +let ts_2022_01_07 = + match Ptime.of_date_time ((2022, 01, 07), ((12, 00, 00), 00)) with + | None -> assert false + | Some t -> Ptime.(Span.to_d_ps (to_span t)) + +let ts_2020_10_11 = + match Ptime.of_date_time ((2020, 10, 11), ((16, 00, 00), 00)) with + | None -> assert false + | Some t -> Ptime.(Span.to_d_ps (to_span t)) + +let ts_2020_05_30 = + match Ptime.of_date_time ((2020, 05, 30), ((16, 00, 00), 00)) with + | None -> assert false + | Some t -> Ptime.(Span.to_d_ps (to_span t)) + +let err = + let module M = struct + type t = X509.Validation.validation_error + + let pp = X509.Validation.pp_validation_error + let equal a b = compare a b = 0 (* TODO relies on polymorphic equality *) + end in + (module M : Alcotest.TESTABLE with type t = M.t) + +let ok = + let module M = struct + type t = (X509.Certificate.t list * X509.Certificate.t) option + + let pp ppf = function + | None -> Fmt.string ppf "none" + | Some (chain, _) -> + Fmt.(list ~sep:(any ", ") X509.Certificate.pp) ppf chain + + let equal a b = + match (a, b) with + | None, None -> true + | Some (a, _), Some (b, _) -> + let rec cmp_lists = function + (* TODO relies on polymorphic equality *) + | hd :: tl, hd' :: tl' -> compare hd hd' = 0 && cmp_lists (tl, tl') + | _, [] -> true + | _ -> false + in + cmp_lists (a, b) + | _ -> false + end in + (module M : Alcotest.TESTABLE with type t = M.t) + +let r = Alcotest.result ok err + +let test_one ta ts result host chain () = + let name, ip, host = + match host with + | `Ip ip -> (Ipaddr.to_string ip, Some ip, None) + | `Host h -> (Domain_name.to_string h, None, Some h) + in + Mirage_ptime_set.set ts; + Alcotest.check r ("test one " ^ name) result (ta ?ip ~host chain) + +let google = + {| +CONNECTED(00000004) +--- +Certificate chain + 0 s:CN = *.google.com + i:C = US, O = Google Trust Services LLC, CN = GTS CA 1C3 +-----BEGIN CERTIFICATE----- +MIINsjCCDJqgAwIBAgIRAPq8ife/MxCUCgAAAAEl/TIwDQYJKoZIhvcNAQELBQAw +RjELMAkGA1UEBhMCVVMxIjAgBgNVBAoTGUdvb2dsZSBUcnVzdCBTZXJ2aWNlcyBM +TEMxEzARBgNVBAMTCkdUUyBDQSAxQzMwHhcNMjExMTI5MDIyMjMzWhcNMjIwMjIx +MDIyMjMyWjAXMRUwEwYDVQQDDAwqLmdvb2dsZS5jb20wWTATBgcqhkjOPQIBBggq +hkjOPQMBBwNCAAShwtJ0zDJohmgYDI9a4Sxu+2c8JyYLtfnS/wdyRoIXUchfFuyr +WO+bwp1BW6Fkauoqu0LeDXO8oysHN8gba4Vdo4ILkzCCC48wDgYDVR0PAQH/BAQD +AgeAMBMGA1UdJQQMMAoGCCsGAQUFBwMBMAwGA1UdEwEB/wQCMAAwHQYDVR0OBBYE +FAQOcJ1gEZcBGw5+crGZ5Sj3KeByMB8GA1UdIwQYMBaAFIp0f6+Fze6VzT2c0OJG +FPNxNR0nMGoGCCsGAQUFBwEBBF4wXDAnBggrBgEFBQcwAYYbaHR0cDovL29jc3Au +cGtpLmdvb2cvZ3RzMWMzMDEGCCsGAQUFBzAChiVodHRwOi8vcGtpLmdvb2cvcmVw +by9jZXJ0cy9ndHMxYzMuZGVyMIIJQgYDVR0RBIIJOTCCCTWCDCouZ29vZ2xlLmNv +bYIWKi5hcHBlbmdpbmUuZ29vZ2xlLmNvbYIJKi5iZG4uZGV2ghIqLmNsb3VkLmdv +b2dsZS5jb22CGCouY3Jvd2Rzb3VyY2UuZ29vZ2xlLmNvbYIYKi5kYXRhY29tcHV0 +ZS5nb29nbGUuY29tggsqLmdvb2dsZS5jYYILKi5nb29nbGUuY2yCDiouZ29vZ2xl +LmNvLmlugg4qLmdvb2dsZS5jby5qcIIOKi5nb29nbGUuY28udWuCDyouZ29vZ2xl +LmNvbS5hcoIPKi5nb29nbGUuY29tLmF1gg8qLmdvb2dsZS5jb20uYnKCDyouZ29v +Z2xlLmNvbS5jb4IPKi5nb29nbGUuY29tLm14gg8qLmdvb2dsZS5jb20udHKCDyou +Z29vZ2xlLmNvbS52boILKi5nb29nbGUuZGWCCyouZ29vZ2xlLmVzggsqLmdvb2ds +ZS5mcoILKi5nb29nbGUuaHWCCyouZ29vZ2xlLml0ggsqLmdvb2dsZS5ubIILKi5n +b29nbGUucGyCCyouZ29vZ2xlLnB0ghIqLmdvb2dsZWFkYXBpcy5jb22CDyouZ29v +Z2xlYXBpcy5jboIRKi5nb29nbGV2aWRlby5jb22CDCouZ3N0YXRpYy5jboIQKi5n +c3RhdGljLWNuLmNvbYIPZ29vZ2xlY25hcHBzLmNughEqLmdvb2dsZWNuYXBwcy5j +boIRZ29vZ2xlYXBwcy1jbi5jb22CEyouZ29vZ2xlYXBwcy1jbi5jb22CDGdrZWNu +YXBwcy5jboIOKi5na2VjbmFwcHMuY26CEmdvb2dsZWRvd25sb2Fkcy5jboIUKi5n +b29nbGVkb3dubG9hZHMuY26CEHJlY2FwdGNoYS5uZXQuY26CEioucmVjYXB0Y2hh +Lm5ldC5jboILd2lkZXZpbmUuY26CDSoud2lkZXZpbmUuY26CEWFtcHByb2plY3Qu +b3JnLmNughMqLmFtcHByb2plY3Qub3JnLmNughFhbXBwcm9qZWN0Lm5ldC5jboIT +Ki5hbXBwcm9qZWN0Lm5ldC5jboIXZ29vZ2xlLWFuYWx5dGljcy1jbi5jb22CGSou +Z29vZ2xlLWFuYWx5dGljcy1jbi5jb22CF2dvb2dsZWFkc2VydmljZXMtY24uY29t +ghkqLmdvb2dsZWFkc2VydmljZXMtY24uY29tghFnb29nbGV2YWRzLWNuLmNvbYIT +Ki5nb29nbGV2YWRzLWNuLmNvbYIRZ29vZ2xlYXBpcy1jbi5jb22CEyouZ29vZ2xl +YXBpcy1jbi5jb22CFWdvb2dsZW9wdGltaXplLWNuLmNvbYIXKi5nb29nbGVvcHRp +bWl6ZS1jbi5jb22CEmRvdWJsZWNsaWNrLWNuLm5ldIIUKi5kb3VibGVjbGljay1j +bi5uZXSCGCouZmxzLmRvdWJsZWNsaWNrLWNuLm5ldIIWKi5nLmRvdWJsZWNsaWNr +LWNuLm5ldIIOZG91YmxlY2xpY2suY26CECouZG91YmxlY2xpY2suY26CFCouZmxz +LmRvdWJsZWNsaWNrLmNughIqLmcuZG91YmxlY2xpY2suY26CEWRhcnRzZWFyY2gt +Y24ubmV0ghMqLmRhcnRzZWFyY2gtY24ubmV0gh1nb29nbGV0cmF2ZWxhZHNlcnZp +Y2VzLWNuLmNvbYIfKi5nb29nbGV0cmF2ZWxhZHNlcnZpY2VzLWNuLmNvbYIYZ29v +Z2xldGFnc2VydmljZXMtY24uY29tghoqLmdvb2dsZXRhZ3NlcnZpY2VzLWNuLmNv +bYIXZ29vZ2xldGFnbWFuYWdlci1jbi5jb22CGSouZ29vZ2xldGFnbWFuYWdlci1j +bi5jb22CGGdvb2dsZXN5bmRpY2F0aW9uLWNuLmNvbYIaKi5nb29nbGVzeW5kaWNh +dGlvbi1jbi5jb22CJCouc2FmZWZyYW1lLmdvb2dsZXN5bmRpY2F0aW9uLWNuLmNv +bYIWYXBwLW1lYXN1cmVtZW50LWNuLmNvbYIYKi5hcHAtbWVhc3VyZW1lbnQtY24u +Y29tggtndnQxLWNuLmNvbYINKi5ndnQxLWNuLmNvbYILZ3Z0Mi1jbi5jb22CDSou +Z3Z0Mi1jbi5jb22CCzJtZG4tY24ubmV0gg0qLjJtZG4tY24ubmV0ghRnb29nbGVm +bGlnaHRzLWNuLm5ldIIWKi5nb29nbGVmbGlnaHRzLWNuLm5ldIIMYWRtb2ItY24u +Y29tgg4qLmFkbW9iLWNuLmNvbYINKi5nc3RhdGljLmNvbYIUKi5tZXRyaWMuZ3N0 +YXRpYy5jb22CCiouZ3Z0MS5jb22CESouZ2NwY2RuLmd2dDEuY29tggoqLmd2dDIu +Y29tgg4qLmdjcC5ndnQyLmNvbYIQKi51cmwuZ29vZ2xlLmNvbYIWKi55b3V0dWJl +LW5vY29va2llLmNvbYILKi55dGltZy5jb22CC2FuZHJvaWQuY29tgg0qLmFuZHJv +aWQuY29tghMqLmZsYXNoLmFuZHJvaWQuY29tggRnLmNuggYqLmcuY26CBGcuY2+C +BiouZy5jb4IGZ29vLmdsggp3d3cuZ29vLmdsghRnb29nbGUtYW5hbHl0aWNzLmNv +bYIWKi5nb29nbGUtYW5hbHl0aWNzLmNvbYIKZ29vZ2xlLmNvbYISZ29vZ2xlY29t +bWVyY2UuY29tghQqLmdvb2dsZWNvbW1lcmNlLmNvbYIIZ2dwaHQuY26CCiouZ2dw +aHQuY26CCnVyY2hpbi5jb22CDCoudXJjaGluLmNvbYIIeW91dHUuYmWCC3lvdXR1 +YmUuY29tgg0qLnlvdXR1YmUuY29tghR5b3V0dWJlZWR1Y2F0aW9uLmNvbYIWKi55 +b3V0dWJlZWR1Y2F0aW9uLmNvbYIPeW91dHViZWtpZHMuY29tghEqLnlvdXR1YmVr +aWRzLmNvbYIFeXQuYmWCByoueXQuYmWCGmFuZHJvaWQuY2xpZW50cy5nb29nbGUu +Y29tghtkZXZlbG9wZXIuYW5kcm9pZC5nb29nbGUuY26CHGRldmVsb3BlcnMuYW5k +cm9pZC5nb29nbGUuY26CGHNvdXJjZS5hbmRyb2lkLmdvb2dsZS5jbjAhBgNVHSAE +GjAYMAgGBmeBDAECATAMBgorBgEEAdZ5AgUDMDwGA1UdHwQ1MDMwMaAvoC2GK2h0 +dHA6Ly9jcmxzLnBraS5nb29nL2d0czFjMy9RcUZ4Ymk5TTQ4Yy5jcmwwggEFBgor +BgEEAdZ5AgQCBIH2BIHzAPEAdwApeb7wnjk5IfBWc59jpXflvld9nGAK+PlNXSZc +JV3HhAAAAX1pt0b0AAAEAwBIMEYCIQC1x9lAp2IZtthi0mxfjtSDXCR714tElKsl +M61c4kJv/gIhAJPjgGFY5XBnQSaV/jHFfoRcbksMU+lruflT+sfvLLqcAHYAQcjK +sd8iRkoQxqE6CUKHXk4xixsD6+tLx2jwkGKWBvYAAAF9abdHmAAABAMARzBFAiEA +hzUCqPYG77z0wZUE3y2DmZhTaStBB9BMVBfYSQmYTogCIHbA8hBzj6kjpaw57Zid +tP5Dz5Zli2xOJQB+W4s15tI8MA0GCSqGSIb3DQEBCwUAA4IBAQB2aorYRKwUQJI2 +80q1y1Q2Z8c6pem1MWxRX/Ptapmsp1ucrsmu+VaC1YMCSlW1exVieyMhOIvcKDBy +/8L0FUEAmsL8fCTroRQ4DnZVLelFk9vmVsiSQtfYHOf6rwEbOrv+94kk964iQCLQ +FYN5klRqI0hWa3wYe6tnXm/2PvPbAwqsnAq3q+Iek+3pGm6YTshJyA7P9L176psd +dm6slAYpHOryFcrvXzu1lHSylCAFNT/OYcH1GLTf0qJXuN7YnX9swoYu2oCDkIyA +Hss2DDp7f8qf0VgDNNxZB8drZ9ID85YA3qgeIbHHAB8UIj8qkKXkmybfMxVL0lz3 +iY73asSm +-----END CERTIFICATE----- + 1 s:C = US, O = Google Trust Services LLC, CN = GTS CA 1C3 + i:C = US, O = Google Trust Services LLC, CN = GTS Root R1 +-----BEGIN CERTIFICATE----- +MIIFljCCA36gAwIBAgINAgO8U1lrNMcY9QFQZjANBgkqhkiG9w0BAQsFADBHMQsw +CQYDVQQGEwJVUzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEU +MBIGA1UEAxMLR1RTIFJvb3QgUjEwHhcNMjAwODEzMDAwMDQyWhcNMjcwOTMwMDAw +MDQyWjBGMQswCQYDVQQGEwJVUzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZp +Y2VzIExMQzETMBEGA1UEAxMKR1RTIENBIDFDMzCCASIwDQYJKoZIhvcNAQEBBQAD +ggEPADCCAQoCggEBAPWI3+dijB43+DdCkH9sh9D7ZYIl/ejLa6T/belaI+KZ9hzp +kgOZE3wJCor6QtZeViSqejOEH9Hpabu5dOxXTGZok3c3VVP+ORBNtzS7XyV3NzsX +lOo85Z3VvMO0Q+sup0fvsEQRY9i0QYXdQTBIkxu/t/bgRQIh4JZCF8/ZK2VWNAcm +BA2o/X3KLu/qSHw3TT8An4Pf73WELnlXXPxXbhqW//yMmqaZviXZf5YsBvcRKgKA +gOtjGDxQSYflispfGStZloEAoPtR28p3CwvJlk/vcEnHXG0g/Zm0tOLKLnf9LdwL +tmsTDIwZKxeWmLnwi/agJ7u2441Rj72ux5uxiZ0CAwEAAaOCAYAwggF8MA4GA1Ud +DwEB/wQEAwIBhjAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwEgYDVR0T +AQH/BAgwBgEB/wIBADAdBgNVHQ4EFgQUinR/r4XN7pXNPZzQ4kYU83E1HScwHwYD +VR0jBBgwFoAU5K8rJnEaK0gnhS9SZizv8IkTcT4waAYIKwYBBQUHAQEEXDBaMCYG +CCsGAQUFBzABhhpodHRwOi8vb2NzcC5wa2kuZ29vZy9ndHNyMTAwBggrBgEFBQcw +AoYkaHR0cDovL3BraS5nb29nL3JlcG8vY2VydHMvZ3RzcjEuZGVyMDQGA1UdHwQt +MCswKaAnoCWGI2h0dHA6Ly9jcmwucGtpLmdvb2cvZ3RzcjEvZ3RzcjEuY3JsMFcG +A1UdIARQME4wOAYKKwYBBAHWeQIFAzAqMCgGCCsGAQUFBwIBFhxodHRwczovL3Br +aS5nb29nL3JlcG9zaXRvcnkvMAgGBmeBDAECATAIBgZngQwBAgIwDQYJKoZIhvcN +AQELBQADggIBAIl9rCBcDDy+mqhXlRu0rvqrpXJxtDaV/d9AEQNMwkYUuxQkq/BQ +cSLbrcRuf8/xam/IgxvYzolfh2yHuKkMo5uhYpSTld9brmYZCwKWnvy15xBpPnrL +RklfRuFBsdeYTWU0AIAaP0+fbH9JAIFTQaSSIYKCGvGjRFsqUBITTcFTNvNCCK9U ++o53UxtkOCcXCb1YyRt8OS1b887U7ZfbFAO/CVMkH8IMBHmYJvJh8VNS/UKMG2Yr +PxWhu//2m+OBmgEGcYk1KCTd4b3rGS3hSMs9WYNRtHTGnXzGsYZbr8w0xNPM1IER +lQCh9BIiAfq0g3GvjLeMcySsN1PCAJA/Ef5c7TaUEDu9Ka7ixzpiO2xj2YC/WXGs +Yye5TBeg2vZzFb8q3o/zpWwygTMD0IZRcZk0upONXbVRWPeyk+gB9lm+cZv9TSjO +z23HFtz30dZGm6fKa+l3D/2gthsjgx0QGtkJAITgRNOidSOzNIb2ILCkXhAd4FJG +AJ2xDx8hcFH1mt0G/FX0Kw4zd8NLQsLxdxP8c4CU6x+7Nz/OAipmsHMdMqUybDKw +juDEI/9bfU1lcKwrmz3O2+BtjjKAvpafkmO8l7tdufThcV4q5O8DIrGKZTqPwJNl +1IXNDw9bg1kWRxYtnCQ6yICmJhSFm/Y3m6xv+cXDBlHz4n/FsRC6UfTd +-----END CERTIFICATE----- + 2 s:C = US, O = Google Trust Services LLC, CN = GTS Root R1 + i:C = BE, O = GlobalSign nv-sa, OU = Root CA, CN = GlobalSign Root CA +-----BEGIN CERTIFICATE----- +MIIFYjCCBEqgAwIBAgIQd70NbNs2+RrqIQ/E8FjTDTANBgkqhkiG9w0BAQsFADBX +MQswCQYDVQQGEwJCRTEZMBcGA1UEChMQR2xvYmFsU2lnbiBudi1zYTEQMA4GA1UE +CxMHUm9vdCBDQTEbMBkGA1UEAxMSR2xvYmFsU2lnbiBSb290IENBMB4XDTIwMDYx +OTAwMDA0MloXDTI4MDEyODAwMDA0MlowRzELMAkGA1UEBhMCVVMxIjAgBgNVBAoT +GUdvb2dsZSBUcnVzdCBTZXJ2aWNlcyBMTEMxFDASBgNVBAMTC0dUUyBSb290IFIx +MIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAthECix7joXebO9y/lD63 +ladAPKH9gvl9MgaCcfb2jH/76Nu8ai6Xl6OMS/kr9rH5zoQdsfnFl97vufKj6bwS +iV6nqlKr+CMny6SxnGPb15l+8Ape62im9MZaRw1NEDPjTrETo8gYbEvs/AmQ351k +KSUjB6G00j0uYODP0gmHu81I8E3CwnqIiru6z1kZ1q+PsAewnjHxgsHA3y6mbWwZ +DrXYfiYaRQM9sHmklCitD38m5agI/pboPGiUU+6DOogrFZYJsuB6jC511pzrp1Zk +j5ZPaK49l8KEj8C8QMALXL32h7M1bKwYUH+E4EzNktMg6TO8UpmvMrUpsyUqtEj5 +cuHKZPfmghCN6J3Cioj6OGaK/GP5Afl4/Xtcd/p2h/rs37EOeZVXtL0m79YB0esW +CruOC7XFxYpVq9Os6pFLKcwZpDIlTirxZUTQAs6qzkm06p98g7BAe+dDq6dso499 +iYH6TKX/1Y7DzkvgtdizjkXPdsDtQCv9Uw+wp9U7DbGKogPeMa3Md+pvez7W35Ei +Eua++tgy/BBjFFFy3l3WFpO9KWgz7zpm7AeKJt8T11dleCfeXkkUAKIAf5qoIbap +sZWwpbkNFhHax2xIPEDgfg1azVY80ZcFuctL7TlLnMQ/0lUTbiSw1nH69MG6zO0b +9f6BQdgAmD06yK56mDcYBZUCAwEAAaOCATgwggE0MA4GA1UdDwEB/wQEAwIBhjAP +BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTkrysmcRorSCeFL1JmLO/wiRNxPjAf +BgNVHSMEGDAWgBRge2YaRQ2XyolQL30EzTSo//z9SzBgBggrBgEFBQcBAQRUMFIw +JQYIKwYBBQUHMAGGGWh0dHA6Ly9vY3NwLnBraS5nb29nL2dzcjEwKQYIKwYBBQUH +MAKGHWh0dHA6Ly9wa2kuZ29vZy9nc3IxL2dzcjEuY3J0MDIGA1UdHwQrMCkwJ6Al +oCOGIWh0dHA6Ly9jcmwucGtpLmdvb2cvZ3NyMS9nc3IxLmNybDA7BgNVHSAENDAy +MAgGBmeBDAECATAIBgZngQwBAgIwDQYLKwYBBAHWeQIFAwIwDQYLKwYBBAHWeQIF +AwMwDQYJKoZIhvcNAQELBQADggEBADSkHrEoo9C0dhemMXoh6dFSPsjbdBZBiLg9 +NR3t5P+T4Vxfq7vqfM/b5A3Ri1fyJm9bvhdGaJQ3b2t6yMAYN/olUazsaL+yyEn9 +WprKASOshIArAoyZl+tJaox118fessmXn1hIVw41oeQa1v1vg4Fv74zPl6/AhSrw +9U5pCZEt4Wi4wStz6dTZ/CLANx8LZh1J7QJVj2fhMtfTJr9w4z30Z209fOU0iOMy ++qduBmpvvYuR7hZL6Dupszfnw0Skfths18dG9ZKb59UhvmaSGZRVbNQpsg3BZlvi +d0lIKO2d1xozclOzgjXPYovJJIultzkMu34qQb9Sz/yilrbCgj8= +-----END CERTIFICATE----- +--- +Server certificate +subject=CN = *.google.com + +issuer=C = US, O = Google Trust Services LLC, CN = GTS CA 1C3 + +--- +No client certificate CA names sent +Peer signing digest: SHA256 +Peer signature type: ECDSA +Server Temp Key: X25519, 253 bits +--- +SSL handshake has read 6640 bytes and written 388 bytes +Verification: OK +--- +New, TLSv1.3, Cipher is TLS_AES_256_GCM_SHA384 +Server public key is 256 bit +Secure Renegotiation IS NOT supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +Early data was not sent +Verify return code: 0 (ok) +--- +|} + +let extended_validation_badssl = + {| +CONNECTED(00000003) +--- +Certificate chain + 0 s:businessCategory = Private Organization, jurisdictionC = US, jurisdictionST = California, serialNumber = C2543436, C = US, ST = California, L = Mountain View, O = Mozilla Foundation, CN = extended-validation.badssl.com + i:C = US, O = DigiCert Inc, OU = www.digicert.com, CN = DigiCert SHA2 Extended Validation Server CA +-----BEGIN CERTIFICATE----- +MIIHZDCCBkygAwIBAgIQDtsxL6s4mGkViYnesbc/1zANBgkqhkiG9w0BAQsFADB1 +MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3 +d3cuZGlnaWNlcnQuY29tMTQwMgYDVQQDEytEaWdpQ2VydCBTSEEyIEV4dGVuZGVk +IFZhbGlkYXRpb24gU2VydmVyIENBMB4XDTIwMDYyMzAwMDAwMFoXDTIyMDgxMDEy +MDAwMFowgeQxHTAbBgNVBA8MFFByaXZhdGUgT3JnYW5pemF0aW9uMRMwEQYLKwYB +BAGCNzwCAQMTAlVTMRswGQYLKwYBBAGCNzwCAQITCkNhbGlmb3JuaWExETAPBgNV +BAUTCEMyNTQzNDM2MQswCQYDVQQGEwJVUzETMBEGA1UECBMKQ2FsaWZvcm5pYTEW +MBQGA1UEBxMNTW91bnRhaW4gVmlldzEbMBkGA1UEChMSTW96aWxsYSBGb3VuZGF0 +aW9uMScwJQYDVQQDEx5leHRlbmRlZC12YWxpZGF0aW9uLmJhZHNzbC5jb20wggEi +MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDCBOz4jO4EwrPYUNVwWMyTGOtc +qGhJsCK1+ZWesSssdj5swEtgTEzqsrTAD4C2sPlyyYYC+VxBXRMrf3HES7zplC5Q +N6ZnHGGM9kFCxUbTFocnn3TrCp0RUiYhc2yETHlV5NFr6AY9SBVSrbMo26r/bv9g +lUp3aznxJNExtt1NwMT8U7ltQq21fP6u9RXSM0jnInHHwhR6bCjqN0rf6my1crR+ +WqIW3GmxV0TbChKr3sMPR3RcQSLhmvkbk+atIgYpLrG6SRwMJ56j+4v3QHIArJII +2YxXhFOBBcvm/mtUmEAnhccQu3Nw72kYQQdFVXz5ZD89LMOpfOuTGkyG0cqFAgMB +AAGjggN+MIIDejAfBgNVHSMEGDAWgBQ901Cl1qCt7vNKYApl0yHU+PjWDzAdBgNV +HQ4EFgQUne7Be4ELOkdpcRh9ETeTvKUbP/swKQYDVR0RBCIwIIIeZXh0ZW5kZWQt +dmFsaWRhdGlvbi5iYWRzc2wuY29tMA4GA1UdDwEB/wQEAwIFoDAdBgNVHSUEFjAU +BggrBgEFBQcDAQYIKwYBBQUHAwIwdQYDVR0fBG4wbDA0oDKgMIYuaHR0cDovL2Ny +bDMuZGlnaWNlcnQuY29tL3NoYTItZXYtc2VydmVyLWcyLmNybDA0oDKgMIYuaHR0 +cDovL2NybDQuZGlnaWNlcnQuY29tL3NoYTItZXYtc2VydmVyLWcyLmNybDBLBgNV +HSAERDBCMDcGCWCGSAGG/WwCATAqMCgGCCsGAQUFBwIBFhxodHRwczovL3d3dy5k +aWdpY2VydC5jb20vQ1BTMAcGBWeBDAEBMIGIBggrBgEFBQcBAQR8MHowJAYIKwYB +BQUHMAGGGGh0dHA6Ly9vY3NwLmRpZ2ljZXJ0LmNvbTBSBggrBgEFBQcwAoZGaHR0 +cDovL2NhY2VydHMuZGlnaWNlcnQuY29tL0RpZ2lDZXJ0U0hBMkV4dGVuZGVkVmFs +aWRhdGlvblNlcnZlckNBLmNydDAMBgNVHRMBAf8EAjAAMIIBfwYKKwYBBAHWeQIE +AgSCAW8EggFrAWkAdgApeb7wnjk5IfBWc59jpXflvld9nGAK+PlNXSZcJV3HhAAA +AXLhwe8uAAAEAwBHMEUCIQC5/b5wmGbMOkgH/GupRPFXZ29CaGG8JQMFkjzgBz8n +owIgZQwjhH6rH8lbUX9y3+DLPyUJMA6JXy+18kKQ90JzanIAdwAiRUUHWVUkVpY/ +oS/x922G4CMmY63AS39dxoNcbuIPAgAAAXLhwe84AAAEAwBIMEYCIQCI7jirWHoe +G5VW0FDM7MkB2pkUyi2RzM9JDFZ5HXfGJwIhAMWSFJKM57x+bFVfOJkqz3V0vDI/ +nywkI96DpHE7tIDdAHYAQcjKsd8iRkoQxqE6CUKHXk4xixsD6+tLx2jwkGKWBvYA +AAFy4cHu+gAABAMARzBFAiASe/ZlNY2nqmcLX6hnjXu7exSER/BmhAVKHexAeGwU +dgIhAJunm2S4Hyz/ofuz4Cs98PknztPlRY3gSxO+ay8lr7XkMA0GCSqGSIb3DQEB +CwUAA4IBAQB0ZpWayltbvblCxkb/KI/UptbKSPex2C8HosV0cXZLdzkAa9UA9Vdg +IYNfkqVUpZH6Z3b7jtyZIUE7Thtcmglmm/OcPeLYOmO6L27T3igni2+b5mlj7L00 +PjWsRforHnD7B+q8KnIpdLs4pJc/0hHK2yn11utAOgn+jnBXs3xoRxKYC+nXWM3C +Syhq4B+z/4clh3Mq+Jgse9h50uRf9bmn+n/TxCcfeiDdgY5Z2KNy+nPrP78Jhpl9 +f8N6Kv+K8Mm398q8iHyM14V6o0VdrQUTr8ZmEa/KmRAL+eMRzbEZg+YlIyn9qQAy +A5GhqEwE29Z5Knslx7CvNEO9xV3CByfS +-----END CERTIFICATE----- + 1 s:C = US, O = DigiCert Inc, OU = www.digicert.com, CN = DigiCert SHA2 Extended Validation Server CA + i:C = US, O = DigiCert Inc, OU = www.digicert.com, CN = DigiCert High Assurance EV Root CA +-----BEGIN CERTIFICATE----- +MIIEtjCCA56gAwIBAgIQDHmpRLCMEZUgkmFf4msdgzANBgkqhkiG9w0BAQsFADBs +MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3 +d3cuZGlnaWNlcnQuY29tMSswKQYDVQQDEyJEaWdpQ2VydCBIaWdoIEFzc3VyYW5j +ZSBFViBSb290IENBMB4XDTEzMTAyMjEyMDAwMFoXDTI4MTAyMjEyMDAwMFowdTEL +MAkGA1UEBhMCVVMxFTATBgNVBAoTDERpZ2lDZXJ0IEluYzEZMBcGA1UECxMQd3d3 +LmRpZ2ljZXJ0LmNvbTE0MDIGA1UEAxMrRGlnaUNlcnQgU0hBMiBFeHRlbmRlZCBW +YWxpZGF0aW9uIFNlcnZlciBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC +ggEBANdTpARR+JmmFkhLZyeqk0nQOe0MsLAAh/FnKIaFjI5j2ryxQDji0/XspQUY +uD0+xZkXMuwYjPrxDKZkIYXLBxA0sFKIKx9om9KxjxKws9LniB8f7zh3VFNfgHk/ +LhqqqB5LKw2rt2O5Nbd9FLxZS99RStKh4gzikIKHaq7q12TWmFXo/a8aUGxUvBHy +/Urynbt/DvTVvo4WiRJV2MBxNO723C3sxIclho3YIeSwTQyJ3DkmF93215SF2AQh +cJ1vb/9cuhnhRctWVyh+HA1BV6q3uCe7seT6Ku8hI3UarS2bhjWMnHe1c63YlC3k +8wyd7sFOYn4XwHGeLN7x+RAoGTMCAwEAAaOCAUkwggFFMBIGA1UdEwEB/wQIMAYB +Af8CAQAwDgYDVR0PAQH/BAQDAgGGMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEF +BQcDAjA0BggrBgEFBQcBAQQoMCYwJAYIKwYBBQUHMAGGGGh0dHA6Ly9vY3NwLmRp +Z2ljZXJ0LmNvbTBLBgNVHR8ERDBCMECgPqA8hjpodHRwOi8vY3JsNC5kaWdpY2Vy +dC5jb20vRGlnaUNlcnRIaWdoQXNzdXJhbmNlRVZSb290Q0EuY3JsMD0GA1UdIAQ2 +MDQwMgYEVR0gADAqMCgGCCsGAQUFBwIBFhxodHRwczovL3d3dy5kaWdpY2VydC5j +b20vQ1BTMB0GA1UdDgQWBBQ901Cl1qCt7vNKYApl0yHU+PjWDzAfBgNVHSMEGDAW +gBSxPsNpA/i/RwHUmCYaCALvY2QrwzANBgkqhkiG9w0BAQsFAAOCAQEAnbbQkIbh +hgLtxaDwNBx0wY12zIYKqPBKikLWP8ipTa18CK3mtlC4ohpNiAexKSHc59rGPCHg +4xFJcKx6HQGkyhE6V6t9VypAdP3THYUYUN9XR3WhfVUgLkc3UHKMf4Ib0mKPLQNa +2sPIoc4sUqIAY+tzunHISScjl2SFnjgOrWNoPLpSgVh5oywM395t6zHyuqB8bPEs +1OG9d4Q3A84ytciagRpKkk47RpqF/oOi+Z6Mo8wNXrM9zwR4jxQUezKcxwCmXMS1 +oVWNWlZopCJwqjyBcdmdqEU79OX2olHdx3ti6G8MdOu42vi/hw15UJGQmxg7kVkn +8TUoE6smftX3eg== +-----END CERTIFICATE----- +--- +Server certificate +subject=businessCategory = Private Organization, jurisdictionC = US, jurisdictionST = California, serialNumber = C2543436, C = US, ST = California, L = Mountain View, O = Mozilla Foundation, CN = extended-validation.badssl.com + +issuer=C = US, O = DigiCert Inc, OU = www.digicert.com, CN = DigiCert SHA2 Extended Validation Server CA + +--- +No client certificate CA names sent +Peer signing digest: SHA512 +Peer signature type: RSA +Server Temp Key: ECDH, P-256, 256 bits +--- +SSL handshake has read 3620 bytes and written 456 bytes +Verification: OK +--- +New, TLSv1.2, Cipher is ECDHE-RSA-AES128-GCM-SHA256 +Server public key is 2048 bit +Secure Renegotiation IS supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +SSL-Session: + Protocol : TLSv1.2 + Cipher : ECDHE-RSA-AES128-GCM-SHA256 + Session-ID: 23F7C5ED976C5282E0560451480503D57BDA046969A848546C71191842D7613E + Session-ID-ctx: + Master-Key: BEF4C35CC73EB08048FCAFA254DECE26E7A8A6841EC829D1B7F20E011F757E234E188B8B8C4948BF6762658D46E7C5D3 + PSK identity: None + PSK identity hint: None + SRP username: None + Start Time: 1602435414 + Timeout : 7200 (sec) + Verify return code: 0 (ok) + Extended master secret: no +--- +|} + +let ok_tests = + [ + ("google.com", google, ts_2022_01_07); + ("extended-validation.badssl.com", extended_validation_badssl, ts_2022_01_07); + ] + +let self_signed_badssl = + {| +CONNECTED(00000003) +--- +Certificate chain + 0 s:C = US, ST = California, L = San Francisco, O = BadSSL, CN = *.badssl.com + i:C = US, ST = California, L = San Francisco, O = BadSSL, CN = *.badssl.com +-----BEGIN CERTIFICATE----- +MIIDeTCCAmGgAwIBAgIJAPziuikCTox4MA0GCSqGSIb3DQEBCwUAMGIxCzAJBgNV +BAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMRYwFAYDVQQHDA1TYW4gRnJhbmNp +c2NvMQ8wDQYDVQQKDAZCYWRTU0wxFTATBgNVBAMMDCouYmFkc3NsLmNvbTAeFw0x +OTEwMDkyMzQxNTJaFw0yMTEwMDgyMzQxNTJaMGIxCzAJBgNVBAYTAlVTMRMwEQYD +VQQIDApDYWxpZm9ybmlhMRYwFAYDVQQHDA1TYW4gRnJhbmNpc2NvMQ8wDQYDVQQK +DAZCYWRTU0wxFTATBgNVBAMMDCouYmFkc3NsLmNvbTCCASIwDQYJKoZIhvcNAQEB +BQADggEPADCCAQoCggEBAMIE7PiM7gTCs9hQ1XBYzJMY61yoaEmwIrX5lZ6xKyx2 +PmzAS2BMTOqytMAPgLaw+XLJhgL5XEFdEyt/ccRLvOmULlA3pmccYYz2QULFRtMW +hyefdOsKnRFSJiFzbIRMeVXk0WvoBj1IFVKtsyjbqv9u/2CVSndrOfEk0TG23U3A +xPxTuW1CrbV8/q71FdIzSOciccfCFHpsKOo3St/qbLVytH5aohbcabFXRNsKEqve +ww9HdFxBIuGa+RuT5q0iBikusbpJHAwnnqP7i/dAcgCskgjZjFeEU4EFy+b+a1SY +QCeFxxC7c3DvaRhBB0VVfPlkPz0sw6l865MaTIbRyoUCAwEAAaMyMDAwCQYDVR0T +BAIwADAjBgNVHREEHDAaggwqLmJhZHNzbC5jb22CCmJhZHNzbC5jb20wDQYJKoZI +hvcNAQELBQADggEBAGlwCdbPxflZfYOaukZGCaxYK6gpincX4Lla4Ui2WdeQxE95 +w7fChXvP3YkE3UYUE7mupZ0eg4ZILr/A0e7JQDsgIu/SRTUE0domCKgPZ8v99k3A +vka4LpLK51jHJJK7EFgo3ca2nldd97GM0MU41xHFk8qaK1tWJkfrrfcGwDJ4GQPI +iLlm6i0yHq1Qg1RypAXJy5dTlRXlCLd8ufWhhiwW0W75Va5AEnJuqpQrKwl3KQVe +wGj67WWRgLfSr+4QG1mNvCZb2CkjZWmxkGPuoP40/y7Yu5OFqxP5tAjj4YixCYTW +EVA0pmzIzgBg+JIe3PdRy27T0asgQW/F4TY61Yk= +-----END CERTIFICATE----- +--- +Server certificate +subject=C = US, ST = California, L = San Francisco, O = BadSSL, CN = *.badssl.com + +issuer=C = US, ST = California, L = San Francisco, O = BadSSL, CN = *.badssl.com + +--- +No client certificate CA names sent +Peer signing digest: SHA512 +Peer signature type: RSA +Server Temp Key: ECDH, P-256, 256 bits +--- +SSL handshake has read 1404 bytes and written 448 bytes +Verification error: self signed certificate +--- +New, TLSv1.2, Cipher is ECDHE-RSA-AES128-GCM-SHA256 +Server public key is 2048 bit +Secure Renegotiation IS supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +SSL-Session: + Protocol : TLSv1.2 + Cipher : ECDHE-RSA-AES128-GCM-SHA256 + Session-ID: F6A1E369801FDF644904D6E4C4E1E29E9448CD8E0FDE574B9F42B9B026FA25BF + Session-ID-ctx: + Master-Key: 90E3C3917FFE81FD81E05C0E2398499C1AC58C81F8D6B35AD7A3F2450F8B89BFF62710A3AC9AFD1378FADD8AD8EB79E0 + PSK identity: None + PSK identity hint: None + SRP username: None + Start Time: 1602434632 + Timeout : 7200 (sec) + Verify return code: 18 (self signed certificate) + Extended master secret: no +--- +|} + +let expired_badssl = + {| +CONNECTED(00000003) +--- +Certificate chain + 0 s:OU = Domain Control Validated, OU = PositiveSSL Wildcard, CN = *.badssl.com + i:C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO RSA Domain Validation Secure Server CA +-----BEGIN CERTIFICATE----- +MIIFSzCCBDOgAwIBAgIQSueVSfqavj8QDxekeOFpCTANBgkqhkiG9w0BAQsFADCB +kDELMAkGA1UEBhMCR0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4G +A1UEBxMHU2FsZm9yZDEaMBgGA1UEChMRQ09NT0RPIENBIExpbWl0ZWQxNjA0BgNV +BAMTLUNPTU9ETyBSU0EgRG9tYWluIFZhbGlkYXRpb24gU2VjdXJlIFNlcnZlciBD +QTAeFw0xNTA0MDkwMDAwMDBaFw0xNTA0MTIyMzU5NTlaMFkxITAfBgNVBAsTGERv +bWFpbiBDb250cm9sIFZhbGlkYXRlZDEdMBsGA1UECxMUUG9zaXRpdmVTU0wgV2ls +ZGNhcmQxFTATBgNVBAMUDCouYmFkc3NsLmNvbTCCASIwDQYJKoZIhvcNAQEBBQAD +ggEPADCCAQoCggEBAMIE7PiM7gTCs9hQ1XBYzJMY61yoaEmwIrX5lZ6xKyx2PmzA +S2BMTOqytMAPgLaw+XLJhgL5XEFdEyt/ccRLvOmULlA3pmccYYz2QULFRtMWhyef +dOsKnRFSJiFzbIRMeVXk0WvoBj1IFVKtsyjbqv9u/2CVSndrOfEk0TG23U3AxPxT +uW1CrbV8/q71FdIzSOciccfCFHpsKOo3St/qbLVytH5aohbcabFXRNsKEqveww9H +dFxBIuGa+RuT5q0iBikusbpJHAwnnqP7i/dAcgCskgjZjFeEU4EFy+b+a1SYQCeF +xxC7c3DvaRhBB0VVfPlkPz0sw6l865MaTIbRyoUCAwEAAaOCAdUwggHRMB8GA1Ud +IwQYMBaAFJCvajqUWgvYkOoSVnPfQ7Q6KNrnMB0GA1UdDgQWBBSd7sF7gQs6R2lx +GH0RN5O8pRs/+zAOBgNVHQ8BAf8EBAMCBaAwDAYDVR0TAQH/BAIwADAdBgNVHSUE +FjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwTwYDVR0gBEgwRjA6BgsrBgEEAbIxAQIC +BzArMCkGCCsGAQUFBwIBFh1odHRwczovL3NlY3VyZS5jb21vZG8uY29tL0NQUzAI +BgZngQwBAgEwVAYDVR0fBE0wSzBJoEegRYZDaHR0cDovL2NybC5jb21vZG9jYS5j +b20vQ09NT0RPUlNBRG9tYWluVmFsaWRhdGlvblNlY3VyZVNlcnZlckNBLmNybDCB +hQYIKwYBBQUHAQEEeTB3ME8GCCsGAQUFBzAChkNodHRwOi8vY3J0LmNvbW9kb2Nh +LmNvbS9DT01PRE9SU0FEb21haW5WYWxpZGF0aW9uU2VjdXJlU2VydmVyQ0EuY3J0 +MCQGCCsGAQUFBzABhhhodHRwOi8vb2NzcC5jb21vZG9jYS5jb20wIwYDVR0RBBww +GoIMKi5iYWRzc2wuY29tggpiYWRzc2wuY29tMA0GCSqGSIb3DQEBCwUAA4IBAQBq +evHa/wMHcnjFZqFPRkMOXxQhjHUa6zbgH6QQFezaMyV8O7UKxwE4PSf9WNnM6i1p +OXy+l+8L1gtY54x/v7NMHfO3kICmNnwUW+wHLQI+G1tjWxWrAPofOxkt3+IjEBEH +fnJ/4r+3ABuYLyw/zoWaJ4wQIghBK4o+gk783SHGVnRwpDTysUCeK1iiWQ8dSO/r +ET7BSp68ZVVtxqPv1dSWzfGuJ/ekVxQ8lEEFeouhN0fX9X3c+s5vMaKwjOrMEpsi +8TRwz311SotoKQwe6Zaoz7ASH1wq7mcvf71z81oBIgxw+s1F73hczg36TuHvzmWf +RwxPuzZEaFZcVlmtqoq8 +-----END CERTIFICATE----- + 1 s:C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO RSA Domain Validation Secure Server CA + i:C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO RSA Certification Authority +-----BEGIN CERTIFICATE----- +MIIGCDCCA/CgAwIBAgIQKy5u6tl1NmwUim7bo3yMBzANBgkqhkiG9w0BAQwFADCB +hTELMAkGA1UEBhMCR0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4G +A1UEBxMHU2FsZm9yZDEaMBgGA1UEChMRQ09NT0RPIENBIExpbWl0ZWQxKzApBgNV +BAMTIkNPTU9ETyBSU0EgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkwHhcNMTQwMjEy +MDAwMDAwWhcNMjkwMjExMjM1OTU5WjCBkDELMAkGA1UEBhMCR0IxGzAZBgNVBAgT +EkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4GA1UEBxMHU2FsZm9yZDEaMBgGA1UEChMR +Q09NT0RPIENBIExpbWl0ZWQxNjA0BgNVBAMTLUNPTU9ETyBSU0EgRG9tYWluIFZh +bGlkYXRpb24gU2VjdXJlIFNlcnZlciBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEP +ADCCAQoCggEBAI7CAhnhoFmk6zg1jSz9AdDTScBkxwtiBUUWOqigwAwCfx3M28Sh +bXcDow+G+eMGnD4LgYqbSRutA776S9uMIO3Vzl5ljj4Nr0zCsLdFXlIvNN5IJGS0 +Qa4Al/e+Z96e0HqnU4A7fK31llVvl0cKfIWLIpeNs4TgllfQcBhglo/uLQeTnaG6 +ytHNe+nEKpooIZFNb5JPJaXyejXdJtxGpdCsWTWM/06RQ1A/WZMebFEh7lgUq/51 +UHg+TLAchhP6a5i84DuUHoVS3AOTJBhuyydRReZw3iVDpA3hSqXttn7IzW3uLh0n +c13cRTCAquOyQQuvvUSH2rnlG51/ruWFgqUCAwEAAaOCAWUwggFhMB8GA1UdIwQY +MBaAFLuvfgI9+qbxPISOre44mOzZMjLUMB0GA1UdDgQWBBSQr2o6lFoL2JDqElZz +30O0Oija5zAOBgNVHQ8BAf8EBAMCAYYwEgYDVR0TAQH/BAgwBgEB/wIBADAdBgNV +HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwGwYDVR0gBBQwEjAGBgRVHSAAMAgG +BmeBDAECATBMBgNVHR8ERTBDMEGgP6A9hjtodHRwOi8vY3JsLmNvbW9kb2NhLmNv +bS9DT01PRE9SU0FDZXJ0aWZpY2F0aW9uQXV0aG9yaXR5LmNybDBxBggrBgEFBQcB +AQRlMGMwOwYIKwYBBQUHMAKGL2h0dHA6Ly9jcnQuY29tb2RvY2EuY29tL0NPTU9E +T1JTQUFkZFRydXN0Q0EuY3J0MCQGCCsGAQUFBzABhhhodHRwOi8vb2NzcC5jb21v +ZG9jYS5jb20wDQYJKoZIhvcNAQEMBQADggIBAE4rdk+SHGI2ibp3wScF9BzWRJ2p +mj6q1WZmAT7qSeaiNbz69t2Vjpk1mA42GHWx3d1Qcnyu3HeIzg/3kCDKo2cuH1Z/ +e+FE6kKVxF0NAVBGFfKBiVlsit2M8RKhjTpCipj4SzR7JzsItG8kO3KdY3RYPBps +P0/HEZrIqPW1N+8QRcZs2eBelSaz662jue5/DJpmNXMyYE7l3YphLG5SEXdoltMY +dVEVABt0iN3hxzgEQyjpFv3ZBdRdRydg1vs4O2xyopT4Qhrf7W8GjEXCBgCq5Ojc +2bXhc3js9iPc0d1sjhqPpepUfJa3w/5Vjo1JXvxku88+vZbrac2/4EjxYoIQ5QxG +V/Iz2tDIY+3GH5QFlkoakdH368+PUq4NCNk+qKBR6cGHdNXJ93SrLlP7u3r7l+L4 +HyaPs9Kg4DdbKDsx5Q5XLVq4rXmsXiBmGqW5prU5wfWYQ//u+aen/e7KJD2AFsQX +j4rBYKEMrltDR5FL1ZoXX/nUh8HCjLfn4g8wGTeGrODcQgPmlKidrv0PJFGUzpII +0fxQ8ANAe4hZ7Q7drNJ3gjTcBpUC2JD5Leo31Rpg0Gcg19hCC0Wvgmje3WYkN5Ap +lBlGGSW4gNfL1IYoakRwJiNiqZ+Gb7+6kHDSVneFeO/qJakXzlByjAA6quPbYzSf ++AZxAeKCINT+b72x +-----END CERTIFICATE----- + 2 s:C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO RSA Certification Authority + i:C = SE, O = AddTrust AB, OU = AddTrust External TTP Network, CN = AddTrust External CA Root +-----BEGIN CERTIFICATE----- +MIIFdDCCBFygAwIBAgIQJ2buVutJ846r13Ci/ITeIjANBgkqhkiG9w0BAQwFADBv +MQswCQYDVQQGEwJTRTEUMBIGA1UEChMLQWRkVHJ1c3QgQUIxJjAkBgNVBAsTHUFk +ZFRydXN0IEV4dGVybmFsIFRUUCBOZXR3b3JrMSIwIAYDVQQDExlBZGRUcnVzdCBF +eHRlcm5hbCBDQSBSb290MB4XDTAwMDUzMDEwNDgzOFoXDTIwMDUzMDEwNDgzOFow +gYUxCzAJBgNVBAYTAkdCMRswGQYDVQQIExJHcmVhdGVyIE1hbmNoZXN0ZXIxEDAO +BgNVBAcTB1NhbGZvcmQxGjAYBgNVBAoTEUNPTU9ETyBDQSBMaW1pdGVkMSswKQYD +VQQDEyJDT01PRE8gUlNBIENlcnRpZmljYXRpb24gQXV0aG9yaXR5MIICIjANBgkq +hkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAkehUktIKVrGsDSTdxc9EZ3SZKzejfSNw +AHG8U9/E+ioSj0t/EFa9n3Byt2F/yUsPF6c947AEYe7/EZfH9IY+Cvo+XPmT5jR6 +2RRr55yzhaCCenavcZDX7P0N+pxs+t+wgvQUfvm+xKYvT3+Zf7X8Z0NyvQwA1onr +ayzT7Y+YHBSrfuXjbvzYqOSSJNpDa2K4Vf3qwbxstovzDo2a5JtsaZn4eEgwRdWt +4Q08RWD8MpZRJ7xnw8outmvqRsfHIKCxH2XeSAi6pE6p8oNGN4Tr6MyBSENnTnIq +m1y9TBsoilwie7SrmNnu4FGDwwlGTm0+mfqVF9p8M1dBPI1R7Qu2XK8sYxrfV8g/ +vOldxJuvRZnio1oktLqpVj3Pb6r/SVi+8Kj/9Lit6Tf7urj0Czr56ENCHonYhMsT +8dm74YlguIwoVqwUHZwK53Hrzw7dPamWoUi9PPevtQ0iTMARgexWO/bTouJbt7IE +IlKVgJNp6I5MZfGRAy1wdALqi2cVKWlSArvX31BqVUa/oKMoYX9w0MOiqiwhqkfO +KJwGRXa/ghgntNWutMtQ5mv0TIZxMOmm3xaG4Nj/QN370EKIf6MzOi5cHkERgWPO +GHFrK+ymircxXDpqR+DDeVnWIBqv8mqYqnK8V0rSS527EPywTEHl7R09XiidnMy/ +s1Hap0flhFMCAwEAAaOB9DCB8TAfBgNVHSMEGDAWgBStvZh6NLQm9/rEJlTvA73g +JMtUGjAdBgNVHQ4EFgQUu69+Aj36pvE8hI6t7jiY7NkyMtQwDgYDVR0PAQH/BAQD +AgGGMA8GA1UdEwEB/wQFMAMBAf8wEQYDVR0gBAowCDAGBgRVHSAAMEQGA1UdHwQ9 +MDswOaA3oDWGM2h0dHA6Ly9jcmwudXNlcnRydXN0LmNvbS9BZGRUcnVzdEV4dGVy +bmFsQ0FSb290LmNybDA1BggrBgEFBQcBAQQpMCcwJQYIKwYBBQUHMAGGGWh0dHA6 +Ly9vY3NwLnVzZXJ0cnVzdC5jb20wDQYJKoZIhvcNAQEMBQADggEBAGS/g/FfmoXQ +zbihKVcN6Fr30ek+8nYEbvFScLsePP9NDXRqzIGCJdPDoCpdTPW6i6FtxFQJdcfj +Jw5dhHk3QBN39bSsHNA7qxcS1u80GH4r6XnTq1dFDK8o+tDb5VCViLvfhVdpfZLY +Uspzgb8c8+a4bmYRBbMelC1/kZWSWfFMzqORcUx8Rww7Cxn2obFshj5cqsQugsv5 +B5a6SE2Q8pTIqXOi6wZ7I53eovNNVZ96YUWYGGjHXkBrI/V5eu+MtWuLt29G9Hvx +PUsE2JOAWVrgQSQdso8VYFhH2+9uRv0V9dlfmrPb2LjkQLPNlzmuhbsdjrzch5vR +pu/xO28QOG8= +-----END CERTIFICATE----- +--- +Server certificate +subject=OU = Domain Control Validated, OU = PositiveSSL Wildcard, CN = *.badssl.com + +issuer=C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO RSA Domain Validation Secure Server CA + +--- +No client certificate CA names sent +Peer signing digest: SHA512 +Peer signature type: RSA +Server Temp Key: ECDH, P-256, 256 bits +--- +SSL handshake has read 4824 bytes and written 444 bytes +Verification error: certificate has expired +--- +New, TLSv1.2, Cipher is ECDHE-RSA-AES128-GCM-SHA256 +Server public key is 2048 bit +Secure Renegotiation IS supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +SSL-Session: + Protocol : TLSv1.2 + Cipher : ECDHE-RSA-AES128-GCM-SHA256 + Session-ID: 0E3D5C358767788B8935538CE2B86C4E7D0B932FC3A91153B45A698FF43E6313 + Session-ID-ctx: + Master-Key: B2B26F72CE2275A7BBF8D2EF170088E7FC98E83619009725FA07E5A3CD8B2E2B7AB36AD7DE63B2B31F649B7771E553EE + PSK identity: None + PSK identity hint: None + SRP username: None + Start Time: 1602434992 + Timeout : 7200 (sec) + Verify return code: 10 (certificate has expired) + Extended master secret: no +--- +|} + +let untrusted_root_badssl = + {| +CONNECTED(00000003) +--- +Certificate chain + 0 s:C = US, ST = California, L = San Francisco, O = BadSSL, CN = *.badssl.com + i:C = US, ST = California, L = San Francisco, O = BadSSL, CN = BadSSL Untrusted Root Certificate Authority +-----BEGIN CERTIFICATE----- +MIIEmTCCAoGgAwIBAgIJAOywCwT04S08MA0GCSqGSIb3DQEBCwUAMIGBMQswCQYD +VQQGEwJVUzETMBEGA1UECAwKQ2FsaWZvcm5pYTEWMBQGA1UEBwwNU2FuIEZyYW5j +aXNjbzEPMA0GA1UECgwGQmFkU1NMMTQwMgYDVQQDDCtCYWRTU0wgVW50cnVzdGVk +IFJvb3QgQ2VydGlmaWNhdGUgQXV0aG9yaXR5MB4XDTE5MTAwOTIzMDg1MFoXDTIx +MTAwODIzMDg1MFowYjELMAkGA1UEBhMCVVMxEzARBgNVBAgMCkNhbGlmb3JuaWEx +FjAUBgNVBAcMDVNhbiBGcmFuY2lzY28xDzANBgNVBAoMBkJhZFNTTDEVMBMGA1UE +AwwMKi5iYWRzc2wuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +wgTs+IzuBMKz2FDVcFjMkxjrXKhoSbAitfmVnrErLHY+bMBLYExM6rK0wA+AtrD5 +csmGAvlcQV0TK39xxEu86ZQuUDemZxxhjPZBQsVG0xaHJ5906wqdEVImIXNshEx5 +VeTRa+gGPUgVUq2zKNuq/27/YJVKd2s58STRMbbdTcDE/FO5bUKttXz+rvUV0jNI +5yJxx8IUemwo6jdK3+pstXK0flqiFtxpsVdE2woSq97DD0d0XEEi4Zr5G5PmrSIG +KS6xukkcDCeeo/uL90ByAKySCNmMV4RTgQXL5v5rVJhAJ4XHELtzcO9pGEEHRVV8 ++WQ/PSzDqXzrkxpMhtHKhQIDAQABozIwMDAJBgNVHRMEAjAAMCMGA1UdEQQcMBqC +DCouYmFkc3NsLmNvbYIKYmFkc3NsLmNvbTANBgkqhkiG9w0BAQsFAAOCAgEAhU5h +jESEo1M5HCTHYlC1EkoxRG+bBLaYtiDsJl3HwlhtYx+r03UvWrwJ7QXhjda1G9fC +313JBLtrainBgjgJXPDHW5fmYaTmNExo7i3d+OunalwS97RQKsFtY/c+CJhYgv25 +8/TOkKhg7uvV/31Uac0cIW9qH7lulE0cBymtbmWvR7sBRjD+P1hU58AULAGyMhBw +ijGBGTqHP2tRb6oMLF+iC0Ej2Eho2qloKdoYaNFivBYPMrWBk8YBGKdKOYv12Kpy +AmWhkR+x4UYPIGzPXUcFz2685E0bxoVJq0+TTXaiyjPeQ9fSgsXxeGx37g9lQ4iA +uZb1qs/MiaVz1dQ7bXGtTQbpSkLjJtRF8Toh0/oJPeM9GGoMPswqcGDTE/wqhD2j +tSl5//9kgviVVCKLNbARDJ0ikpnkhB/2K37pz9of+ltYCVHc58cCFfgmCwZfl1nJ +Zyd36FfAlATZAG2V+5JE/oir6ggPN/f1Zs21wSTejpunkDaNqWZutYalmpg1hsq8 +76RNkfxtkONIubPUI90ymmJ7h6l8YPmuV+J/CE7LzDVAU51+uvFjtPNvEmJPRfug +rXmQ974mtlnvQfhb+Z3WmERgczbQCSN6C/j6+U86KrUqYcALf5rkX9cVJ1qMp0XS +6/5tfSQQuvJ7vzHVdo0OWQ7IOaSnVVV/cXQjkB4= +-----END CERTIFICATE----- + 1 s:C = US, ST = California, L = San Francisco, O = BadSSL, CN = BadSSL Untrusted Root Certificate Authority + i:C = US, ST = California, L = San Francisco, O = BadSSL, CN = BadSSL Untrusted Root Certificate Authority +-----BEGIN CERTIFICATE----- +MIIGfjCCBGagAwIBAgIJAJeg/PrX5Sj9MA0GCSqGSIb3DQEBCwUAMIGBMQswCQYD +VQQGEwJVUzETMBEGA1UECAwKQ2FsaWZvcm5pYTEWMBQGA1UEBwwNU2FuIEZyYW5j +aXNjbzEPMA0GA1UECgwGQmFkU1NMMTQwMgYDVQQDDCtCYWRTU0wgVW50cnVzdGVk +IFJvb3QgQ2VydGlmaWNhdGUgQXV0aG9yaXR5MB4XDTE2MDcwNzA2MzEzNVoXDTM2 +MDcwMjA2MzEzNVowgYExCzAJBgNVBAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlh +MRYwFAYDVQQHDA1TYW4gRnJhbmNpc2NvMQ8wDQYDVQQKDAZCYWRTU0wxNDAyBgNV +BAMMK0JhZFNTTCBVbnRydXN0ZWQgUm9vdCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkw +ggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDKQtPMhEH073gis/HISWAi +bOEpCtOsatA3JmeVbaWal8O/5ZO5GAn9dFVsGn0CXAHR6eUKYDAFJLa/3AhjBvWa +tnQLoXaYlCvBjodjLEaFi8ckcJHrAYG9qZqioRQ16Yr8wUTkbgZf+er/Z55zi1yn +CnhWth7kekvrwVDGP1rApeLqbhYCSLeZf5W/zsjLlvJni9OrU7U3a9msvz8mcCOX +fJX9e3VbkD/uonIbK2SvmAGMaOj/1k0dASkZtMws0Bk7m1pTQL+qXDM/h3BQZJa5 +DwTcATaa/Qnk6YHbj/MaS5nzCSmR0Xmvs/3CulQYiZJ3kypns1KdqlGuwkfiCCgD +yWJy7NE9qdj6xxLdqzne2DCyuPrjFPS0mmYimpykgbPnirEPBF1LW3GJc9yfhVXE +Cc8OY8lWzxazDNNbeSRDpAGbBeGSQXGjAbliFJxwLyGzZ+cG+G8lc+zSvWjQu4Xp +GJ+dOREhQhl+9U8oyPX34gfKo63muSgo539hGylqgQyzj+SX8OgK1FXXb2LS1gxt +VIR5Qc4MmiEG2LKwPwfU8Yi+t5TYjGh8gaFv6NnksoX4hU42gP5KvjYggDpR+NSN +CGQSWHfZASAYDpxjrOo+rk4xnO+sbuuMk7gORsrl+jgRT8F2VqoR9Z3CEdQxcCjR +5FsfTymZCk3GfIbWKkaeLQIDAQABo4H2MIHzMB0GA1UdDgQWBBRvx4NzSbWnY/91 +3m1u/u37l6MsADCBtgYDVR0jBIGuMIGrgBRvx4NzSbWnY/913m1u/u37l6MsAKGB +h6SBhDCBgTELMAkGA1UEBhMCVVMxEzARBgNVBAgMCkNhbGlmb3JuaWExFjAUBgNV +BAcMDVNhbiBGcmFuY2lzY28xDzANBgNVBAoMBkJhZFNTTDE0MDIGA1UEAwwrQmFk +U1NMIFVudHJ1c3RlZCBSb290IENlcnRpZmljYXRlIEF1dGhvcml0eYIJAJeg/PrX +5Sj9MAwGA1UdEwQFMAMBAf8wCwYDVR0PBAQDAgEGMA0GCSqGSIb3DQEBCwUAA4IC +AQBQU9U8+jTRT6H9AIFm6y50tXTg/ySxRNmeP1Ey9Zf4jUE6yr3Q8xBv9gTFLiY1 +qW2qfkDSmXVdBkl/OU3+xb5QOG5hW7wVolWQyKREV5EvUZXZxoH7LVEMdkCsRJDK +wYEKnEErFls5WPXY3bOglBOQqAIiuLQ0f77a2HXULDdQTn5SueW/vrA4RJEKuWxU +iD9XPnVZ9tPtky2Du7wcL9qhgTddpS/NgAuLO4PXh2TQ0EMCll5reZ5AEr0NSLDF +c/koDv/EZqB7VYhcPzr1bhQgbv1dl9NZU0dWKIMkRE/T7vZ97I3aPZqIapC2ulrf +KrlqjXidwrGFg8xbiGYQHPx3tHPZxoM5WG2voI6G3s1/iD+B4V6lUEvivd3f6tq7 +d1V/3q1sL5DNv7TvaKGsq8g5un0TAkqaewJQ5fXLigF/yYu5a24/GUD783MdAPFv +gWz8F81evOyRfpf9CAqIswMF+T6Dwv3aw5L9hSniMrblkg+ai0K22JfoBcGOzMtB +Ke/Ps2Za56dTRoY/a4r62hrcGxufXd0mTdPaJLw3sJeHYjLxVAYWQq4QKJQWDgTS +dAEWyN2WXaBFPx5c8KIW95Eu8ShWE00VVC3oA4emoZ2nrzBXLrUScifY6VaYYkkR +2O2tSqU8Ri3XRdgpNPDWp8ZL49KhYGYo3R/k98gnMHiY5g== +-----END CERTIFICATE----- +--- +Server certificate +subject=C = US, ST = California, L = San Francisco, O = BadSSL, CN = *.badssl.com + +issuer=C = US, ST = California, L = San Francisco, O = BadSSL, CN = BadSSL Untrusted Root Certificate Authority + +--- +No client certificate CA names sent +Peer signing digest: SHA512 +Peer signature type: RSA +Server Temp Key: ECDH, P-256, 256 bits +--- +SSL handshake has read 3361 bytes and written 451 bytes +Verification error: self signed certificate in certificate chain +--- +New, TLSv1.2, Cipher is ECDHE-RSA-AES128-GCM-SHA256 +Server public key is 2048 bit +Secure Renegotiation IS supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +SSL-Session: + Protocol : TLSv1.2 + Cipher : ECDHE-RSA-AES128-GCM-SHA256 + Session-ID: 649A3C21016DC17582243CEA5FF0E4A66E44261F2193BE54C11FAB1EE0CCBB9B + Session-ID-ctx: + Master-Key: 4D6B719C876D3025D6C7BD3EA00D0EDE1D026C4A94713AAE19C170ABFF800FC0EE5FB6C4478BB5C9375A51E69D29BC45 + PSK identity: None + PSK identity hint: None + SRP username: None + Start Time: 1602435337 + Timeout : 7200 (sec) + Verify return code: 19 (self signed certificate in certificate chain) + Extended master secret: no +--- +|} + +let wrong_host_badssl = + {| +CONNECTED(00000003) +--- +Certificate chain + 0 s:C = US, ST = California, L = Walnut Creek, O = Lucas Garron Torres, CN = *.badssl.com + i:C = US, O = DigiCert Inc, CN = DigiCert SHA2 Secure Server CA +-----BEGIN CERTIFICATE----- +MIIGqDCCBZCgAwIBAgIQCvBs2jemC2QTQvCh6x1Z/TANBgkqhkiG9w0BAQsFADBN +MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMScwJQYDVQQDEx5E +aWdpQ2VydCBTSEEyIFNlY3VyZSBTZXJ2ZXIgQ0EwHhcNMjAwMzIzMDAwMDAwWhcN +MjIwNTE3MTIwMDAwWjBuMQswCQYDVQQGEwJVUzETMBEGA1UECBMKQ2FsaWZvcm5p +YTEVMBMGA1UEBxMMV2FsbnV0IENyZWVrMRwwGgYDVQQKExNMdWNhcyBHYXJyb24g +VG9ycmVzMRUwEwYDVQQDDAwqLmJhZHNzbC5jb20wggEiMA0GCSqGSIb3DQEBAQUA +A4IBDwAwggEKAoIBAQDCBOz4jO4EwrPYUNVwWMyTGOtcqGhJsCK1+ZWesSssdj5s +wEtgTEzqsrTAD4C2sPlyyYYC+VxBXRMrf3HES7zplC5QN6ZnHGGM9kFCxUbTFocn +n3TrCp0RUiYhc2yETHlV5NFr6AY9SBVSrbMo26r/bv9glUp3aznxJNExtt1NwMT8 +U7ltQq21fP6u9RXSM0jnInHHwhR6bCjqN0rf6my1crR+WqIW3GmxV0TbChKr3sMP +R3RcQSLhmvkbk+atIgYpLrG6SRwMJ56j+4v3QHIArJII2YxXhFOBBcvm/mtUmEAn +hccQu3Nw72kYQQdFVXz5ZD89LMOpfOuTGkyG0cqFAgMBAAGjggNhMIIDXTAfBgNV +HSMEGDAWgBQPgGEcgjFh1S8o541GOLQs4cbZ4jAdBgNVHQ4EFgQUne7Be4ELOkdp +cRh9ETeTvKUbP/swIwYDVR0RBBwwGoIMKi5iYWRzc2wuY29tggpiYWRzc2wuY29t +MA4GA1UdDwEB/wQEAwIFoDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIw +awYDVR0fBGQwYjAvoC2gK4YpaHR0cDovL2NybDMuZGlnaWNlcnQuY29tL3NzY2Et +c2hhMi1nNi5jcmwwL6AtoCuGKWh0dHA6Ly9jcmw0LmRpZ2ljZXJ0LmNvbS9zc2Nh +LXNoYTItZzYuY3JsMEwGA1UdIARFMEMwNwYJYIZIAYb9bAEBMCowKAYIKwYBBQUH +AgEWHGh0dHBzOi8vd3d3LmRpZ2ljZXJ0LmNvbS9DUFMwCAYGZ4EMAQIDMHwGCCsG +AQUFBwEBBHAwbjAkBggrBgEFBQcwAYYYaHR0cDovL29jc3AuZGlnaWNlcnQuY29t +MEYGCCsGAQUFBzAChjpodHRwOi8vY2FjZXJ0cy5kaWdpY2VydC5jb20vRGlnaUNl +cnRTSEEyU2VjdXJlU2VydmVyQ0EuY3J0MAwGA1UdEwEB/wQCMAAwggF+BgorBgEE +AdZ5AgQCBIIBbgSCAWoBaAB2ALvZ37wfinG1k5Qjl6qSe0c4V5UKq1LoGpCWZDaO +HtGFAAABcQhGXioAAAQDAEcwRQIgDfWVBXEuUZC2YP4Si3AQDidHC4U9e5XTGyG7 +SFNDlRkCIQCzikrA1nf7boAdhvaGu2Vkct3VaI+0y8p3gmonU5d9DwB2ACJFRQdZ +VSRWlj+hL/H3bYbgIyZjrcBLf13Gg1xu4g8CAAABcQhGXlsAAAQDAEcwRQIhAMWi +Vsi2vYdxRCRsu/DMmCyhY0iJPKHE2c6ejPycIbgqAiAs3kSSS0NiUFiHBw7QaQ/s +GO+/lNYvjExlzVUWJbgNLwB2AFGjsPX9AXmcVm24N3iPDKR6zBsny/eeiEKaDf7U +iwXlAAABcQhGXnoAAAQDAEcwRQIgKsntiBqt8Au8DAABFkxISELhP3U/wb5lb76p +vfenWL0CIQDr2kLhCWP/QUNxXqGmvr1GaG9EuokTOLEnGPhGv1cMkDANBgkqhkiG +9w0BAQsFAAOCAQEA0RGxlwy3Tl0lhrUAn2mIi8LcZ9nBUyfAcCXCtYyCdEbjIP64 +xgX6pzTt0WJoxzlT+MiK6fc0hECZXqpkTNVTARYtGkJoljlTK2vAdHZ0SOpm9OT4 +RLfjGnImY0hiFbZ/LtsvS2Zg7cVJecqnrZe/za/nbDdljnnrll7C8O5naQuKr4te +uice3e8a4TtviFwS/wdDnJ3RrE83b1IljILbU5SV0X1NajyYkUWS7AnOmrFUUByz +MwdGrM6kt0lfJy/gvGVsgIKZocHdedPeECqAtq7FAJYanOsjNN9RbBOGhbwq0/FP +CC01zojqS10nGowxzOiqyB4m6wytmzf0QwjpMw== +-----END CERTIFICATE----- + 1 s:C = US, O = DigiCert Inc, CN = DigiCert SHA2 Secure Server CA + i:C = US, O = DigiCert Inc, OU = www.digicert.com, CN = DigiCert Global Root CA +-----BEGIN CERTIFICATE----- +MIIElDCCA3ygAwIBAgIQAf2j627KdciIQ4tyS8+8kTANBgkqhkiG9w0BAQsFADBh +MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3 +d3cuZGlnaWNlcnQuY29tMSAwHgYDVQQDExdEaWdpQ2VydCBHbG9iYWwgUm9vdCBD +QTAeFw0xMzAzMDgxMjAwMDBaFw0yMzAzMDgxMjAwMDBaME0xCzAJBgNVBAYTAlVT +MRUwEwYDVQQKEwxEaWdpQ2VydCBJbmMxJzAlBgNVBAMTHkRpZ2lDZXJ0IFNIQTIg +U2VjdXJlIFNlcnZlciBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEB +ANyuWJBNwcQwFZA1W248ghX1LFy949v/cUP6ZCWA1O4Yok3wZtAKc24RmDYXZK83 +nf36QYSvx6+M/hpzTc8zl5CilodTgyu5pnVILR1WN3vaMTIa16yrBvSqXUu3R0bd +KpPDkC55gIDvEwRqFDu1m5K+wgdlTvza/P96rtxcflUxDOg5B6TXvi/TC2rSsd9f +/ld0Uzs1gN2ujkSYs58O09rg1/RrKatEp0tYhG2SS4HD2nOLEpdIkARFdRrdNzGX +kujNVA075ME/OV4uuPNcfhCOhkEAjUVmR7ChZc6gqikJTvOX6+guqw9ypzAO+sf0 +/RR3w6RbKFfCs/mC/bdFWJsCAwEAAaOCAVowggFWMBIGA1UdEwEB/wQIMAYBAf8C +AQAwDgYDVR0PAQH/BAQDAgGGMDQGCCsGAQUFBwEBBCgwJjAkBggrBgEFBQcwAYYY +aHR0cDovL29jc3AuZGlnaWNlcnQuY29tMHsGA1UdHwR0MHIwN6A1oDOGMWh0dHA6 +Ly9jcmwzLmRpZ2ljZXJ0LmNvbS9EaWdpQ2VydEdsb2JhbFJvb3RDQS5jcmwwN6A1 +oDOGMWh0dHA6Ly9jcmw0LmRpZ2ljZXJ0LmNvbS9EaWdpQ2VydEdsb2JhbFJvb3RD +QS5jcmwwPQYDVR0gBDYwNDAyBgRVHSAAMCowKAYIKwYBBQUHAgEWHGh0dHBzOi8v +d3d3LmRpZ2ljZXJ0LmNvbS9DUFMwHQYDVR0OBBYEFA+AYRyCMWHVLyjnjUY4tCzh +xtniMB8GA1UdIwQYMBaAFAPeUDVW0Uy7ZvCj4hsbw5eyPdFVMA0GCSqGSIb3DQEB +CwUAA4IBAQAjPt9L0jFCpbZ+QlwaRMxp0Wi0XUvgBCFsS+JtzLHgl4+mUwnNqipl +5TlPHoOlblyYoiQm5vuh7ZPHLgLGTUq/sELfeNqzqPlt/yGFUzZgTHbO7Djc1lGA +8MXW5dRNJ2Srm8c+cftIl7gzbckTB+6WohsYFfZcTEDts8Ls/3HB40f/1LkAtDdC +2iDJ6m6K7hQGrn2iWZiIqBtvLfTyyRRfJs8sjX7tN8Cp1Tm5gr8ZDOo0rwAhaPit +c+LJMto4JQtV05od8GiG7S5BNO98pVAdvzr508EIDObtHopYJeS4d60tbvVS3bR0 +j6tJLp07kzQoH3jOlOrHvdPJbRzeXDLz +-----END CERTIFICATE----- +--- +Server certificate +subject=C = US, ST = California, L = Walnut Creek, O = Lucas Garron Torres, CN = *.badssl.com + +issuer=C = US, O = DigiCert Inc, CN = DigiCert SHA2 Secure Server CA + +--- +No client certificate CA names sent +Peer signing digest: SHA512 +Peer signature type: RSA +Server Temp Key: ECDH, P-256, 256 bits +--- +SSL handshake has read 3398 bytes and written 447 bytes +Verification: OK +--- +New, TLSv1.2, Cipher is ECDHE-RSA-AES128-GCM-SHA256 +Server public key is 2048 bit +Secure Renegotiation IS supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +SSL-Session: + Protocol : TLSv1.2 + Cipher : ECDHE-RSA-AES128-GCM-SHA256 + Session-ID: 3E96EF49E031153871907BFA4362E9AAD79785ED70996B1750AC7FB2004AA85D + Session-ID-ctx: + Master-Key: 67084AF570632BD11B554FF000D5F67A34923BF512D9AE20E57627C6C8FACF80FA6D74A9298BEE5C908F72666813F2CC + PSK identity: None + PSK identity hint: None + SRP username: None + Start Time: 1602435542 + Timeout : 7200 (sec) + Verify return code: 0 (ok) + Extended master secret: no +--- +|} + +let incomplete_chain_badssl = + {| +CONNECTED(00000003) +--- +Certificate chain + 0 s:C = US, ST = California, L = Walnut Creek, O = Lucas Garron Torres, CN = *.badssl.com + i:C = US, O = DigiCert Inc, CN = DigiCert SHA2 Secure Server CA +-----BEGIN CERTIFICATE----- +MIIGqDCCBZCgAwIBAgIQCvBs2jemC2QTQvCh6x1Z/TANBgkqhkiG9w0BAQsFADBN +MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMScwJQYDVQQDEx5E +aWdpQ2VydCBTSEEyIFNlY3VyZSBTZXJ2ZXIgQ0EwHhcNMjAwMzIzMDAwMDAwWhcN +MjIwNTE3MTIwMDAwWjBuMQswCQYDVQQGEwJVUzETMBEGA1UECBMKQ2FsaWZvcm5p +YTEVMBMGA1UEBxMMV2FsbnV0IENyZWVrMRwwGgYDVQQKExNMdWNhcyBHYXJyb24g +VG9ycmVzMRUwEwYDVQQDDAwqLmJhZHNzbC5jb20wggEiMA0GCSqGSIb3DQEBAQUA +A4IBDwAwggEKAoIBAQDCBOz4jO4EwrPYUNVwWMyTGOtcqGhJsCK1+ZWesSssdj5s +wEtgTEzqsrTAD4C2sPlyyYYC+VxBXRMrf3HES7zplC5QN6ZnHGGM9kFCxUbTFocn +n3TrCp0RUiYhc2yETHlV5NFr6AY9SBVSrbMo26r/bv9glUp3aznxJNExtt1NwMT8 +U7ltQq21fP6u9RXSM0jnInHHwhR6bCjqN0rf6my1crR+WqIW3GmxV0TbChKr3sMP +R3RcQSLhmvkbk+atIgYpLrG6SRwMJ56j+4v3QHIArJII2YxXhFOBBcvm/mtUmEAn +hccQu3Nw72kYQQdFVXz5ZD89LMOpfOuTGkyG0cqFAgMBAAGjggNhMIIDXTAfBgNV +HSMEGDAWgBQPgGEcgjFh1S8o541GOLQs4cbZ4jAdBgNVHQ4EFgQUne7Be4ELOkdp +cRh9ETeTvKUbP/swIwYDVR0RBBwwGoIMKi5iYWRzc2wuY29tggpiYWRzc2wuY29t +MA4GA1UdDwEB/wQEAwIFoDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIw +awYDVR0fBGQwYjAvoC2gK4YpaHR0cDovL2NybDMuZGlnaWNlcnQuY29tL3NzY2Et +c2hhMi1nNi5jcmwwL6AtoCuGKWh0dHA6Ly9jcmw0LmRpZ2ljZXJ0LmNvbS9zc2Nh +LXNoYTItZzYuY3JsMEwGA1UdIARFMEMwNwYJYIZIAYb9bAEBMCowKAYIKwYBBQUH +AgEWHGh0dHBzOi8vd3d3LmRpZ2ljZXJ0LmNvbS9DUFMwCAYGZ4EMAQIDMHwGCCsG +AQUFBwEBBHAwbjAkBggrBgEFBQcwAYYYaHR0cDovL29jc3AuZGlnaWNlcnQuY29t +MEYGCCsGAQUFBzAChjpodHRwOi8vY2FjZXJ0cy5kaWdpY2VydC5jb20vRGlnaUNl +cnRTSEEyU2VjdXJlU2VydmVyQ0EuY3J0MAwGA1UdEwEB/wQCMAAwggF+BgorBgEE +AdZ5AgQCBIIBbgSCAWoBaAB2ALvZ37wfinG1k5Qjl6qSe0c4V5UKq1LoGpCWZDaO +HtGFAAABcQhGXioAAAQDAEcwRQIgDfWVBXEuUZC2YP4Si3AQDidHC4U9e5XTGyG7 +SFNDlRkCIQCzikrA1nf7boAdhvaGu2Vkct3VaI+0y8p3gmonU5d9DwB2ACJFRQdZ +VSRWlj+hL/H3bYbgIyZjrcBLf13Gg1xu4g8CAAABcQhGXlsAAAQDAEcwRQIhAMWi +Vsi2vYdxRCRsu/DMmCyhY0iJPKHE2c6ejPycIbgqAiAs3kSSS0NiUFiHBw7QaQ/s +GO+/lNYvjExlzVUWJbgNLwB2AFGjsPX9AXmcVm24N3iPDKR6zBsny/eeiEKaDf7U +iwXlAAABcQhGXnoAAAQDAEcwRQIgKsntiBqt8Au8DAABFkxISELhP3U/wb5lb76p +vfenWL0CIQDr2kLhCWP/QUNxXqGmvr1GaG9EuokTOLEnGPhGv1cMkDANBgkqhkiG +9w0BAQsFAAOCAQEA0RGxlwy3Tl0lhrUAn2mIi8LcZ9nBUyfAcCXCtYyCdEbjIP64 +xgX6pzTt0WJoxzlT+MiK6fc0hECZXqpkTNVTARYtGkJoljlTK2vAdHZ0SOpm9OT4 +RLfjGnImY0hiFbZ/LtsvS2Zg7cVJecqnrZe/za/nbDdljnnrll7C8O5naQuKr4te +uice3e8a4TtviFwS/wdDnJ3RrE83b1IljILbU5SV0X1NajyYkUWS7AnOmrFUUByz +MwdGrM6kt0lfJy/gvGVsgIKZocHdedPeECqAtq7FAJYanOsjNN9RbBOGhbwq0/FP +CC01zojqS10nGowxzOiqyB4m6wytmzf0QwjpMw== +-----END CERTIFICATE----- +--- +Server certificate +subject=C = US, ST = California, L = Walnut Creek, O = Lucas Garron Torres, CN = *.badssl.com + +issuer=C = US, O = DigiCert Inc, CN = DigiCert SHA2 Secure Server CA + +--- +No client certificate CA names sent +Peer signing digest: SHA512 +Peer signature type: RSA +Server Temp Key: ECDH, P-256, 256 bits +--- +SSL handshake has read 2219 bytes and written 453 bytes +Verification error: unable to verify the first certificate +--- +New, TLSv1.2, Cipher is ECDHE-RSA-AES128-GCM-SHA256 +Server public key is 2048 bit +Secure Renegotiation IS supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +SSL-Session: + Protocol : TLSv1.2 + Cipher : ECDHE-RSA-AES128-GCM-SHA256 + Session-ID: 3A7DBDAC0199C67176A6191BC6ACC812FF469163BD550FCC0AC4CD7190C4980D + Session-ID-ctx: + Master-Key: A45673CF402FD94CD1B0F4FF96DE8C2651B1DCDC230570AC62ACDAA7BF5D9235D1B66F9FBE4FFBE2746CF61935D5DB9D + PSK identity: None + PSK identity hint: None + SRP username: None + Start Time: 1602435786 + Timeout : 7200 (sec) + Verify return code: 21 (unable to verify the first certificate) + Extended master secret: no +--- +|} + +let sha1_intermediate_badssl = + {| +CONNECTED(00000003) +--- +Certificate chain + 0 s:OU = Domain Control Validated, OU = COMODO SSL Wildcard, CN = *.badssl.com + i:C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO SSL CA +-----BEGIN CERTIFICATE----- +MIIE8TCCA9mgAwIBAgIRAL4AQmnXWHlXEDwE56pO2LIwDQYJKoZIhvcNAQELBQAw +cDELMAkGA1UEBhMCR0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4G +A1UEBxMHU2FsZm9yZDEaMBgGA1UEChMRQ09NT0RPIENBIExpbWl0ZWQxFjAUBgNV +BAMTDUNPTU9ETyBTU0wgQ0EwHhcNMTcwNDEzMDAwMDAwWhcNMjAwNTMwMjM1OTU5 +WjBYMSEwHwYDVQQLExhEb21haW4gQ29udHJvbCBWYWxpZGF0ZWQxHDAaBgNVBAsT +E0NPTU9ETyBTU0wgV2lsZGNhcmQxFTATBgNVBAMMDCouYmFkc3NsLmNvbTCCASIw +DQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMIE7PiM7gTCs9hQ1XBYzJMY61yo +aEmwIrX5lZ6xKyx2PmzAS2BMTOqytMAPgLaw+XLJhgL5XEFdEyt/ccRLvOmULlA3 +pmccYYz2QULFRtMWhyefdOsKnRFSJiFzbIRMeVXk0WvoBj1IFVKtsyjbqv9u/2CV +SndrOfEk0TG23U3AxPxTuW1CrbV8/q71FdIzSOciccfCFHpsKOo3St/qbLVytH5a +ohbcabFXRNsKEqveww9HdFxBIuGa+RuT5q0iBikusbpJHAwnnqP7i/dAcgCskgjZ +jFeEU4EFy+b+a1SYQCeFxxC7c3DvaRhBB0VVfPlkPz0sw6l865MaTIbRyoUCAwEA +AaOCAZwwggGYMB8GA1UdIwQYMBaAFBtrvR+KSRiUVDdVtCAX7Te5dxh9MB0GA1Ud +DgQWBBSd7sF7gQs6R2lxGH0RN5O8pRs/+zAOBgNVHQ8BAf8EBAMCBaAwDAYDVR0T +AQH/BAIwADAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwTwYDVR0gBEgw +RjA6BgsrBgEEAbIxAQICBzArMCkGCCsGAQUFBwIBFh1odHRwczovL3NlY3VyZS5j +b21vZG8uY29tL0NQUzAIBgZngQwBAgEwOAYDVR0fBDEwLzAtoCugKYYnaHR0cDov +L2NybC5jb21vZG9jYS5jb20vQ09NT0RPU1NMQ0EuY3JsMGkGCCsGAQUFBwEBBF0w +WzAzBggrBgEFBQcwAoYnaHR0cDovL2NydC5jb21vZG9jYS5jb20vQ09NT0RPU1NM +Q0EuY3J0MCQGCCsGAQUFBzABhhhodHRwOi8vb2NzcC5jb21vZG9jYS5jb20wIwYD +VR0RBBwwGoIMKi5iYWRzc2wuY29tggpiYWRzc2wuY29tMA0GCSqGSIb3DQEBCwUA +A4IBAQCjAoXzYKLon9rpcYVKD1Y3zvIZyojAiUgibAi/v3trIBDA92bOCxBNgCyw +yU3yFR8eSriE1lROeZghScU/qMKqJQhNv8jSRKiCaVjX/6XGJeGjJ4vDZgkoFOAt +3BUpzUSqCNZPuHim6YSIWRgcoCgvqzvh9wVh/eRTMGt2naTfy2ieUkYSKleGbE91 +DeCKiiAJlimR0MJ5xOznTvCMxvs0ZppG41F+ain6rmsKQaVZfw4IxJW+9KmtNO4g +EJO5rT+lOyz3t3Ij2yblHAwtcdxxwyA9BdvnIxfDcXVtNcqPNfBZRkhct/APO/yS +Ix4MYaiI3P48eZeMnLgiw/MOh2Vi +-----END CERTIFICATE----- + 1 s:C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO SSL CA + i:C = SE, O = AddTrust AB, OU = AddTrust External TTP Network, CN = AddTrust External CA Root +-----BEGIN CERTIFICATE----- +MIIE4jCCA8qgAwIBAgIQbrrwj3mD+p3hsm+W/G6YvzANBgkqhkiG9w0BAQUFADBv +MQswCQYDVQQGEwJTRTEUMBIGA1UEChMLQWRkVHJ1c3QgQUIxJjAkBgNVBAsTHUFk +ZFRydXN0IEV4dGVybmFsIFRUUCBOZXR3b3JrMSIwIAYDVQQDExlBZGRUcnVzdCBF +eHRlcm5hbCBDQSBSb290MB4XDTExMDgyMzAwMDAwMFoXDTIwMDUzMDEwNDgzOFow +cDELMAkGA1UEBhMCR0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4G +A1UEBxMHU2FsZm9yZDEaMBgGA1UEChMRQ09NT0RPIENBIExpbWl0ZWQxFjAUBgNV +BAMTDUNPTU9ETyBTU0wgQ0EwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIB +AQDUKy4c0qP4f1UUQN73RN2EVfeFe1VmaaflWetlg/TzdrFmw09OmJMJt0Cz0Reg +EgmogOEpY5cCjDGdCgLgWVu77TC1735drwhOjYvCOVYWmHOUeArJpk8ot6g0N9sl +IbE8mfbgEj5z6mQyn0IGPBnYCgR6TFdJK9J3etAAvF76ju7MwuQTbiVf3DykiKPc +Sce8xw/dGcCxcu147ziDCkUXG8l9ne3fqywso3WuW4IdiIONzghlDGYmVwWhDN/m +B4QLhKPIq9WVR7/c3P4d/AKTRAHK5rW3axYwAV3piQmVnvheKVzdx1WM8o4gTkB6 +5PVFA7SYK8SAflOHb8LSV7DpAgMBAAGjggF3MIIBczAfBgNVHSMEGDAWgBStvZh6 +NLQm9/rEJlTvA73gJMtUGjAdBgNVHQ4EFgQUG2u9H4pJGJRUN1W0IBftN7l3GH0w +DgYDVR0PAQH/BAQDAgEGMBIGA1UdEwEB/wQIMAYBAf8CAQAwEQYDVR0gBAowCDAG +BgRVHSAAMEQGA1UdHwQ9MDswOaA3oDWGM2h0dHA6Ly9jcmwudXNlcnRydXN0LmNv +bS9BZGRUcnVzdEV4dGVybmFsQ0FSb290LmNybDCBswYIKwYBBQUHAQEEgaYwgaMw +PwYIKwYBBQUHMAKGM2h0dHA6Ly9jcnQudXNlcnRydXN0LmNvbS9BZGRUcnVzdEV4 +dGVybmFsQ0FSb290LnA3YzA5BggrBgEFBQcwAoYtaHR0cDovL2NydC51c2VydHJ1 +c3QuY29tL0FkZFRydXN0VVROU0dDQ0EuY3J0MCUGCCsGAQUFBzABhhlodHRwOi8v +b2NzcC51c2VydHJ1c3QuY29tMA0GCSqGSIb3DQEBBQUAA4IBAQBDJTkjBwSsmV1Z +Zz3mL2F9WlZ7/AaNs0ud+tUFTA1mtb08x6Iqa7XP5rqDPmCQNgzVwu2KldmSQiMc +A3Y+wkjxdXKds4zPs1g0VkkdoS4rPbLoWhBG3mS1Ta5LbvwBtyEQ1ZW36yy+FAbM +QS7kbOJGkP/GKH5z/uUXuoLDEAWBZsKLKDigRD7p5M4zsHz44VOduLTL2sku2ZNw +jnwL43M+mZmP6+ERRDXYYIFiRdTeRVuQLkkbG9ukD4BiIXNp8ePebdhIfFYSJiIR +RwHGXhnCtJWX7mEAVfEEOPyE5ni0DUO+QzPdaNMiWwD7FILoS2J5MM/TlZ+zuYQB +1N3PIxL4 +-----END CERTIFICATE----- +--- +Server certificate +subject=OU = Domain Control Validated, OU = COMODO SSL Wildcard, CN = *.badssl.com + +issuer=C = GB, ST = Greater Manchester, L = Salford, O = COMODO CA Limited, CN = COMODO SSL CA + +--- +No client certificate CA names sent +Peer signing digest: SHA512 +Peer signature type: RSA +Server Temp Key: ECDH, P-256, 256 bits +--- +SSL handshake has read 3037 bytes and written 454 bytes +Verification error: certificate has expired +--- +New, TLSv1.2, Cipher is ECDHE-RSA-AES128-GCM-SHA256 +Server public key is 2048 bit +Secure Renegotiation IS supported +Compression: NONE +Expansion: NONE +No ALPN negotiated +SSL-Session: + Protocol : TLSv1.2 + Cipher : ECDHE-RSA-AES128-GCM-SHA256 + Session-ID: 1AA79F6F986D20959EFE3F4E293F2F5F05E1C33C779BB086A95C33B7B2A13716 + Session-ID-ctx: + Master-Key: 0F738EDA295FEA1972787E50BDFE693B8E0504BA41AC9EE75A6630CAEBD150693CCE7D2209F6D89482B1319C5975EA97 + PSK identity: None + PSK identity hint: None + SRP username: None + Start Time: 1602436102 + Timeout : 7200 (sec) + Verify return code: 10 (certificate has expired) + Extended master secret: no +--- +|} + +let err_tests = + [ + ( "self-signed.badssl.com", + (fun _ _ -> `InvalidChain), + self_signed_badssl, + ts_2020_10_11 ); + ( "expired.badssl.com", + (fun _ c -> + `LeafCertificateExpired (List.hd c, Some (Ptime.v ts_2020_10_11))), + expired_badssl, + ts_2020_10_11 ); + ( "untrusted-root.badssl.com", + (fun _ _ -> `InvalidChain), + untrusted_root_badssl, + ts_2020_10_11 ); + ( "wrong.host.badssl.com", + (fun h c -> `LeafInvalidName (List.hd c, Some h)), + wrong_host_badssl, + ts_2020_10_11 ); + ( "incomplete-chain.badssl.com", + (fun _ _ -> `InvalidChain), + incomplete_chain_badssl, + ts_2020_10_11 ); + ( "sha1-intermediate.badssl.com", + (fun _ _ -> `InvalidChain), + sha1_intermediate_badssl, + ts_2020_05_30 ); + ( "wrong.host.google.com", + (fun h c -> `LeafInvalidName (List.hd c, Some h)), + google, + ts_2022_01_07 ); + ] + +let auth = Result.get_ok (Ca_certs_nss.authenticator ()) + +let tests = + List.map + (fun (name, data, ts) -> + let host = Domain_name.(of_string_exn name |> host_exn) + and chain = Result.get_ok (X509.Certificate.decode_pem_multiple data) in + ( name, + `Quick, + test_one auth ts (Ok (Some (chain, List.hd chain))) (`Host host) chain + )) + ok_tests + @ List.map + (fun (name, result, data, ts) -> + let host = Domain_name.(of_string_exn name |> host_exn) + and chain = Result.get_ok (X509.Certificate.decode_pem_multiple data) in + ( name, + `Quick, + test_one auth ts (Error (result host chain)) (`Host host) chain )) + err_tests + +let () = + Alcotest.run "verification tests" [ ("X509 certificate validation", tests) ] diff --git a/unikernel/duniverse/camlp-streams/.gitignore b/unikernel/duniverse/camlp-streams/.gitignore new file mode 100644 index 00000000..e22b8a82 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/.gitignore @@ -0,0 +1,4 @@ +_build +camlpstreams.opam +*~ +dune-workspace diff --git a/unikernel/duniverse/camlp-streams/CHANGES.md b/unikernel/duniverse/camlp-streams/CHANGES.md new file mode 100644 index 00000000..37d2f334 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/CHANGES.md @@ -0,0 +1,13 @@ +# Release 5.0.1 (2022-06-26) + +- Update licensing metadata. +- Update dune files to 2.7 to auto-generate opam files correctly (#2) +- Lower required OCaml version to 4.02.3 (#3) +- Install empty library for OCaml < 4.08 to fix linking problems (#5) +- Re-export Standard Library modules for 4.08-4.14 for type equality (#5) + +# Release 5.0 (2021-06-29) + +- Initial import from OCaml 4.14 +- Packaging improvements (#1) +- Initial release diff --git a/unikernel/duniverse/camlp-streams/LICENSE b/unikernel/duniverse/camlp-streams/LICENSE new file mode 100644 index 00000000..ea4ed156 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/LICENSE @@ -0,0 +1,204 @@ +The Camlp-streams library is copyright Institut National de Recherche +en Informatique et en Automatique (INRIA) and distributed under the +terms of the GNU Lesser General Public License (LGPL) version 2.1 +(included below). + +As a special exception to the GNU Lesser General Public License, you +may link, statically or dynamically, a "work that uses the +Camlp-streams library" with a publicly distributed version of the +Camlp-streams library to produce an executable file containing +portions of the Camlp-streams library, and distribute that executable +file under terms of your choice, without any of the additional +requirements listed in clause 6 of the GNU Lesser General Public +License. By "a publicly distributed version of the Camlp-streams +library", we mean either the unmodified Camlp-streams library +available from https://github/com/ocaml/camlp-streams, or a modified +version of the Camlp-streams library that is distributed under the +conditions defined in clause 2 of the GNU Lesser General Public +License. This exception does not however invalidate any other reasons +why the executable file might be covered by the GNU Lesser General +Public License. + +---------------------------------------------------------------------- + +GNU LESSER GENERAL PUBLIC LICENSE + +Version 2.1, February 1999 + +Copyright (C) 1991, 1999 Free Software Foundation, Inc. +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +Everyone is permitted to copy and distribute verbatim copies +of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + +Preamble + +The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. + +This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. + +When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. + +To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. + +For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. + +We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. + +To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. + +Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. + +Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. + +When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. + +We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. + +For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. + +In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. + +Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. + +The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. + +TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + +0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". + +A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. + +The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) + +"Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. + +Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. + +1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. + +You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. + +2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. + c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. + d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. + + (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. + +3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. + +Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. + +This option is useful when you wish to copy part of the code of the Library into a program that is not a library. + +4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. + +If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. + +5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. + +However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. + +When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. + +If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) + +Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. + +6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. + +You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: + + a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) + b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. + c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. + d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. + e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. + +For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. + +It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. + +7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. + b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. + +8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. + +9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. + +10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. + +11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. + +This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. + +12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. + +13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. + +14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. + +NO WARRANTY + +15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + +16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. +END OF TERMS AND CONDITIONS + +How to Apply These Terms to Your New Libraries + +If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). + +To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. + +one line to give the library's name and an idea of what it does. +Copyright (C) year name of author + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: + +Yoyodyne, Inc., hereby disclaims all copyright interest in +the library `Frob' (a library for tweaking knobs) written +by James Random Hacker. + +signature of Ty Coon, 1 April 1990 +Ty Coon, President of Vice + +That's all there is to it! + +-------------------------------------------------- diff --git a/unikernel/duniverse/camlp-streams/README.md b/unikernel/duniverse/camlp-streams/README.md new file mode 100644 index 00000000..2480eaa7 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/README.md @@ -0,0 +1,13 @@ +# The Stream and Genlex libraries for use with Camlp4 and Camlp5 + +The `camlp-streams` package provides two library modules: +- `Stream`: imperative streams, with in-place update and memoization of the latest element produced. +- `Genlex`: a small parameterized lexical analyzer producing streams of tokens from streams of characters. + +The two modules are designed for use with [Camlp4](https://github.com/camlp4/camlp4/) and [Camlp5](https://github.com/camlp5/camlp5): +- The stream patterns and stream expressions of Camlp4/Camlp5 consume and produce data of type `'a Stream.t`. +- The `Genlex` tokenizer can be used as a simple lexical analyzer for Camlp4/Camlp5-generated parsers. + +The `Stream` module can also be used by hand-written recursive-descent parsers, but is not very convenient for this purpose. + +The `Stream` and `Genlex` modules have been part of the OCaml standard library for a long time, and have been distributed as part of the core OCaml system. They will be removed from the OCaml standard library at some future point, but will be maintained and distributed separately in this `camlp-streams` package. diff --git a/unikernel/duniverse/camlp-streams/camlp-streams.opam b/unikernel/duniverse/camlp-streams/camlp-streams.opam new file mode 100644 index 00000000..a95f46dc --- /dev/null +++ b/unikernel/duniverse/camlp-streams/camlp-streams.opam @@ -0,0 +1,52 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "The Stream and Genlex libraries for use with Camlp4 and Camlp5" +description: """ + +This package provides two library modules: +- Stream: imperative streams, with in-place update and memoization + of the latest element produced. +- Genlex: a small parameterized lexical analyzer producing streams + of tokens from streams of characters. + +The two modules are designed for use with Camlp4 and Camlp5: +- The stream patterns and stream expressions of Camlp4/Camlp5 consume + and produce data of type 'a Stream.t. +- The Genlex tokenizer can be used as a simple lexical analyzer for + Camlp4/Camlp5-generated parsers. + +The Stream module can also be used by hand-written recursive-descent +parsers, but is not very convenient for this purpose. + +The Stream and Genlex modules have been part of the OCaml standard library +for a long time, and have been distributed as part of the core OCaml system. +They will be removed from the OCaml standard library at some future point, +but will be maintained and distributed separately in this camlpstreams package. +""" +maintainer: [ + "Florian Angeletti " + "Xavier Leroy " +] +authors: ["Daniel de Rauglaudre" "Xavier Leroy"] +homepage: "https://github.com/ocaml/camlp-streams" +bug-reports: "https://github.com/ocaml/camlp-streams/issues" +depends: [ + "dune" {>= "2.7"} + "ocaml" {>= "4.02.3"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml/camlp-streams.git" diff --git a/unikernel/duniverse/camlp-streams/dune b/unikernel/duniverse/camlp-streams/dune new file mode 100644 index 00000000..23dcb29f --- /dev/null +++ b/unikernel/duniverse/camlp-streams/dune @@ -0,0 +1,63 @@ +(* -*- tuareg -*- *) + +(* camlp-streams is built in three different ways, depending on the version of + OCaml it's built for: + - 4.07 and earlier: empty library; Standard Library Stream and Genlex used + directly, since it's not possible in these versions to override the modules + - 4.08-4.14: Standard Library Stream and Genlex re-exported (without + deprecation for 4.14) + - 5.0+: modules in src/ are compiled + *) + +open Jbuild_plugin.V1 + +let modules = + let version = Scanf.sscanf ocaml_version "%u.%u" (fun a b -> (a, b)) in + if version >= (4, 08) then ":standard" else "" + +let dune_fragment_for mod_name basename = + Printf.sprintf {| +(rule + (target %s.mli) + (action (copy src/%%{target} %%{target})) + (enabled_if (>= %%{ocaml_version} 5.0))) + +(rule + (target %s.ml) + (action (copy src/%%{target} %%{target})) + (enabled_if (>= %%{ocaml_version} 5.0))) + +(rule + (target %s.mli) + (action (with-stdout-to %%{target} + (echo "include module type of struct include %s end"))) + (enabled_if (< %%{ocaml_version} 5.0))) + +(rule + (target %s.ml) + (action (with-stdout-to %%{target} + (echo "include %s"))) + (enabled_if (< %%{ocaml_version} 5.0)))|} + basename basename basename mod_name basename mod_name + +let () = + let stream = dune_fragment_for "Stream" "stream" in + let genlex = dune_fragment_for "Genlex" "genlex" in + Printf.ksprintf send {| +%s %s +(rule + (action (with-stdout-to flags.sexp (echo "(-w -9)"))) + (enabled_if (>= %%{ocaml_version} 5.0))) +(rule + (action (with-stdout-to flags.sexp (echo "(-w -3)"))) + (enabled_if (and (>= %%{ocaml_version} 4.14) (< %%{ocaml_version} 5.0)))) +(rule + (action (with-stdout-to flags.sexp (echo "()"))) + (enabled_if (< %%{ocaml_version} 4.14))) + +(library + (name camlp_streams) + (public_name camlp-streams) + (modules %s) + (wrapped false) + (flags :standard (:include flags.sexp)))|} stream genlex modules diff --git a/unikernel/duniverse/camlp-streams/dune-project b/unikernel/duniverse/camlp-streams/dune-project new file mode 100644 index 00000000..f76ec975 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/dune-project @@ -0,0 +1,39 @@ +(lang dune 2.7) +(generate_opam_files true) +(formatting disabled) + +(name camlp-streams) +(source (github ocaml/camlp-streams)) +(authors "Daniel de Rauglaudre" "Xavier Leroy") +(maintainers + "Florian Angeletti " + "Xavier Leroy ") + +(package + (name camlp-streams) + (synopsis "The Stream and Genlex libraries for use with Camlp4 and Camlp5") + (description " +This package provides two library modules: +- Stream: imperative streams, with in-place update and memoization + of the latest element produced. +- Genlex: a small parameterized lexical analyzer producing streams + of tokens from streams of characters. + +The two modules are designed for use with Camlp4 and Camlp5: +- The stream patterns and stream expressions of Camlp4/Camlp5 consume + and produce data of type 'a Stream.t. +- The Genlex tokenizer can be used as a simple lexical analyzer for + Camlp4/Camlp5-generated parsers. + +The Stream module can also be used by hand-written recursive-descent +parsers, but is not very convenient for this purpose. + +The Stream and Genlex modules have been part of the OCaml standard library +for a long time, and have been distributed as part of the core OCaml system. +They will be removed from the OCaml standard library at some future point, +but will be maintained and distributed separately in this camlpstreams package. +") + + (depends + (ocaml (>= 4.02.3))) +) diff --git a/unikernel/duniverse/camlp-streams/dune-workspace.dev b/unikernel/duniverse/camlp-streams/dune-workspace.dev new file mode 100644 index 00000000..51c85396 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/dune-workspace.dev @@ -0,0 +1,16 @@ +(lang dune 1.0) +(context default) +; Test on all 4.x versions as well +(context (opam (switch 4.02))) +(context (opam (switch 4.03))) +(context (opam (switch 4.04))) +(context (opam (switch 4.05))) +(context (opam (switch 4.06))) +(context (opam (switch 4.07))) +(context (opam (switch 4.08))) +(context (opam (switch 4.09))) +(context (opam (switch 4.10))) +(context (opam (switch 4.11))) +(context (opam (switch 4.12))) +(context (opam (switch 4.13))) +(context (opam (switch 4.14))) diff --git a/unikernel/duniverse/camlp-streams/src/genlex.ml b/unikernel/duniverse/camlp-streams/src/genlex.ml new file mode 100644 index 00000000..b015bb95 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/src/genlex.ml @@ -0,0 +1,201 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type token = + Kwd of string + | Ident of string + | Int of int + | Float of float + | String of string + | Char of char + +(* The string buffering machinery *) + +let initial_buffer = Bytes.create 32 + +let buffer = ref initial_buffer +let bufpos = ref 0 + +let reset_buffer () = buffer := initial_buffer; bufpos := 0 + +let store c = + if !bufpos >= Bytes.length !buffer then begin + let newbuffer = Bytes.create (2 * !bufpos) in + Bytes.blit !buffer 0 newbuffer 0 !bufpos; + buffer := newbuffer + end; + Bytes.set !buffer !bufpos c; + incr bufpos + +let get_string () = + let s = Bytes.sub_string !buffer 0 !bufpos in buffer := initial_buffer; s + +(* The lexer *) + +let make_lexer keywords = + let kwd_table = Hashtbl.create 17 in + List.iter (fun s -> Hashtbl.add kwd_table s (Kwd s)) keywords; + let ident_or_keyword id = + try Hashtbl.find kwd_table id with + Not_found -> Ident id + and keyword_or_error c = + let s = String.make 1 c in + try Hashtbl.find kwd_table s with + Not_found -> raise (Stream.Error ("Illegal character " ^ s)) + in + let rec next_token (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some (' ' | '\010' | '\013' | '\009' | '\026' | '\012') -> + Stream.junk strm__; next_token strm__ + | Some ('A'..'Z' | 'a'..'z' | '_' | '\192'..'\255' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store c; ident s + | Some + ('!' | '%' | '&' | '$' | '#' | '+' | '/' | ':' | '<' | '=' | '>' | + '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store c; ident2 s + | Some ('0'..'9' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store c; number s + | Some '\'' -> + Stream.junk strm__; + let c = + try char strm__ with + Stream.Failure -> raise (Stream.Error "") + in + begin match Stream.peek strm__ with + Some '\'' -> Stream.junk strm__; Some (Char c) + | _ -> raise (Stream.Error "") + end + | Some '\"' -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); Some (String (string s)) + | Some '-' -> Stream.junk strm__; neg_number strm__ + | Some '(' -> Stream.junk strm__; maybe_comment strm__ + | Some c -> Stream.junk strm__; Some (keyword_or_error c) + | _ -> None + and ident (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some + ('A'..'Z' | 'a'..'z' | '\192'..'\255' | '0'..'9' | '_' | '\'' as c) -> + Stream.junk strm__; let s = strm__ in store c; ident s + | _ -> Some (ident_or_keyword (get_string ())) + and ident2 (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some + ('!' | '%' | '&' | '$' | '#' | '+' | '-' | '/' | ':' | '<' | '=' | + '>' | '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> + Stream.junk strm__; let s = strm__ in store c; ident2 s + | _ -> Some (ident_or_keyword (get_string ())) + and neg_number (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store '-'; store c; number s + | _ -> let s = strm__ in reset_buffer (); store '-'; ident2 s + and number (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; let s = strm__ in store c; number s + | Some '.' -> + Stream.junk strm__; let s = strm__ in store '.'; decimal_part s + | Some ('e' | 'E') -> + Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s + | _ -> Some (Int (int_of_string (get_string ()))) + and decimal_part (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; let s = strm__ in store c; decimal_part s + | Some ('e' | 'E') -> + Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s + | _ -> Some (Float (float_of_string (get_string ()))) + and exponent_part (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('+' | '-' as c) -> + Stream.junk strm__; let s = strm__ in store c; end_exponent_part s + | _ -> end_exponent_part strm__ + and end_exponent_part (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; let s = strm__ in store c; end_exponent_part s + | _ -> Some (Float (float_of_string (get_string ()))) + and string (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '\"' -> Stream.junk strm__; get_string () + | Some '\\' -> + Stream.junk strm__; + let c = + try escape strm__ with + Stream.Failure -> raise (Stream.Error "") + in + let s = strm__ in store c; string s + | Some c -> Stream.junk strm__; let s = strm__ in store c; string s + | _ -> raise Stream.Failure + and char (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '\\' -> + Stream.junk strm__; + begin try escape strm__ with + Stream.Failure -> raise (Stream.Error "") + end + | Some c -> Stream.junk strm__; c + | _ -> raise Stream.Failure + and escape (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some 'n' -> Stream.junk strm__; '\n' + | Some 'r' -> Stream.junk strm__; '\r' + | Some 't' -> Stream.junk strm__; '\t' + | Some ('0'..'9' as c1) -> + Stream.junk strm__; + begin match Stream.peek strm__ with + Some ('0'..'9' as c2) -> + Stream.junk strm__; + begin match Stream.peek strm__ with + Some ('0'..'9' as c3) -> + Stream.junk strm__; + Char.chr + ((Char.code c1 - 48) * 100 + (Char.code c2 - 48) * 10 + + (Char.code c3 - 48)) + | _ -> raise (Stream.Error "") + end + | _ -> raise (Stream.Error "") + end + | Some c -> Stream.junk strm__; c + | _ -> raise Stream.Failure + and maybe_comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '*' -> + Stream.junk strm__; let s = strm__ in comment s; next_token s + | _ -> Some (keyword_or_error '(') + and comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '(' -> Stream.junk strm__; maybe_nested_comment strm__ + | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ + | Some _ -> Stream.junk strm__; comment strm__ + | _ -> raise Stream.Failure + and maybe_nested_comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '*' -> Stream.junk strm__; let s = strm__ in comment s; comment s + | Some _ -> Stream.junk strm__; comment strm__ + | _ -> raise Stream.Failure + and maybe_end_comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ')' -> Stream.junk strm__; () + | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ + | Some _ -> Stream.junk strm__; comment strm__ + | _ -> raise Stream.Failure + in + fun input -> Stream.from (fun _count -> next_token input) diff --git a/unikernel/duniverse/camlp-streams/src/genlex.mli b/unikernel/duniverse/camlp-streams/src/genlex.mli new file mode 100644 index 00000000..875782c2 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/src/genlex.mli @@ -0,0 +1,73 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** A generic lexical analyzer. + + + This module implements a simple 'standard' lexical analyzer, presented + as a function from character streams to token streams. It implements + roughly the lexical conventions of OCaml, but is parameterized by the + set of keywords of your language. + + + Example: a lexer suitable for a desk calculator is obtained by +{[ let lexer = make_lexer ["+"; "-"; "*"; "/"; "let"; "="; "("; ")"]]} + + The associated parser would be a function from [token stream] + to, for instance, [int], and would have rules such as: + + {[ + let rec parse_expr = parser + | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2 + and parse_atom = parser + | [< 'Int n >] -> n + | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n + and parse_remainder n1 = parser + | [< 'Kwd "+"; n2 = parse_expr >] -> n1 + n2 + | [< >] -> n1 + ]} + + One should notice that the use of the [parser] keyword and associated + notation for streams are only available through camlp4 extensions. This + means that one has to preprocess its sources {i e. g.} by using the + ["-pp"] command-line switch of the compilers. +*) + +(** The type of tokens. The lexical classes are: [Int] and [Float] + for integer and floating-point numbers; [String] for + string literals, enclosed in double quotes; [Char] for + character literals, enclosed in single quotes; [Ident] for + identifiers (either sequences of letters, digits, underscores + and quotes, or sequences of 'operator characters' such as + [+], [*], etc); and [Kwd] for keywords (either identifiers or + single 'special characters' such as [(], [}], etc). *) +type token = + Kwd of string + | Ident of string + | Int of int + | Float of float + | String of string + | Char of char + +val make_lexer : string list -> char Stream.t -> token Stream.t +(** Construct the lexer function. The first argument is the list of + keywords. An identifier [s] is returned as [Kwd s] if [s] + belongs to this list, and as [Ident s] otherwise. + A special character [s] is returned as [Kwd s] if [s] + belongs to this list, and cause a lexical error (exception + {!Stream.Error} with the offending lexeme as its parameter) otherwise. + Blanks and newlines are skipped. Comments delimited by [(*] and [*)] + are skipped as well, and can be nested. A {!Stream.Failure} exception + is raised if end of stream is unexpectedly reached.*) diff --git a/unikernel/duniverse/camlp-streams/src/stream.ml b/unikernel/duniverse/camlp-streams/src/stream.ml new file mode 100644 index 00000000..2bfef709 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/src/stream.ml @@ -0,0 +1,236 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type 'a t = 'a cell option +and 'a cell = { mutable count : int; mutable data : 'a data } +and 'a data = + Sempty + | Scons of 'a * 'a data + | Sapp of 'a data * 'a data + | Slazy of 'a data Lazy.t + | Sgen of 'a gen + | Sbuffio : buffio -> char data +and 'a gen = { mutable curr : 'a option option; func : int -> 'a option } +and buffio = + { ic : in_channel; buff : bytes; mutable len : int; mutable ind : int } + +exception Failure +exception Error of string + +let count = function + | None -> 0 + | Some { count } -> count +let data = function + | None -> Sempty + | Some { data } -> data + +let fill_buff b = + b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0 + + +let rec get_data : type v. int -> v data -> v data = fun count d -> match d with + (* Returns either Sempty or Scons(a, _) even when d is a generator + or a buffer. In those cases, the item a is seen as extracted from + the generator/buffer. + The count parameter is used for calling `Sgen-functions'. *) + Sempty | Scons (_, _) -> d + | Sapp (d1, d2) -> + begin match get_data count d1 with + Scons (a, d11) -> Scons (a, Sapp (d11, d2)) + | Sempty -> get_data count d2 + | _ -> assert false + end + | Sgen {curr = Some None} -> Sempty + | Sgen ({curr = Some(Some a)} as g) -> + g.curr <- None; Scons(a, d) + | Sgen g -> + begin match g.func count with + None -> g.curr <- Some(None); Sempty + | Some a -> Scons(a, d) + (* Warning: anyone using g thinks that an item has been read *) + end + | Sbuffio b -> + if b.ind >= b.len then fill_buff b; + if b.len == 0 then Sempty else + let r = Bytes.unsafe_get b.buff b.ind in + (* Warning: anyone using g thinks that an item has been read *) + b.ind <- succ b.ind; Scons(r, d) + | Slazy f -> get_data count (Lazy.force f) + + +let rec peek_data : type v. v cell -> v option = fun s -> + (* consult the first item of s *) + match s.data with + Sempty -> None + | Scons (a, _) -> Some a + | Sapp (_, _) -> + begin match get_data s.count s.data with + Scons(a, _) as d -> s.data <- d; Some a + | Sempty -> None + | _ -> assert false + end + | Slazy f -> s.data <- (Lazy.force f); peek_data s + | Sgen {curr = Some a} -> a + | Sgen g -> let x = g.func s.count in g.curr <- Some x; x + | Sbuffio b -> + if b.ind >= b.len then fill_buff b; + if b.len == 0 then begin s.data <- Sempty; None end + else Some (Bytes.unsafe_get b.buff b.ind) + + +let peek = function + | None -> None + | Some s -> peek_data s + + +let rec junk_data : type v. v cell -> unit = fun s -> + match s.data with + Scons (_, d) -> s.count <- (succ s.count); s.data <- d + | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None + | Sbuffio b -> + if b.ind >= b.len then fill_buff b; + if b.len == 0 then s.data <- Sempty + else (s.count <- (succ s.count); b.ind <- succ b.ind) + | _ -> + match peek_data s with + None -> () + | Some _ -> junk_data s + + +let junk = function + | None -> () + | Some data -> junk_data data + +let rec nget_data n s = + if n <= 0 then [], s.data, 0 + else + match peek_data s with + Some a -> + junk_data s; + let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k + | None -> [], s.data, 0 + + +let npeek_data n s = + let (al, d, len) = nget_data n s in + s.count <- (s.count - len); + s.data <- d; + al + + +let npeek n = function + | None -> [] + | Some d -> npeek_data n d + +let next s = + match peek s with + Some a -> junk s; a + | None -> raise Failure + + +let empty s = + match peek s with + Some _ -> raise Failure + | None -> () + + +let iter f strm = + let rec do_rec () = + match peek strm with + Some a -> junk strm; ignore(f a); do_rec () + | None -> () + in + do_rec () + + +(* Stream building functions *) + +let from f = Some {count = 0; data = Sgen {curr = None; func = f}} + +let of_list l = + Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty} + + +let of_string s = + let count = ref 0 in + from (fun _ -> + (* We cannot use the index passed by the [from] function directly + because it returns the current stream count, with absolutely no + guarantee that it will start from 0. For example, in the case + of [Stream.icons 'c' (Stream.from_string "ab")], the first + access to the string will be made with count [1] already. + *) + let c = !count in + if c < String.length s + then (incr count; Some s.[c]) + else None) + + +let of_bytes s = + let count = ref 0 in + from (fun _ -> + let c = !count in + if c < Bytes.length s + then (incr count; Some (Bytes.get s c)) + else None) + + +let of_channel ic = + Some {count = 0; + data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}} + + +(* Stream expressions builders *) + +let iapp i s = Some {count = 0; data = Sapp (data i, data s)} +let icons i s = Some {count = 0; data = Scons (i, data s)} +let ising i = Some {count = 0; data = Scons (i, Sempty)} + +let lapp f s = + Some {count = 0; data = Slazy (lazy(Sapp (data (f ()), data s)))} + +let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))} +let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))} + +let sempty = None +let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))} + +(* For debugging use *) + +let rec dump : type v. (v -> unit) -> v t -> unit = fun f s -> + print_string "{count = "; + print_int (count s); + print_string "; data = "; + dump_data f (data s); + print_string "}"; + print_newline () +and dump_data : type v. (v -> unit) -> v data -> unit = fun f -> + function + Sempty -> print_string "Sempty" + | Scons (a, d) -> + print_string "Scons ("; + f a; + print_string ", "; + dump_data f d; + print_string ")" + | Sapp (d1, d2) -> + print_string "Sapp ("; + dump_data f d1; + print_string ", "; + dump_data f d2; + print_string ")" + | Slazy _ -> print_string "Slazy" + | Sgen _ -> print_string "Sgen" + | Sbuffio _ -> print_string "Sbuffio" diff --git a/unikernel/duniverse/camlp-streams/src/stream.mli b/unikernel/duniverse/camlp-streams/src/stream.mli new file mode 100644 index 00000000..93c2c315 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/src/stream.mli @@ -0,0 +1,111 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Streams and parsers. *) + +type 'a t +(** The type of streams holding values of type ['a]. *) + +exception Failure +(** Raised by parsers when none of the first components of the stream + patterns is accepted. *) + +exception Error of string +(** Raised by parsers when the first component of a stream pattern is + accepted, but one of the following components is rejected. *) + + +(** {1 Stream builders} *) + +val from : (int -> 'a option) -> 'a t +(** [Stream.from f] returns a stream built from the function [f]. + To create a new stream element, the function [f] is called with + the current stream count. The user function [f] must return either + [Some ] for a value or [None] to specify the end of the + stream. + + Do note that the indices passed to [f] may not start at [0] in the + general case. For example, [[< '0; '1; Stream.from f >]] would call + [f] the first time with count [2]. +*) + +val of_list : 'a list -> 'a t +(** Return the stream holding the elements of the list in the same + order. *) + +val of_string : string -> char t +(** Return the stream of the characters of the string parameter. *) + +val of_bytes : bytes -> char t +(** Return the stream of the characters of the bytes parameter. + @since 4.02.0 *) + +val of_channel : in_channel -> char t +(** Return the stream of the characters read from the input channel. *) + + +(** {1 Stream iterator} *) + +val iter : ('a -> unit) -> 'a t -> unit +(** [Stream.iter f s] scans the whole stream s, applying function [f] + in turn to each stream element encountered. *) + + +(** {1 Predefined parsers} *) + +val next : 'a t -> 'a +(** Return the first element of the stream and remove it from the + stream. + @raise Stream.Failure if the stream is empty. *) + +val empty : 'a t -> unit +(** Return [()] if the stream is empty, else raise {!Stream.Failure}. *) + + +(** {1 Useful functions} *) + +val peek : 'a t -> 'a option +(** Return [Some] of "the first element" of the stream, or [None] if + the stream is empty. *) + +val junk : 'a t -> unit +(** Remove the first element of the stream, possibly unfreezing + it before. *) + +val count : 'a t -> int +(** Return the current count of the stream elements, i.e. the number + of the stream elements discarded. *) + +val npeek : int -> 'a t -> 'a list +(** [npeek n] returns the list of the [n] first elements of + the stream, or all its remaining elements if less than [n] + elements are available. *) + +(**/**) + +(* The following is for system use only. Do not call directly. *) + +val iapp : 'a t -> 'a t -> 'a t +val icons : 'a -> 'a t -> 'a t +val ising : 'a -> 'a t + +val lapp : (unit -> 'a t) -> 'a t -> 'a t +val lcons : (unit -> 'a) -> 'a t -> 'a t +val lsing : (unit -> 'a) -> 'a t + +val sempty : 'a t +val slazy : (unit -> 'a t) -> 'a t + +val dump : ('a -> unit) -> 'a t -> unit diff --git a/unikernel/duniverse/camlp-streams/test/dune b/unikernel/duniverse/camlp-streams/test/dune new file mode 100644 index 00000000..5ba478f3 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/test/dune @@ -0,0 +1,41 @@ +(library + (name stream_stdlib) + (flags :standard -w -3) + (modules stream_stdlib) + (enabled_if (< %{ocaml_version} 5.0))) + +(library + (name stream_camlp_streams) + (libraries camlp-streams) + (modules stream_camlp_streams)) + +(executable + (name equality) + (libraries stream_stdlib stream_camlp_streams) + (modules equality) + (enabled_if (< %{ocaml_version} 5.0))) + +(rule + (action (with-stdout-to equality.output (run ./equality.exe))) + (enabled_if (< %{ocaml_version} 5.0))) + +(rule + (alias runtest) + (action (diff equality.expected equality.output)) + (enabled_if (< %{ocaml_version} 5.0))) + +(executable + (name linking) + (libraries camlp-streams stream_stdlib) + (modules linking) + (flags :standard -w -3) + (enabled_if (< %{ocaml_version} 5.0))) + +(rule + (action (with-stdout-to issue4.output (run ./linking.exe))) + (enabled_if (< %{ocaml_version} 5.0))) + +(rule + (alias runtest) + (action (diff issue4.expected issue4.output)) + (enabled_if (< %{ocaml_version} 5.0))) diff --git a/unikernel/duniverse/camlp-streams/test/equality.ml b/unikernel/duniverse/camlp-streams/test/equality.ml new file mode 100644 index 00000000..981fa124 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/test/equality.ml @@ -0,0 +1,6 @@ +(* Test type equality between a library using camlp-streams and one using + Stdlib.Stream *) + +let () = + Stream.empty Stream_stdlib.stream; + Stream.empty Stream_camlp_streams.stream diff --git a/unikernel/duniverse/camlp-streams/test/linking.ml b/unikernel/duniverse/camlp-streams/test/linking.ml new file mode 100644 index 00000000..027259e4 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/test/linking.ml @@ -0,0 +1,6 @@ +(* Test that we can link programs using libraries which use Stream.t but don't + necessarily use camlp-streams. Test is most relevant on 4.02-4.06 before the + Stdlib module was introduced. *) + +let () = + Stream.(empty (Stream.of_list Stream_stdlib.list)) diff --git a/unikernel/duniverse/camlp-streams/test/stream_camlp_streams.ml b/unikernel/duniverse/camlp-streams/test/stream_camlp_streams.ml new file mode 100644 index 00000000..9364a010 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/test/stream_camlp_streams.ml @@ -0,0 +1 @@ +let stream = Stream.of_list ([] : unit list) diff --git a/unikernel/duniverse/camlp-streams/test/stream_stdlib.ml b/unikernel/duniverse/camlp-streams/test/stream_stdlib.ml new file mode 100644 index 00000000..b1aadf27 --- /dev/null +++ b/unikernel/duniverse/camlp-streams/test/stream_stdlib.ml @@ -0,0 +1,2 @@ +let list = ([] : unit list) +let stream = Stream.of_list list diff --git a/unikernel/duniverse/cmdliner-stdlib/.gitignore b/unikernel/duniverse/cmdliner-stdlib/.gitignore new file mode 100644 index 00000000..2ab186cc --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/.gitignore @@ -0,0 +1,6 @@ +_build +*~ +\.\#* +\#*# +_opam +.DS_Store diff --git a/unikernel/duniverse/cmdliner-stdlib/.ocamlformat b/unikernel/duniverse/cmdliner-stdlib/.ocamlformat new file mode 100644 index 00000000..eed22253 --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/.ocamlformat @@ -0,0 +1,4 @@ +version = 0.25.1 +profile = conventional +break-infix = fit-or-vertical +parse-docstrings = true diff --git a/unikernel/duniverse/cmdliner-stdlib/CHANGES.md b/unikernel/duniverse/cmdliner-stdlib/CHANGES.md new file mode 100644 index 00000000..76ed943e --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/CHANGES.md @@ -0,0 +1,8 @@ +## 1.0.1 (2024-10-11) + +- use "OCAML RUNTIME OPTIONS" as section header (not "OCAML RUNTIME PARAMETERS") + #2 @hannesm + +## 1.0.0 (2023-07-04) + +- Initial release diff --git a/unikernel/duniverse/cmdliner-stdlib/LICENSE.md b/unikernel/duniverse/cmdliner-stdlib/LICENSE.md new file mode 100644 index 00000000..339df622 --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/LICENSE.md @@ -0,0 +1,15 @@ +ISC License + +Copyright (X) 2011-2023, the [MirageOS contributors](https://mirage.io/community/#team) + +Permission to use, copy, modify, and distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/unikernel/duniverse/cmdliner-stdlib/README.md b/unikernel/duniverse/cmdliner-stdlib/README.md new file mode 100644 index 00000000..f8ecd56a --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/README.md @@ -0,0 +1,63 @@ +# cmdliner-stdlib + +The `cmdliner-stdlib` package is a collection of cmdliner terms that +help control OCaml runtime parameters, usually configured through the +`OCAMLRUNPARAM` environment variable. The package provides command-line +options for controlling features like backtrace, hash table +randomization, and garbage collector tuning. + +## Installation + +You can install the package using `opam`: + +```bash +opam install cmdliner-stdlib +``` + +## Usage + +You can use these command-line arguments to: +- enable/disable backtraces; +- enable/disable table randomization, for better security and prevent + collision attacks; and +- control the OCaml garbage collector as described in detail in the + [GC + control](http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#TYPEcontrol) + documentation. + +```ocaml +open Cmdliner + +let cmd = Cmd.v (Cmd.info "hello") (Cmdliner_stdlib.setup ()) +let () = exit (Cmd.eval cmd) +``` + +You can then use command-line options to change parameters of the +OCaml runtime. For instance, to enable backtraces and change the GC +allocation policy to "first fit": + +```sh +$ dune exec -- ./hello.exe --allocation-policy=first-fit --backtrace=true +``` + +You can disable some of these arguments. For instance, to disable GC control use: + +```ocaml + Cmdliner_stdlib.setup ~gc_control:None () +``` + +Or to change the default allocation policy to be `first-fit`: + + +```ocaml + let default = Gc.get () in + let gc_control = Some { default with allocation_policy = 1 } in + Cmdliner_stdlib.setup ~gc_control () +``` + +## Contributions + +We welcome contributions, bug reports, and feature requests. Please +visit our [GitHub +repository](https://github.com/mirage/cmdliner-stdlib) for more +information. diff --git a/unikernel/duniverse/cmdliner-stdlib/cmdliner-stdlib.opam b/unikernel/duniverse/cmdliner-stdlib/cmdliner-stdlib.opam new file mode 100644 index 00000000..56fdc7e9 --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/cmdliner-stdlib.opam @@ -0,0 +1,31 @@ +version: "1.0.1" +opam-version: "2.0" +maintainer: ["thomas@gazagnaire.org"] +authors: ["Thomas Gazagnaire" "Hannes Mehnert"] +homepage: "https://github.com/mirage/cmdliner-stdlib" +bug-reports: "https://github.com/mirage/cmdliner-stdlib/issues/" +dev-repo: "git+https://github.com/mirage/cmdliner-stdlib.git" +license: "ISC" +tags: ["org:mirage"] +doc: "https://mirage.github.io/cmdliner-stdlib/" + +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] + +depends: [ + "ocaml" {>= "4.08.0"} + "dune" {>= "2.9.0"} + "cmdliner" {>= "1.0.0"} +] +synopsis: "A collection of cmdliner terms to control OCaml runtime parameters" +description: """ +Cmdliner-stdlib is a package that provides a collection of cmdliner terms +to control the OCaml runtime parameters. This is typically done with environment +variables, but there are situations where such an environment is not accessible, +like in MirageOS. This package enables the configuration and manipulation of +runtime parameters in these contexts, improving the flexibility of applications +built on these platforms. +""" \ No newline at end of file diff --git a/unikernel/duniverse/cmdliner-stdlib/dune-project b/unikernel/duniverse/cmdliner-stdlib/dune-project new file mode 100644 index 00000000..a20881c2 --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/dune-project @@ -0,0 +1,3 @@ +(lang dune 2.9) +(name cmdliner-stdlib) +(version 1.0.1) diff --git a/unikernel/duniverse/cmdliner-stdlib/lib/cmdliner_stdlib.ml b/unikernel/duniverse/cmdliner-stdlib/lib/cmdliner_stdlib.ml new file mode 100644 index 00000000..4d01ec08 --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/lib/cmdliner_stdlib.ml @@ -0,0 +1,210 @@ +(* + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +open Cmdliner + +let ocaml_section = "OCAML RUNTIME OPTIONS" + +let backtrace ~default = + let doc = + "Trigger the printing of a stack backtrace when an uncaught exception \ + aborts the unikernel." + in + let doc = Arg.info ~docs:ocaml_section ~docv:"BOOL" ~doc [ "backtrace" ] in + Arg.(value & opt bool default doc) + +let randomize_hashtables ~default = + let doc = "Turn on randomization of all hash tables by default." in + let doc = + Arg.info ~docs:ocaml_section ~docv:"BOOL" ~doc [ "randomize-hashtables" ] + in + Arg.(value & opt bool default doc) + +let policy_of_int = function + | 0 -> `Next_fit + | 1 -> `First_fit + | 2 -> `Best_fit + | _ -> assert false + +let int_of_policy = function `Next_fit -> 0 | `First_fit -> 1 | `Best_fit -> 2 + +let allocation_policy d = + let policy = + Arg.enum + [ + ("next-fit", `Next_fit); + ("first-fit", `First_fit); + ("best-fit", `Best_fit); + ] + in + let doc = + "The policy used for allocating in the OCaml heap. Possible values are: \ + $(i,next-fit), $(i,first-fit), $(i,best-fit). Best-fit is only supported \ + since OCaml 4.10." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"ALLOCATION" ~doc [ "allocation-policy" ] + in + Arg.(value & opt policy (policy_of_int d.Gc.allocation_policy) doc) + +let minor_heap_size d = + let doc = "The size of the minor heap (in words)." in + let doc = + Arg.info ~docs:ocaml_section ~docv:"WORDS" ~doc [ "minor-heap-size" ] + in + Arg.(value & opt int d.Gc.minor_heap_size doc) + +let major_heap_increment d = + let doc = + "The size increment for the major heap (in words). If less than or equal \ + 1000, it is a percentage of the current heap size. If more than 1000, it \ + is a fixed number of words." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"PERCENT/WORDS" ~doc + [ "major-heap-increment" ] + in + Arg.(value & opt int d.Gc.major_heap_increment doc) + +let space_overhead d = + let doc = + "The percentage of live data of wasted memory, due to GC does not \ + immediately collect unreachable blocks. The major GC speed is computed \ + from this parameter, it will work more if smaller." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"PERCENT" ~doc [ "space-overhead" ] + in + Arg.(value & opt int d.Gc.space_overhead doc) + +let max_space_overhead d = + let doc = + "Heap compaction is triggered when the estimated amount of wasted memory \ + exceeds this (percentage of live data). If above 1000000, compaction is \ + never triggered." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"PERCENT" ~doc [ "max-space-overhead" ] + in + Arg.(value & opt int d.Gc.max_overhead doc) + +let gc_verbosity d = + let doc = + "GC messages on standard error output. Sum of flags. Check GC module \ + documentation for details." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"VERBOSITY" ~doc [ "gc-verbosity" ] + in + Arg.(value & opt int d.Gc.verbose doc) + +let gc_window_size d = + let doc = + "The size of the window used by the major GC for smoothing out variations \ + in its workload. Between 1 and 50." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"INT" ~doc [ "gc-window-size" ] + in + Arg.(value & opt int d.Gc.window_size doc) + +let custom_major_ratio d = + let doc = + "Target ratio of floating garbage to major heap size for out-of-heap \ + memory held by custom values." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"RATIO" ~doc [ "custom-major-ratio" ] + in + Arg.(value & opt int d.Gc.custom_minor_ratio doc) + +let custom_minor_ratio d = + let doc = + "Bound on floating garbage for out-of-heap memory held by custom values in \ + the minor heap." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"RATIO" ~doc [ "custom-minor-ratio" ] + in + Arg.(value & opt int d.Gc.custom_minor_ratio doc) + +let custom_minor_max_size d = + let doc = + "Maximum amount of out-of-heap memory for each custom value allocated in \ + the minor heap." + in + let doc = + Arg.info ~docs:ocaml_section ~docv:"BYTES" ~doc [ "custom-minor-max-size" ] + in + Arg.(value & opt int d.Gc.custom_minor_max_size doc) + +let stack_limit d = + let doc = "The maximum size of the fiber stacks (in words)." in + let doc = Arg.info ~docs:ocaml_section ~docv:"WORDS" ~doc [ "stack-limit" ] in + Arg.(value & opt int d.Gc.stack_limit doc) + +let gc_control ~default = + let f minor_heap_size major_heap_increment space_overhead verbose max_overhead + stack_limit allocation_policy window_size custom_major_ratio + custom_minor_ratio custom_minor_max_size = + let allocation_policy = int_of_policy allocation_policy in + { + Gc.minor_heap_size; + major_heap_increment; + space_overhead; + verbose; + max_overhead; + stack_limit; + allocation_policy; + window_size; + custom_major_ratio; + custom_minor_ratio; + custom_minor_max_size; + } + in + Term.( + const f + $ minor_heap_size default + $ major_heap_increment default + $ space_overhead default + $ gc_verbosity default + $ max_space_overhead default + $ stack_limit default + $ allocation_policy default + $ gc_window_size default + $ custom_major_ratio default + $ custom_minor_ratio default + $ custom_minor_max_size default) + +let setup ?backtrace:(b = Some false) ?randomize_hashtables:(r = Some false) + ?gc_control:(c = Some (Gc.get ())) () = + let f backtrace randomize_hashtables gc_control = + let () = + match backtrace with None -> () | Some b -> Printexc.record_backtrace b + in + let () = + match randomize_hashtables with + | None | Some false -> () + | Some true -> Hashtbl.randomize () + in + let () = match gc_control with None -> () | Some c -> Gc.set c in + () + in + let some c = Term.(const Option.some $ c) in + let none = Term.const None in + let fold f d = Option.fold ~none ~some:(fun d -> some (f ~default:d)) d in + let b = fold backtrace b in + let r = fold randomize_hashtables r in + let c = fold gc_control c in + Term.(const f $ b $ r $ c) diff --git a/unikernel/duniverse/cmdliner-stdlib/lib/cmdliner_stdlib.mli b/unikernel/duniverse/cmdliner-stdlib/lib/cmdliner_stdlib.mli new file mode 100644 index 00000000..49770898 --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/lib/cmdliner_stdlib.mli @@ -0,0 +1,61 @@ +(* + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +open Cmdliner + +(** {2 OCaml runtime keys} + + The OCaml runtime is usually configurable via the [OCAMLRUNPARAM] + environment variable. We provide boot parameters covering these options. *) + +val backtrace : default:bool -> bool Term.t +(** [--backtrace]: Output a backtrace if an uncaught exception terminated the + application. [default] is the default value if the parameter is not provided + on the command-line. *) + +val randomize_hashtables : default:bool -> bool Term.t +(** [--randomize-hashtables]: Randomize all hash tables. [default] is the + default value if the parameter is not provided on the command-line. *) + +val gc_control : default:Gc.control -> Gc.control Term.t +(** [gc_control] is a term that evaluates to a value of type [Gc.control]. + [default] is the default value if the parameter is not provided on the + command-line.. + + The OCaml garbage collector can be configured, as described in detail in + {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#TYPEcontrol} GC + control}. *) + +val setup : + ?backtrace:bool option -> + ?randomize_hashtables:bool option -> + ?gc_control:Gc.control option -> + unit -> + unit Term.t +(** [setup ?backtrace ?randomize_hashtables ?gc_control ()] is the term that set + the corresponding OCaml runtime parameters: + + - if [backtrace] is set to [Some d], adding [--backtrace] on the + command-line will call [Printexc.record_backtrace]. [d] is the default if + case no parameters are provided. If not set, [backtrace] is [Some false] + to match the default OCaml runtime behavior. + - if [randomize_hashtables] is set to [Some d], adding + [--randomize-hashtables] to the command-line will call + [Hashtable.randomize ()]. [d] is the default if no paramaters are + provided. If not set, [randomize_hashtables] is set to [Some false] to + match the default OCaml runtime behavior. + - if [gc_control] is set to [Some d], various control parameters are added + to the command-line options that will cause [Gc.set] with the right + parameters. [d] is the default if no parameters are provided. If not set, + [gc_control] is [Some (Gc.get ())]. *) diff --git a/unikernel/duniverse/cmdliner-stdlib/lib/dune b/unikernel/duniverse/cmdliner-stdlib/lib/dune new file mode 100644 index 00000000..b39107ad --- /dev/null +++ b/unikernel/duniverse/cmdliner-stdlib/lib/dune @@ -0,0 +1,4 @@ +(library + (public_name cmdliner-stdlib) + (name cmdliner_stdlib) + (libraries cmdliner)) diff --git a/unikernel/duniverse/cmdliner/.gitignore b/unikernel/duniverse/cmdliner/.gitignore new file mode 100644 index 00000000..cb8325a9 --- /dev/null +++ b/unikernel/duniverse/cmdliner/.gitignore @@ -0,0 +1,7 @@ +_build +_b0 +tmp +test/b0 +*.byte +*.native +cmdliner.install diff --git a/unikernel/duniverse/cmdliner/.merlin b/unikernel/duniverse/cmdliner/.merlin new file mode 100644 index 00000000..b36b958d --- /dev/null +++ b/unikernel/duniverse/cmdliner/.merlin @@ -0,0 +1,3 @@ +S src +S test +B _b0/b/** diff --git a/unikernel/duniverse/cmdliner/.ocp-indent b/unikernel/duniverse/cmdliner/.ocp-indent new file mode 100644 index 00000000..ad2fbcbf --- /dev/null +++ b/unikernel/duniverse/cmdliner/.ocp-indent @@ -0,0 +1 @@ +strict_with=always,match_clause=4,strict_else=never \ No newline at end of file diff --git a/unikernel/duniverse/cmdliner/B0.ml b/unikernel/duniverse/cmdliner/B0.ml new file mode 100644 index 00000000..1b199c58 --- /dev/null +++ b/unikernel/duniverse/cmdliner/B0.ml @@ -0,0 +1,105 @@ +[@@@B0.include "test/b0/B0.ml"] +(* See DEVEL.md for an explanation for the above line *) + +open B0_kit.V000 +open Result.Syntax + +(* OCaml library names *) + +let b0_std = B0_ocaml.libname "b0.std" +let cmdliner = B0_ocaml.libname "cmdliner" + +(* Units *) + +let cmdliner_lib = + B0_ocaml.lib cmdliner ~name:"cmdliner-lib" ~srcs:[`Dir ~/"src"] + +(* Tool *) + +let cmdliner_tool = + let srcs = [`Dir ~/"src/tool"] in + B0_ocaml.exe "cmdliner" ~public:true ~srcs ~requires:[cmdliner] + +(* Tests *) + +let test ?(requires = []) = B0_ocaml.test ~requires:(cmdliner :: requires) + +let testing = `File ~/"test/testing_cmdliner.ml" + +let test_arg = test ~/"test/test_arg.ml" ~srcs:[testing] ~requires:[b0_std] +let test_cmd = test ~/"test/test_cmd.ml" ~srcs:[testing] ~requires:[b0_std] +let test_completion = + test ~/"test/test_completion.ml" ~srcs:[testing] ~requires:[b0_std] + +let test_deprecation = + test ~/"test/test_deprecation.ml" ~srcs:[testing] ~requires:[b0_std] + +let test_legacy_prefix = + test ~/"test/test_legacy_prefix.ml" ~srcs:[testing] ~requires:[b0_std] + +let test_man = test ~/"test/test_man.ml" ~srcs:[testing] ~requires:[b0_std] +let test_term = test ~/"test/test_term.ml" ~srcs:[testing] ~requires:[b0_std] + +let example_chorus = test ~/"test/example_chorus.ml" ~run:false +let example_cp = test ~/"test/example_cp.ml" ~run:false +let example_darcs = test ~/"test/example_darcs.ml" ~run:false +let example_group = + let srcs = [testing] and requires = [b0_std] in + test ~/"test/example_group.ml" ~run:false ~srcs ~requires + +let example_revolt1 = test ~/"test/example_revolt1.ml" ~run:false +let example_revolt2 = test ~/"test/example_revolt2.ml" ~run:false +let example_rm = test ~/"test/example_rm.ml" ~run:false +let example_tail = test ~/"test/example_tail.ml" ~run:false + +let blueprint_min = test ~/"test/blueprint_min.ml" ~run:false +let blueprint_tool = test ~/"test/blueprint_tool.ml" ~run:false +let blueprint_cmds = test ~/"test/blueprint_cmds.ml" ~run:false + +(* Completion scripts update *) + +let update_completion_scripts = + B0_unit.of_action "update-cmdliner-data" @@ fun env _ ~args:_ -> + let bash = B0_env.in_scope_dir env ~/"src/tool/bash-completion.sh" in + let zsh = B0_env.in_scope_dir env ~/"src/tool/zsh-completion.sh" in + let ml = B0_env.in_scope_dir env ~/"src/tool/cmdliner_data.ml" in + let* bash = Os.File.read bash in + let* zsh = Os.File.read zsh in + let src = Fmt.str + "let bash_generic_completion =\n{|%s\ + |}\n\n\ + let zsh_generic_completion =\n{|%s\ + |}" bash zsh + in + Os.File.write ~force:true ~make_path:false ml src + +(* Packs *) + +(* FIXME b0 it's unclear whether the fact that the @@@B0.included units + show up in B0_unit.list () is a bug or a feature. If it's a bug + the filter on B0_unit.in_current_scope could be avoided. *) + +let default = + let meta = + B0_meta.empty + |> ~~ B0_meta.authors ["The cmdliner programmers"] + |> ~~ B0_meta.maintainers ["Daniel Bünzli "] + |> ~~ B0_meta.homepage "https://erratique.ch/software/cmdliner" + |> ~~ B0_meta.online_doc "https://erratique.ch/software/cmdliner/doc" + |> ~~ B0_meta.issues "https://github.com/dbuenzli/cmdliner/issues" + |> ~~ B0_meta.repo "git+https://erratique.ch/repos/cmdliner.git" + |> ~~ B0_meta.licenses ["ISC"] + |> ~~ B0_meta.description_tags + ["cli"; "system"; "declarative"; "org:erratique"] + |> ~~ B0_opam.depends [ "ocaml", {|>= "4.08.0"|}; ] + |> ~~ B0_opam.build {|[[ make "all" "PREFIX=%{prefix}%" ]]|} + |> ~~ B0_opam.install +{|[[make "install" "BINDIR=%{_:bin}%" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%" + "SHAREDIR=%{share}%" "MANDIR=%{man}%"] + [make "install-doc" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%" + "SHAREDIR=%{share}%" "MANDIR=%{man}%"]]|} + |> B0_meta.tag B0_opam.tag + in + let locked = false (* So that it looks up b0.std *) in + B0_pack.make "default" ~doc:"cmdliner package" ~meta ~locked @@ + List.filter B0_unit.in_current_scope (B0_unit.list ()) diff --git a/unikernel/duniverse/cmdliner/BRZO b/unikernel/duniverse/cmdliner/BRZO new file mode 100644 index 00000000..b1e48ff9 --- /dev/null +++ b/unikernel/duniverse/cmdliner/BRZO @@ -0,0 +1 @@ +(srcs-x build.ml test pkg) \ No newline at end of file diff --git a/unikernel/duniverse/cmdliner/CHANGES.md b/unikernel/duniverse/cmdliner/CHANGES.md new file mode 100644 index 00000000..78b98382 --- /dev/null +++ b/unikernel/duniverse/cmdliner/CHANGES.md @@ -0,0 +1,565 @@ +v2.0.0 2025-09-26 Zagreb +------------------------ + +### End-user visible changes + +- **IMPORTANT** Cmdliner no longer allows command names, option names, + and `Arg.enum` values to be specified by a prefix if the prefix is + unambiguous. See #200 for the rationale. To quickly salvage scripts + that may be relying on the old behaviour, it can be restored by + setting the environment variable `CMDLINER_LEGACY_PREFIXES=true`. + However the scripts should be fixed: this escape hatch will be + removed in the future. + +- Pager. If set, respect the user's `LESS` environment variable + (otherwise the default `LESS=FRX` is left unchanged). Note however + that you likely need at least `R` specified if you define it + yourself, otherwise the manpage may look garbled (#191). Thanks to + Yukai Chou for suggesting. + +- Fix lack of output whenever `PAGER` or `MANPAGER` is set but empty; + fallback to pager discovery (#194). For example this prevented to + see manpages in `emacs`'s compilation mode which unhelpfully + hardcodes `PAGER=""`. + +- Fix synopsis rendering of required optional arguments (#203). + +- Output error messages on `stderr` with styled text (#144). Quoted + and typewriter text is in bold. Variables are written as + underlines. Key words of error messages are in red. + +- Output error messages after the usage line and remove the `Try with + $(tool) --help for more information` message. Instead we explicitly + indicate the `--help` option in the usage line. Having the error message + at the end makes it easier to spot. + +- Make `--help` request work in any context, except after `--` or on + the arguments after an unknown command error in which case that + error is reported (less confusing). Since the option has an optional + argument value, one had to be carefull that it would not pickup the + next argument and try to parse it according to `FMT`. This is no + longer the case. If the argument fails to parse `--help=auto` is + assumed. (#201). + +- Deprecation messages are now prepended to the doc strings in the manpage. + +### API changes + +- Reserve the `--__complete` option for library use. + +- Documentation language, `$(cmd)`, `$(cmd.name)` and `$(tool)` can be + used and should be prefered over of `$(iname)`, `$(tname)` and + `$(mname)`. `$(cmd.parent)` is added to refer to a command's parent + or itself at the root. + +- Make `Cmdliner.Arg.conv` abstract. Thanks to Andrey Popp for + the patch (#206). + +- Thanks to the previous point, use the `docv` parameter of argument + converters can now be used to define the default value used by `docv` in + `Arg.info`. See `Arg.Conv.docv`. + +- Add `Manpage.section_name` type alias (#202). + +- Add `Cmd.make` which should be preferred to `Cmd.v` (The `M.v` notation is + nice for simulating literals, not for heavy constructor). + +- Add `Cmd.Env.info_var`. To get back the environment variable name + from a variable info. + +- Add optional `doc_envs` argument to `Arg.info` for adding the given + environment variables info to the command in which the argument is used. + Sometimes more than one variable make sense and the `env` argument is + not directly used. + +- Add `Arg.Completion` a module to define argument completion + strategies (#1, #187). + +- Add `Arg.Conv` module to define converters. This should be used in + new code. + +- Add `Arg.{file,dir,}path` string converters equiped with appropriate + file system completions. + +- Add `docv` optional parameter to `Arg.enum`. + +- Add `Term.env` which provides access to the environment access + function provided to evaluation functions. + +- Clarify the semantics of the `deprecated` argument of + `Cmdliner.Cmd.info`, `Cmdliner.Arg.info` and + `Cmdliner.Cmd.Env.info`. First, the language markup is now supported + therein. Second the message is no longer only used to warn about + usage it is now also prepended to the doc string of the entity. + +- Use `Arg.conv`'s `docv` property in the documentation of arguments + whenever `Arg.info`'s `docv` is unspecified (#207). + +- Do not check file existence for `-` in `Arg.file` or + `Arg.non_dir_file` values. This is supposed to mean `stdin` or + `stdout` (#208). + +- Fix manpage rendering performing direct calls to `Sys.getenv` in + `Cmd.eval*` functions instead of calling the `env` argument as + advertised in the docs. Incidentally add an `env` optional argument + to `Manpage.print` (#209). + +- Deprecate. `Arg.{printer,conv_docv,conv_parser, + conv_printer,parser_of_kind_of_string,conv,conv'}`. These will + likely never be removed but they should no longer be used for + new code. Use `Arg.Conv`. + +- Remove deprecated `Arg.{converter,parser,pconv}` (#206). +- Remove deprecated `Arg.{env,env_var}` (#206). +- Remove deprecated `Term.{pure,man_format}` (#206). +- Remove deprecated `Term` evaluation interface (#206). + +### Other + +- Install a `cmdliner` tool to help with manpage and completion script + installation. See the command line interface manual of the library + for more information (#187, #227, #228). + +- Install all source files for `odoc` and goto definition editor + functionality. Thanks to Emile Trotignon and Paul-Elliot Anglès + d'Auriac for noticing and suggesting (#225). + +- Added a proper test suite to the library to check for regressions. + Replaces most of the test executables that had to be run and inspected + manually (#205). + +v1.3.0 2024-05-23 La Forclaz (VS) +--------------------------------- + +- Add let operators in `Cmdliner.Term.Syntax` (#173). Thanks to Benoit + Montagu for suggesting, Gabriel Scherer for reminding us of language + punning obscurities and Sebastien Mondet for strengthening the case + to add them. +- Pager. Support full path command lookups on Windows. + (#185). Thanks to @kit-ty-kate for the report. +- In manpage specifications use `$(iname)` in the default + introduction of the `ENVIRONMENT` section. Follow up to + #168. +- Add `Cmd.eval_value'` a variation on `Cmd.eval_value`. + +v1.2.0 2023-04-10 La Forclaz (VS) +--------------------------------- + +- In manpage specification the new variable `$(iname)` substitutes the + command invocation (from program name to subcommand) in bold (#168). + This variable is now used in the default introduction of the `EXIT STATUS` + section. Thanks to Ali Caglayan for suggesting. +- Fix manpage rendering when `PAGER=less` is set (#167). +- Plain text manpage rendering: fix broken handling of `` `Noblank ``. + Thanks to Michael Richards and Reynir Björnsson for the report (#176). +- Fix install to directory with spaces (#172). Thanks to + @ZSFactory for reporting and suggesting the fix. +- Fix manpage paging on Windows (#166). Thanks to Nicolás Ojeda Bär + for the report and the solution. + +v1.1.1 2022-03-23 La Forclaz (VS) +--------------------------------- + +- General documentation fixes, tweaks and improvements. +- Docgen: suppress trailing whitespace in synopsis rendering. +- Docgen: fix duplicate rendering of standard options when using `Term.ret` (#135). +- Docgen: fix duplicate rendering of command name on ``Term.ret (`Help (fmt, None)`` + (#135). + +v1.1.0 2022-02-06 La Forclaz (VS) +--------------------------------- + +- Require OCaml 4.08. + +- Support for deprecating commands, arguments and environment variables (#66). + See the `?deprecated` argument of `Cmd.info`, `Cmd.Env.info` and `Arg.info`. + +- Add `Manpage.s_none` a special section name to use whenever you + want something not to be listed in a command's manpage. + +- Add `Arg.conv'` like `Arg.conv` but with a parser signature that returns + untagged string errors. + +- Add `Term.{term,cli_parse}_result'` functions. + +- Add deprecation alerts on what is already deprecated. + +- On unices, use `command -v` rather than `type` to find commands. + +- Stop using backticks for left quotes. Use apostrophes everywhere. + Thanks to Ryan Moore for reporting a typo that prompted the change (#128). + +- Rework documentation structure. Move out tutorial, examples and + reference doc from the `.mli` to multiple `.mld` pages. + +- `Arg.doc_alts` and `Arg.doc_alts_enum`, change the default rendering + to match the manpage convention which is to render these tokens in + bold. If you want to recover the previous rendering or were using + these functions outside man page rendering use an explicit + `~quoted:true` (the optional argument is available on earlier + versions). + +- The deprecated `Term.exit` and `Term.exit_status_of_result` now + require a `unit` result. This avoids various errors to go undetected. + Thanks to Thomas Leonard for the patch (#124). + +- Fix absent and default option values (`?none` string argument of `Arg.some`) + rendering in manpages: + + 1. They were not escaped, they now are. + 2. They where not rendered in bold, they now are. + 3. The documentation language was interpreted, it is no longer the case. + + If you were relying on the third point via `?none` of `Arg.some`, use the new + `?absent` optional argument of `Arg.info` instead. Besides a new + `Arg.some'` function is added to specify a value for `?none` instead + of a string. Thanks to David Allsopp for the patch (#111). + +- Documentation generation use: `…` (U+2026) instead of `...` for + ellipsis. See also UTF-8 manpage support below. + +- Documentation generation, improve command synopsis rendering on + commands with few options (i.e. mention them). + +- Documentation generation, drop section heading in the output if the section + is empty. + +### New `Cmd` module and deprecation of the `Term` evaluation interface + +This version of cmdliner deprecates the `Term.eval*` evaluation +functions and `Term.info` information values in favor of the new +`Cmdliner.Cmd` module. + +The `Cmd` module generalizes the existing subcommand support to allow +arbitrarily nested subcommands each with its own man page and command +line syntax represented by a `Term.t` value. + +The mapping between the old interface and the new one should be rather +straightforward. In particular `Term.info` and `Cmd.info` have exactly +the same semantics and fields and a command value simply pairs a +command information with a term. + +However in this transition the following things are changed or added: + +* All default values of `Cmd.info` match those of `Term.info` except + for: + * The `?exits` argument which defaults to `Cmd.Exit.defaults` + rather than the empty list. + * The `?man_xrefs` which defaults to the list ``[`Main]`` rather + than the empty list (this means that by default subcommands + at any level automatically cross-reference the main command). + * The `?sdocs` argument which defaults to `Manpage.s_common_options` + rather than `Manpage.s_options`. + +* The `Cmd.Exit.some_error` code is added to `Cmd.Exit.defaults` + (which in turn is the default for `Cmd.info` see above). This is an + error code clients can use when they don't want to bother about + having precise exit codes. It is high so that low, meaningful, + codes can later be added without breaking a tool's compatibility. In + particular the convenience evaluation functions `Cmd.eval_result*` + use this code when they evaluate to an error. + +* If you relied on `?term_err` defaulting to `1` in the various + `Term.exit*` function, note that the new `Cmd.eval*` function use + `Exit.cli_error` as a default. You may want to explicitly specify + `1` instead if you use `Term.ret` with the `` `Error`` case + or `Term.term_result`. + +Finally be aware that if you replace, in an existing tool, an encoding +of subcommands as positional arguments you will effectively break the +command line compatibility of your tool since options can no longer be +specified before the subcommands, i.e. your tool synopsis moves from: + +``` +tool cmd [OPTION]… SUBCMD [ARG]… +``` +to +``` +tool cmd SUBCMD [OPTION]… [ARG]… +``` + +Thanks to Rudi Grinberg for prototyping the feature in #123. + +### UTF-8 manpage support + +It is now possible to write UTF-8 encoded text in your doc strings and +man pages. + +The man page renderer used on `--help` defaults to `mandoc` if +available, then uses `groff` and then defaults to `nroff`. Starting +with `mandoc` catches macOS whose `groff` as of 11.6 still doesn't +support UTF-8 input and struggles to render some Unicode characters. + +The invocations were also tweaked to remove the `-P-c` option which +entails that the default pager `less` is now invoked with the `-R` option. + +If you install UTF-8 encoded man pages output via `--help=groff`, in +`man` directories bear in mind that these pages will look garbled on +stock macOS (at least until 11.6). One way to work around is to +instruct your users to change the `NROFF` definition in +`/private/etc/man.conf` from: + + NROFF /usr/bin/groff -Wall -mtty-char -Tascii -mandoc -c + +to: + + NROFF /usr/bin/mandoc -Tutf8 -c + +Thanks to Antonin Décimo for his knowledge and helping with these +`man`gnificent intricacies (#27). + +v1.0.4 2019-06-14 Zagreb +------------------------ + +- Change the way `Error (_, e)` term evaluation results + are formatted. Instead of treating `e` as text, treat + it as formatted lines. +- Fix 4.08 `Pervasives` deprecation. +- Fix 4.03 String deprecations. +- Fix bootstrap build in absence of dynlink. +- Make the `Makefile` bootstrap build reproducible. + Thanks to Thomas Leonard for the patch. + +v1.0.3 2018-11-26 Zagreb +------------------------ + +- Add `Term.with_used_args`. Thanks to Jeremie Dimino for + the patch. +- Use `Makefile` bootstrap build in opam file. +- Drop ocamlbuild requirement for `Makefile` bootstrap build. +- Drop support for ocaml < 4.03.0 +- Dune build support. + +v1.0.2 2017-08-07 Zagreb +------------------------ + +- Don't remove the `Makefile` from the distribution. + +v1.0.1 2017-08-03 Zagreb +------------------------ + +- Add a `Makefile` to build and install cmdliner without `topkg` and + opam `.install` files. Helps bootstraping opam in OS package + managers. Thanks to Hendrik Tews for the patches. + +v1.0.0 2017-03-02 La Forclaz (VS) +--------------------------------- + +**IMPORTANT** The `Arg.converter` type is deprecated in favor of the +`Arg.conv` type. For this release both types are equal but the next +major release will drop the former and make the latter abstract. All +users are kindly requested to migrate to use the new type and **only** +via the new `Arg.[p]conv` and `Arg.conv_{parser,printer}` functions. + +- Allow terms to be used more than once in terms without tripping out + documentation generation (#77). Thanks to François Bobot and Gabriel + Radanne. +- Disallow defining the same option (resp. command) name twice via two + different arguments (resp. terms). Raises Invalid_argument, used + to be undefined behaviour (in practice, an arbitrary one would be + ignored). +- Improve converter API (see important message above). +- Add `Term.exit[_status]` and `Term.exit_status_of[_status]_result`. + improves composition with `Pervasives.exit`. +- Add `Term.term_result` and `Term.cli_parse_result` improves composition + with terms evaluating to `result` types. +- Add `Arg.parser_of_kind_of_string`. +- Change semantics of `Arg.pos_left` (see #76 for details). +- Deprecate `Term.man_format` in favor of `Arg.man_format`. +- Reserve the `--cmdliner` option for library use. This is unused for now + but will be in the future. +- Relicense from BSD3 to ISC. +- Safe-string support. +- Build depend on topkg. + +### End-user visible changes + +The following changes affect the end-user behaviour of all binaries using +cmdliner. + +- Required positional arguments. All missing required position + arguments are now reported to the end-user, in the correct + order (#39). Thanks to Dmitrii Kashin for the report. +- Optional arguments. All unknown and ambiguous optional argument + arguments are now reported to the end-user (instead of only + the first one). +- Change default behaviour of `--help[=FMT]` option. `FMT` no longer + defaults to `pager` if unspecified. It defaults to the new value + `auto` which prints the help as `pager` or `plain` whenever the + `TERM` environment variable is `dumb` or undefined (#43). At the API + level this changes the signature of the type `Term.ret` and values + `Term.ret`, `Term.man_format` (deprecated) and `Manpage.print` to add the + new `` `Auto`` case to manual formats. These are now represented by the + `Manpage.format` type rather than inlined polyvars. + +### Doc specification improvements and fixes + +- Add `?envs` optional argument to `Term.info`. Documents environment + variables that influence a term's evaluation and automatically + integrate them in the manual. +- Add `?exits` optional argument to `Term.info`. Documents exit statuses of + the program. Use `Term.default_exits` if you are using the new `Term.exit` + functions. +- Add `?man_xrefs` optional argument to `Term.info`. Documents + references to other manpages. Automatically formats a `SEE ALSO` section + in the manual. +- Add `Manpage.escape` to escape a string from the documentation markup + language. +- Add `Manpage.s_*` constants for standard man page section names. +- Add a `` `Blocks`` case to `Manpage.blocks` to allow block splicing + (#69). This avoids having to concatenate block lists at the + toplevel of your program. +- `Arg.env_var`, change default environment variable section to the + standard `ENVIRONMENT` manual section rather than `ENVIRONMENT + VARIABLES`. If you previously manually positioned that section in + your man page you will have to change the name. See also next point. +- Fix automatic placement of default environment variable section (#44) + whenever unspecified in the man page. +- Better automatic insertions of man page sections (#73). See the API + docs about manual specification. As a side effect the `NAME` section + can now also be overridden manually. +- Fix repeated environment variable printing for flags (#64). Thanks to + Thomas Gazagnaire for the report. +- Fix rendering of env vars in man pages, bold is standard (#71). +- Fix plain help formatting for commands with empty + description. Thanks to Maciek Starzyk for the patch. +- Fix (implement really) groff man page escaping (#48). +- Request `an` macros directly in the man page via `.mso` this + makes man pages self-describing and avoids having to call `groff` with + the `-man` option. +- Document required optional arguments as such (#82). Thanks to Isaac Hodes + for the report. + +### Doc language sanitization + +This release tries to bring sanity to the doc language. This may break +the rendering of some of your man pages. Thanks to Gabriel Scherer, +Ivan Gotovchits and Nicolás Ojeda Bär for the feedback. + +- It is only allowed to use the variables `$(var)` that are mentioned in + the docs (`$(docv)`, `$(opt)`, etc.) and the markup directives + `$({i,b},text)`. Any other unknown `$(var)` will generate errors + on standard error during documentation generation. +- Markup directives `$({i,b},text)` treat `text` as is, modulo escapes; + see next point. +- Characters `$`, `(`, `)` and `\` can respectively be escaped by `\$`, + `\(`, `\)` and `\\`. Escaping `$` and `\` is mandatory everywhere. + Escaping `)` is mandatory only in markup directives. Escaping `(` + is only here for your symmetric pleasure. Any other sequence of + character starting with a `\` is an illegal sequence. +- Variables `$(mname)` and `$(tname)` are now marked up with bold when + substituted. If you used to write `$(b,$(tname))` this will generate + an error on standard output, since `$` is not escaped in the markup + directive. Simply replace these by `$(tname)`. + +v0.9.8 2015-10-11 Cambridge (UK) +-------------------------------- + +- Bring back support for OCaml 3.12.0 +- Support for pre-formatted paragraphs in man pages. This adds a + ```Pre`` case to the `Manpage.block` type which can break existing + programs. Thanks to Guillaume Bury for suggesting and help. +- Support for environment variables. If an argument is absent from the + command line, its value can be read and parsed from an environment + variable. This adds an `env` optional argument to the `Arg.info` + function which can break existing programs. +- Support for new variables in option documentation strings. `$(opt)` + can be used to refer to the name of the option being documented and + `$(env)` for the name of the option's the environment variable. +- Deprecate `Term.pure` in favor of `Term.const`. +- Man page generation. Keep undefined variables untouched. Previously + a `$(undef)` would be turned into `undef`. +- Turn a few mysterious and spurious `Not_found` exceptions into + `Invalid_arg`. These can be triggered by client programming errors + (e.g. an unclosed variable in a documentation string). +- Positional arguments. Invoke the printer on the default (absent) + value only if needed. See Optional arguments in the release notes of + v0.9.6. + +v0.9.7 2015-02-06 La Forclaz (VS) +--------------------------------- + +- Build system, don't depend on `ocamlfind`. The package no longer + depends on ocamlfind. Thanks to Louis Gesbert for the patch. + +v0.9.6 2014-11-18 La Forclaz (VS) +--------------------------------- + +- Optional arguments. Invoke the printer on the default (absent) value + only if needed, i.e. if help is shown. Strictly speaking an + interface breaking change – for example if the absent value was lazy + it would be forced on each run. This is no longer the case. +- Parsed command line syntax: allow short flags to be specified + together under a single dash, possibly ending with a short option. + This allows to specify e.g. `tar -xvzf archive.tgz` or `tar + -xvzfarchive.tgz`. Previously this resulted in an error, all the + short flags had to be specified separately. Backward compatible in + the sense that only more command lines are parsed. Thanks to Hugo + Heuzard for the patch. +- End user error message improvements using heuristics and edit + distance search in the optional argument and subcommand name + spaces. Thanks to Hugo Heuzard for the patch. +- Adds `Arg.doc_{quote,alts,alts_enum}`, documentation string + helpers. +- Adds the `Term.eval_peek_opts` function for advanced usage scenarios. +- The function `Arg.enum` now raises `Invalid_argument` if the + enumeration is empty. +- Improves help paging behaviour on Windows. Thanks to Romain Bardou + for the help. + + +v0.9.5 2014-07-04 Cambridge (UK) +-------------------------------- + +- Add variance annotation to Term.t. Thanks to Peter Zotov for suggesting. +- Fix section name formatting in plain text output. Thanks to Mikhail + Sobolev for reporting. + + +v0.9.4 2014-02-09 La Forclaz (VS) +--------------------------------- + +- Remove temporary files created for paged help. Thanks to Kaustuv Chaudhuri + for the suggestion. +- Avoid linking against `Oo` (was used to get program uuid). +- Check the environment for `$MANPAGER` as well. Thanks to Raphaël Proust + for the patch. +- OPAM friendly workflow and drop OASIS support. + + +v0.9.3 2013-01-04 La Forclaz (VS) +--------------------------------- + +- Allow user specified `SYNOPSIS` sections. + + +v0.9.2 2012-08-05 Lausanne +-------------------------- + +- OASIS 0.3.0 support. + + +v0.9.1 2012-03-17 La Forclaz (VS) +--------------------------------- + +- OASIS support. +- Fixed broken `Arg.pos_right`. +- Variables `$(tname)` and `$(mname)` can be used in a term's man + page to respectively refer to the term's name and the main term + name. +- Support for custom variable substitution in `Manpage.print`. +- Adds `Term.man_format`, to facilitate the definition of help commands. +- Rewrote the examples with a better and consistent style. + +Incompatible API changes: + +- The signature of `Term.eval` and `Term.eval_choice` changed to make + it more regular: the given term and its info must be tupled together + even for the main term and the tuple order was swapped to make it + consistent with the one used for arguments. + + +v0.9.0 2011-05-27 Lausanne +-------------------------- + +- First release. diff --git a/unikernel/duniverse/cmdliner/DEVEL.md b/unikernel/duniverse/cmdliner/DEVEL.md new file mode 100644 index 00000000..4fefe535 --- /dev/null +++ b/unikernel/duniverse/cmdliner/DEVEL.md @@ -0,0 +1,57 @@ +This project uses (perhaps the development version of) [`b0`] for +development. Consult [b0 occasionally] for quick hints on how to +perform common development tasks. + +[`b0`]: https://erratique.ch/software/b0 +[b0 occasionally]: https://erratique.ch/software/b0/doc/occasionally.html + +# Build system for distribution + +The build system used for distribution is in the `Makefile`. + +# Changing completion scripts + +To test them you can: + + source ./src/tool/zsh-completion.sh # zsh + source ./src/tool/bash-completion.sh # bash + +This replaces the generic completion function used by tool completion +scripts with the new definition. Trying to complete tools should now +use the new definitions. + +If you change completion scripts in [`src/tool`](src/tool) you must invoke: + + b0 -- update-cmdliner-data + +so that the changes get incorporated into the `cmdliner` tool. + + +# Testing + +Testing is done with `B0_testing` from `b0.std`. The catch is that +`B0_testing` depends on `cmdliner` so we need a build of `b0.std` with +our build of `cmdliner` to link against our test executables. + +To do so we do a checkout of `b0`'s repo in `test/b0` (which is ignored +by `git`). + + cd test + git clone https://erratique.ch/repos/b0.git + +The [`B0.ml`](B0.ml) file of cmdliner includes `test/b0/B0.ml` and the +`default` pack of `B0.ml` is unlocked so that when a test executable +requires `b0.std` it is looked up and built againt the development +version of cmdliner. After that testing remains [as usual]. + +[as usual]: https://erratique.ch/software/b0/doc/occasionally.html#test + +## Manual renderings + +Various manual renderings are snapshot tested in the test executables, +mostly in plain text. + +The `test_man` test can be invoked with `--test-help[=FMT]` to interactively +test the various `--help[=FMT]` invocations, including paging. + + b0 -- test_man --test-help diff --git a/unikernel/duniverse/cmdliner/LICENSE.md b/unikernel/duniverse/cmdliner/LICENSE.md new file mode 100644 index 00000000..c4cd256d --- /dev/null +++ b/unikernel/duniverse/cmdliner/LICENSE.md @@ -0,0 +1,13 @@ +Copyright (c) 2011 The cmdliner programmers + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/unikernel/duniverse/cmdliner/Makefile b/unikernel/duniverse/cmdliner/Makefile new file mode 100644 index 00000000..4ac6983e --- /dev/null +++ b/unikernel/duniverse/cmdliner/Makefile @@ -0,0 +1,127 @@ +# To be used by system package managers to bootstrap opam. topkg +# cannot be used as it needs opam-installer which is provided by opam +# itself. + +# Typical usage: +# +# make all +# make install PREFIX=/usr/local +# make install-doc PREFIX=/usr/local + +# Adjust the following on the cli invocation for configuring + +-include $(shell ocamlc -where)/Makefile.config + +PREFIX=/usr +BINDIR=$(DESTDIR)$(PREFIX)/bin +LIBDIR=$(DESTDIR)$(PREFIX)/lib/ocaml/cmdliner +SHAREDIR=$(DESTDIR)$(PREFIX)/share +DOCDIR=$(SHAREDIR)/doc/cmdliner +MANDIR=$(SHAREDIR)/man +BASHCOMPDIR=$(SHAREDIR)/bash-completion/completions +ZSHCOMPDIR=$(SHAREDIR)/zsh/site-functions +NATIVE=$(shell ocamlopt -version > /dev/null 2>&1 && echo true) +# EXT_LIB by default value of OCaml's Makefile.config +# NATDYNLINK by default value of OCaml's Makefile.config + +INSTALL=install +B=_build +BASE=$(B)/src/cmdliner +TOOLBDIR=$(B)/src/tool +TOOL=$(TOOLBDIR)/cmdliner + +ifeq ($(NATIVE),true) + BUILD-EXE=build-native-exe + BUILD-TARGETS=build-byte build-native build-native-exe build-completions \ + build-man + INSTALL-TARGETS=install-common install-srcs install-byte install-native \ + install-exe install-completions + ifeq ($(NATDYNLINK),true) + BUILD-TARGETS += build-native-dynlink + INSTALL-TARGETS += install-native-dynlink + endif +else + BUILD-EXE=build-byte-exe + BUILD-TARGETS=build-byte build-byte-exe build-completions \ + build-man + INSTALL-TARGETS=install-common install-srcs install-byte install-exe \ + install-completions +endif + +all: $(BUILD-TARGETS) + +install: $(INSTALL-TARGETS) + +clean: + ocaml build.ml clean + +build-byte: + ocaml build.ml cma + +build-native: + ocaml build.ml cmxa + +build-native-dynlink: + ocaml build.ml cmxs + +build-byte-exe: build-byte + ocaml build.ml bytexe + +build-native-exe: build-native + ocaml build.ml natexe + +build-completions: $(BUILD-EXE) + $(TOOL) generic-completion bash > $(TOOLBDIR)/bash-completion.sh + $(TOOL) tool-completion bash cmdliner > $(TOOLBDIR)/bash-cmdliner.sh + $(TOOL) generic-completion zsh > $(TOOLBDIR)/zsh-completion.sh + $(TOOL) tool-completion zsh cmdliner > $(TOOLBDIR)/zsh-cmdliner.sh + +build-man: $(BUILD-EXE) + $(TOOL) install tool-manpages $(TOOLBDIR)/cmdliner $(TOOLBDIR)/man + +prepare-prefix: + $(INSTALL) -d "$(BINDIR)" "$(LIBDIR)" + +install-common: prepare-prefix + $(INSTALL) -m 644 pkg/META $(BASE).cmi "$(LIBDIR)" + $(INSTALL) -m 644 cmdliner.opam "$(LIBDIR)/opam" + +install-srcs: prepare-prefix + $(INSTALL) -m 644 $(wildcard $(BASE)*.mli) $(wildcard $(BASE)*.ml) \ + $(wildcard $(BASE)*.cmti) $(wildcard $(BASE)*.cmt) "$(LIBDIR)" + +install-byte: prepare-prefix + $(INSTALL) -m 644 $(BASE).cma "$(LIBDIR)" + +install-native: prepare-prefix + $(INSTALL) -m 644 $(BASE).cmxa $(BASE)$(EXT_LIB) $(wildcard $(BASE)*.cmx) \ + "$(LIBDIR)" + +install-native-dynlink: prepare-prefix + $(INSTALL) -m 644 $(BASE).cmxs "$(LIBDIR)" + +install-exe: + $(INSTALL) -m 755 "$(TOOLBDIR)/cmdliner" "$(BINDIR)/cmdliner" + +install-doc: + $(INSTALL) -d "$(MANDIR)/man1" + $(INSTALL) -m 644 $(wildcard $(TOOLBDIR)/man/man1/*.1) "$(MANDIR)/man1" + $(INSTALL) -d "$(DOCDIR)/odoc-pages" + $(INSTALL) -m 644 CHANGES.md LICENSE.md README.md "$(DOCDIR)" + $(INSTALL) -m 644 doc/index.mld doc/cli.mld doc/examples.mld \ + doc/tutorial.mld doc/cookbook.mld doc/tool_man.mld "$(DOCDIR)/odoc-pages" + +install-completions: + $(INSTALL) -d "$(BASHCOMPDIR)" + $(INSTALL) -m 644 $(TOOLBDIR)/bash-completion.sh \ + "$(BASHCOMPDIR)/_cmdliner_generic" + $(INSTALL) -m 644 $(TOOLBDIR)/bash-cmdliner.sh "$(BASHCOMPDIR)/cmdliner" + $(INSTALL) -d "$(ZSHCOMPDIR)" + $(INSTALL) -m 644 $(TOOLBDIR)/zsh-completion.sh \ + "$(ZSHCOMPDIR)/_cmdliner_generic" + $(INSTALL) -m 644 $(TOOLBDIR)/zsh-cmdliner.sh "$(ZSHCOMPDIR)/_cmdliner" + +.PHONY: all install install-doc clean build-byte build-native \ + build-native-dynlink build-byte-exe build-native-exe build-completions \ + prepare-prefix install-common install-byte install-native install-dynlink \ + install-exe install-completions build-man diff --git a/unikernel/duniverse/cmdliner/README.md b/unikernel/duniverse/cmdliner/README.md new file mode 100644 index 00000000..112119b0 --- /dev/null +++ b/unikernel/duniverse/cmdliner/README.md @@ -0,0 +1,43 @@ +Cmdliner — Declarative definition of command line interfaces for OCaml +====================================================================== + +Cmdliner allows the declarative definition of command line interfaces +for OCaml. + +It provides a simple and compositional mechanism to convert command +line arguments to OCaml values and pass them to your functions. The +module automatically handles command line completion, syntax errors, +help messages and UNIX man page generation. It supports programs with +single or multiple commands and respects most of the [POSIX] and [GNU] +conventions. + +Cmdliner has no dependencies and is distributed under the ISC license. + +Homepage: + +[POSIX]: http://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html +[GNU]: http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html + +## Installation + +Cmdliner can be installed with `opam`: + + opam install cmdliner + +If you don't use `opam` consult the [`opam`](opam) file for build +instructions. + +## Documentation + +The documentation can be consulted [online] or via `odig doc cmdliner`. + +Questions are welcome but better asked on the [OCaml forum] than on the +issue tracker. + +[online]: http://erratique.ch/software/cmdliner/doc/ +[OCaml forum]: https://discuss.ocaml.org/ + +## Sample programs + +A few examples and blueprints can be found in the +[documentation][online] and in the [test](test/) directory. diff --git a/unikernel/duniverse/cmdliner/_tags b/unikernel/duniverse/cmdliner/_tags new file mode 100644 index 00000000..88803ea4 --- /dev/null +++ b/unikernel/duniverse/cmdliner/_tags @@ -0,0 +1,3 @@ +true : bin_annot, safe_string +<_b0> : -traverse + : include \ No newline at end of file diff --git a/unikernel/duniverse/cmdliner/build.ml b/unikernel/duniverse/cmdliner/build.ml new file mode 100755 index 00000000..f88c362d --- /dev/null +++ b/unikernel/duniverse/cmdliner/build.ml @@ -0,0 +1,182 @@ +#!/usr/bin/env ocaml + +(* Usage: ocaml build.ml [cma|cmxa|cmxs|clean] *) + +let root_dir = Sys.getcwd () +let root_build_dir = Filename.concat root_dir "_build" +let src_dir = "src" + +type unit = Lib | Bin + +let unit_dir = function Lib -> "src" | Bin -> "src/tool" +let build_dir u = Filename.concat root_build_dir (unit_dir u) + +let base_ocaml_opts = + [ "-g"; "-bin-annot"; + "-safe-string"; (* Remove once we require >= 4.06 *) ] + +(* Logging *) + +let strf = Printf.sprintf +let err fmt = Printf.kfprintf (fun oc -> flush oc; exit 1) stderr fmt +let log fmt = Printf.kfprintf (fun oc -> flush oc) stdout fmt + +(* The running joke *) + +let rev_cut ~sep s = match String.rindex s sep with +| exception Not_found -> None +| i -> String.(Some (sub s 0 i, sub s (i + 1) (length s - (i + 1)))) + +let cuts ~sep s = + let rec loop acc = function + | "" -> acc + | s -> + match rev_cut ~sep s with + | None -> s :: acc + | Some (l, r) -> loop (r :: acc) l + in + loop [] s + +(* Read, write and collect files *) + +let fpath ~dir f = String.concat "" [dir; "/"; f] + +let string_of_file f = + let ic = open_in_bin f in + let len = in_channel_length ic in + let buf = Bytes.create len in + really_input ic buf 0 len; + close_in ic; + Bytes.unsafe_to_string buf + +let string_to_file f s = + let oc = open_out_bin f in + output_string oc s; + close_out oc + +let cp src dst = string_to_file dst (string_of_file src) + +let ml_srcs dir = + let add_file dir acc f = match rev_cut ~sep:'.' f with + | Some (m, e) when e = "ml" || e = "mli" -> f :: acc + | Some _ | None -> acc + in + Array.fold_left (add_file dir) [] (Sys.readdir dir) + +(* Finding and running commands *) + +let find_cmd cmds = + let test, null = match Sys.win32 with + | true -> "where", " NUL" + | false -> "command -v", "/dev/null" + in + let cmd c = Sys.command (strf "%s %s 1>%s 2>%s" test c null null) = 0 in + try Some (List.find cmd cmds) with Not_found -> None + +let err_cmd exit cmd = err "exited with %d: %s\n" exit cmd +let quote_cmd = match Sys.win32 with +| false -> fun cmd -> cmd +| true -> fun cmd -> strf "\"%s\"" cmd + +let run_cmd args = + let cmd = String.concat " " (List.map Filename.quote args) in +(* log "[EXEC] %s\n" cmd; *) + let exit = Sys.command (quote_cmd cmd) in + if exit = 0 then () else err_cmd exit cmd + +let read_cmd args = + let stdout = Filename.temp_file (Filename.basename Sys.argv.(0)) "b00t" in + at_exit (fun () -> try ignore (Sys.remove stdout) with _ -> ()); + let cmd = String.concat " " (List.map Filename.quote args) in + let cmd = quote_cmd @@ strf "%s 1>%s" cmd (Filename.quote stdout) in + let exit = Sys.command cmd in + if exit = 0 then string_of_file stdout else err_cmd exit cmd + +(* Create and delete directories *) + +let rec mkdir dir = + let parent = Filename.dirname dir in + if String.equal dir parent then () + else mkdir (Filename.dirname dir); + try match Sys.file_exists dir with + | true -> () + | false -> run_cmd ["mkdir"; dir] + with + | Sys_error e -> err "%s: %s" dir e + +let rec rmdir dir = + try match Sys.file_exists dir with + | false -> () + | true -> + let rm f = + let p = fpath ~dir f in + if Sys.is_directory p + then rmdir p + else Sys.remove (fpath ~dir f) + in + Array.iter rm (Sys.readdir dir); + run_cmd ["rmdir"; dir] + with + | Sys_error e -> err "%s: %s" dir e + +(* Lookup OCaml compilers and ocamldep *) + +let really_find_cmd alts = match find_cmd alts with +| Some cmd -> cmd +| None -> err "No %s found in PATH\n" (List.hd @@ List.rev alts) + +let ocamlc () = really_find_cmd ["ocamlc.opt"; "ocamlc"] +let ocamlopt () = really_find_cmd ["ocamlopt.opt"; "ocamlopt"] +let ocamldep () = really_find_cmd ["ocamldep.opt"; "ocamldep"] + +(* Build *) + +let sort_srcs srcs = + let srcs = List.sort String.compare srcs in + read_cmd (ocamldep () :: "-slash" :: "-sort" :: srcs) + |> String.trim |> cuts ~sep:' ' + +let common srcs = base_ocaml_opts @ sort_srcs srcs + +let exe ar src = + let lib = build_dir Lib in + ["-I"; lib; ar] @ common src + +let build_natexe srcs = + run_cmd ([ocamlopt ()] @ exe "cmdliner.cmxa" srcs @ ["-o"; "cmdliner"]) + +let build_bytexe srcs = + run_cmd ([ocamlc ()] @ exe "cmdliner.cma" srcs @ ["-o"; "cmdliner"]) + +let build_cma srcs = + run_cmd ([ocamlc ()] @ common srcs @ ["-a"; "-o"; "cmdliner.cma"]) + +let build_cmxa srcs = + run_cmd ([ocamlopt ()] @ common srcs @ ["-a"; "-o"; "cmdliner.cmxa"]) + +let build_cmxs srcs = + run_cmd ([ocamlopt ()] @ common srcs @ ["-shared"; "-o"; "cmdliner.cmxs"]) + +let clean () = rmdir root_build_dir + +let in_build_dir u f = + let src_dir = unit_dir u in + let build_dir = build_dir u in + let srcs = ml_srcs src_dir in + let cp src = cp (fpath ~dir:src_dir src) (fpath ~dir:build_dir src) in + mkdir build_dir; + List.iter cp srcs; + Sys.chdir build_dir; f srcs; Sys.chdir root_dir + +let main () = match Array.to_list Sys.argv with +| _ :: [ "natexe" ] -> in_build_dir Bin build_natexe +| _ :: [ "bytexe" ] -> in_build_dir Bin build_bytexe +| _ :: [ "cma" ] -> in_build_dir Lib build_cma +| _ :: [ "cmxa" ] -> in_build_dir Lib build_cmxa +| _ :: [ "cmxs" ] -> in_build_dir Lib build_cmxs +| _ :: [ "clean" ] -> clean () +| [] | [_] -> err "Missing argument: cma, cmxa, cmxs or clean\n"; +| cmd :: args -> + err "%s: Unknown argument(s): %s\n" cmd @@ String.concat " " args + +let () = main () diff --git a/unikernel/duniverse/cmdliner/cmdliner.opam b/unikernel/duniverse/cmdliner/cmdliner.opam new file mode 100644 index 00000000..f89dfd8b --- /dev/null +++ b/unikernel/duniverse/cmdliner/cmdliner.opam @@ -0,0 +1,34 @@ +version: "2.0.0+dune" +opam-version: "2.0" +name: "cmdliner" +synopsis: "Declarative definition of command line interfaces for OCaml" +description: """\ +Cmdliner allows the declarative definition of command line interfaces +for OCaml. + +It provides a simple and compositional mechanism to convert command +line arguments to OCaml values and pass them to your functions. The +module automatically handles command line completion, syntax errors, +help messages and UNIX man page generation. It supports programs with +single or multiple commands and respects most of the [POSIX] and [GNU] +conventions. + +Cmdliner has no dependencies and is distributed under the ISC license. + +Homepage: + +[POSIX]: http://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html +[GNU]: http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html""" +maintainer: "Daniel Bünzli " +authors: "The cmdliner programmers" +license: "ISC" +tags: ["cli" "system" "declarative" "org:erratique"] +homepage: "https://github.com/dune-universe/cmdliner" +bug-reports: "https://github.com/dbuenzli/cmdliner/issues" +depends: [ + "dune" + "ocaml" {>= "4.08.0"} +] +build: [ "dune" "build" "-p" name "-j" jobs ] +dev-repo: "git+https://github.com/dune-universe/cmdliner.git" +x-maintenance-intent: ["(latest)"] \ No newline at end of file diff --git a/unikernel/duniverse/cmdliner/doc/cli.mld b/unikernel/duniverse/cmdliner/doc/cli.mld new file mode 100644 index 00000000..a66abc1e --- /dev/null +++ b/unikernel/duniverse/cmdliner/doc/cli.mld @@ -0,0 +1,484 @@ +{0:cmdline Command line interface} + +This manual describes how your tool ends up interacting +with shells when you use Cmdliner. + +{1:invocation Tool invocation} + +For tools evaluating a command without subcommands the most general +form of invocation is: + +{v +tool [OPTION]… [ARG]… +v} + +The tool automatically reponds to the [--help] option by printing +{{!help}the help}. If a version string is provided in the +{{!Cmdliner.Cmd.val-info}command information}, it also automatically +responds to the [--version] option by printing this string on standard +output. + +Command line arguments are either {{!optargs}{e optional}} or +{{!posargs}{e positional}}. Both can be freely interleaved but since +[Cmdliner] accepts many optional forms this may result in +ambiguities. The special {{!posargs} token [--]} can be used to +resolve them: anything that follows it is treated as a positional +argument. + +Tools evaluating commands with subcommands have this form of invocation + +{v +tool [COMMAND]… [OPTION]… [ARG]… +v} + +Commands automatically respond to the [--help] option by printing +{{!help}their help}. The sequence of [COMMAND] strings must be the first +strings following the tool name – as soon as an optional argument is +seen the search for a subcommand stops. + +{1:args Arguments} + +{2:optargs Optional arguments} + +An optional argument is specified on the command line by a {e name} +possibly followed by a {e value}. + +The name of an option can be short or long. + +{ul +{- A {e short} name is a dash followed by a single alphanumeric + character: [-h], [-q], [-I].} +{- A {e long} name is two dashes followed by alphanumeric + characters and dashes: [--help], [--silent], [--ignore-case].}} + +More than one name may refer to the same optional argument. For +example in a given program the names [-q], [--quiet] and [--silent] +may all stand for the same boolean argument indicating the program to +be quiet. + +The value of an option can be specified in three different ways. + +{ul +{- As the next token on the command line: [-o a.out], [--output a.out].} +{- Glued to a short name: [-oa.out].} +{- Glued to a long name after an equal character: [--output=a.out].}} + +Glued forms are especially useful if the value itself starts with a +dash as is the case for negative numbers, [--min=-10]. + +An optional argument without a value is either a {e flag} (see +{!Cmdliner.Arg.flag}, {!Cmdliner.Arg.vflag}) or an optional argument with +an optional value (see the [~vopt] argument of {!Cmdliner.Arg.opt}). + +Short flags can be grouped together to share a single dash and the +group can end with a short option. For example assuming [-v] and +[-x] are flags and [-f] is a short option: + +{ul +{- [-vx] will be parsed as [-v -x].} +{- [-vxfopt] will be parsed as [-v -x -fopt].} +{- [-vxf opt] will be parsed as [-v -x -fopt].} +{- [-fvx] will be parsed as [-f=vx].}} + +{2:posargs Positional arguments} + +Positional arguments are tokens on the command line that are not +option names and are not the value of an optional argument. They are +numbered from left to right starting with zero. + +Since positional arguments may be mistaken as the optional value of an +optional argument or they may need to look like option names, anything +that follows the special token ["--"] on the command line is +considered to be a positional argument: + +{v +tool --option -- but --now we -are --all positional --argu=ments +v} + +{2:constraints Constraints on option names} + +Using the cmdliner library puts the following constraints on your +command line interface: + +{ul +{- The option names [--cmdliner] and [--__complete] are reserved by the + library.} +{- The option name [--help], (and [--version] if you specify a version + string) is reserved by the library. Using it as a term or option + name may result in undefined behaviour.} +{- Defining the same option or command name via two different + arguments or terms is illegal and raises [Invalid_argument].}} + +{1:envlookup Environment variables} + +Non-required command line arguments can be backed up by an environment +variable. If the argument is absent from the command line and +the environment variable is defined, its value is parsed using the +argument converter and defines the value of the argument. + +For {!Cmdliner.Arg.flag} and {!Cmdliner.Arg.flag_all} that do not have an +argument converter a boolean is parsed from the lowercased variable value +as follows: + +{ul +{- [""], ["false"], ["no"], ["n"] or ["0"] is [false].} +{- ["true"], ["yes"], ["y"] or ["1"] is [true].} +{- Any other string is an error.}} + +Note that environment variables are not supported for +{!Cmdliner.Arg.vflag} and {!Cmdliner.Arg.vflag_all}. + +{1:help Help and man pages} + +Help and man pages are are generated when you call your tool or a subcommand +with [--help]. By default, if the [TERM] environment variable +is not [dumb] or unset, the tool tries to {{!paging}page} the manual +so that you can directly search it. Otherwise it outputs the manual +as plain text. + +Alternative help formats can be specified with the optional argument +of [--help], see your own [tool --help] for more information. + +{@sh[ +tool --help +tool cmd --help +tool --help=groff > tool.1 +]} + +{2:paging Paging} + +The pager is selected by looking up, in order: + +{ol +{- The [MANPAGER] variable.} +{- The [PAGER] variable.} +{- The tool [less].} +{- The tool [more].}} + +Regardless of the pager, it is invoked with [LESS=FRX] set in the +environment unless, the [LESS] environment variable is set in your +environment. + +{2:install_tool_manpages Install} + +The manpages of a tool and its subcommands can be installed to a root +[man] directory [$MANDIR] by invoking: + +{@shell[ +cmdliner install tool-manpages thetool $MANDIR +]} + +This looks up [thetool] in the [PATH]. Use an explicit file path like +[./thetool] to directly specify an executable. + +If you are also {{!install_tool_completion}installing completions} +rather use the [install tool-support] command, see this +{{!page-cookbook.tip_tool_support}cookbook tip} which also has +instructions on how to install if you are using [opam]. + +{1:cli_completion Command line completion} + +Cmdliner programs automatically get support for shell command line +completion. + +The completion process happens via a {{!completion_protocol}protocol} +which is interpreted by generic shell completion scripts that are +installed by the library. For now the [zsh] and [bash] shells are +supported. + +Tool developers can easily {{!install_tool_completion}install} +completion definitions that invoke these completion scripts. Tool +end-users need to {{!user_configuration}make sure} these definitions are +looked up by their shell. + +{2:user_configuration End-user configuration} + +If you are the user of a cmdliner based tool, the following +shell-dependent steps need to be performed in order to benefit from +command line completion. + +{3:user_zsh For [zsh]} + +The [FPATH] environment variable must be setup to include the +directory where the generic cmdliner completion function is +{{!install_completion} installed} {b before} properly initializing the +completion system. + +For example, {{:https://github.com/ocaml/opam/issues/6427}for now}, if +you are using [opam]. You should add something like this to your +[.zshrc]: + +{@sh[ +FPATH="$(opam var share)/zsh/site-functions:${FPATH}" +autoload -Uz compinit +compinit -u +]} + +Also make sure this {b happens before} [opam]'s [zsh] init script +inclusion, see {{:https://github.com/ocaml/opam/issues/6428}this +issue}. Note that these instruction do not react dynamically +to [opam] switches changes so you may see odd completion behaviours +when you do so, see this {{:https://github.com/ocaml/opam/issues/6427}this +opam issue}. + +After this, to test everything is right, check that the [_cmdliner_generic] +function can be looked by invoking it (this will result in an error). + +{@sh[ +> autoload _cmdliner_generic +> _cmdliner_generic +_cmdliner_generic:1: words: assignment to invalid subscript range +]} + +If the function cannnot be found make sure the [cmdliner] library is +installed, that the generic scripts were +{{!install_generic_completion}installed} and that the +[_cmdliner_generic] file can be found in one of the directories +mentioned in the [FPATH] variable. + +With this setup, if you are using a cmdliner based tool named +[thetool] that did not {{!install_tool_completion}install} a completion +definition. You can always do it yourself by invoking: + +{@sh[ +autoload _cmdliner_generic +compdef _cmdliner_generic thetool +]} + +{3:user_bash For [bash]} + +These instructions assume that you have +{{:https://repology.org/project/bash-completion/versions}[bash-completion]} +installed and setup in some way in your [.bashrc]. + +The [XDG_DATA_DIRS] environment variable must be setup to include the +[share] directory where the generic cmdliner completion function is +{{!install_completion}installed}. + +For example, {{:https://github.com/ocaml/opam/issues/6427}for now}, if +you are using [opam]. You should add something like this to your +[.bashrc]: +{@sh[ +XDG_DATA_DIRS="$(opam var share):${XDG_DATA_DIRS}" +]} + +Note that these instruction do not react dynamically to [opam] +switches changes so you may see odd completion behaviours when you do +so, see this {{:https://github.com/ocaml/opam/issues/6427}this opam +issue}. + +After this, to test everything is right, check that the [_cmdliner_generic] +function can be looked up: + +{@sh[ +> _completion_loader _cmdliner_generic +> declare -F _cmdliner_generic &>/dev/null && echo "Found" || echo "Not found" +Found! +]} + +If the function cannot be found make sure the [cmdliner] library is +installed, that the generic scripts were +{{!install_generic_completion}installed} and that the +[_cmdliner_generic] file can be looked up by [_completion_loader]. + +With this setup, if you are using a cmdliner based tool named +[thetool] that did not {{!install_tool_completion}install} a completion +definition. You can always do it yourself by invoking: + +{@sh[ +_completion_loader _cmdliner_generic +complete -F _cmdliner_generic thetool +]} + +{b Note.} {{:https://github.com/scop/bash-completion/commit/9efc596735c4509001178f0cf28e02f66d1f7703}It seems} [_completion_loader] was deprecated in +bash-completion [2.12] in favour of [_comp_load] but many distributions +are on [< 2.12] and in [2.12] [_completion_loader] simply calls +[_comp_load]. + +{2:install_completion Install} + +Completion scripts need to be installed in subdirectories of a +{{:https://refspecs.linuxfoundation.org/FHS_3.0/fhs/ch04s11.html}[share]} +directory which we denote by the [$SHAREDIR] variable below. In a +package installation script this variable is typically defined by: + +{@sh[ +SHAREDIR="$DESTDIR/$PREFIX/share" +]} + +The final destination directory in [share] depends on the shell: + +{ul +{- For [zsh] it is [$SHAREDIR/zsh/site-functions]} +{- For [bash] it is [$SHAREDIR/bash-completion/completions]}} + +If that is unsatisfying you can output the completion scripts directly +where you want with the [cmdliner generic-completion] and +[cmdliner tool-completion] commands. + +{3:install_generic_completion Generic completion scripts} + +The generic completion scripts must be installed by the +[cmdliner] library. They should not be part of your tool install. If +they are not installed you can inspect and install them with the +following invocations, invoke with [--help] for more information. + +{@sh[ +cmdliner generic-completion zsh # Output generic zsh script on stdout +cmdliner install generic-completion $SHAREDIR # All shells +cmdliner install generic-completion --shell zsh $SHAREDIR # Only zsh +]} + +Directories are created as needed. Use option [--dry-run] to see which +paths would be written by an [install] invocation. + +{3:install_tool_completion Tool completion scripts} + +If your tool named [thetool] uses Cmdliner you should install completion +definitions for them. They rely on the {{!install_generic_completion}generic +scripts} to be installed. These tool specific scripts can be inspected +and installed via these invocations: + +{@sh[ +cmdliner tool-completion zsh thetool # Output tool zsh script on stdout. +cmdliner install tool-completion thetool $SHAREDIR # All shells +cmdliner install tool-completion --shell zsh thetool $SHAREDIR # Only zsh +]} + +Directories are created as needed. Use option [--dry-run] to see which +paths would be written by an [install] invocation. + +If you are also {{!install_tool_manpages}installing manpages} rather +use the [install tool-support] command, see this +{{!page-cookbook.tip_tool_support}cookbook tip} which also has +instructions on how to install if you are using [opam]. + +{2:completion_protocol Completion protocol} + +There is no standard that allows tools and shells to interact to +perform shell command line completion. Completion is supposed to +happen through idiosyncratic, ad-hoc, obscure and brain damaging +shell-specific completion scripts. + +To alleviate this, Cmdliner defines one generic script per shell and +interacts with it using the protocol described below. The protocol can +be used to implement generic completion scripts for other shells. The +protocol is versioned but can change even between minor versions of +Cmdliner. Generic scripts for popular shells can be inspected via +the [cmdliner generic-completion] command. + +The protocol betwen the shell completion {e script} and a +cmdliner based {e tool} is as follows: + +{ol +{- When completion is requested the script invokes the tool with a + modified command line: + {ul + {- The first argument to the tool ([Sys.argv.(1)]) must be the + option [--__complete].} + {- The (possibly empty) argument [ARG] on which the completion is + requested must be replaced by {e exactly} [--__complete=ARG]. Note + that this can happen after the [--] token, this is the reason + why we have an explicit [--__complete] argument in [Sys.argv.(1)]: + it indicates the command line parser must operate in a special mode.}}} +{- The tool responds by writing on standard output a list of + completion directives which match the [completions] rule of the grammar + given below.} +{- The script interprets the completion directives according + to the given semantics below so that the shell can display the + completions. The script is free to ignore directives + or data that it is unable to present.}} + +The following ABNF grammar is described using the notations of +{{:https://www.rfc-editor.org/rfc/rfc5234}RFC 5234} and +{{:https://www.rfc-editor.org/rfc/rfc7405}RFC 7405}. A few constraints +are not expressed by the grammar: + +{ul +{- Except in the [completion] rule, the byte stream may contain ANSI escape + sequences introduced by the byte [0x1B].} +{- After stripping the ANSI escape sequences, the resulting byte stream must + be valid UTF-8 text.}} + +{@abnf[ +completions = version nl directives +version = "1" +directives = *(directive nl) +directive = message / group / %s"files" / %s"dirs" / %"restart" +message = %s"message" nl text nl %s"message-end" +group = %s"group" nl group_name nl *item +group_name = *pchar +item = %s"item" nl completion nl item_doc nl %s"item-end" +completion = *pchar +item_doc = text +text = *(pchar / nl) +nl = %0A +pchar = %20-%7E / %8A-%FF +]} + +The semantics of directives is as follows: + +{ul +{- A [message] directive defines a message to be reported to the user. + It is multi-line ANSI styled text which cannot have a line that is + exactly made of the text [message-end] as it is used to signal the + end of the message. Messages should be reported in the order they + are received.} +{- A [group] directive defines an informational [group_name] followed + by a possibly empty list of completion items that are part of the + group. An item provides a [completion] value, this is a string that + defines what the requested [ARG] value can be replaced with. It is + followed by an [item_doc], multi-line ANSI styled text which cannot + have a line that is exactly made of the text [item-end] as it is + used to signal the end of the item.} +{- A [file] directive indicates that the script should add existing + files staring with [ARG] to completion values.} +{- A [dir] directive indicates that the script should add existing + directories starting with [ARG] to completion values.} +{- A [restart] directive indicates that the script should restart + shell completion as if the command line was starting after the leftmost + [--] disambiguation token. The directive never gets emited if + there is no [--] on the command line.}} + +You can easily inspect the completions of any cmdliner based tool by +invoking it like the protocol suggests. For example for the [cmdliner] +tool itself: + +{@shell[ +cmdliner --__complete --__complete= +]} + +{1:error_message_styling Error message ANSI styling} + +Since Cmdliner 2.0 error messages printed on [stderr] use styled text +with ANSI escapes unless one of the following conditions is met: + +{ul +{- The [NO_COLOR] environment variable is set and different + from the empty string. Yes, even if you have [NO_COLOR=false], that's + what the particularly dumb {:https://no-color.org} standard says.} +{- The [TERM] environment variable is [dumb].} +{- The [TERM] environment variable is unset and {!Sys.backend_type} is + not [Other "js_of_ocaml"]. Yes, browser consoles support + ANSI escapes. Yes, you can run Cmdliner in your browser.}} + +{1:legacy_prefix_specification Legacy prefix specification} + +Before Cmdliner 2.0, command names, long option names and +{!Cmdliner.Arg.enum} values could be specified by a prefix as long as +the prefix was not ambiguous. + +This turned out to be a mistake. It makes the user experience of the +tool unstable as it evolves: former user established shortcuts or +invocations in scripts may be broken by new command, option and +enumerant additions. + +Therefore this behaviour was unconditionally removed in Cmdliner +2.0. If you happen to have scripts that rely on it, you can invoke +them with [CMDLINER_LEGACY_PREFIXES=true] set in the environment to +recover the old behaviour. {b However the scripts should be fixed: this +escape hatch will be removed in the future.} + +The [CMDLINER_LEGACY_PREFIX=true] escape hatch should not be used for +interactive tool interaction. In particular the behaviour of Cmdliner +completion support under this setting is undefined. diff --git a/unikernel/duniverse/cmdliner/doc/cookbook.mld b/unikernel/duniverse/cmdliner/doc/cookbook.mld new file mode 100644 index 00000000..dffa35a6 --- /dev/null +++ b/unikernel/duniverse/cmdliner/doc/cookbook.mld @@ -0,0 +1,720 @@ +{0 [Cmdliner] cookbook} + +A few recipes and starting {{!blueprints}blueprints} to describe your +command lines with {!Cmdliner}. + +{b Note.} Some of the code snippets here assume they are done after: +{[ +open Cmdliner +open Cmdliner.Term.Syntax +]} + +{1:tips Tips and pitfalls} + +Command line interfaces are a rather crude and inexpressive user +interaction medium. It is tempting to try to be nice to users in +various ways but this often backfires in confusing context sensitive +behaviours. Here are a few tips and Cmdliner features you {b should +rather not use}. + +{2:tip_avoid_default_command Avoid default commands in groups} + +Command {{!Cmdliner.Cmd.group}groups} can have a default command, that +is be of the form [tool [CMD]]. Except perhaps at the top level of +your tool, it's better to avoid them. They increase command line +parsing ambiguities. + +In particular if the default command has positional arguments, users +are forced to use the {{!cli.posargs}disambiguation token [--]} to +specify them so that they can be distinguished from command +names. For example: + +{@sh[ +tool -- file … +]} + +One thing that is acceptable is to have a default command that simply +{{!cmds_show_docs}shows documentation} for the group of subcommands as +this not interfere with tool operation. + +{2:tip_avoid_default_option_values Avoid default option values} + +Optional arguments {{!Cmdliner.Arg.opt}with values} can have a default +value, that is be of the form [--opt[=VALUE]]. In general it is better +to avoid them as they lead to context sensitive command lines +specifications and surprises when users refine invocations. For examples +suppose you have the synopsis + +{@sh[ +tool --opt[=VALUE] [FILE] +]} + +Trying to refine the following invocation to add a [FILE] parameter is +error prone and painful: + +{@sh[ +tool --opt +]} + +There is more than one way but the easiest way is to specify: +{@sh[ +tool --opt -- FILE +]} +which is not obvious unless you have [tool]'s cli hard wired in your +brain. This would have been a careless refinement if [--opt] did not +have a default option value. + +{2:tip_avoid_required_opt Avoid required optional arguments} + +Cmdliner allows to define required optional arguments. Avoid doing +this, it's a contradiction in the terms. In command line interfaces +optional arguments are defined to be… optional, not doing so is +surprising for your users. Use required positional arguments if +arguments are required by your command invocation. + +Required optional arguments can be useful though if your tool is not +meant to be invoked manually but rather through scripts and has many +required arguments. In this case they become a form of labelled +arguments which can make invocations easier to understand. + +{2:tip_avoid_manpages Avoid making manpages your main documentation} + +Unless your tool is very simple, avoid making manpages the main +documentation medium of your tool. The medium is rather limited and +even though you can convert them to HTML, its cross references +capabilities are rather limited which makes discussing your tool +online more difficult. + +Keep information in manpages to the minimum needed to operate your +tool without having to leave the terminal too much and defer reference +manuals, conceptual information and tutorials to a more evolved medium +like HTML. + +{2:tip_migrating Migrating from other conventions} + +If you are porting your command line parsing to [Cmdliner] and that +you have conventions that clash with [Cmdliner]'s ones but you need to +preserve backward compatibility, one way of proceeding is to +pre-process {!Sys.argv} into a new array of the right shape before +giving it to command {{!Cmdliner.Cmd.section-eval}evaluation +functions} via the [?argv] optional argument. + +These are two common cases: + +{ul +{- Long option names with a single dash like [-warn-error]. In this + case simply prefix an additional [-] to these arguments when they + occur in {!Sys.argv} before the [--] argument; after it, all arguments are + positional and to be treated literally.} +{- Long option names with a single letter like [--X]. In this + case simply chop the first [-] to make it a short option when they + occur in {!Sys.argv} before the [--] argument; after it all arguments are + positional and to be treated literally.}} + +{2:tip_src_structure Source code structure} + +In general Cmdliner wants you to see your tools as regular OCaml functions +that you make available to the shell. This means adopting the following +source structure: + +{[ +(* Implementation of your command. Except for exit codes does not deal with + command line interface related matters and is independent from + Cmdliner. *) + +let exit_ok = 0 +let tool … = …; exit_ok + +(* Command line interface. Adds metadata to your [tool] function arguments + so that they can be parsed from the command line and documented. *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let cmd = … (* Has a term that invokes [tool] *) +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +In particular it is good for your readers' understanding that your +program has a single point where it {!Stdlib.exit}s. This structure is +also useful for playing with your program in the OCaml toplevel +(REPL), you can invoke its [main] function without having the risk of it +[exit]ing the toplevel. + +If your tool named [tool] is growing into multiple commands which +have a lot of definitions it is advised to: +{ul +{- Gather command line definition commonalities such as argument + converters or common options in a module called [Tool_cli].} +{- Define each command named [name] in a separate module [Cmd_name] which + exports its command as a [val cmd : int Cmd.t] value.} +{- Gather the commands with {!Cmdliner.Cmd.group} in a source file + called [tool_main.ml].}} + +For an hypothetic tool named [tool] with commands [import], [serve] +and [user], this leads to the following set of files: + +{[ +cmd_import.ml cmd_serve.ml cmd_user.ml tool_cli.ml tool_main.ml +cmd_import.mli cmd_serve.mli cmd_user.mli tool_cli.mli +]} + +The [.mli] files simply export commands: +{[ +val cmd : int Cmdliner.Cmd.t +]} + +And the [tool_main.ml] gathers them with a {!Cmdliner.Cmd.group}: +{[ +let cmd = + let default = Term.(ret (const (`Help (`Auto, None)))) (* show help *) in + Cmd.group (Cmd.info "tool") ~default @@ + [Cmd_import.cmd; Cmd_serve.cmd; Cmd_user.cmd] + +let main () = Cmd.value' cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +{2:tip_tool_support Installing completions and manpages} + +The [cmdliner] tool can be used to install completion scripts and +manpages for you tool and its subcommands by using the dedicated +{{!page-cli.install_tool_completion}[install tool-completion]} and +{{!page-cli.install_tool_manpages}[install tool-manpages]} subcommands. + +To install both directly (and possibly other support files in the future) +it is more concise to use the [install +tool-support] command. Invoke with [--help] for more information. + +{3:tip_tool_support_with_opam With [opam]} + +If you are installing your package with [opam] for a tool named [tool] +located in the build at the path [$BUILD/tool], you can add the following +instruction after your build instructions in the [build:] field of +your [opam] file (also works if your build system is not using a +[.install] file). + +{@sh[ +build: [ + [ … ] # Your regular build instructions + ["cmdliner" "install" "tool-support" + "--update-opam-install=%{_:name}%.install" + "$BUILD/tool" "_build/cmdliner-install"]] +]} + +You need to specify the path to the built executable, as it cannot be +looked up in the [PATH] yet. Also more than one tool can be specified +in a single invocation and there is a syntax for specifying the actual +tool name if it is renamed on install; see [--help] for more +details. + +If [cmdliner] is only an optional dependency of your package use the +opam filter [{cmdliner:installed}] after the closing bracket of the command +invocation. + +{3:tip_tool_support_with_opam_dune With [opam] and [dune]} + +First make sure your understand the +{{!tip_tool_support_with_opam}above basic instructions} for [opam]. +You then +{{:https://dune.readthedocs.io/en/stable/reference/packages.html#generating-opam-files}need to figure out} how to add the [cmdliner install] instruction to the [build:] +field of the opam file after your [dune] build instructions. For a tool named +[tool] the result should eventually look this: + +{@sh[ +build: [ + [ … ] # Your regular dune build instructions + ["cmdliner" "install" "tool-support" + "--update-opam-install=%{_:name}%.install" + "_build/default/install/bin/tool" {os != "win32"} + "_build/default/install/bin/tool.exe" {os = "win32"} + "_build/cmdliner-install"]] +]} + +{1:conventions Conventions} + +By simply using Cmdliner you are already abiding to a great deal +of command line interface conventions. Here are a few other ones that +are not necessarily enforced by the library but that are good to +adopt for your users. + +{2:conv_use_dash Use ["-"] to specify [stdio] in file path arguments} + +Whenever a command line argument specifies a file path to read or +write you should let the user specify [-] to denote standard in or +standard out, if possible. If you worry about a file sporting this +name, note that the user can always specify it using [./-] for +the argument. + +Very often tools default to [stdin] or [stdout] when a file +input or output is unspecified, here is typical argument definitions +to support these conventions: + +{[ +let infile = + let doc = "$(docv) is the file to read from. Use $(b,-) for $(b,stdin)" in + Arg.(value & opt string "-" & info ["i", "input-file"] ~doc ~docv:"FILE") + +let outfile = + let doc = "$(docv) is the file to write to. Use $(b,-) for $(b,stdout)" in + Arg.(value & opt string "-" & info ["o", "output-file"] ~doc ~docv:"FILE") +]} + +Here is {!Stdlib} based code to read to a string a file or standard +input if [-] is specified: + +{[ +let read_file file = + let read file ic = try Ok (In_channel.input_all ic) with + | Sys_error e -> Error (Printf.sprintf "%s: %s" file e) + in + let binary_stdin () = In_channel.set_binary_mode In_channel.stdin true in + try match file with + | "-" -> binary_stdin (); read file In_channel.stdin + | file -> In_channel.with_open_bin file (read file) + with Sys_error e -> Error e +]} + +Here is {!Stdlib} based code to write a string to a file or standard output +if [-] is specified: + +{[ +let write_file file s = + let write file s oc = try Ok (Out_channel.output_string oc s) with + | Sys_error e -> Error (Printf.sprintf "%s: %s" file e) + in + let binary_stdout () = Out_channel.(set_binary_mode stdout true) in + try match file with + | "-" -> binary_stdout (); write file s Out_channel.stdout + | file -> Out_channel.with_open_bin file (write file s) + with Sys_error e -> Error e +]} + +{2:conv_env_defaults Environment variables as default modifiers} + +Cmdliner has support to back values defined by arguments with +environment variables. The value specified via an environment variable +should never take over an argument specified explicitely on the +command line. The environment variable should be seen as providing +the default value when the argument is absent. + +This is exactly what Cmdliner's support for environment variables does, +see {!env_args} + +{1:args Arguments} + +{2:args_positional How do I define a positional argument?} + +Positional arguments are extracted from the command line using +{{!Cmdliner.Arg.posargs}these combinators} which use zero-based +indexing. The following example extracts the first argument and if +the argument is absent from the command line it evaluates +to ["Revolt!"]. +{[ +let msg = + let doc = "$(docv) is the message to utter." and docv = "MSG" in + Arg.(value & pos 0 string "Revolt!" & info [] ~doc ~docv) +]} + +{2:args_optional How do I define an optional argument?} + +Optional arguments are extracted from the command line using +{{!Cmdliner.Arg.optargs}these combinators}. The actual option +name is defined in the {!Cmdliner.Arg.val-info} structure without +dashes. One character strings define short options, others long +options (see the {{!page-cli.optargs}parsed syntax}). + +The following defines the [-l] and [--loud] options. This is a simple +command line argument without a value also known as a command line {e +flag}. The term [loud] evaluates to [false] when the argument is +absent on the command line and [true] otherwise. + +{[ +let loud = + let doc = "Say the message loudly." in + Arg.(value & flag & info ["l"; "loud"] ~doc) +]} + +The following defines the [-m] and [--message] options. The term [msg] evalutes +to ["Revolt!"] when the option is absent on the command line. +{[ +let msg = + let doc = "$(docv) is the message to utter." and docv = "MSG" in + Arg.(value & opt string "Revolt!" & info ["m"; "message"] ~doc ~docv) +]} + +{2:args_required How do I define a required argument?} + +Some of the constraints on the presence of arguments occur when the +specification of arguments is {{!Cmdliner.Arg.argterms}converted} to +terms. The following says that the first positional argument is required: + +{[ +let msg = + let msg = "$(docv) is the message to utter." and docv = "MSG" in + Arg.(required & pos 0 (some string) None & info [] ~absent ~doc ~docv) +]} + +The value [msg] ends up being a term of type [string]. If the argument +is not provided, Cmdliner will automatically bail out during evaluation +with an error message. + +Note that while it is possible to define required positional argument +it is {{!tip_avoid_required_opt}discouraged}. + +{2:args_detect_absent How can I know if an argument was absent?} + +Most {{!Cmdliner.Arg.posargs}positional} and +{{!Cmdliner.Arg.optargs}optional} arguments have a default value. You +can use a [None] for the default argument and the {!Cmdliner.Arg.some} or +{!Cmdliner.Arg.some'} combinators on your argument converter which simply +wrap its result in a [Some]. + +{[ +let msg = + let msg = "$(docv) is the message to utter." in + let absent = "Random quote." in + Arg.(value & pos 0 (some string) None & info [] ~absent ~doc ~docv:"MSG") +]} + +There is more than one way to document the value when it is +absent. See {!args_absent_doc} + +{2:args_absent_doc How do I document absent argument behaviours?} + +There are three ways to document the behaviour when an argument is +unspecified on the command line. + +{ul +{- If you specify a default value in the argument combinator, this value + gets printed in bold using the {{!Cmdliner.Arg.conv_printer}printer} + of the converter.} +{- If you are using the {!Cmdliner.Arg.some'} and {!Cmdliner.Arg.some} + there is an optional [none] argument that allows you to specify + the default value. If you can exhibit this value at definition + point use {!Cmdliner.Arg.some'}, the underlying converter's + {{!Cmdliner.Arg.conv_printer}printer} will be used. If not + you can specify it as a string rendered in bold via {!Cmdliner.Arg.some}.} +{- If you want to describe a more complex, but short, behaviour use + the [~absent] parameter of {!Cmdliner.Arg.val-info}. Using this + parameter overrides the two previous ways. See + {{!args_detect_absent}this} example. }} + +{2:args_completion How can I customize positional and option value completion?} + +Positional argument values and option values are completed according +to the {{!Cmdliner.Arg.argconv}argument converter} you use for defining +the optional or positional argument. + +A couple of predefined argument converter like {!Cmdliner.Arg.path}, +{!Cmdliner.Arg.filepath} and {!Cmdliner.Arg.dirpath} or +{!Cmdliner.Arg.enum} automatically handle this for you. + +If you would like to perform custom or more elaborate context +sensitive completions you can define your own argument converter with +a completion defined with {!Cmdliner.Arg.Completion.make}. + +Here is an example where the first positional argument is completed +with the filenames found in a directory specified via the [--dir] +option (which defaults to the current working directory if unspecified). +{[ +let dir = Arg.(value & opt dirpath "." & info ["d"; "dir"]) +let dir_filenames_conv = + let complete dir ~token = match dir with + | None -> Error "Could not determine directory to lookup" + | Some dir -> + match Array.to_list (Sys.readdir dir) with + | exception Sys_error e -> Error (String.concat ": " [dir; e]) + | fnames -> + let fnames = List.filter (String.starts_with ~prefix:token) fnames in + Ok (List.map Arg.Completion.string fnames) + in + let completion = Arg.Completion.make ~context:dir complete in + Arg.Conv.of_conv ~completion Arg.string + +let pos0 = Arg.(required & pos 0 (some dir_filenames_conv) None & info []) +]} + +Note that when you use [pos0] in a command line definition you also +need to make sure [dir] is part of the term otherwise the context will +always be [None]: + +{[ +let+ pos0 and+ dir and+ … in … +]} + +{1:envs Environment variables} + +{2:env_args How can environment variables define defaults?} + +As mentioned in {!conv_env_defaults}, any non-required argument can be +defined by an environment variable when absent. This works by +specifying the [env] argument in the argument's {!Cmdliner.Arg.val-info} +information. For example: + +{[ +let msg = + let doc = "$(docv) is the message to utter." and docv = "MSG" in + let env = Cmd.Env.info "MESSAGE" in + Arg.(value & pos 0 string "Revolt!" & info [] ~env ~doc ~docv) +]} + +When the first positional argument is absent it takes the default +value ["Revolt!"], unless the [MESSAGE] variable is defined in +the environment in which case it takes its value. + +Cmdliner handles the environment variable lookup for you. By using the +[msg] term in your command definition all this gets automatically +documented in the tool help. + +{2:env_cmd How do I document environment variables influencing a command?} + +Environment variable that are used to change {{!env_args}argument +defaults} automatically get documented in a command's man page when +you use the argument's term in the command's term. + +However if your command implementation looks up other variables and you +wish to document them in the command's man page, use the [envs] +argument of {!Cmdliner.Cmd.val-info} or the [docs_env] argument +of {!Cmdliner.Arg.val-info}. + +This documents in the {!Cmdliner.Manpage.s_environment} manual section +of [tool] that [EDITOR] is looked up to find the tool to invoke to +edit the files: + +{[ +let editor_env = "EDITOR" +let tool … = … Sys.getenv_opt editor_env +let cmd = + let env = Cmd.Env.info editor_env ~doc:"The editor used to edit files." in + Cmd.make (Cmd.info "tool" ~envs:[env]) @@ + … +]} + +{1:cmds Commands} + +{2:cmds_exit_code_docs How do I document command exit codes?} + +Exit codes are documentd by {!Cmdliner.Cmd.Exit.type-info} values and +must be given to the command's {!Cmdliner.Cmd.type-info} value via the +[exits] optional arguments. For example: + +{[ +let conf_not_found = 1 +let tool … = +let tool_cmd = + let exits = + Cmd.Exit.info conf_not_found "if no configuration could be found." :: + Cmd.Exit.defaults + in + Cmd.make (Cmd.info "mycmd" ~exits) @@ + … +]} + +{2:cmds_show_docs How do I show help in a command group's default?} + +While it is usually {{!tip_avoid_default_command}not advised} to have a default +command in a group, just showing docs is acceptable. A term can request +Cmdliner's generated help by using {!Cmdliner.Term.val-ret}: +{[ +let group_cmd = + let default = Term.(ret (const (`Help (`Auto, None)))) (* show help *) in + Cmd.group (Cmd.info "group") ~default @@ + [first_cmd; second_cmd] +]} + +{2:cmds_which_eval Which [Cmd] evaluation function should I use?} + +There are (too) many {{!Cmdliner.Cmd.section-eval}command evaluation} +functions. They have grown organically in a rather ad-hoc manner. Some +of these are there for backwards compatibility reasons and advanced +usage for complex tools. + +Here are the main ones to use and why you may want to use them which +essentially depends on how you want to handle errors and exit codes +in your tool function. + +{ul +{- {!Cmdliner.Cmd.val-eval}. This forces your tool function to return [()]. + The evaluation function always returns an exit code of [0] unless a + command line parsing error occurs.} +{- {!Cmdliner.Cmd.eval'}. {b Recommended}. This forces your tool function to + return an exit code [exit] which is returned by the evaluation function + unless a command line parsing error occurs. This is the recommended + function to use as it forces you to think about how to report errors and + design useful exit codes for users.} +{- {!Cmdliner.Cmd.eval_result} is akin to {!Cmdliner.Cmd.val-eval} except + it forces your function to return either [Ok ()] or [Error msg]. + The evaluation function returns with exit code [0] unless [Error msg] is + computed in which case [msg] is printed on the error stream prefixed by the + executable name and the evaluation function returns with + exit code {!Cmdliner.Cmd.Exit.some_error}.} +{- {!Cmdliner.Cmd.eval_result'} is akin to {!Cmdliner.Cmd.eval_result}, except + the [Ok] case carries an exit code which is returned by the evaluation + function.}} + +{2:cmds_howto_complete How can my tool support command line completion?} + +The command line interface manual has all +{{!page-cli.cli_completion}the details} and +{{!page-cli.install_tool_completion} specific instructions} for +complementing your tool install. See also {!tip_tool_support}. + +{2:cmds_listing How can I list all the commands of my tool?} + +In a shell the invocation [cmdliner tool-commands $TOOL] lists every +command of the tool $TOOL. + +{2:cmds_errmsg_styling How can I suppress error message styling?} + +Since Cmdliner 2.0, error message printed on [stderr] use styled text +with ANSI escapes. Styled text is disabled if one of the conditions +mentioned {{!page-cli.error_message_styling}here} is met. + +If you want to be more aggressive in suppressing them you can use the +[err] formatter argument of {{!Cmdliner.Cmd.section-eval}command +evaluation} functions with a suitable formatter on which a function +like +{{:https://erratique.ch/software/more/doc/More/Fmt/index.html#val-strip_styles} +this one} has been applied that automatically strips the styling. + +{1:manpage Manpages} + +{2:manpage_hide How do I prevent an item from being automatically listed?} + +In general it's not a good idea to hide stuff from your users but in +case an item needs to be hidden you can use the special +{!Cmdliner.Manpage.s_none} section name. This ensures the item does +not get listed in any section. + +{[ +let secret = Arg.(value & flag & info ["super-secret"] ~docs:Manpage.s_none) +]} + +{2:manpage_synopsis How can I write a better command synopsis section?} + +Define the {!Cmdliner.Manpage.s_synopsis} section in the manpage of +your command. It takes over the one generated by Cmdliner. For example: + +{[ +let man = [ + `S Manpage.s_synopsis; + `P "$(cmd) $(b,--) $(i,TOOL) [$(i,ARG)]…"; `Noblank; + `P "$(cmd) $(i,COMMAND) …"; + `S Manpage.s_description; + `P "Without a command $(cmd) invokes $(i,TOOL)"; ] +]} + +{2:manpage_install How can I install all the manpages of my tool?} + +The command line interface manual +{{!page-cli.install_tool_manpages}the details} on how to install the manpages +of your tool and its subcommands. See also {!tip_tool_support}. + +{1:blueprints Blueprints} + +These blueprints when copied to a [src.ml] file can be compiled and run with: + +{@sh[ +ocamlfind ocamlopt -package cmdliner -linkgpkg src.ml +./a.out --help +]} + +More concrete examples can be found on the {{!page-examples}examples page} +and the {{!page-tutorial}tutorial} may help too. + +These examples follow a conventional {!tip_src_structure}. + +{2:blueprint_min Minimal} + +A minimal example. + +{@ocaml name=blueprint_min.ml[ +let tool () = Cmdliner.Cmd.Exit.ok + +open Cmdliner +open Cmdliner.Term.Syntax + +let cmd = + Cmd.make (Cmd.info "TODO" ~version:"v2.0.0+dune") @@ + let+ unit = Term.const () in + tool unit + +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +{2:blueprint_tool A simple tool} + +This is a tool that has a flag, an optional positional argument for +specifying an input file. It also responds to the [--version] option. + +{@ocaml name=blueprint_tool.ml[ +let exit_todo = 1 +let tool ~flag ~infile = exit_todo + +open Cmdliner +open Cmdliner.Term.Syntax + +let flag = Arg.(value & flag & info ["flag"] ~doc:"The flag") +let infile = + let doc = "$(docv) is the input file. Use $(b,-) for $(b,stdin)." in + Arg.(value & pos 0 string "-" & info [] ~doc ~docv:"FILE") + +let cmd = + let doc = "The tool synopsis is TODO" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) does TODO" ] + in + let exits = + Cmd.Exit.info exit_todo ~doc:"When there is stuff todo" :: + Cmd.Exit.defaults + in + Cmd.make (Cmd.info "TODO" ~version:"v2.0.0+dune" ~doc ~man ~exits) @@ + let+ flag and+ infile in + tool ~flag ~infile + +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +{2:blueprint_cmds A tool with subcommands} + +This is a tool with two subcommands [hey] and [ho]. If your tools +grows many subcommands you may want to follow these +{{!tip_src_structure}source code conventions}. + +{@ocaml name=blueprint_cmds.ml[ +let hey () = Cmdliner.Cmd.Exit.ok +let ho () = Cmdliner.Cmd.Exit.ok + +open Cmdliner +open Cmdliner.Term.Syntax + +let flag = Arg.(value & flag & info ["flag"] ~doc:"The flag") +let infile = + let doc = "$(docv) is the input file. Use $(b,-) for $(b,stdin)." in + Arg.(value & pos 0 file "-" & info [] ~doc ~docv:"FILE") + +let hey_cmd = + let doc = "The hey command synopsis is TODO" in + Cmd.make (Cmd.info "hey" ~doc) @@ + let+ unit = Term.const () in + ho () + +let ho_cmd = + let doc = "The ho command synopsis is TODO" in + Cmd.make (Cmd.info "ho" ~doc) @@ + let+ unit = Term.const () in + ho unit + +let cmd = + let doc = "The tool synopsis is TODO" in + Cmd.group (Cmd.info "TODO" ~version:"v2.0.0+dune" ~doc) @@ + [hey_cmd; ho_cmd] + +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) +]} diff --git a/unikernel/duniverse/cmdliner/doc/examples.mld b/unikernel/duniverse/cmdliner/doc/examples.mld new file mode 100644 index 00000000..5d982867 --- /dev/null +++ b/unikernel/duniverse/cmdliner/doc/examples.mld @@ -0,0 +1,453 @@ +{0 Examples} + +The examples are self-contained, cut and paste them in a file to play +with them. See also the suggested {{!page-cookbook.tip_src_structure}source +code structure} and program {{!page-cookbook.blueprints}blueprints}. + +{1:example_rm A [rm] command} + +We define the command line interface of an [rm] command with the +synopsis: + +{v +rm [OPTION]… FILE… +v} + +The [-f], [-i] and [-I] flags define the prompt behaviour of [rm]. It +is represented in our program by the [prompt] type. If more than one +of these flags is present on the command line the last one takes +precedence. + +To implement this behaviour we map the presence of these flags to +values of the [prompt] type by using {!Cmdliner.Arg.vflag_all}. + +This argument will contain all occurrences of the flag on the command +line and we just take the {!Cmdliner.Arg.last} one to define our term +value. If there is no occurrence the last value of the default list +[[Always]] is taken. This means the default prompt behaviour is [Always]. + +{@ocaml name=example_rm.ml[ +(* Implementation of the command, we just print the args. *) + +type prompt = Always | Once | Never +let prompt_str = function +| Always -> "always" | Once -> "once" | Never -> "never" + +let rm ~prompt ~recurse files = + Printf.printf "prompt = %s\nrecurse = %B\nfiles = %s\n" + (prompt_str prompt) recurse (String.concat ", " files) + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let files = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILE") +let prompt = + let always = + let doc = "Prompt before every removal." in + Always, Arg.info ["i"] ~doc + in + let never = + let doc = "Ignore nonexistent files and never prompt." in + Never, Arg.info ["f"; "force"] ~doc + in + let once = + let doc = "Prompt once before removing more than three files, or when + removing recursively. Less intrusive than $(b,-i), while + still giving protection against most mistakes." + in + Once, Arg.info ["I"] ~doc + in + Arg.(last & vflag_all [Always] [always; never; once]) + +let recursive = + let doc = "Remove directories and their contents recursively." in + Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) + +let rm_cmd = + let doc = "Remove files or directories" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) removes each specified $(i,FILE). By default it does not + remove directories, to also remove them and their contents, use the + option $(b,--recursive) ($(b,-r) or $(b,-R))."; + `P "To remove a file whose name starts with a $(b,-), for example + $(b,-foo), use one of these commands:"; + `Pre "$(cmd) $(b,-- -foo)"; `Noblank; + `Pre "$(cmd) $(b,./-foo)"; + `P "$(cmd.name) removes symbolic links, not the files referenced by the + links."; + `S Manpage.s_bugs; `P "Report bugs to ."; + `S Manpage.s_see_also; `P "$(b,rmdir)(1), $(b,unlink)(2)" ] + in + Cmd.make (Cmd.info "rm" ~version:"v2.0.0+dune" ~doc ~man) @@ + let+ prompt and+ recursive and+ files in + rm ~prompt ~recurse:recursive files + +let main () = Cmd.eval rm_cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +{1:example_cp A [cp] command} + +We define the command line interface of a [cp] command with the synopsis: + +{v +cp [OPTION]… SOURCE… DEST +v} + +The [DEST] argument must be a directory if there is more than one +[SOURCE]. This constraint is too complex to be expressed by the +combinators of {!Cmdliner.Arg}. + +Hence we just give [DEST] the {!Cmdliner.Arg.string} type and verify +the constraint at the beginning of the implementation of [cp]. If the +constraint is unsatisfied we return an [`Error] result. By using +{!Cmdliner.Term.val-ret} on the command's term for [cp], [Cmdliner] +handles the error reporting. + +{@ocaml name=example_cp.ml[ +(* Implementation, we check the dest argument and print the args *) + +let cp ~verbose ~recurse ~force srcs dest = + let many = List.length srcs > 1 in + if many && (not (Sys.file_exists dest) || not (Sys.is_directory dest)) + then `Error (false, dest ^ ": not a directory") else + `Ok (Printf.printf + "verbose = %B\nrecurse = %B\nforce = %B\nsrcs = %s\ndest = %s\n" + verbose recurse force (String.concat ", " srcs) dest) + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let verbose = + let doc = "Print file names as they are copied." in + Arg.(value & flag & info ["v"; "verbose"] ~doc) + +let recurse = + let doc = "Copy directories recursively." in + Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) + +let force = + let doc = "If a destination file cannot be opened, remove it and try again."in + Arg.(value & flag & info ["f"; "force"] ~doc) + +let srcs = + let doc = "Source file(s) to copy." in + Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc) + +let dest = + let doc = "Destination of the copy. Must be a directory if there is more \ + than one $(i,SOURCE)." in + let docv = "DEST" in + Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv ~doc) + +let cp_cmd = + let doc = "Copy files" in + let man_xrefs = + [`Tool "mv"; `Tool "scp"; `Page ("umask", 2); `Page ("symlink", 7)] + in + let man = [ + `S Manpage.s_bugs; + `P "Email them to ."; ] + in + Cmd.make (Cmd.info "cp" ~version:"v2.0.0+dune" ~doc ~man ~man_xrefs) @@ + Term.ret @@ + let+ verbose and+ recurse and+ force and+ srcs and+ dest in + cp ~verbose ~recurse ~force srcs dest + +let main () = Cmd.eval cp_cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +{1:example_tail A [tail] command} + +We define the command line interface of a [tail] command with the +synopsis: + +{v +tail [OPTION]… [FILE]… +v} + +The [--lines] option whose value specifies the number of last lines to +print has a special syntax where a [+] prefix indicates to start +printing from that line number. In the program this is represented by +the [loc] type. We define a custom [loc_arg] +{{!Cmdliner.Arg.type-conv}argument converter} for this option. + +The [--follow] option has an optional enumerated value. The argument +converter [follow], created with {!Cmdliner.Arg.enum} parses the +option value into the enumeration. By using {!Cmdliner.Arg.some} and +the [~vopt] argument of {!Cmdliner.Arg.opt}, the term corresponding to +the option [--follow] evaluates to [None] if [--follow] is absent from +the command line, to [Some Descriptor] if present but without a value +and to [Some v] if present with a value [v] specified. + +{@ocaml name=example_tail.ml[ +(* Implementation of the command, we just print the args. *) + +type loc = bool * int +type verb = Verbose | Quiet +type follow = Name | Descriptor + +let str = Printf.sprintf +let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) +let loc_str (rev, k) = if rev then str "%d" k else str "+%d" k +let follow_str = function Name -> "name" | Descriptor -> "descriptor" +let verb_str = function Verbose -> "verbose" | Quiet -> "quiet" + +let tail ~lines ~follow ~verb ~pid files = + Printf.printf + "lines = %s\nfollow = %s\nverb = %s\npid = %s\nfiles = %s\n" + (loc_str lines) (opt_str follow_str follow) (verb_str verb) + (opt_str string_of_int pid) (String.concat ", " files) + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let loc_arg = + let parser s = + try + if s <> "" && s.[0] <> '+' + then Ok (true, int_of_string s) + else Ok (false, int_of_string (String.sub s 1 (String.length s - 1))) + with Failure _ -> Error "unable to parse integer" + in + let pp ppf p = Format.fprintf ppf "%s" (loc_str p) in + Arg.Conv.make ~docv:"N" ~parser ~pp () + +let lines = + let doc = "Output the last $(docv) lines or use $(i,+)$(docv) to start \ + output after the $(i,N)-1th line." + in + Arg.(value & opt loc_arg (true, 10) & info ["n"; "lines"] ~docv:"N" ~doc) + +let follow = + let doc = "Output appended data as the file grows. $(docv) specifies how \ + the file should be tracked, by its $(b,name) or by its \ + $(b,descriptor)." + in + let follow = Arg.enum ["name", Name; "descriptor", Descriptor] in + Arg.(value & opt (some follow) ~vopt:(Some Descriptor) None & + info ["f"; "follow"] ~docv:"ID" ~doc) + +let verb = + let quiet = + let doc = "Never output headers giving file names." in + Quiet, Arg.info ["q"; "quiet"; "silent"] ~doc + in + let verbose = + let doc = "Always output headers giving file names." in + Verbose, Arg.info ["v"; "verbose"] ~doc + in + Arg.(last & vflag_all [Quiet] [quiet; verbose]) + +let pid = + let doc = "With -f, terminate after process $(docv) dies." in + Arg.(value & opt (some int) None & info ["pid"] ~docv:"PID" ~doc) + +let files = Arg.(value & (pos_all non_dir_file []) & info [] ~docv:"FILE") + +let tail_cmd = + let doc = "Display the last part of a file" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) prints the last lines of each $(i,FILE) to standard output. + If no file is specified reads standard input. The number of printed + lines can be specified with the $(b,-n) option."; + `S Manpage.s_bugs; + `P "Report them to ."; + `S Manpage.s_see_also; + `P "$(b,cat)(1), $(b,head)(1)" ] + in + Cmd.make (Cmd.info "tail" ~version:"v2.0.0+dune" ~doc ~man) @@ + let+ lines and+ follow and+ verb and+ pid and+ files in + tail ~lines ~follow ~verb ~pid files + +let main () = Cmd.eval tail_cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +{1:example_darcs A [darcs] command} + +We define the command line interface of a [darcs] command with the +synopsis: + +{v +darcs [COMMAND] … +v} + +The [--debug], [-q], [-v] and [--prehook] options are available in +each command. To avoid having to pass them individually to each +command we gather them in a record of type [copts]. By lifting the +record constructor [copts] into the term [copts_t] we now have a term +that we can pass to the commands to stand for an argument of type +[copts]. These options are documented in the section +{!Cmdliner.Manpage.s_common_options}. + +The [help] command shows help about commands or other topics. The help +shown for commands is generated by [Cmdliner] by making an appropriate +use of {!Cmdliner.Term.val-ret} on the lifted [help] function. + +If the program is invoked without a command we just want to show the +help of the program as printed by [Cmdliner] with [--help]. This is +done by the [default] term. + +{@ocaml name=example_darcs.ml[ +(* Implementations, just print the args. *) + +type verb = Normal | Quiet | Verbose +type copts = { debug : bool; verb : verb; prehook : string option } + +let str = Printf.sprintf +let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) +let opt_str_str = opt_str (fun s -> s) +let verb_str = function + | Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose" + +let pr_copts oc copts = Printf.fprintf oc + "debug = %B\nverbosity = %s\nprehook = %s\n" + copts.debug (verb_str copts.verb) (opt_str_str copts.prehook) + +let initialize copts repodir = Printf.printf + "%arepodir = %s\n" pr_copts copts repodir + +let record copts name email all ask_deps files = Printf.printf + "%aname = %s\nemail = %s\nall = %B\nask-deps = %B\nfiles = %s\n" + pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps + (String.concat ", " files) + +let help copts man_format cmds topic = match topic with +| None -> `Help (`Pager, None) (* help about the program. *) +| Some topic -> + let topics = "topics" :: "patterns" :: "environment" :: cmds in + let conv = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in + let parse = Cmdliner.Arg.Conv.parser conv in + match parse topic with + | Error e -> `Error (false, e) + | Ok t when t = "topics" -> List.iter print_endline topics; `Ok () + | Ok t when List.mem t cmds -> `Help (man_format, Some t) + | Ok t -> + let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in + `Ok (Cmdliner.Manpage.print man_format Format.std_formatter page) + +open Cmdliner +open Cmdliner.Term.Syntax + +(* Help sections common to all commands *) + +let help_secs = [ + `S Manpage.s_common_options; + `P "These options are common to all commands."; + `S "MORE HELP"; + `P "Use $(tool) $(i,COMMAND) --help for help on a single command.";`Noblank; + `P "Use $(tool) $(b,help patterns) for help on patch matching."; `Noblank; + `P "Use $(tool) $(b,help environment) for help on environment variables."; + `S Manpage.s_bugs; `P "Check bug reports at http://bugs.example.org.";] + +(* Options common to all commands *) + +let copts debug verb prehook = { debug; verb; prehook } +let copts_t = + let docs = Manpage.s_common_options in + let debug = + let doc = "Give only debug output." in + Arg.(value & flag & info ["debug"] ~docs ~doc) + in + let verb = + let doc = "Suppress informational output." in + let quiet = Quiet, Arg.info ["q"; "quiet"] ~docs ~doc in + let doc = "Give verbose output." in + let verbose = Verbose, Arg.info ["v"; "verbose"] ~docs ~doc in + Arg.(last & vflag_all [Normal] [quiet; verbose]) + in + let prehook = + let doc = "Specify command to run before this $(tool) command." in + Arg.(value & opt (some string) None & info ["prehook"] ~docs ~doc) + in + Term.(const copts $ debug $ verb $ prehook) + +(* Commands *) + +let sdocs = Manpage.s_common_options + +let initialize_cmd = + let repodir = + let doc = "Run the program in repository directory $(docv)." in + Arg.(value & opt file Filename.current_dir_name & info ["repodir"] + ~docv:"DIR" ~doc) + in + let doc = "make the current directory a repository" in + let man = [ + `S Manpage.s_description; + `P "Turns the current directory into a Darcs repository. Any + existing files and subdirectories become …"; + `Blocks help_secs; ] + in + Cmd.make (Cmd.info "initialize" ~doc ~sdocs ~man) @@ + let+ copts_t and+ repodir in + initialize copts_t repodir + +let record_cmd = + let pname = + let doc = "Name of the patch." in + Arg.(value & opt (some string) None & info ["m"; "patch-name"] ~docv:"NAME" + ~doc) + in + let author = + let doc = "Specifies the author's identity." in + Arg.(value & opt (some string) None & info ["A"; "author"] ~docv:"EMAIL" + ~doc) + in + let all = + let doc = "Answer yes to all patches." in + Arg.(value & flag & info ["a"; "all"] ~doc) + in + let ask_deps = + let doc = "Ask for extra dependencies." in + Arg.(value & flag & info ["ask-deps"] ~doc) + in + let files = Arg.(value & (pos_all file) [] & info [] ~docv:"FILE or DIR") in + let doc = "create a patch from unrecorded changes" in + let man = + [`S Manpage.s_description; + `P "Creates a patch from changes in the working tree. If you specify + a set of files…"; + `Blocks help_secs; ] + in + Cmd.make (Cmd.info "record" ~doc ~sdocs ~man) @@ + let+ copts_t and+ pname and+ author and+ all and+ ask_deps and+ files in + record copts_t pname author all ask_deps files + +let help_cmd = + let topic = + let doc = "The topic to get help on. $(b,topics) lists the topics." in + Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc) + in + let doc = "display help about darcs and darcs commands" in + let man = + [`S Manpage.s_description; + `P "Prints help about darcs commands and other subjects…"; + `Blocks help_secs; ] + in + Cmd.make (Cmd.info "help" ~doc ~man) @@ + Term.ret @@ + let+ copts_t and+ man_format = Arg.man_format + and+ choice_names = Term.choice_names and+ topic in + help copts_t man_format choice_names topic + +let main_cmd = + let doc = "a revision control system" in + let man = help_secs in + let info = Cmd.info "darcs" ~version:"v2.0.0+dune" ~doc ~sdocs ~man in + let default = Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)) in + Cmd.group info ~default [initialize_cmd; record_cmd; help_cmd] + +let main () = Cmd.eval main_cmd +let () = if !Sys.interactive then () else exit (main ()) +]} diff --git a/unikernel/duniverse/cmdliner/doc/index.mld b/unikernel/duniverse/cmdliner/doc/index.mld new file mode 100644 index 00000000..81a8b082 --- /dev/null +++ b/unikernel/duniverse/cmdliner/doc/index.mld @@ -0,0 +1,46 @@ +{0 Cmdliner {%html: v2.0.0+dune%}} + +Cmdliner provides a simple and compositional mechanism +to convert command line arguments to OCaml values and pass them to +your functions. + +The library automatically handles command line completion, syntax +errors, help messages and UNIX man page generation. It supports +programs with single or multiple commands (like [git]) and respect +most of the +{{:http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html} +POSIX} and +{{:http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html} +GNU} conventions. + +{1:manuals Manuals} + +The following manuals are available. + +{ul +{- The {{!page-tutorial}tutorial} makes you write your first command line + interface with Cmdliner.} +{- The {{!page-cookbook}cookbook} has a few off-the-shelf recipes, + tips about {{!page-cookbook.tip_src_structure}source code structure}, + and {{!page-cookbook.blueprints}blueprints} to define your command lines + with Cmdliner.} +{- The {{!page-cli}command line interface manual} describes how command + lines and environment variables are parsed by Cmdliner and how command line + completion is performed. This can be communicated to the users of your + tools.} +{- The {{!page-tool_man}tool man page} manual describes how + Cmdliner generates man pages for your tools and their commands and how + you can format them.} +{- The {{!page-examples}examples page} has examples of a some + classic UNIX tools with their command line interface implemented by + Cmdliner.}} + +{1:library Library [cmdliner]} + +{!modules: Cmdliner} +{!modules: +Cmdliner.Arg +Cmdliner.Cmd +Cmdliner.Manpage +Cmdliner.Term +} diff --git a/unikernel/duniverse/cmdliner/doc/tool_man.mld b/unikernel/duniverse/cmdliner/doc/tool_man.mld new file mode 100644 index 00000000..e6836c00 --- /dev/null +++ b/unikernel/duniverse/cmdliner/doc/tool_man.mld @@ -0,0 +1,73 @@ +{0:tool_man Tool man pages} + +See also the {{!page-cli.help}section} about man pages in the command +line interface manual. + +{1:manual Man page generation} + +Man page sections for a command are printed in the order specified by +the [man] value given to {!Cmdliner.Cmd.val-info}. Unless +specified explicitly in the [man] value the following sections +are automatically created and populated for you: + +{ul +{- {{!Cmdliner.Manpage.s_name}[NAME]} section.} +{- {{!Cmdliner.Manpage.s_synopsis}[SYNOPSIS]} section.}} + +The various [doc] documentation strings specified by the command's +term arguments get inserted at the end of the documentation section +they respectively mention in their [docs] argument: + +{ol +{- For commands, see {!Cmdliner.Cmd.val-info}.} +{- For positional arguments, see {!Cmdliner.Arg.type-info}. Those are listed iff + both the [docv] and [doc] string is specified by {!Cmdliner.Arg.val-info}.} +{- For optional arguments, see {!Cmdliner.Arg.val-info}.} +{- For exit statuses, see {!Cmdliner.Cmd.Exit.val-info}.} +{- For environment variables, see {!Cmdliner.Cmd.Env.val-info}.}} + +If a [docs] section name is mentioned and does not exist in the command's +[man] value, an empty section is created for it, after which the [doc] strings +are inserted, possibly prefixed by boilerplate text (e.g. for +{!Cmdliner.Manpage.s_environment} and {!Cmdliner.Manpage.s_exit_status}). + +If the created section is: +{ul +{- {{!Cmdliner.Manpage.standard_sections}standard}, it + is inserted at the right place in the order specified + {{!Cmdliner.Manpage.standard_sections}here}, but after a + possible non-standard + section explicitly specified by the command's [man] value since the latter + get the order number of the last previously specified standard section + or the order of {!Cmdliner.Manpage.s_synopsis} if there is no such section.} +{- non-standard, it is inserted before the {!Cmdliner.Manpage.s_commands} + section or the first subsequent existing standard section if it + doesn't exist. Taking advantage of this behaviour is discouraged, + you should declare manually your non standard section in the command's + manual page.}} + +Finally note that the header of empty sections are dropped from the +output. This allows you to share section placements among many +commands and render them only if something actually gets inserted in +it. + +{1:doclang Documentation markup language} + +Manpage {{!Cmdliner.Manpage.block}blocks} and the doc strings of the +various [info] values support the following markup language. + +{ul +{- Markup directives [$(i,text)] and [$(b,text)], where [text] is raw + text respectively rendered in italics and bold.} +{- Outside markup directives, context dependent variables of the form + [$(var)] are substituted by marked up data. For example in a command + man page [$(cmd)] is substituted by the command's invocation in + bold.} +{- Characters '$', '(', ')' and '\' can respectively be escaped by \$, \(, \) + and \\ . In OCaml strings this will be ["\\$"], ["\\("], ["\\)"], + ["\\\\"]. Escaping '$' and '\' is mandatory everywhere. Escaping ')' is + mandatory only in markup directives. Escaping '(' is only here for + your symmetric pleasure. Any other sequence of characters starting + with a '\' is an illegal character sequence.} +{- Referring to unknown markup directives or variables will generate + errors on standard error during documentation generation.}} diff --git a/unikernel/duniverse/cmdliner/doc/tutorial.mld b/unikernel/duniverse/cmdliner/doc/tutorial.mld new file mode 100644 index 00000000..83cb4646 --- /dev/null +++ b/unikernel/duniverse/cmdliner/doc/tutorial.mld @@ -0,0 +1,228 @@ +{0:tutorial Tutorial} + +See also the {{!page-cookbook}cookbook}, +{{!page-cookbook.blueprints}blueprints} and +{{!page-examples}examples}. + +{1:terms Commands and terms} + +With [Cmdliner] your tool's [main] function evaluates a command. + +A command is a value of type {!Cmdliner.Cmd.t} which gathers a command +name and a term of type {!Cmdliner.Term.t}. A term represents both a +command line syntax fragment and an expression to be evaluated that +implements your tool. The type parameter of the term (and the command) +indicates the type of the result of the evaluation. + +One way to create terms is by lifting regular OCaml values with +{!Cmdliner.Term.const}. Terms can be applied to terms evaluating to +functional values with {!Cmdliner.Term.app}. + +For example, in a [revolt.ml] file, for the function: + +{@ocaml name=example_revolt1.ml[ +let revolt () = print_endline "Revolt!" +]} + +the term : + +{@ocaml name=example_revolt1.ml[ +open Cmdliner + +let revolt_term = Term.app (Term.const revolt) (Term.const ()) +]} + +is a term that evaluates to the result (and effect) of the [revolt] +function. This term can be associated to a command: + +{@ocaml name=example_revolt1.ml[ +let cmd_revolt = Cmd.make (Cmd.info "revolt") revolt_term +]} + +and evaluated with {!Cmdliner.Cmd.val-eval}: +{@ocaml name=example_revolt1.ml[ +let main () = Cmd.eval cmd_revolt +let () = if !Sys.interactive then () else exit (main ()) +]} + +This defines a command line tool named ["revolt"] (this name will be +used in error reporting and documentation generation), without command +line arguments, that just prints ["Revolt!"] on [stdout]. + +{@sh[ +> ocamlfind ocamlopt -linkpkg -package cmdliner -o revolt revolt.ml +> ./revolt +Revolt! +]} + +{1:term_syntax Term syntax} + +There is a special syntax that uses OCaml's +{{:https://ocaml.org/manual/5.3/bindingops.html}binding operators} for +writing terms which is less error prone when the number of arguments +you want to give to your function grows. In particular it allows you to +easily lift functions which have labels. + +So in fact the program we have just shown above is usually rather +written this way: + +{@ocaml name=example_revolt2.ml[ +let revolt () = print_endline "Revolt!" + +open Cmdliner +open Cmdliner.Term.Syntax + +let cmd_revolt = + Cmd.make (Cmd.info "revolt") @@ + let+ () = Term.const () in + revolt () + +let main () = Cmd.eval cmd_revolt +let () = if !Sys.interactive then () else exit (main ()) +]} + +{1:args_as_terms Command line arguments as terms} + +The combinators in the {!Cmdliner.Arg} module allow to extract command +line arguments as terms. These terms can then be applied to lifted +OCaml functions to be evaluated. A term that uses terms that correspond +to command line argument implicitely defines a command line syntax +fragment. We show this on an concrete example. + +In a [chorus.ml] file, consider the [chorus] function that prints +repeatedly a given message : + +{@ocaml name=example_chorus.ml[ +let chorus ~count msg = for i = 1 to count do print_endline msg done +]} + +we want to make it available from the command line with the synopsis: + +{@sh[ +chorus [-c COUNT | --count=COUNT] [MSG] +]} + +where [COUNT] defaults to [10] and [MSG] defaults to ["Revolt!"]. We +first define a term corresponding to the [--count] option: + +{@ocaml name=example_chorus.ml[ +open Cmdliner +open Cmdliner.Term.Syntax + +let count = + let doc = "Repeat the message $(docv) times." in + Arg.(value & opt int 10 & info ["c"; "count"] ~doc ~docv:"COUNT") +]} + +This says that [count] is a term that evaluates to the value of an +optional argument of type [int] that defaults to [10] if unspecified +and whose option name is either [-c] or [--count]. The arguments [doc] +and [docv] are used to generate the option's man page information. + +The term for the positional argument [MSG] is: + +{@ocaml name=example_chorus.ml[ +let msg = + let env = + let doc = "Overrides the default message to print." in + Cmd.Env.info "CHORUS_MSG" ~doc + in + let doc = "The message to print." in + Arg.(value & pos 0 string "Revolt!" & info [] ~env ~doc ~docv:"MSG") +]} + +which says that [msg] is a term whose value is the positional argument +at index [0] of type [string] and defaults to ["Revolt!"] or the +value of the environment variable [CHORUS_MSG] if the argument is +unspecified on the command line. Here again [doc] and [docv] are used +for the man page information. + +We can now define a term and command for invoking the [chorus] function +using the {{!term_syntax}term syntax} and the obscure but handy +{{:https://ocaml.org/manual/5.2/bindingops.html#ss%3Aletops-punning} +let-punning} OCaml notation. This also shows that the +value {!Cmdliner.Cmd.val-info} can be given more +information about the term we execute which is notably used to +to generate the tool's man page. + +{@ocaml name=example_chorus.ml[ +let chorus_cmd = + let doc = "Print a customizable message repeatedly" in + let man = [ + `S Manpage.s_bugs; + `P "Email bug reports to ." ] + in + Cmd.make (Cmd.info "chorus" ~version:"v2.0.0+dune" ~doc ~man) @@ + let+ count and+ msg in + chorus ~count msg + +let main () = Cmd.eval chorus_cmd +let () = if !Sys.interactive then () else exit (main ()) +]} + +Since we provided a [~version] string, the tool will automatically +respond to the [--version] option by printing this string. + +Besides a tool using {!Cmdliner.Cmd.val-eval} always responds to the +[--help] option by showing the tool's man page +{{!page-tool_man.manual}generated} using the information you provided +with {!Cmdliner.Cmd.val-info} and {!Cmdliner.Arg.val-info}. Here is +the manual generated by our example: + +{v +> ocamlfind ocamlopt -linkpkg -package cmdliner -o chorus chorus.ml +> ./chorus --help +NAME + chorus - Print a customizable message repeatedly + +SYNOPSIS + chorus [--count=COUNT] [OPTION]… [MSG] + +ARGUMENTS + MSG (absent=Revolt! or CHORUS_MSG env) + The message to print. + +OPTIONS + -c COUNT, --count=COUNT (absent=10) + Repeat the message COUNT times. + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + chorus exits with the following status: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +ENVIRONMENT + These environment variables affect the execution of chorus: + + CHORUS_MSG + Overrides the default message to print. + +BUGS + Email bug reports to . +v} + +If a pager is available, this output is written to a pager. This help +is also available in plain text or in the +{{:http://www.gnu.org/software/groff/groff.html}groff} man page format +by invoking the program with the option [--help=plain] or +[--help=groff]. + +And with this you should master the basics of Cmdliner, for examples +of more complex command line definitions consult the +{{!page-examples}examples}. For more tips, off-the-shelf recipes and +conventions have look at the {{!page-cookbook}cookbook}. \ No newline at end of file diff --git a/unikernel/duniverse/cmdliner/dune b/unikernel/duniverse/cmdliner/dune new file mode 100644 index 00000000..d1170852 --- /dev/null +++ b/unikernel/duniverse/cmdliner/dune @@ -0,0 +1 @@ +(env (_ (flags -g -bin-annot -safe-string))) ; Use the same flags as with ocamlbuild diff --git a/unikernel/duniverse/cmdliner/dune-project b/unikernel/duniverse/cmdliner/dune-project new file mode 100644 index 00000000..e5c1fca1 --- /dev/null +++ b/unikernel/duniverse/cmdliner/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.4) +(name cmdliner) +(version v2.0.0+dune) diff --git a/unikernel/duniverse/cmdliner/pkg/META b/unikernel/duniverse/cmdliner/pkg/META new file mode 100644 index 00000000..cc950c80 --- /dev/null +++ b/unikernel/duniverse/cmdliner/pkg/META @@ -0,0 +1,8 @@ +description = "Declarative definition of command line interfaces for OCaml" +version = "2.0.0+dune" +requires = "" +archive(byte) = "cmdliner.cma" +archive(native) = "cmdliner.cmxa" +plugin(byte) = "cmdliner.cma" +plugin(native) = "cmdliner.cmxs" +exists_if = "cmdliner.cma cmdliner.cmxa" diff --git a/unikernel/duniverse/cmdliner/pkg/pkg.ml b/unikernel/duniverse/cmdliner/pkg/pkg.ml new file mode 100755 index 00000000..a86fccf3 --- /dev/null +++ b/unikernel/duniverse/cmdliner/pkg/pkg.ml @@ -0,0 +1,17 @@ +#!/usr/bin/env ocaml +#use "topfind" +#require "topkg" +open Topkg + +(* This is only here for `topkg distrib`. Remove once + we switch to `b0 -- .release` *) + +let distrib = + (* The default removes Makefile *) + let exclude_paths () = Ok [".git";".gitignore";".gitattributes";"_build"] in + Pkg.distrib ~exclude_paths () + +let () = + let opams = [Pkg.opam_file "cmdliner.opam"] in + Pkg.describe "cmdliner" ~distrib ~opams @@ fun c -> + Ok [ Pkg.mllib ~api:["Cmdliner"] "src/cmdliner.mllib" ] diff --git a/unikernel/duniverse/cmdliner/src/cmdliner.ml b/unikernel/duniverse/cmdliner/src/cmdliner.ml new file mode 100644 index 00000000..b1c77ee5 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner.ml @@ -0,0 +1,14 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +module Manpage = Cmdliner_manpage +module Term = Cmdliner_term +module Cmd = struct + module Exit = Cmdliner_def.Exit + module Env = Cmdliner_def.Env + include Cmdliner_cmd + include Cmdliner_eval +end +module Arg = Cmdliner_arg diff --git a/unikernel/duniverse/cmdliner/src/cmdliner.mli b/unikernel/duniverse/cmdliner/src/cmdliner.mli new file mode 100644 index 00000000..64e2cf11 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner.mli @@ -0,0 +1,1183 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Declarative definition of command line interfaces. + + Consult the {{!page-tutorial}tutorial}, the + {{!page-cookbook}cookbook}, program + {{!page-cookbook.blueprints}blueprints} and + {{!page-cookbook.tip_src_structure}source structure}, details about the + supported {{!page-cli}command line syntax} and + {{!page-examples}examples} of use. + + Open the module to use it, it defines only these modules in your + scope. *) + +(** Man pages. + + Man page generation is automatically handled by [Cmdliner], see + the {{!page-tool_man.manual}details}. The {!Manpage.block} type is + used to define a man page's content. It's a good idea to follow + the {{!Manpage.standard_sections}standard} manual page structure. + + {b References.} + {ul + {- [man-pages(7)], {{:http://man7.org/linux/man-pages/man7/man-pages.7.html} + {e Conventions for writing Linux man pages}}.}} *) +module Manpage : sig + + (** {1:man Man pages} *) + + type section_name = string + (** The type for section names (titles). See + {{!standard_sections}standard section names}. *) + + type block = + [ `S of section_name (** Start a new section with given name. *) + | `P of string (** Paragraph with given text. *) + | `Pre of string (** Preformatted paragraph with given text. *) + | `I of string * string (** Indented paragraph with given label and text. *) + | `Noblank (** Suppress blank line introduced between two blocks. *) + | `Blocks of block list (** Splice given blocks. *) ] + (** The type for a block of man page text. + + Except in [`Pre], whitespace and newlines are not significant + and are all collapsed to a single space. All block strings + support the {{!page-tool_man.doclang}documentation markup language}.*) + + val escape : string -> string + (** [escape s] escapes [s] so that it doesn't get interpreted by the + {{!page-tool_man.doclang}documentation markup language}. *) + + type title = string * int * string * string * string + (** The type for man page titles. Describes the man page + [title], [section], [center_footer], [left_footer], [center_header]. *) + + type t = title * block list + (** The type for a man page. A title and the page text as a list of blocks. *) + + type xref = + [ `Main (** Refer to the man page of the program itself. *) + | `Cmd of string (** Refer to the command [cmd] of the tool, which must + exist. *) + | `Tool of string (** Tool refer to the given command line tool. *) + | `Page of string * int (** Refer to the manpage [name(sec)]. *) ] + (** The type for man page cross-references. *) + + (** {1:standard_sections Standard section names and content} + + The following are standard man page section names, roughly ordered + in the order they conventionally appear. See also + {{:http://man7.org/linux/man-pages/man7/man-pages.7.html}[man man-pages]} + for more elaborations about what sections should contain. *) + + val s_name : section_name + (** The [NAME] section. This section is automatically created by + [Cmdliner] for your command. *) + + val s_synopsis : section_name + (** The [SYNOPSIS] section. By default this section is automatically + created by [Cmdliner] for your command, unless it is the first + section of your term's man page, in which case it will replace + it with yours. *) + + val s_description : section_name + (** The [DESCRIPTION] section. This should be a description of what + the tool does and provide a little bit of command line usage and + documentation guidance. *) + + val s_commands : section_name + (** The [COMMANDS] section. By default subcommands get listed here. *) + + val s_arguments : section_name + (** The [ARGUMENTS] section. By default positional arguments get + listed here. *) + + val s_options : section_name + (** The [OPTIONS] section. By default optional arguments get + listed here. *) + + val s_common_options : section_name + (** The [COMMON OPTIONS] section. By default help and version options get + listed here. For programs with multiple commands, optional arguments + common to all commands can be added here. *) + + val s_exit_status : section_name + (** The [EXIT STATUS] section. By default term status exit codes + get listed here. *) + + val s_environment : section_name + (** The [ENVIRONMENT] section. By default environment variables get + listed here. *) + + val s_environment_intro : block + (** [s_environment_intro] is the introduction content used by cmdliner + when it creates the {!s_environment} section. *) + + val s_files : section_name + (** The [FILES] section. *) + + val s_bugs : section_name + (** The [BUGS] section. *) + + val s_examples : section_name + (** The [EXAMPLES] section. *) + + val s_authors : section_name + (** The [AUTHORS] section. *) + + val s_see_also : section_name + (** The [SEE ALSO] section. *) + + val s_none : section_name + (** [s_none] is a special section named ["cmdliner-none"] that can be used + whenever you do not want something to be listed. *) + + (** {1:output Output} + + The {!print} function can be useful if the client wants to define + other man pages (e.g. to implement a help command). *) + + type format = + [ `Auto (** Format like [`Pager] or [`Plain] whenever the [TERM] + environment variable is [dumb] or unset. *) + | `Pager (** {{!page-cli.help}Tries} to use a pager or falls back + to [`Plain]. *) + | `Plain (** Format to plain text. *) + | `Groff (** Format to groff commands. *) ] + (** The type for man page output specification. *) + + val print : + ?env:(string -> string option) -> ?errs:Format.formatter -> + ?subst:(string -> string option) -> format -> Format.formatter -> t -> unit + (** [print ~env ~errs ~subst fmt ppf page] prints [page] on [ppf] in the + format [fmt]. + {ul + {- [env] is used to lookup environment for driving paging when the + format is [`Pager]. Defaults to {!Sys.getenv_opt}.} + {- [subst] can be used to perform variable + substitution (defaults to the identity).} + {- [errs] is used to print formatting errors, it defaults to + {!Format.err_formatter}.}} *) +end + +(** Terms. + + A term made of terms referring to {{!Arg.argterms}command line arguments} + implicitly defines a command line syntax fragment. Terms are associated + to command values {!Cmd.t} which are + {{!Cmd.section-eval}evaluated} to eventually produce an + {{!Cmd.Exit.code}exit code}. + + Nowadays terms are best defined using the {!Cmdliner.Term.Syntax}. + See examples in the {{!page-cookbook.blueprints}blueprints}. *) +module Term : sig + + (** {1:terms Terms} *) + + type +'a t + (** The type for terms evaluating to values of type ['a]. *) + + val const : 'a -> 'a t + (** [const v] is a term that evaluates to [v]. *) + + val app : ('a -> 'b) t -> 'a t -> 'b t + (** [app f v] is a term that evaluates to the result applying + the evaluation of [v] to the one of [f]. *) + + val map : ('a -> 'b) -> 'a t -> 'b t + (** [map f t] is [app (const f) t]. *) + + val product : 'a t -> 'b t -> ('a * 'b) t + (** [product t0 t1] is [app (app (map (fun x y -> (x, y)) t0) t1)] *) + + val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t + (** [f $ v] is {!app}[ f v]. *) + + (** [let] operators. + + See how to use them in the {{!page-cookbook.blueprints}blueprints}. *) + module Syntax : sig + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + (** [( let+ )] is {!map}. *) + + val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t + (** [( and+ )] is {!product}. *) + end + + (** {1 Interacting with {!Cmd.t} evaluation} + + These special terms allow to interact with the + {{!Cmd.section-eval_low}low-level evaluation process} performed + on commands. *) + + val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t + (** [term_result] is such that: + {ul + {- [term_result ~usage (Ok v)] {{!Cmd.eval_value}evaluates} + to [Ok (`Ok v)].} + {- [term_result ~usage (Error (`Msg e))] + {{!Cmd.eval_value}evaluates} to [Error `Term] with the error message + [e] and usage shown according to [usage] (defaults to [false])}} + + See also {!term_result'}. *) + + val term_result' : ?usage:bool -> ('a, string) result t -> 'a t + (** [term_result'] is like {!term_result} but with a [string] + error case. *) + + val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t + (** [cli_parse_result] is such that: + {ul + {- [cli_parse_result (Ok v)] {{!Cmd.eval_value}evaluates} + [Ok (`Ok v)).} + {- [cli_parse_result (Error (`Msg e))]] {{!Cmd.eval_value}evaluates} + [Error `Parse].}} + See also {!cli_parse_result'}. *) + + val cli_parse_result' : ('a, string) result t -> 'a t + (** [cli_parse_result'] is like {!cli_parse_result} but with a + [string] error case. *) + + val main_name : string t + (** [main_name] is a term that evaluates to the main command name; + that is the name of the tool. *) + + val choice_names : string list t + (** [choice_names] is a term that evaluates to the names of the commands + that are children of the main command. *) + + val with_used_args : 'a t -> ('a * string list) t + (** [with_used_args t] is a term that evaluates to [t] tupled + with the arguments from the command line that where used to + evaluate [t]. *) + + type 'a ret = + [ `Help of Manpage.format * string option + | `Error of (bool * string) + | `Ok of 'a ] + (** The type for command return values. See {!val-ret}. *) + + val ret : 'a ret t -> 'a t + (** [ret v] is a term whose evaluation depends on the case + to which [v] evaluates. With : + {ul + {- [`Ok v], it evaluates to [v].} + {- [`Error (usage, e)], the evaluation fails and [Cmdliner] prints + the error [e] and the term's usage if [usage] is [true].} + {- [`Help (format, name)], the evaluation fails and [Cmdliner] prints + a manpage in format [format]. If [name] is [None] this is the + the main command's manpage. If [name] is [Some c] this is + the man page of the subcommand [c] of the main command.}} *) + + val env : (string -> string option) t + (** [env] is the [env] argument given to {{!Cmd.section-eval}command + evaluation functions}. If you need to refine the environment + lookup done by Cmdliner's machinery you should use this rather + than direct calls to {!Sys.getenv_opt}. *) +end + +(** Commands. + + Command line syntaxes are implicitely defined by {!Term.t} + values. A command value binds a term and its documentation to a + command name. + + A command can group a list of subcommands (and recursively). In this + case your tool defines a tree of commands, each with its own command + line syntax. The root of that tree is called the {e main command}; + it represents your tool and its name. *) +module Cmd : sig + + (** {1:info Command information} + + Command information defines the name and documentation of a command. *) + + (** Exit codes and their information. *) + module Exit : sig + + (** {1:codes Exit codes} *) + + type code = int + (** The type for exit codes. + + {b Warning.} You should avoid status codes strictly greater than 125 + as those may be used by + {{:https://www.gnu.org/software/bash/manual/html_node/Exit-Status.html} + some} shells. *) + + (** {2:predefined Predefined codes} + + These are documented by {!defaults}. *) + + val ok : code + (** [ok] is [0], the exit status for success. *) + + val some_error : code + (** [some_error] is [123], an exit status for indiscriminate errors + reported on [stderr]. *) + + val cli_error : code + (** [cli_error] is [124], an exit status for command line parsing + errors. *) + + val internal_error : code + (** [internal_error] is [125], an exit status for unexpected internal + errors. *) + + (** {1:info Exit code information} *) + + type info + (** The type for exit code information. *) + + val info : + ?docs:Manpage.section_name -> ?doc:string -> ?max:code -> code -> info + (** [info ~docs ~doc min ~max] describe the range of exit + statuses from [min] to [max] (defaults to [min]). + {ul + {- [doc] is the man page information for the statuses, + defaults to ["undocumented"]. The + {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(status)], the value of [min].} + {- [$(status_max)], the value of [max].} + {- The variables mentioned in the documentation of + {!Cmd.val-info}}}} + {- [docs] is the title of the man page section in which the statuses + will be listed, it defaults to {!Manpage.s_exit_status}.}} *) + + val info_code : info -> code + (** [info_code i] is the minimal code of [i]. *) + + val defaults : info list + (** [defaults] are exit code information for {!ok}, {!some_error}, + {!cli_error} and {!internal_error}. *) + end + + (** Environment variable and their information. *) + module Env : sig + + (** {1:envvars Environment variables} *) + + type var = string + (** The type for environment variable names. *) + + (** {1:info Environment variable information} *) + + type info + (** The type for environment variable information. *) + + val info : + ?deprecated:string -> ?docs:Manpage.section_name -> ?doc:string -> var -> + info + (** [info ~docs ~doc var] describes an environment variable + [var] such that: + {ul + {- [doc] is the man page information of the environment + variable, defaults to ["See option $(opt)."].} + {- [docs] is the title of the man page section in which the environment + variable will be listed, it defaults to + {!Cmdliner.Manpage.s_environment}.} + {- [deprecated], if specified the environment variable is + deprecated. Use of the variable warns on dep[stderr] This + message which should be a capitalized sentence is + preprended to [doc] and output on standard error when the + environment variable ends up being used.}} + + In [doc] and [deprecated] the {{!page-tool_man.doclang}documentation + markup language} can be used with following variables: + + {ul + {- [$(opt)], if any the option name of the argument the variable is + looked up for.} + {- [$(env)], the value of [var].} + {- The variables mentioned in the doc string of {!Cmd.val-info}.}} *) + + val info_var : info -> var + (** [info_var info] is the variable described by [info]. *) + end + + type info + (** The type for information about commands. *) + + val info : + ?deprecated:string -> ?man_xrefs:Manpage.xref list -> + ?man:Manpage.block list -> ?envs:Env.info list -> ?exits:Exit.info list -> + ?sdocs:Manpage.section_name -> ?docs:Manpage.section_name -> ?doc:string -> + ?version:string -> string -> info + (** [info ?sdocs ?man ?docs ?doc ?version name] is a term information + such that: + {ul + {- [name] is the name of the command.} + {- [version] is the version string of the command line tool, this + is only relevant for the main command and ignored otherwise.} + {- [deprecated], if specified the command is deprecated. Use of the + variable warns on [stderr]. This + message which should be a capitalized sentence is + preprended to [doc] and output on standard error when the + environment variable ends up being used.} + {- [doc] is a one line description of the command used + for the [NAME] section of the command's man page and in command + group listings.} + {- [docs], for commands that are part of a group, the title of the + section of the parent's command man page where it should be listed + (defaults to {!Manpage.s_commands}).} + {- [sdocs] defines the title of the section in which the + standard [--help] and [--version] arguments are listed + (defaults to {!Manpage.s_common_options}).} + {- [exits] is a list of exit statuses that the command evaluation + may produce, defaults to {!Exit.defaults}.} + {- [envs] is a list of environment variables that influence + the command's evaluation.} + {- [man] is the text of the man page for the command.} + {- [man_xrefs] are cross-references to other manual pages. These + are used to generate a {!Manpage.s_see_also} section.}} + + [doc], [deprecated], [man], [envs], [exits] support the + {{!page-tool_man.doclang} documentation markup language} in which the + following variables are recognized: + + {ul + {- [$(tool)] the main, topmost, command name.} + {- [$(cmd)] the command invocation from main command to the + command name.} + {- [$(cmd.name)] the command's name.} + {- [$(cmd.parent)] the command's parent or the main command if none.}} + + Previously some of these names were refered to as [$(tname)], + [$(mname)] and [$(iname)], they still work but do not use them, + they are obscure. *) + + + (** {1:cmds Commands} *) + + type 'a t + (** The type for commands whose evaluation result in a value of + type ['a]. *) + + val make : info -> 'a Term.t -> 'a t + (** [make i t] is a command with information [i] and command line syntax + parsed by [t]. *) + + val v : info -> 'a Term.t -> 'a t + (** [v] is an old name for {!make} which should be preferred. *) + + val group : ?default:'a Term.t -> info -> 'a t list -> 'a t + (** [group i ?default cmds] is a command with information [i] that + groups subcommands [cmds]. [default] is the command line syntax + to parse if no subcommand is specified on the command line. If + [default] is [None] (default), the tool errors when no subcommand + is specified. *) + + val name : 'a t -> string + (** [name c] is the name of [c]. *) + + (** {1:eval Evaluation} + + Read {!page-cookbook.cmds_which_eval} in the cookbook if you + struggle to choose between this menagerie of evaluation + functions. + + These functions are meant to be composed with {!Stdlib.exit}. + The following exit codes may be returned by all these functions: + {ul + {- {!Exit.cli_error} if a parse error occurs.} + {- {!Exit.internal_error} if the [~catch] argument is [true] (default) + and an uncaught exception is raised.} + {- The value of [~term_err] (defaults to {!Exit.cli_error}) if + a term error occurs.}} + + These exit codes are described in {!Exit.defaults} which is the + default value of the [?exits] argument of the function {!val-info}. *) + + val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> unit t -> Exit.code + (** [eval cmd] is {!Exit.ok} if [cmd] evaluates to [()]. + See {!eval_value} for other arguments. *) + + val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> Exit.code t -> Exit.code + (** [eval' cmd] is [c] if [cmd] evaluates to the exit code [c]. + See {!eval_value} for other arguments. *) + + val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (unit, string) result t -> Exit.code + (** [eval_result cmd] is: + {ul + {- {!Exit.ok} if [cmd] evaluates to [Ok ()].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (Exit.code, string) result t -> Exit.code + (** [eval_result' cmd] is: + {ul + {- [c] if [cmd] evaluates to [Ok c].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + (** {2:eval_low Low level evaluation} + + This interface gives more information on command evaluation results + and lets you choose how to map evaluation results to exit codes. + All evaluation functions are wrappers around {!eval_value}. *) + + type 'a eval_ok = + [ `Ok of 'a (** The term of the command evaluated to this value. *) + | `Version (** The version of the main cmd was requested. *) + | `Help (** Help was requested. *) ] + (** The type for successful evaluation results. *) + + type eval_error = + [ `Parse (** A parse error occurred. *) + | `Term (** A term evaluation error occurred. *) + | `Exn (** An uncaught exception occurred. *) ] + (** The type for erroring evaluation results. *) + + val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a t -> + ('a eval_ok, eval_error) result + (** [eval ~help ~err ~catch ~env ~argv cmd] is the evaluation result + of [cmd] with: + {ul + {- [argv] the command line arguments to parse (defaults to {!Sys.argv})} + {- [env] the function used for environment variable lookup (defaults + to {!Sys.getenv}).} + {- [catch] if [true] (default) uncaught exceptions + are intercepted and their stack trace is written to the [err] + formatter} + {- [help] is the formatter used to print help, version messages + or completions, (defaults to {!Format.std_formatter}). Note + that the completion protocol needs to output ['\n'] line ending, + if you are outputing to a channel make sure it is in binary + mode to avoid newline translation (this is done automatically + before completion when [help] is {!Format.std_formatter}).} + {- [err] is the formatter used to print error messages + (defaults to {!Format.err_formatter}).}} *) + + type 'a eval_exit = + [ `Ok of 'a (** The term of the command evaluated to this value. *) + | `Exit of Exit.code (** The evaluation wants to exit with this code. *) ] + (** The type for evaluation exits. *) + + val eval_value' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> ?term_err:int -> + 'a t -> 'a eval_exit + (** [eval_value'] is like {!eval_value}, but if the command term + does not evaluate to [Ok (`Ok v)], returns an exit code like the + higher-level {{!val-eval}evaluation} functions do (which can be + {!Exit.ok} in case help or version was requested). *) + + val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Term.t -> + 'a option * ('a eval_ok, eval_error) result + (** {b WARNING.} You are highly encouraged not to use this + function it may be removed in the future. + + [eval_peek_opts version_opt argv t] evaluates [t], a term made + of optional arguments only, with the command line [argv] + (defaults to {!Sys.argv}). In this evaluation, unknown optional + arguments and positional arguments are ignored. + + The evaluation returns a pair. The first component is + the result of parsing the command line [argv] stripped from + any help and version option if [version_opt] is [true] (defaults + to [false]). It results in: + {ul + {- [Some _] if the command line would be parsed correctly given the + {e partial} knowledge in [t].} + {- [None] if a parse error would occur on the options of [t]}} + + The second component is the result of parsing the command line + [argv] without stripping the help and version options. It + indicates what the evaluation would result in on [argv] given + the partial knowledge in [t] (for example it would return + [`Help] if there's a help option in [argv]). However in + contrasts to {!val-eval_value} no side effects like error + reporting or help output occurs. + + {b Note.} Positional arguments can't be peeked without the full + specification of the command line: we can't tell apart a + positional argument from the value of an unknown optional + argument. *) +end + +(** Terms for command line arguments. + + This module provides functions to define terms that evaluate + to the arguments provided on the command line. + + Basic constraints, like the argument type or repeatability, are + specified by defining a value of type {!Arg.t}. Further constraints can + be specified during the {{!Arg.argterms}conversion} to a term. *) +module Arg : sig + + (** {1:argconv Argument converters} *) + + (** Argument completion. + + This module provides a type to describe how positional and + optional argument values of {{!Arg.type-conv}argument + converters} can be completed. It defines which completion + directives from the {{!page-cli.completion_protocol}protocol} + get emitted by your tool for the argument. + + {b Note.} Subcommand and option name are completed + automatically by the library itself and + {{!Cmdliner.Arg.predef}prefined argument converters} already + have completions built-in whenever appropriate. *) + module Completion : sig + + (** {1:directives Completion directives} *) + + type 'a directive + (** The type for a completion directive for values of type ['a]. *) + + val value : ?doc:string -> 'a -> 'a directive + (** [value v ~doc] indicates that the token to complete could be + replaced by the value [v] as serialized by the argument's + formatter {!Conv.pp}. [doc] is ANSI styled UTF-8 text + documenting the value, defaults to [""]. *) + + val string : ?doc:string -> string -> 'a directive + (** [string s ~doc] indicates that the token to complete could be + replaced by the string [s]. [doc] is ANSI styled UTF-8 text + documenting the value, defaults to [""]. *) + + val files : 'a directive + (** [files] indicates that the token to complete could be replaced + with files that the shell deems suitable. *) + + val dirs : 'a directive + (** [dirs] indicates that the token to complete could be replaced with + directories that the shell deems suitable. *) + + val restart : 'a directive + (** [restart] indicates that the shell should restart the completion + after the positional disambiguation token [--]. + + This is typically used for tools that end-up invoking other + tools like [sudo -- TOOL [ARG]…]. For the latter a restart + completion should be added on all positional arguments. If + you allow [TOOL] to be only a restricted set of tools known to + your program you'd eschew [restart] on the first postional + argument but add it to the remaining ones. + + {b Warning.} A [restart] directive is eventually emited only + if the completion is requested after a [--] token. In this + case other completions returned alongside by {!func} are + ignored. Educate your users to use the [--], for example + mention them in {{!page-cookbook.manpage_synopsis}user defined + synopses}, it is good cli specification hygiene as it properly + delineates argument scopes. *) + + val message : string -> 'a directive + (** [message s] is a multi-line, ANSI styled, UTF-8 message reported + to end users. *) + + val raw : string -> 'a directive + (** [raw s] takes over the whole {{!page-cli.completion_protocol}protocol} + output (including subcommand and option name completion) with [s], + you are in charge. Any other directive in the result of {!func} + is ignored. + + {b Warning.} The protocol is unstable, it is not advised to + output it yourself. However this can be useful to invoke + another tool according to the protocol in the completion + function and treat its result as the requested completion. *) + + (** {1:completion Completion} *) + + type ('ctx, 'a) func = + 'ctx option -> token:string -> ('a directive list, string) result + (** The type for completion functions. + + Given an optional context determined from a partial command + line parse and a token to complete it returns a list of + completion directives or an error which is reported to + end-users by using a protocol {!message}. + + The context is [None] if no context was given to {!make} or if + the context failed to parse on the current command line. *) + + type 'a complete = + | Complete : 'ctx Term.t option * ('ctx, 'a) func -> 'a complete (** *) + (** The type for completing. + + A completion context specification which captures a partial + command line parse (for example the path to a configuration + file) and a completion function. *) + + type 'a t + (** The type for completing values parsed into values of type ['a]. *) + + val make : ?context:'ctx Term.t -> ('ctx, 'a) func -> 'a t + (** [make ~context func] uses [func] to complete. + + [context] defines a commmand line fragment that is evaluated + before performing the completion. It the evaluation is + successful the result is given to the completion + function. Otherwise [None] is given. + + {b Warning.} [context] must be part of the term of the command + in which you use the completion otherwise the context will + always be [None] in the function. *) + + val complete : 'a t -> 'a complete + (** [complete c] completes with [c]. *) + + val complete_files : 'a t + (** [complete_files] holds a context insensitive function that + always returns [Ok \[]{!files}[\]]. *) + + val complete_dirs : 'a t + (** [complete_dirs] holds a context insensitive function that + always returns [Ok \[]{!dirs}[\]]. *) + + val complete_paths : 'a t + (** [complete_paths] holds a context insensitive function that + always returns [Ok \[]{!files}[;]{!dirs}[\]]. *) + + val complete_restart : 'a t + (** [complete_dirs] holds a context insensitive function that + always returns [Ok \[]{!restart}[\]]. *) + end + + (** Argument converters. + + An argument converter transforms a string argument of the command + line to an OCaml value. {{!converters}Predefined converters} + are provided for many types of the standard library. *) + module Conv : sig + + (** {1:converters Converters} *) + + type 'a parser = string -> ('a, string) result + (** The type for parsing arguments to values of type ['a]. *) + + type 'a fmt = Format.formatter -> 'a -> unit + (** The type for formatting values of type ['a]. *) + + type 'a t + (** The type for converting arguments to values of type ['a]. *) + + val make : + ?completion:'a Completion.t -> docv:string -> parser:'a parser -> + pp:'a fmt -> unit -> 'a t + (** [make ~docv ~parser ~pp ()] is an argument converter with + given properties. See corresponding accessors for semantics. *) + + val of_conv : + ?completion:'a Completion.t -> ?docv:string -> + ?parser:'a parser -> ?pp:'a fmt -> 'a t -> 'a t + (** [of_conv conv ()] is a new converter with given unspecified + properties defaulting to those of [conv]. *) + + (** {1:properties Properties} *) + + val docv : 'a t -> string + (** [docv c] is [c]'s documentation meta-variable. This value can + be refered to as [$(docv)] in the documentation strings of + arguments. It can be overriden by the {!val-info} value of an + argument. *) + + val parser : 'a t -> 'a parser + (** [parser c] is [c]'s argument parser. *) + + val pp : 'a t -> 'a fmt + (** [pp c] is [c]'s argument formatter. *) + + val completion : 'a t -> 'a Completion.t + (** [completion c] is [c]'s completion. *) + end + + type 'a conv = 'a Conv.t + (** The type for argument converters. See the + {{!predef}predefined converters}. *) + + val some' : ?none:'a -> 'a conv -> 'a option conv + (** [some' ?none c] is like the converter [c] except it returns + [Some] value. It is used for command line arguments that default + to [None] when absent. If provided, [none] is used with [c]'s + formatter to document the value taken on absence; to document + a more complex behaviour use the [absent] argument of {!val-info}. + If you cannot construct an ['a] value use {!some}. *) + + val some : ?none:string -> 'a conv -> 'a option conv + (** [some ?none c] is like [some'] but [none] is described as a + string that will be rendered in bold. Use the [absent] argument + of {!val-info} to document more complex behaviours. *) + + (** {1:arginfo Arguments} *) + + type 'a t + (** The type for arguments holding data of type ['a]. *) + + type info + (** The type for information about command line arguments. + + Argument information defines the man page information of an + argument and, for optional arguments, its names. An environment + variable can also be specified to read get the argument value from + if the argument is absent from the command line and the variable + is defined. *) + + val info : + ?deprecated:string -> ?absent:string -> ?docs:Manpage.section_name -> + ?doc_envs:Cmd.Env.info list -> ?docv:string -> ?doc:string -> + ?env:Cmd.Env.info -> string list -> info + (** [info docs docv doc env names] defines information for + an argument. + {ul + {- [names] defines the names under which an optional argument + can be referred to. Strings of length [1] like ["c"]) define + short option names ["-c"], longer strings like ["count"]) + define long option names ["--count"]. [names] must be empty + for positional arguments.} + {- [env] defines the name of an environment variable which is + looked up for defining the argument if it is absent from the + command line. See {{!page-cli.envlookup}environment variables} for + details.} + {- [doc] is the man page information of the argument. + {{!doc_helpers}These functions} can help with formatting argument + values.} + {- [docv] is for positional and non-flag optional arguments. + It is a variable name used in the man page to stand for their value. + If unspecified is taken from the argument converter's, see + {!Conv.docv}.} + {- [doc_envs] is a list of environment variable that are + added to the manual of the command when the argument is used.} + {- [docs] is the title of the man page section in which the argument + will be listed. For optional arguments this defaults + to {!Manpage.s_options}. For positional arguments this defaults + to {!Manpage.s_arguments}. However a positional argument is only + listed if it has both a [doc] and [docv] specified.} + {- [deprecated], if specified the argument is deprecated. Use of the + variable warns on [stderr]. This + message which should be a capitalized sentence is + preprended to [doc] and output on standard error when the + environment variable ends up being used.} + {- [absent], if specified a documentation string that indicates + what happens when the argument is absent. The document language + can be used like in [doc]. This overrides the automatic default + value rendering that is performed by the combinators.}} + + In [doc], [deprecated], [absent] the + {{!page-tool_man.doclang}documentation markup language} can be + used with following variables: + + {ul + {- ["$(docv)"] the value of [docv] (see below).} + {- ["$(opt)"], one of the options of [names], preference + is given to a long one.} + {- ["$(env)"], the environment var specified by [env] (if any).}} *) + + val ( & ) : ('a -> 'b) -> 'a -> 'b + (** [f & v] is [f v], a right associative composition operator for + specifying argument terms. *) + +(** {2:optargs Optional arguments} + + The {{!type-info}information} of an optional argument must have at least + one name or [Invalid_argument] is raised. *) + + val flag : info -> bool t + (** [flag i] is a [bool] argument defined by an optional flag + that may appear {e at most} once on the command line under one of + the names specified by [i]. The argument holds [true] if the + flag is present on the command line and [false] otherwise. *) + + val flag_all : info -> bool list t + (** [flag_all] is like {!flag} except the flag may appear more than + once. The argument holds a list that contains one [true] value per + occurrence of the flag. It holds the empty list if the flag + is absent from the command line. *) + + val vflag : 'a -> ('a * info) list -> 'a t + (** [vflag v \[v]{_0}[,i]{_0}[;…\]] is an ['a] argument defined + by an optional flag that may appear {e at most} once on + the command line under one of the names specified in the [i]{_k} + values. The argument holds [v] if the flag is absent from the + command line and the value [v]{_k} if the name under which it appears + is in [i]{_k}. + + {b Note.} Automatic environment variable lookup is unsupported for + for these arguments but an [env] in an info will be documented. + Use an option and {!Term.env} for manually looking something up. *) + + val vflag_all : 'a list -> ('a * info) list -> 'a list t + (** [vflag_all v l] is like {!vflag} except the flag may appear more + than once. The argument holds the list [v] if the flag is absent + from the command line. Otherwise it holds a list that contains one + corresponding value per occurrence of the flag, in the order found on + the command line. + + {b Note.} Automatic environment variable lookup is unsupported for + for these arguments but an [env] in an info will be documented. + Use an option and {!Term.env} for manually looking something up. *) + + val opt : ?vopt:'a -> 'a conv -> 'a -> info -> 'a t + (** [opt vopt c v i] is an ['a] argument defined by the value of + an optional argument that may appear {e at most} once on the command + line under one of the names specified by [i]. The argument holds + [v] if the option is absent from the command line. Otherwise + it has the value of the option as converted by [c]. + + If [vopt] is provided the value of the optional argument is + itself optional, taking the value [vopt] if unspecified on the + command line. {b Warning} using [vopt] is + {{!page-cookbook.tip_avoid_default_option_values}not + recommended}. *) + + val opt_all : ?vopt:'a -> 'a conv -> 'a list -> info -> 'a list t + (** [opt_all vopt c v i] is like {!opt} except the optional argument may + appear more than once. The argument holds a list that contains one value + per occurrence of the flag in the order found on the command line. + It holds the list [v] if the flag is absent from the command line. *) + + (** {2:posargs Positional arguments} + + The {{!type-info}information} of a positional argument must have no name + or [Invalid_argument] is raised. Positional arguments indexing + is zero-based. + + {b Warning.} The following combinators allow to specify and + extract a given positional argument with more than one term. + This should not be done as it will likely confuse end users and + documentation generation. These over-specifications may be + prevented by raising [Invalid_argument] in the future. But for now + it is the client's duty to make sure this doesn't happen. *) + + val pos : ?rev:bool -> int -> 'a conv -> 'a -> info -> 'a t + (** [pos rev n c v i] is an ['a] argument defined by the [n]th + positional argument of the command line as converted by [c]. + If the positional argument is absent from the command line + the argument is [v]. + + If [rev] is [true] (defaults to [false]), the computed + position is [max-n] where [max] is the position of + the last positional argument present on the command line. *) + + val pos_all : 'a conv -> 'a list -> info -> 'a list t + (** [pos_all c v i] is an ['a list] argument that holds + all the positional arguments of the command line as converted + by [c] or [v] if there are none. *) + + val pos_left : + ?rev:bool -> int -> 'a conv -> 'a list -> info -> 'a list t + (** [pos_left rev n c v i] is an ['a list] argument that holds + all the positional arguments as converted by [c] found on the left + of the [n]th positional argument or [v] if there are none. + + If [rev] is [true] (defaults to [false]), the computed + position is [max-n] where [max] is the position of + the last positional argument present on the command line. *) + + val pos_right : + ?rev:bool -> int -> 'a conv -> 'a list -> info -> 'a list t + (** [pos_right] is like {!pos_left} except it holds all the positional + arguments found on the right of the specified positional argument. *) + + (** {2:argterms Converting to terms} *) + + val value : 'a t -> 'a Term.t + (** [value a] is a term that evaluates to [a]'s value. *) + + val required : 'a option t -> 'a Term.t + (** [required a] is a term that fails if [a]'s value is [None] and + evaluates to the value of [Some] otherwise. Use this in combination + with {!Arg.some'} for required + positional arguments. {b Warning} using this on optional arguments + is {{!page-cookbook.tip_avoid_required_opt}not recommended}. *) + + val non_empty : 'a list t -> 'a list Term.t + (** [non_empty a] is term that fails if [a]'s list is empty and + evaluates to [a]'s list otherwise. Use this for non empty lists + of positional arguments. *) + + val last : 'a list t -> 'a Term.t + (** [last a] is a term that fails if [a]'s list is empty and evaluates + to the value of the last element of the list otherwise. Use this + for lists of flags or options where the last occurrence takes precedence + over the others. *) + + (** {2:predef Predefined arguments} *) + + val man_format : Manpage.format Term.t + (** [man_format] is a term that defines a [--man-format] option and + evaluates to a value that can be used with {!Manpage.print}. *) + + (** {1:converters Predefined converters} *) + + val bool : bool conv + (** [bool] converts values with {!bool_of_string}. *) + + val char : char conv + (** [char] converts values by ensuring the argument has a single char. *) + + val int : int conv + (** [int] converts values with {!int_of_string}. *) + + val nativeint : nativeint conv + (** [nativeint] converts values with {!Nativeint.of_string}. *) + + val int32 : int32 conv + (** [int32] converts values with {!Int32.of_string}. *) + + val int64 : int64 conv + (** [int64] converts values with {!Int64.of_string}. *) + + val float : float conv + (** [float] converts values with {!float_of_string}. *) + + val string : string conv + (** [string] converts values with the identity function. *) + + val enum : ?docv:string -> (string * 'a) list -> 'a conv + (** [enum l p] converts values such that string names in [l] map to + the corresponding value of type ['a]. [docv] is the converter's + documentation meta-variable, it defaults to [ENUM]. A + {{!Completion.make}completion} is added for the names. + + {b Warning.} The type ['a] must be comparable with {!Stdlib.compare}. + + @raise Invalid_argument if [l] is empty. *) + + val list : ?sep:char -> 'a conv -> 'a list conv + (** [list sep c] splits the argument at each [sep] (defaults to [',']) + character and converts each substrings with [c]. *) + + val array : ?sep:char -> 'a conv -> 'a array conv + (** [array sep c] splits the argument at each [sep] (defaults to [',']) + character and converts each substring with [c]. *) + + val pair : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv + (** [pair sep c0 c1] splits the argument at the {e first} [sep] character + (defaults to [',']) and respectively converts the substrings with + [c0] and [c1]. *) + + val t2 : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv + (** {!t2} is {!pair}. *) + + val t3 : ?sep:char -> 'a conv ->'b conv -> 'c conv -> ('a * 'b * 'c) conv + (** [t3 sep c0 c1 c2] splits the argument at the {e first} two [sep] + characters (defaults to [',']) and respectively converts the + substrings with [c0], [c1] and [c2]. *) + + val t4 : + ?sep:char -> 'a conv -> 'b conv -> 'c conv -> 'd conv -> + ('a * 'b * 'c * 'd) conv + (** [t4 sep c0 c1 c2 c3] splits the argument at the {e first} three [sep] + characters (defaults to [',']) respectively converts the substrings + with [c0], [c1], [c2] and [c3]. *) + + (** {2:files Files and directories} *) + + val path : string conv + (** [path] is like {!string} but prints using {!Filename.quote} + and completes both files and directories. *) + + val filepath : string conv + (** [filepath] is like {!string} but prints using {!Filename.quote} + and completes files. *) + + val dirpath : string conv + (** [dirpath] is like {!string} but prints using {!Filename.quote} + and completes directories. *) + + (** {b Note.} The following converters report errors whenever the + requested file system object does not exist. This is only mildly + useful since nothing guarantees they will still exist at the + time you act upon them. So you will have to treat these error + cases anyways in your tool function. It is also unhelpful if the file + system object may be created by your tool. Rather use + {!filepath} and {!dirpath}. *) + + val file : string conv + (** [file] converts a value with the identity function and checks + with {!Sys.file_exists} that a file with that name exists. The + string ["-"] is parsed without checking: it represents [stdio]. + It completes both files directories. *) + + val dir : string conv + (** [dir] converts a value with the identity function and checks + with {!Sys.file_exists} and {!Sys.is_directory} that a directory + with that name exists. It completes directories. *) + + val non_dir_file : string conv + (** [non_dir_file] converts a value with the identity function and + checks with {!Sys.file_exists} and {!Sys.is_directory} that a + non directory file with that name exists. The string ["-"] is + parsed without checking it represents [stdio]. It completes + files. *) + + (** {1:doc_helpers Documentation formatting helpers} *) + + val doc_quote : string -> string + (** [doc_quote s] quotes the string [s]. *) + + val doc_alts : ?quoted:bool -> string list -> string + (** [doc_alts alts] documents the alternative tokens [alts] + according the number of alternatives. If [quoted] is: + {ul + {- [None], the tokens are enclosed in manpage markup directives + to render them in bold (manpage convention).} + {- [Some true], the tokens are quoted with {!doc_quote}.} + {- [Some false], the tokens are written as is}} + The resulting string can be used in sentences of + the form ["$(docv) must be %s"]. + + @raise Invalid_argument if [alts] is the empty list. *) + + val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string + (** [doc_alts_enum quoted alts] is [doc_alts quoted (List.map fst alts)]. *) + + (** {1:deprecated Deprecated} + + These identifiers are silently deprecated. For now there is no + plan to remove them. But you should prefer to use the {!Conv} + interface in new code. *) + + type 'a printer = 'a Conv.fmt + (** Deprecated. Use {!Conv.fmt}. *) + + val conv' : ?docv:string -> 'a Conv.parser * 'a Conv.fmt -> 'a conv + (** Deprecated. Use {!Conv.make} instead. *) + + val conv : + ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a Conv.fmt -> + 'a conv + (** Deprecated. Use {!Conv.make} instead. *) + + val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) + (** Deprecated. Use {!Conv.val-parser}. *) + + val conv_printer : 'a conv -> 'a Conv.fmt + (** Deprecated. Use {!Conv.val-pp}. *) + + val conv_docv : 'a conv -> string + (** Deprecated. Use {!Conv.val-docv}. *) + + val parser_of_kind_of_string : + kind:string -> (string -> 'a option) -> + (string -> ('a, [`Msg of string]) result) + (** Deprecated. [parser_of_kind_of_string ~kind kind_of_string] is an argument + parser using the [kind_of_string] function for parsing and [kind] + to report errors (e.g. could be ["an integer"] for an [int] parser.). *) +end diff --git a/unikernel/duniverse/cmdliner/src/cmdliner.mllib b/unikernel/duniverse/cmdliner/src/cmdliner.mllib new file mode 100644 index 00000000..05a2134f --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner.mllib @@ -0,0 +1,12 @@ +Cmdliner_trie +Cmdliner_base +Cmdliner_manpage +Cmdliner_def +Cmdliner_docgen +Cmdliner_msg +Cmdliner_cline +Cmdliner_arg +Cmdliner_term +Cmdliner_cmd +Cmdliner_eval +Cmdliner diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_arg.ml b/unikernel/duniverse/cmdliner/src/cmdliner_arg.ml new file mode 100644 index 00000000..9d7e79a3 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_arg.ml @@ -0,0 +1,625 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let rev_compare n0 n1 = compare n1 n0 + +(* Documentation formatting helpers *) + +module Fmt = Cmdliner_base.Fmt + +let doc_quote = Cmdliner_base.quote +let doc_alts = Cmdliner_base.alts_str +let doc_alts_enum ?quoted enum = doc_alts ?quoted (List.map fst enum) +let str_of_pp pp v = pp Format.str_formatter v; Format.flush_str_formatter () + +(* Invalid_argument strings *) + +let err_not_opt = "Option argument without name" +let err_not_pos = "Positional argument with a name" +let err_incomplete_enum ss = + Printf.sprintf + "Arg.enum: missing printable string for a value, other strings are: %s" + (String.concat ", " ss) + +(* Parse error strings *) + +let err_no kind s = Fmt.str "no %a %s" Fmt.code_or_quote s kind +let err_not_dir s = + Fmt.str "%a %a" Fmt.code_or_quote s Fmt.ereason "is not a directory" + +let err_is_dir s = + Fmt.str "%a %a" Fmt.code_or_quote s Fmt.ereason "is a directory" + +let err_element kind s exp = + Fmt.str "%a element in %s (%a): %s" + Fmt.invalid () kind Fmt.code_or_quote s exp + +let err_invalid kind s exp = + Fmt.str "@[%a %s %a, %s@]" Fmt.invalid () kind Fmt.code_or_quote s exp + +let err_invalid_val = err_invalid "value" +let err_sep_miss sep s = + err_invalid_val s (Fmt.str "%a a '%c' separator" Fmt.missing () sep) + +let err_invalid_enum var s enums = + let pp_docv ppf var = + if not (var = "ENUM" || var = "") then Fmt.pf ppf "%a " Fmt.code_var var + in + Fmt.str "@[%a@ %avalue %a, expected@ %a@]" Fmt.invalid () pp_docv var + Fmt.code_or_quote s Cmdliner_base.pp_alts enums + +(* Argument converters *) + +module Completion = Cmdliner_def.Arg_completion +module Conv = Cmdliner_def.Arg_conv +type 'a conv = 'a Conv.t +let some = Cmdliner_def.Arg_conv.some +let some' = Cmdliner_def.Arg_conv.some' +let none = Cmdliner_def.Arg_conv.none + +(* Argument information *) + +type 'a t = 'a Cmdliner_term.t +type info = Cmdliner_def.Arg_info.t +let info = Cmdliner_def.Arg_info.make + +(* Arguments *) + +let ( & ) f x = f x +let parse_error e = Error (`Parse e) + +let env_bool_parse s = match String.lowercase_ascii s with +| "" | "false" | "no" | "n" | "0" -> Ok false +| "true" | "yes" | "y" | "1" -> Ok true +| s -> + let alts = doc_alts ~quoted:true ["true"; "yes"; "false"; "no" ] in + Error (err_invalid_val s alts) + +let parse_to_list parser s = match parser s with +| Ok v -> Ok [v] | Error _ as e -> e + +let try_env ei a parse ~absent = match Cmdliner_def.Arg_info.env a with +| None -> Ok absent +| Some env -> + let var = Cmdliner_def.Env.info_var env in + match Cmdliner_def.Eval.env_var ei var with + | None -> Ok absent + | Some v -> + match parse v with + | Error e -> parse_error (Cmdliner_msg.err_env_parse env ~err:e) + | Ok _ as v -> v + +let arg_to_args a complete = Cmdliner_def.Arg_info.Set.singleton a complete +let list_to_args f l complete = + let add acc v = Cmdliner_def.Arg_info.Set.add (f v) complete acc in + List.fold_left add Cmdliner_def.Arg_info.Set.empty l + +let flag a = + if Cmdliner_def.Arg_info.is_pos a then invalid_arg err_not_opt else + let convert ei cl = match Cmdliner_def.Cline.get_opt_arg cl a with + | [] -> try_env ei a env_bool_parse ~absent:false + | [_, _, None] -> Ok true + | [_, f, Some v] -> parse_error (Cmdliner_msg.err_flag_value f v) + | (_, f, _) :: (_ ,g, _) :: _ -> + parse_error (Cmdliner_msg.err_opt_repeated f g) + in + Cmdliner_term.make (arg_to_args a (Conv none)) convert + +let flag_all a = + if Cmdliner_def.Arg_info.is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_def.Arg_info.make_all_opts a in + let convert ei cl = match Cmdliner_def.Cline.get_opt_arg cl a with + | [] -> try_env ei a (parse_to_list env_bool_parse) ~absent:[] + | l -> + try + let truth (_, f, v) = match v with + | None -> true + | Some v -> failwith (Cmdliner_msg.err_flag_value f v) + in + Ok (List.rev_map truth l) + with Failure e -> parse_error e + in + Cmdliner_term.make (arg_to_args a (Conv none)) convert + +let vflag v l = + let convert _ cl = + let rec aux fv = function + | (v, a) :: rest -> + begin match Cmdliner_def.Cline.get_opt_arg cl a with + | [] -> aux fv rest + | [_, f, None] -> + begin match fv with + | None -> aux (Some (f, v)) rest + | Some (g, _) -> failwith (Cmdliner_msg.err_opt_repeated g f) + end + | [_, f, Some v] -> failwith (Cmdliner_msg.err_flag_value f v) + | (_, f, _) :: (_, g, _) :: _ -> + failwith (Cmdliner_msg.err_opt_repeated g f) + end + | [] -> match fv with None -> v | Some (_, v) -> v + in + try Ok (aux None l) with Failure e -> parse_error e + in + let flag (_, a) = + if Cmdliner_def.Arg_info.is_pos a then invalid_arg err_not_opt else a + in + Cmdliner_term.make (list_to_args flag l (Conv none)) convert + +let vflag_all v l = + let convert _ cl = + let rec aux acc = function + | (fv, a) :: rest -> + begin match Cmdliner_def.Cline.get_opt_arg cl a with + | [] -> aux acc rest + | l -> + let fval (k, f, v) = match v with + | None -> (k, fv) + | Some v -> failwith (Cmdliner_msg.err_flag_value f v) + in + aux (List.rev_append (List.rev_map fval l) acc) rest + end + | [] -> + if acc = [] then v else List.rev_map snd (List.sort rev_compare acc) + in + try Ok (aux [] l) with Failure e -> parse_error e + in + let flag (_, a) = + if Cmdliner_def.Arg_info.is_pos a then invalid_arg err_not_opt else + Cmdliner_def.Arg_info.make_all_opts a + in + Cmdliner_term.make (list_to_args flag l (Conv none)) convert + +let parse_opt_value parse f v = match parse v with +| Ok v -> v | Error err -> failwith (Cmdliner_msg.err_opt_parse f ~err) + +let opt ?vopt conv v a = + if Cmdliner_def.Arg_info.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_def.Arg_info.absent a with + | Cmdliner_def.Arg_info.Doc d as a when d <> "" -> a + | _ -> Cmdliner_def.Arg_info.Val (lazy (str_of_pp (Conv.pp conv) v)) + in + let kind = match vopt with + | None -> Cmdliner_def.Arg_info.Opt + | Some dv -> Cmdliner_def.Arg_info.Opt_vopt (str_of_pp (Conv.pp conv) dv) + in + let docv = match Cmdliner_def.Arg_info.docv a with + | "" -> Conv.docv conv | docv -> docv + in + let a = Cmdliner_def.Arg_info.make_opt ~docv ~absent ~kind a in + let convert ei cl = match Cmdliner_def.Cline.get_opt_arg cl a with + | [] -> try_env ei a (Conv.parser conv) ~absent:v + | [_, f, Some v] -> + (try Ok (parse_opt_value (Conv.parser conv) f v) with + | Failure e -> parse_error e) + | [_, f, None] -> + begin match vopt with + | None -> parse_error (Cmdliner_msg.err_opt_value_missing f) + | Some optv -> Ok optv + end + | (_, f, _) :: (_, g, _) :: _ -> + parse_error (Cmdliner_msg.err_opt_repeated g f) + in + Cmdliner_term.make (arg_to_args a (Conv conv)) convert + +let opt_all ?vopt conv v a = + if Cmdliner_def.Arg_info.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_def.Arg_info.absent a with + | Cmdliner_def.Arg_info.Doc d as a when d <> "" -> a + | _ -> Cmdliner_def.Arg_info.Val (lazy "") + in + let kind = match vopt with + | None -> Cmdliner_def.Arg_info.Opt + | Some dv -> Cmdliner_def.Arg_info.Opt_vopt (str_of_pp (Conv.pp conv) dv) + in + let docv = match Cmdliner_def.Arg_info.docv a with + | "" -> Conv.docv conv | docv -> docv + in + let a = Cmdliner_def.Arg_info.make_opt_all ~docv ~absent ~kind a in + let convert ei cl = match Cmdliner_def.Cline.get_opt_arg cl a with + | [] -> try_env ei a (parse_to_list (Conv.parser conv)) ~absent:v + | l -> + let parse (k, f, v) = match v with + | Some v -> (k, parse_opt_value (Conv.parser conv) f v) + | None -> match vopt with + | None -> failwith (Cmdliner_msg.err_opt_value_missing f) + | Some dv -> (k, dv) + in + try Ok (List.rev_map snd + (List.sort rev_compare (List.rev_map parse l))) with + | Failure e -> parse_error e + in + Cmdliner_term.make (arg_to_args a (Conv conv)) convert + +(* Positional arguments *) + +let parse_pos_value parse a v = match parse v with +| Ok v -> v +| Error err -> failwith (Cmdliner_msg.err_pos_parse a ~err) + +let pos ?(rev = false) k conv v a = + if Cmdliner_def.Arg_info.is_opt a then invalid_arg err_not_pos else + let absent = match Cmdliner_def.Arg_info.absent a with + | Cmdliner_def.Arg_info.Doc d as a when d <> "" -> a + | _ -> Cmdliner_def.Arg_info.Val (lazy (str_of_pp (Conv.pp conv) v)) + in + let pos = Cmdliner_def.Arg_info.pos ~rev ~start:k ~len:(Some 1) in + let docv = match Cmdliner_def.Arg_info.docv a with + | "" -> Conv.docv conv | docv -> docv + in + let a = Cmdliner_def.Arg_info.make_pos_abs ~docv ~absent ~pos a in + let convert ei cl = match Cmdliner_def.Cline.get_pos_arg cl a with + | [] -> try_env ei a (Conv.parser conv) ~absent:v + | [v] -> + (try Ok (parse_pos_value (Conv.parser conv) a v) with + | Failure e -> parse_error e) + | _ -> assert false + in + Cmdliner_term.make (arg_to_args a (Conv conv)) convert + +let pos_list pos conv v a = + if Cmdliner_def.Arg_info.is_opt a then invalid_arg err_not_pos else + let docv = match Cmdliner_def.Arg_info.docv a with + | "" -> Conv.docv conv | docv -> docv + in + let a = Cmdliner_def.Arg_info.make_pos ~docv ~pos a in + let convert ei cl = match Cmdliner_def.Cline.get_pos_arg cl a with + | [] -> try_env ei a (parse_to_list (Conv.parser conv)) ~absent:v + | l -> + try Ok (List.rev (List.rev_map (parse_pos_value (Conv.parser conv) a) l)) + with + | Failure e -> parse_error e + in + Cmdliner_term.make (arg_to_args a (Conv conv)) convert + +let all = Cmdliner_def.Arg_info.pos ~rev:false ~start:0 ~len:None +let pos_all c v a = pos_list all c v a + +let pos_left ?(rev = false) k = + let start = if rev then k + 1 else 0 in + let len = if rev then None else Some k in + pos_list (Cmdliner_def.Arg_info.pos ~rev ~start ~len) + +let pos_right ?(rev = false) k = + let start = if rev then 0 else k + 1 in + let len = if rev then Some k else None in + pos_list (Cmdliner_def.Arg_info.pos ~rev ~start ~len) + +(* Arguments as terms *) + +let absent_error args = + let make_req a v acc = + let req_a = Cmdliner_def.Arg_info.make_req a in + Cmdliner_def.Arg_info.Set.add req_a v acc + in + Cmdliner_def.Arg_info.Set.fold make_req args Cmdliner_def.Arg_info.Set.empty + +let value a = a + +let err_arg_missing args = + parse_error @@ + Cmdliner_msg.err_arg_missing (fst (Cmdliner_def.Arg_info.Set.choose args)) + +let required t = + let args = absent_error (Cmdliner_term.argset t) in + let convert ei cl = match (Cmdliner_term.parser t) ei cl with + | Ok (Some v) -> Ok v + | Ok None -> err_arg_missing args + | Error _ as e -> e + in + Cmdliner_term.make args convert + +let non_empty t = + let args = absent_error (Cmdliner_term.argset t) in + let convert ei cl = match (Cmdliner_term.parser t) ei cl with + | Ok [] -> err_arg_missing args + | Ok l -> Ok l + | Error _ as e -> e + in + Cmdliner_term.make args convert + +let last t = + let convert ei cl = match (Cmdliner_term.parser t) ei cl with + | Ok [] -> err_arg_missing (Cmdliner_term.argset t) + | Ok l -> Ok (List.hd (List.rev l)) + | Error _ as e -> e + in + Cmdliner_term.make (Cmdliner_term.argset t) convert + +(* Predefined converters. *) + +let add_prefix_completion ~token name = + if Cmdliner_base.string_starts_with ~prefix:token name + then Some (Completion.string name) else None + +let bool = + let alts = ["true"; "false"] in + let parser s = try Ok (bool_of_string s) with + | Invalid_argument _ -> Error (err_invalid_enum "" s alts) + in + let completion = + let func _ctx ~token = + Ok (List.filter_map (add_prefix_completion ~token) alts) + in + Completion.make func + in + Conv.make ~docv:"BOOL" ~parser ~pp:Format.pp_print_bool ~completion () + +let char = + let parser s = match String.length s = 1 with + | true -> Ok s.[0] + | false -> Error (err_invalid_val s "expected a character") + in + Conv.make ~docv:"CHAR" ~parser ~pp:Fmt.char () + +let parse_with t_of_str exp s = + try Ok (t_of_str s) with Failure _ -> Error (err_invalid_val s exp) + +let int = + let parser = parse_with int_of_string "expected an integer" in + Conv.make ~docv:"INT" ~parser ~pp:Format.pp_print_int () + +let int32 = + let parser = parse_with Int32.of_string "expected a 32-bit integer" in + let pp ppf = Fmt.pf ppf "%ld" in + Conv.make ~docv:"INT32" ~parser ~pp () + +let int64 = + let parser = parse_with Int64.of_string "expected a 64-bit integer" in + let pp ppf = Fmt.pf ppf "%Ld" in + Conv.make ~docv:"INT64" ~parser ~pp () + +let nativeint = + let err = "expected a processor-native integer" in + let parser = parse_with Nativeint.of_string err in + let pp ppf = Fmt.pf ppf "%nd" in + Conv.make ~docv:"NATIVEINT" ~parser ~pp () + +let float = + let parser = parse_with float_of_string "expected a floating point number" in + Conv.make ~docv:"DOUBLE" ~parser ~pp:Format.pp_print_float () + +let string = Conv.make ~docv:"" ~parser:Result.ok ~pp:Fmt.string () + +let enum ?(docv = "ENUM") sl = + if sl = [] then invalid_arg Cmdliner_base.err_empty_list else + let t = Cmdliner_trie.of_list sl in + let parser s = + let legacy_prefixes = Cmdliner_trie.legacy_prefixes ~env:Sys.getenv_opt in + match Cmdliner_trie.find ~legacy_prefixes t s with + | Ok _ as v -> v + | Error `Ambiguous (* Only on legacy prefixes *) -> + let ambs = List.sort compare (Cmdliner_trie.ambiguities t s) in + Error (Cmdliner_base.err_ambiguous ~kind:"enum value" s ~ambs) + | Error `Not_found -> + let alts = List.rev (List.rev_map (fun (s, _) -> s) sl) in + Error (err_invalid_enum docv s alts) + in + let pp ppf v = + let sl_inv = List.rev_map (fun (s,v) -> (v,s)) sl in + try Fmt.string ppf (List.assoc v sl_inv) + with Not_found -> invalid_arg (err_incomplete_enum (List.map fst sl)) + in + let completion = + let func _ctx ~token = + Ok (List.filter_map (fun (n, _) -> add_prefix_completion ~token n) sl) + in + Completion.make func + in + Conv.make ~docv ~parser ~pp ~completion () + +let path = + let parser s = Ok s in + let pp ppf s = Fmt.string ppf (Filename.quote s) in + let completion = Completion.complete_paths in + Conv.make ~docv:"PATH" ~parser ~pp ~completion () + +let filepath = + let parser s = Ok s in + let pp ppf s = Fmt.string ppf (Filename.quote s) in + let completion = Completion.complete_files in + Conv.make ~docv:"FILE" ~parser ~pp ~completion () + +let dirpath = + let parser s = Ok s in + let pp ppf s = Fmt.string ppf (Filename.quote s) in + let completion = Completion.complete_dirs in + Conv.make ~docv:"DIR" ~parser ~pp ~completion () + +let file = + let parser s = + if s = "-" then Ok s else + if Sys.file_exists s then Ok s else + Error (err_no "file or directory" s) + in + let completion = Completion.complete_files in + Conv.make ~docv:"PATH" ~parser ~pp:Fmt.string ~completion () + +let dir = + let parser s = + if Sys.file_exists s + then (if Sys.is_directory s then Ok s else Error (err_not_dir s)) + else Error (err_no "directory" s) + in + let completion = Completion.complete_dirs in + Conv.make ~docv:"DIR" ~parser ~pp:Fmt.string ~completion () + +let non_dir_file = + let parser s = + if s = "-" then Ok s else + if Sys.file_exists s + then (if not (Sys.is_directory s) then Ok s else Error (err_is_dir s)) + else Error (err_no "file" s) + in + let completion = Completion.complete_files in + Conv.make ~docv:"FILE" ~parser ~pp:Fmt.string ~completion () + +let split_and_parse sep parse s = (* raises [Failure] *) + let parse sub = match parse sub with + | Error e -> failwith e | Ok v -> v + in + let rec split accum j = + let i = try String.rindex_from s j sep with Not_found -> -1 in + if (i = -1) then + let p = String.sub s 0 (j + 1) in + if p <> "" then parse p :: accum else accum + else + let p = String.sub s (i + 1) (j - i) in + let accum' = if p <> "" then parse p :: accum else accum in + split accum' (i - 1) + in + split [] (String.length s - 1) + +let list ?(sep = ',') conv = + let parser s = try Ok (split_and_parse sep (Conv.parser conv) s) with + | Failure e -> Error (err_element "list" s e) + in + let rec pp ppf = function + | [] -> () + | v :: l -> + (Conv.pp conv) ppf v; if (l <> []) then (Fmt.char ppf sep; pp ppf l) + in + let docv = Printf.sprintf "%s[%c…]" (Conv.docv conv) sep in + Conv.make ~docv ~parser ~pp () + +let array ?(sep = ',') conv = + let parser s = + try Ok (Array.of_list (split_and_parse sep (Conv.parser conv) s)) with + | Failure e -> Error (err_element "array" s e) + in + let pp ppf v = + let max = Array.length v - 1 in + for i = 0 to max do + Conv.pp conv ppf v.(i); if i <> max then Fmt.char ppf sep + done + in + let docv = Printf.sprintf "%s[%c…]" (Conv.docv conv) sep in + Conv.make ~docv ~parser ~pp () + +let split_left sep s = + try + let i = String.index s sep in + let len = String.length s in + Some ((String.sub s 0 i), (String.sub s (i + 1) (len - i - 1))) + with Not_found -> None + +let pair ?(sep = ',') conv0 conv1 = + let parser s = match split_left sep s with + | None -> Error (err_sep_miss sep s) + | Some (v0, v1) -> + match (Conv.parser conv0) v0, (Conv.parser conv1) v1 with + | Ok v0, Ok v1 -> Ok (v0, v1) + | Error e, _ | _, Error e -> Error (err_element "pair" s e) + in + let pp ppf (v0, v1) = + Fmt.pf ppf "%a%c%a" (Conv.pp conv0) v0 sep (Conv.pp conv1) v1 + in + let docv = Printf.sprintf "%s%c%s" (Conv.docv conv0) sep (Conv.docv conv1) in + Conv.make ~docv ~parser ~pp () + +let t2 = pair +let t3 ?(sep = ',') conv0 conv1 conv2 = + let parser s = match split_left sep s with + | None -> Error (err_sep_miss sep s) + | Some (v0, s) -> + match split_left sep s with + | None -> Error (err_sep_miss sep s) + | Some (v1, v2) -> + match (Conv.parser conv0) v0, (Conv.parser conv1) v1, + (Conv.parser conv2) v2 with + | Ok v0, Ok v1, Ok v2 -> Ok (v0, v1, v2) + | Error e, _, _ | _, Error e, _ | _, _, Error e -> + Error (err_element "triple" s e) + in + let pp ppf (v0, v1, v2) = + let pp = Conv.pp in + Fmt.pf ppf "%a%c%a%c%a" (pp conv0) v0 sep (pp conv1) v1 sep (pp conv2) v2 + in + let docv = + let docv = Conv.docv in + Printf.sprintf "%s%c%s%c%s" (docv conv0) sep (docv conv1) sep (docv conv2) + in + Conv.make ~docv ~parser ~pp () + +let t4 ?(sep = ',') conv0 conv1 conv2 conv3 = + let parser s = match split_left sep s with + | None -> Error (err_sep_miss sep s) + | Some(v0, s) -> + match split_left sep s with + | None -> Error (err_sep_miss sep s) + | Some (v1, s) -> + match split_left sep s with + | None -> Error (err_sep_miss sep s) + | Some (v2, v3) -> + match (Conv.parser conv0) v0, (Conv.parser conv1) v1, + (Conv.parser conv2) v2, (Conv.parser conv3) v3 with + | Ok v1, Ok v2, Ok v3, Ok v4 -> Ok (v1, v2, v3, v4) + | Error e, _, _, _ | _, Error e, _, _ | _, _, Error e, _ + | _, _, _, Error e -> Error (err_element "quadruple" s e) + in + let pp ppf (v0, v1, v2, v3) = + let pp = Conv.pp in + Fmt.pf ppf "%a%c%a%c%a%c%a" (pp conv0) v0 sep (pp conv1) v1 sep (pp conv2) + v2 sep (pp conv3) v3 + in + let docv = + let docv = Conv.docv in + Printf.sprintf "%s%c%s%c%s%c%s" + (docv conv0) sep (docv conv1) sep (docv conv2) sep (docv conv3) + in + Conv.make ~docv ~parser ~pp () + +(* Predefined arguments *) + +let man_fmts = + ["auto", `Auto; "pager", `Pager; "groff", `Groff; "plain", `Plain] + +let man_fmt_docv = "FMT" +let man_fmts_enum = enum ~docv:man_fmt_docv man_fmts +let man_fmts_alts = doc_alts_enum man_fmts +let man_fmts_doc kind = + Printf.sprintf + "Show %s in format $(docv). The value $(docv) must be %s. \ + With $(b,auto), the format is $(b,pager) or $(b,plain) whenever \ + the $(b,TERM) env var is $(b,dumb) or undefined." + kind man_fmts_alts + +let man_format = + let doc = man_fmts_doc "output" in + let docv = man_fmt_docv in + value & opt man_fmts_enum `Pager & info ["man-format"] ~docv ~doc + +let stdopt_version ~docs = + value & flag & info ["version"] ~docs ~doc:"Show version information." + +let stdopt_help ~docs = + let doc = man_fmts_doc "this help" in + let docv = man_fmt_docv in + value & opt ~vopt:(Some `Auto) (some man_fmts_enum) None & + info ["help"] ~docv ~docs ~doc + +(* Deprecated *) + +type 'a printer = 'a Conv.fmt +let docv_default = "VALUE" +let conv' ?docv (parser, pp) = Conv.make ~docv:docv_default ~parser ~pp () +let conv ?docv (parser, pp) = + let parser s = match parser s with + | Ok _ as v -> v | Error (`Msg e) -> Error e + in + Conv.make ~docv:docv_default ~parser ~pp () + +let conv_printer = Conv.pp +let conv_docv = Conv.docv +let conv_parser conv = + fun s -> match Conv.parser conv s with + | Ok _ as v -> v | Error e -> Error (`Msg e) + +let err_invalid s kind = + `Msg (Printf.sprintf "invalid value '%s', expected %s" s kind) + +let parser_of_kind_of_string ~kind k_of_string = + fun s -> match k_of_string s with + | None -> Error (err_invalid s kind) + | Some v -> Ok v diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_arg.mli b/unikernel/duniverse/cmdliner/src/cmdliner_arg.mli new file mode 100644 index 00000000..cebd6117 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_arg.mli @@ -0,0 +1,142 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Command line arguments as terms. *) + +(* Converters *) + +type 'a conv + +module Completion : sig + type 'a directive + + val value : ?doc:string -> 'a -> 'a directive + val string : ?doc:string -> string -> 'a directive + val files : 'a directive + val dirs : 'a directive + val restart : 'a directive + val message : string -> 'a directive + val raw : string -> 'a directive + + type ('ctx, 'a) func = + 'ctx option -> token:string -> ('a directive list, string) result + + type 'a complete = + | Complete : 'ctx Cmdliner_term.t option * ('ctx, 'a) func -> 'a complete + + type 'a t + + val make : ?context:'ctx Cmdliner_term.t -> ('ctx, 'a) func -> 'a t + + val complete : 'a t -> 'a complete + val complete_none : 'a t + val complete_files : 'a t + val complete_dirs : 'a t + val complete_paths : 'a t + val complete_restart : 'a t +end + +module Conv : sig + type 'a parser = string -> ('a, string) result + type 'a fmt = Format.formatter -> 'a -> unit + type 'a t = 'a conv + val make : + ?completion:'a Completion.t -> docv:string -> parser:'a parser -> + pp:'a fmt -> unit -> 'a t + + val of_conv : + ?completion:'a Completion.t -> ?docv:string -> ?parser:'a parser -> + ?pp:'a fmt -> 'a t -> 'a t + + val docv : 'a conv -> string + val parser : 'a conv -> 'a parser + val pp : 'a conv -> 'a fmt + val completion : 'a t -> 'a Completion.t +end + +val some : ?none:string -> 'a conv -> 'a option conv +val some' : ?none:'a -> 'a conv -> 'a option conv + +(* Arguments *) + +type 'a t = 'a Cmdliner_term.t + +type info +val info : + ?deprecated:string -> ?absent:string -> ?docs:string -> + ?doc_envs:Cmdliner_def.Env.info list -> ?docv:string -> ?doc:string -> + ?env:Cmdliner_def.Env.info -> string list -> info + +val ( & ) : ('a -> 'b) -> 'a -> 'b + +val flag : info -> bool t +val flag_all : info -> bool list t +val vflag : 'a -> ('a * info) list -> 'a t +val vflag_all : 'a list -> ('a * info) list -> 'a list t +val opt : ?vopt:'a -> 'a conv -> 'a -> info -> 'a t +val opt_all : ?vopt:'a -> 'a conv -> 'a list -> info -> 'a list t + +val pos : ?rev:bool -> int -> 'a conv -> 'a -> info -> 'a t +val pos_all : 'a conv -> 'a list -> info -> 'a list t +val pos_left : ?rev:bool -> int -> 'a conv -> 'a list -> info -> 'a list t +val pos_right : ?rev:bool -> int -> 'a conv -> 'a list -> info -> 'a list t + +(* As terms *) + +val value : 'a t -> 'a Cmdliner_term.t +val required : 'a option t -> 'a Cmdliner_term.t +val non_empty : 'a list t -> 'a list Cmdliner_term.t +val last : 'a list t -> 'a Cmdliner_term.t + +(* Predefined arguments *) + +val man_format : Cmdliner_manpage.format Cmdliner_term.t +val stdopt_version : docs:string -> bool Cmdliner_term.t +val stdopt_help : docs:string -> Cmdliner_manpage.format option Cmdliner_term.t + +(* Predifined converters *) + +val bool : bool conv +val char : char conv +val int : int conv +val nativeint : nativeint conv +val int32 : int32 conv +val int64 : int64 conv +val float : float conv +val string : string conv +val enum : ?docv:string -> (string * 'a) list -> 'a conv +val path : string conv +val filepath : string conv +val dirpath : string conv +val file : string conv +val dir : string conv +val non_dir_file : string conv +val list : ?sep:char -> 'a conv -> 'a list conv +val array : ?sep:char -> 'a conv -> 'a array conv +val pair : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv +val t2 : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv +val t3 : ?sep:char -> 'a conv ->'b conv -> 'c conv -> ('a * 'b * 'c) conv +val t4 : + ?sep:char -> 'a conv ->'b conv -> 'c conv -> 'd conv -> + ('a * 'b * 'c * 'd) conv + +val doc_quote : string -> string +val doc_alts : ?quoted:bool -> string list -> string +val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string + +(* Deprecated *) + +type 'a printer = Format.formatter -> 'a -> unit +val conv' : ?docv:string -> 'a Conv.parser * 'a Conv.fmt -> 'a conv +val conv : + ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a Conv.fmt -> + 'a conv + +val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) +val conv_printer : 'a conv -> 'a printer +val conv_docv : 'a conv -> string +val parser_of_kind_of_string : + kind:string -> (string -> 'a option) -> + (string -> ('a, [`Msg of string]) result) diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_base.ml b/unikernel/duniverse/cmdliner/src/cmdliner_base.ml new file mode 100644 index 00000000..840a8a32 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_base.ml @@ -0,0 +1,254 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let strf = Printf.sprintf + +(* Unique ids *) + +let uid = + (* Thread-safe UIDs, Oo.id (object end) was used before. + Note this won't be thread-safe in multicore, we should use + Atomic but this is >= 4.12 and we have 4.08 for now. *) + let c = ref 0 in + fun () -> + let id = !c in + incr c; if id > !c then assert false (* too many ids *) else id + +(* Edit distance + + The stdlib has much better in but this will be only >= 5.4, maybe + in twenty years. *) + +let edit_distance s0 s1 = + let minimum (a : int) (b : int) (c : int) : int = min a (min b c) in + let s0,s1 = if String.length s0 <= String.length s1 then s0,s1 else s1,s0 in + let m = String.length s0 and n = String.length s1 in + let rec rows row0 row i = match i > n with + | true -> row0.(m) + | false -> + row.(0) <- i; + for j = 1 to m do + if s0.[j - 1] = s1.[i - 1] then row.(j) <- row0.(j - 1) else + row.(j) <- minimum (row0.(j - 1) + 1) (row0.(j) + 1) (row.(j - 1) + 1) + done; + rows row row0 (i + 1) + in + rows (Array.init (m + 1) (fun x -> x)) (Array.make (m + 1) 0) 1 + +let suggest s candidates = + let add (min, acc) name = + let d = edit_distance s name in + if d = min then min, (name :: acc) else + if d < min then d, [name] else + min, acc + in + let dist, suggs = List.fold_left add (max_int, []) candidates in + if dist < 3 (* suggest only if not too far *) then suggs else [] + +(* Stdlib compatibility *) + +let is_space = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false + +let string_starts_with ~prefix s = (* available in 4.13 *) + let prefix_len = String.length prefix in + let s_len = String.length s in + if prefix_len > s_len then false else + let rec loop i = + if i = prefix_len then true + else if String.get prefix i = String.get s i then loop (i + 1) + else false + in + loop 0 + +let string_drop_first n s = + if n <= 0 then s else + if n >= String.length s then "" else + String.sub s n (String.length s - n) + +(* Invalid argument strings *) + +let err_empty_list = "empty list" + +(* Formatting tools *) + +module Fmt = struct + type 'a t = Format.formatter -> 'a -> unit + let str = Format.asprintf + let pf = Format.fprintf + let nop ppf _ = () + let sp = Format.pp_print_space + let cut = Format.pp_print_cut + let string = Format.pp_print_string + let char = Format.pp_print_char + let comma ppf () = char ppf ','; sp ppf () + let indent ppf c = for i = 1 to c do char ppf ' ' done + let list ?sep pp_v ppf l = Format.pp_print_list ?pp_sep:sep pp_v ppf l + let text = Format.pp_print_text + let lines ppf s = + let rec stop_at sat ~start ~max s = + if start > max then start else + if sat s.[start] then start else + stop_at sat ~start:(start + 1) ~max s + in + let sub s start stop ~max = + if start = stop then "" else + if start = 0 && stop > max then s else + String.sub s start (stop - start) + in + let is_nl c = c = '\n' in + let max = String.length s - 1 in + let rec loop start s = match stop_at is_nl ~start ~max s with + | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max) + | stop -> + Format.pp_print_string ppf (sub s start stop ~max); + Format.pp_force_newline ppf (); + loop (stop + 1) s + in + loop 0 s + + let tokens ~spaces ppf s = (* collapse white and hint spaces (maybe) *) + let i_max = String.length s - 1 in + let flush start stop = string ppf (String.sub s start (stop - start + 1)) in + let rec skip_white i = + if i > i_max then i else + if is_space s.[i] then skip_white (i + 1) else i + in + let rec loop start i = + if i > i_max then flush start i_max else + if not (is_space s.[i]) then loop start (i + 1) else + let next_start = skip_white i in + (flush start (i - 1); if spaces then sp ppf () else char ppf ' '; + if next_start > i_max then () else loop next_start next_start) + in + loop 0 0 + + (* Text styling *) + + type styler = Ansi | Plain + let styler' = + ref begin match Sys.getenv_opt "NO_COLOR" with + | Some s when s <> "" -> Plain + | _ -> + match Sys.getenv_opt "TERM" with + | Some "dumb" -> Plain + | None when Sys.backend_type <> Other "js_of_ocaml" -> Plain + | _ -> Ansi + end + + let set_styler styler = styler' := styler + let styler () = !styler' + + let sgr_of_style = function + | `Bold -> "01" + | `Underline -> "04" + | `Fg `Red -> string_of_int (30 + 1) + | `Fg `Yellow -> string_of_int (30 + 3) + + let sgrs_of_styles styles = String.concat ";" (List.map sgr_of_style styles) + let ansi_esc = "\x1B[" + let sgr_reset = "\x1B[m" + + let ansi styles ppf s = + let sgrs = String.concat "" [ansi_esc; sgrs_of_styles styles; "m"] in + Format.pp_print_as ppf 0 sgrs; + string ppf s; + Format.pp_print_as ppf 0 sgr_reset + + let st styles ppf s = match !styler' with + | Plain -> string ppf s + | Ansi -> ansi styles ppf s + + let code ppf v = st [`Bold] ppf v + let code_var ppf v = st [`Underline] ppf v + let code_or_quote ppf v = match !styler' with + | Plain -> char ppf '\''; string ppf v; char ppf '\'' + | Ansi -> ansi [`Bold] ppf v + + let ereason ppf s = match !styler' with + | Plain -> string ppf s + | Ansi -> ansi [`Fg `Red] ppf s + + let wreason ppf s = match !styler' with + | Plain -> string ppf s + | Ansi -> ansi [`Fg `Yellow] ppf s + + let missing ppf () = ereason ppf "missing" + let invalid ppf () = ereason ppf "invalid" + let unknown ppf () = ereason ppf "unknown" + let deprecated ppf () = wreason ppf "deprecated" + + let puterr ppf () = st [`Bold; `Fg `Red] ppf "Error"; char ppf ':' + + let styled_text ppf s = + (* Detects ANSI escapes and prints them as 0 width. Collapses spaces + and newlines to single space except for blank lines which are + preserved. *) + let rec loop ppf s i max = + if i > max then () else + let ansi = s.[i] = '\x1B' && i + 1 < max && s.[i+1] = '[' in + if not ansi then match s.[i] with + | ' ' when i = max || s.[i+1] = ' ' || s.[i+1] = '\n' -> + loop ppf s (i + 1) max + | ' ' -> sp ppf (); loop ppf s (i + 1) max + | '\n' when i = max || s.[i+1] = ' ' -> loop ppf s (i + 1) max + | '\n' when s.[i+1] = '\n' -> + Format.pp_force_newline ppf (); + if i > 0 && s.[i-1] <> '\n' then Format.pp_force_newline ppf (); + loop ppf s (i + 1) max + | '\n' -> sp ppf (); loop ppf s (i + 1) max + | c -> char ppf s.[i]; loop ppf s (i + 1) max + else begin + let k = ref (i + 2) in + while (!k <= max && s.[!k] <> 'm') do incr k done; + let esc = String.sub s i (!k - i + 1) in + Format.pp_print_as ppf 0 esc; + loop ppf s (!k + 1) max + end + in + loop ppf s 0 (String.length s - 1) +end + +(* Converter (end-user) error messages *) + +let err_multi_def ~kind name doc v v' = (* programming error *) + strf "%s %s defined twice (doc strings are '%s' and '%s')" + kind name (doc v) (doc v') + +let quote s = strf "'%s'" s (* Exposed in the API do not change *) +let _alts_str ~styled ?quoted ppf alts = + let quote = match quoted with + | None -> fun ppf s -> Fmt.pf ppf "$(b,%s)" s + | Some quoted -> + if not quoted then Fmt.string else + if styled then Fmt.code_or_quote else + fun ppf s -> Fmt.pf ppf "'%s'" s + in + match alts with + | [] -> invalid_arg err_empty_list + | [a] -> quote ppf a + | [a; b] -> Fmt.pf ppf "either@ %a@ or@ %a" quote a quote b + | alts -> + let rev_alts = List.rev alts in + Fmt.pf ppf "one@ of@ %a@ or@ %a" + Fmt.(list ~sep:comma quote) (List.rev (List.tl rev_alts)) + quote (List.hd rev_alts) + +let alts_str ?quoted alts = (* Exposed in the API do not change *) + Fmt.str "@[%a@]" (_alts_str ~styled:false ?quoted) alts + +let pp_alts ppf alts = + _alts_str ~styled:true ~quoted:true ppf alts + +let err_ambiguous ~kind s ~ambs = + Fmt.str "@[%s %a %a@ and@ could@ be@ %a@]" + kind Fmt.code_or_quote s Fmt.ereason "ambiguous" pp_alts ambs + +let err_unknown ?(dom = []) ?(hints = []) ~kind v = + let hints ppf () = match hints, dom with + | [], [] -> () + | [], dom -> Fmt.pf ppf ". Must@ be@ %a" pp_alts dom + | hints, _ -> Fmt.pf ppf ". Did@ you@ mean@ %a?" pp_alts hints + in + Fmt.str "@[%a %s@ %a%a@]" Fmt.unknown () kind Fmt.code_or_quote v hints () diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_base.mli b/unikernel/duniverse/cmdliner/src/cmdliner_base.mli new file mode 100644 index 00000000..59295082 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_base.mli @@ -0,0 +1,60 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** A few helpful base definitions. *) + +val uid : unit -> int +(** [uid ()] is new unique for the program run. *) + +val suggest : string -> string list -> string list +(** [suggest near candidates] suggest values from [candidates] + not too far from [near]. *) + +val is_space : char -> bool +val string_starts_with : prefix:string -> string -> bool +val string_drop_first : int -> string -> string + +(* Formatters *) + +module Fmt : sig + type 'a t = Format.formatter -> 'a -> unit + val str : ('a, Format.formatter, unit, string) format4 -> 'a + val pf : Format.formatter -> ('a, Format.formatter, unit) format -> 'a + val nop : 'a t + val sp : unit t + val comma : unit t + val cut : unit t + val char : char t + val string : string t + val indent : int t + val list : ?sep:unit t -> 'a t -> 'a list t + val styled_text : string t + val lines : string t + val tokens : spaces:bool -> string t + val text : string t + val code : string t + val code_var : string t + val code_or_quote : string t + val ereason : string t + val missing : unit t + val invalid : unit t + val deprecated : unit t + val puterr : unit t + + type styler = Ansi | Plain + val styler : unit -> styler +end + +(* Error message helpers *) + +val quote : string -> string +val pp_alts : string list Fmt.t +val alts_str : ?quoted:bool -> string list -> string +val err_empty_list : string +val err_ambiguous : kind:string -> string -> ambs:string list -> string +val err_unknown : + ?dom:string list -> ?hints:string list -> kind:string -> string -> string +val err_multi_def : + kind:string -> string -> ('b -> string) -> 'b -> 'b -> string diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_cline.ml b/unikernel/duniverse/cmdliner/src/cmdliner_cline.ml new file mode 100644 index 00000000..b8008783 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_cline.ml @@ -0,0 +1,345 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* A command line stores pre-parsed information about the command + line's arguments in a more structured way. Given the + Cmdliner_def.Arg_info.t values mentioned in a term and Sys.argv + (without exec name) we parse the command line into + [Cmdliner_def.Cline.t] which is map of [Cmdliner_def.Arg_info.t] + values to [Cmdliner_def.Cline.arg] values. This map is used by the + term's closures to retrieve and convert command line arguments (see + the [Cmdliner_arg] module). *) + +(* Completion *) + +let complete_prefix = "--__complete=" +let has_complete_prefix s = + Cmdliner_base.string_starts_with ~prefix:complete_prefix s + +let get_token_to_complete s = + Cmdliner_base.string_drop_first (String.length complete_prefix) s + +let is_opt_to_complete s = (* assert (has_complete_prefix s) *) + String.length s > String.length complete_prefix && + s.[String.length complete_prefix] = '-' + +let maybe_token_to_complete ~for_completion s = + if not for_completion || not (has_complete_prefix s) then None else + Some (get_token_to_complete s) + +(* Command lines *) + +let err_multi_opt_name_def name arg_info arg_info' = + Cmdliner_base.err_multi_def ~kind:"option name" name + Cmdliner_def.Arg_info.doc arg_info arg_info' + +let arg_info_indexes arg_infos = + (* from [args] returns a trie mapping the names of optional arguments to + their arg_info, a list with all arg_info for positional arguments and + a Cmdliner_def.Cline.t mapping each arg_info to an empty [arg]. *) + let rec loop optidx posidx cline = function + | [] -> optidx, posidx, cline + | arg_info :: l -> + match Cmdliner_def.Arg_info.is_pos arg_info with + | true -> + let cline = Cmdliner_def.Cline.add arg_info (P []) cline in + loop optidx (arg_info :: posidx) cline l + | false -> + let add t name = match Cmdliner_trie.add t name arg_info with + | `New t -> t + | `Replaced (a', _) -> + invalid_arg (err_multi_opt_name_def name arg_info a') + in + let names = Cmdliner_def.Arg_info.opt_names arg_info in + let optidx = List.fold_left add optidx names in + let cline = Cmdliner_def.Cline.add arg_info (O []) cline in + loop optidx posidx cline l + in + let cline = Cmdliner_def.Cline.empty in + let arg_infos = Cmdliner_def.Arg_info.Set.elements arg_infos in + loop Cmdliner_trie.empty [] cline arg_infos + +(* Optional argument parsing *) + +(* Note on option completion. Technically when trying to complete an + option we could try to avoid mentioning names that have already be + mentioned and that are not repeatable. Sometimes not being able to + complete what we know exists ends up being more confusing than + enlightening so we don't do that for now. + + Also the code is quite messy, perhaps we should cleanly separate + parsing for completion and parsing for evaluation. *) + +let is_opt s = String.length s > 1 && s.[0] = '-' +let is_short_opt s = String.length s = 2 && s.[0] = '-' + +let parse_opt_arg s = + (* (name, value) of opt arg, assert len > 1. except if complete *) + let is_completion = has_complete_prefix s in + let s = if is_completion then get_token_to_complete s else s in + let l = String.length s in + if l <= 1 then "-", None, is_completion else + if s.[1] <> '-' then (* short opt *) + if l = 2 then s, None, is_completion else + String.sub s 0 2, Some (String.sub s 2 (l - 2)) (* with glued opt arg *), + is_completion + else try (* long opt *) + let i = String.index s '=' in + String.sub s 0 i, Some (String.sub s (i + 1) (l - i - 1)), is_completion + with Not_found -> s, None, is_completion + +let hint_matching_opt optidx s = + (* hint option names that could match [s] in [optidx]. *) + if String.length s <= 2 then [] else + let short_opt, long_opt = + if s.[1] <> '-' + then s, Printf.sprintf "-%s" s + else String.sub s 1 (String.length s - 1), s + in + let short_opt, _, _ = parse_opt_arg short_opt in + let long_opt, _, _ = parse_opt_arg long_opt in + let all = Cmdliner_trie.ambiguities optidx "-" in + match List.mem short_opt all, Cmdliner_base.suggest long_opt all with + | false, [] -> [] + | false, l -> l + | true, [] -> [short_opt] + | true, l -> if List.mem short_opt l then l else short_opt :: l + +let parse_opt_value ~for_completion cline arg_info name value args = + (* Either we got a value glued in [value] or we need to get one in [args] + in this case we need to take care of a possible completion token *) + match Cmdliner_def.Arg_info.opt_kind arg_info with + | Flag -> (* Flags have no values but we may get dash sharing in [value] *) + begin match value with + | None -> None, None, args + | Some v when is_short_opt name -> (* short flag dash sharing *) + None, None, ("-" ^ v) :: args + | Some _ -> (* an error but this is reported during typed parsing *) + None, value, args + end + | _ -> + match value with + | Some _ -> None, value, args + | None -> (* Get it from the next argument. *) + match args with + | [] -> None, None, args + | v :: rest when for_completion && has_complete_prefix v -> + let v = get_token_to_complete v in + if is_opt v then (* not an option value *) None, None, args else + let comp = + Cmdliner_def.Complete.make ~token:v (Opt_value arg_info) + in + Some comp, None, rest + | v :: rest -> + if is_opt v then None, None, args else None, Some v, rest + +let try_complete_opt_value cline arg_info name value args = + (* At that point we found a matching option name so this should be mostly + about completing a glued option value, but there are twists. *) + match Cmdliner_def.Arg_info.opt_kind arg_info with + | Cmdliner_def.Arg_info.Flag -> + begin match value with + | Some v when is_short_opt name -> + (* short flag dash sharing, push the completion *) + let args = (complete_prefix ^ "-" ^ v) :: args in + None, None, args + | Some v -> + (* This is actually a parse error, flags have no value. We + make it an option completion but the completions will + eventually be empty (the prefix won't match) *) + Some (Cmdliner_def.Complete.make ~token:(name ^ v) Opt_name), + None, args + | None -> + (* We have in fact a fully completed flag turn it into an + option completion. *) + Some (Cmdliner_def.Complete.make ~token:name Opt_name), None, args + end + | _ -> + begin match value with + | Some token -> + Some (Cmdliner_def.Complete.make ~token (Opt_value arg_info)), None, + args + | None -> + (* We have a fully completed option name, we don't try to + lookup what happens in the next argument which should + hold the value if any, we just turn it into an option + completion. *) + Some (Cmdliner_def.Complete.make ~token:name Opt_name), None, args + end + +let parse_opt_args + ~peek_opts ~legacy_prefixes ~for_completion optidx cline args + = + (* returns an updated [cline] cmdline according to the options found in [args] + with the trie index [optidx]. Positional arguments are returned in order + in a list. *) + let rec loop errs k comp cline pargs = function + | [] -> List.rev errs, comp, cline, false, List.rev pargs + | "--" :: args -> + List.rev errs, comp, cline, true, (List.rev_append pargs args) + | s :: args -> + let do_parse = + is_opt s && + (if not for_completion then true else + if not (has_complete_prefix s) then true else + is_opt_to_complete s) + in + if not do_parse then loop errs (k + 1) comp cline (s :: pargs) args else + let name, value, is_completion = parse_opt_arg s in + match Cmdliner_trie.find ~legacy_prefixes optidx name with + | Ok arg_info -> + let acomp, value, args = + if is_completion + then try_complete_opt_value cline arg_info name value args + else parse_opt_value ~for_completion cline arg_info name value args + in + let comp = match acomp with Some _ -> acomp | None -> comp in + let arg : Cmdliner_def.Cline.arg = + O ((k, name, value) :: + Cmdliner_def.Cline.get_opt_arg cline arg_info) + in + let cline = Cmdliner_def.Cline.add arg_info arg cline in + loop errs (k + 1) comp cline pargs args + | Error `Not_found when for_completion -> + if not is_completion then + (* Drop the data, if the user thought this was an opt with + an argument this may confuse positional args but there's + not much we can do. *) + loop errs (k + 1) comp cline pargs args + else + let token = name ^ Option.value ~default:"" value in + let comp = Some (Cmdliner_def.Complete.make ~token Opt_name) in + loop errs (k + 1) comp cline pargs args + | Error `Not_found when peek_opts -> + loop errs (k + 1) comp cline pargs args + | Error `Not_found -> + let hints = hint_matching_opt optidx s in + let err = Cmdliner_base.err_unknown ~kind:"option" ~hints name in + loop (err :: errs) (k + 1) comp cline pargs args + | Error `Ambiguous (* Only on legacy prefixes *) -> + let ambs = Cmdliner_trie.ambiguities optidx name in + let ambs = List.sort compare ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"option" name ~ambs in + loop (err :: errs) (k + 1) comp cline pargs args + in + let errs, comp, cline, has_dashdash, pargs = loop [] 0 None cline [] args in + if errs = [] then Ok (comp, cline, has_dashdash, pargs) else + match comp with + | Some _ -> Ok (comp, cline, has_dashdash, pargs) + | None -> + let err = String.concat "\n" errs in + Error (err, cline, has_dashdash, pargs) + +(* Positional argument parsing *) + +let take_range ~for_completion start stop l = + let rec loop i comp acc = function + | [] -> comp, (List.rev acc) + | v :: vs -> + if i < start then loop (i + 1) comp acc vs else + if i <= stop then match maybe_token_to_complete ~for_completion v with + | Some _ as comp -> loop (i + 1) comp (v :: acc) vs + | None -> loop (i + 1) comp (v :: acc) vs + else comp, List.rev acc + in + loop 0 None [] l + +let parse_pos_args ~for_completion posidx comp cline ~has_dashdash pargs = + (* returns an updated [cline] cmdline in which each positional arg mentioned + in the list index [posidx], is given a value according the list + of positional arguments values [pargs]. *) + if pargs = [] then + let misses = List.filter Cmdliner_def.Arg_info.is_req posidx in + if misses = [] then Ok (comp, cline) else + match comp with + | Some _ -> Ok (comp, cline) + | None -> Error (Cmdliner_msg.err_pos_misses misses, cline) + else + let last = List.length pargs - 1 in + let pos rev k = if rev then last - k else k in + let rec loop misses comp cline max_spec = function + | [] -> misses, comp, cline, max_spec + | arg_info :: al -> + let apos = Cmdliner_def.Arg_info.pos_kind arg_info in + let rev = Cmdliner_def.Arg_info.pos_rev apos in + let start = pos rev (Cmdliner_def.Arg_info.pos_start apos) in + let stop = match Cmdliner_def.Arg_info.pos_len apos with + | None -> pos rev last + | Some n -> pos rev (Cmdliner_def.Arg_info.pos_start apos + n - 1) + in + let start, stop = if rev then stop, start else start, stop in + let comp, args = match take_range ~for_completion start stop pargs with + | None, args -> comp, args + | Some token, args -> + let comp = + Cmdliner_def.Complete.make ~after_dashdash:has_dashdash ~token + (Opt_name_or_pos_value arg_info) + in + Some comp, args + in + let max_spec = max stop max_spec in + let cline = Cmdliner_def.Cline.add arg_info (P args) cline in + let misses = match Cmdliner_def.Arg_info.is_req arg_info && args = [] with + | true -> arg_info :: misses + | false -> misses + in + loop misses comp cline max_spec al + in + let misses, comp, cline, max_spec = loop [] comp cline (-1) posidx in + if misses <> [] then begin + if Option.is_some comp then Ok (comp, cline) else + Error (Cmdliner_msg.err_pos_misses misses, cline) + end else + if last <= max_spec then Ok (comp, cline) else + if Option.is_some comp then Ok (comp, cline) else + let comp, excess = take_range ~for_completion (max_spec + 1) last pargs in + match comp with + | None -> Error (Cmdliner_msg.err_pos_excess excess, cline) + | Some token -> + let comp = + Cmdliner_def.Complete.make ~after_dashdash:has_dashdash ~token Opt_name + in + Ok (Some comp, cline) + +let create ?(peek_opts = false) ~legacy_prefixes ~for_completion al args = + let optidx, posidx, cline = arg_info_indexes al in + match + parse_opt_args ~for_completion ~peek_opts ~legacy_prefixes optidx cline args + with + | Ok (comp, cline, _has_dashdash, _pargs) when peek_opts -> + begin match comp with + | None -> `Ok cline + | Some comp -> `Complete (comp, cline) + end + | Ok (comp, cline, has_dashdash, pargs) -> + begin match + parse_pos_args ~for_completion posidx comp cline ~has_dashdash pargs + with + | Ok (None, _) | Error _ when for_completion -> + (* Normally we should have found a completion token This + may fail to happen if pos args are ill defined: we may miss the + completion token. Just make sure we do a completion. *) + begin match List.find_opt has_complete_prefix pargs with + | None -> assert false + | Some arg -> + match maybe_token_to_complete ~for_completion:true arg with + | None -> assert false + | Some token -> + let comp = + Cmdliner_def.Complete.make + ~after_dashdash:has_dashdash ~token Opt_name + in + `Complete (comp, cline) + end + | Ok (None, cline) -> `Ok cline + | Ok (Some comp, cline) -> `Complete (comp, cline) + | Error v -> `Error v + end + | Error (errs, cline, has_dashdash, pargs) -> + match + parse_pos_args ~for_completion posidx None cline ~has_dashdash pargs + with + | Ok (Some comp, cline) -> `Complete (comp, cline) + | _ -> `Error (errs, cline) diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_cline.mli b/unikernel/duniverse/cmdliner/src/cmdliner_cline.mli new file mode 100644 index 00000000..b1e6c315 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_cline.mli @@ -0,0 +1,19 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Command lines. *) + +val is_opt : string -> bool +val has_complete_prefix : string -> bool +val get_token_to_complete : string -> string + +(** {1:cli Command lines} *) + +val create : + ?peek_opts:bool -> legacy_prefixes:bool -> for_completion:bool -> + Cmdliner_def.Arg_info.Set.t -> string list -> + [ `Ok of Cmdliner_def.Cline.t + | `Complete of Cmdliner_def.Complete.t * Cmdliner_def.Cline.t + | `Error of string * Cmdliner_def.Cline.t ] diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_cmd.ml b/unikernel/duniverse/cmdliner/src/cmdliner_cmd.ml new file mode 100644 index 00000000..5a8db32d --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_cmd.ml @@ -0,0 +1,52 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* Commands *) + +type info = Cmdliner_def.Cmd_info.t +let info = Cmdliner_def.Cmd_info.make + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +let make info t = + let info = Cmdliner_def.Cmd_info.add_args info (Cmdliner_term.argset t) in + Cmd (info, Cmdliner_term.parser t) + +let v = make + +let get_info = function Cmd (info, _) | Group (info, _) -> info +let get_children_infos = function +| Cmd _ -> [] | Group (_, (_, cs)) -> List.map get_info cs + +let group ?default info cmds = + let args, parser = match default with + | None -> None, None + | Some t -> Some (Cmdliner_term.argset t), Some (Cmdliner_term.parser t) + in + let children = List.map get_info cmds in + let info = Cmdliner_def.Cmd_info.with_children info ~args ~children in + Group (info, (parser, cmds)) + +let name c = Cmdliner_def.Cmd_info.name (get_info c) + +let name_trie cmds = + let add acc cmd = + let info = get_info cmd in + let name = Cmdliner_def.Cmd_info.name info in + match Cmdliner_trie.add acc name cmd with + | `New t -> t + | `Replaced (cmd', _) -> + let info' = get_info cmd' and kind = "command" in + invalid_arg @@ + Cmdliner_base.err_multi_def ~kind name + Cmdliner_def.Cmd_info.doc info info' + in + List.fold_left add Cmdliner_trie.empty cmds + +let list_names cmds = + let cmd_name c = Cmdliner_def.Cmd_info.name (get_info c) in + List.sort String.compare (List.rev_map cmd_name cmds) diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_cmd.mli b/unikernel/duniverse/cmdliner/src/cmdliner_cmd.mli new file mode 100644 index 00000000..9f644f88 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_cmd.mli @@ -0,0 +1,27 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Commands and their information. *) + +type info = Cmdliner_def.Cmd_info.t + +val info : + ?deprecated:string -> ?man_xrefs:Cmdliner_manpage.xref list -> + ?man:Cmdliner_manpage.block list -> ?envs:Cmdliner_def.Env.info list -> + ?exits:Cmdliner_def.Exit.info list -> ?sdocs:string -> ?docs:string -> + ?doc:string -> ?version:string -> string -> info + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +val make : info -> 'a Cmdliner_term.t -> 'a t +val v : info -> 'a Cmdliner_term.t -> 'a t +val group : ?default:'a Cmdliner_term.t -> info -> 'a t list -> 'a t +val name : 'a t -> string +val name_trie : 'a t list -> 'a t Cmdliner_trie.t +val list_names : 'a t list -> string list +val get_info : 'a t -> info +val get_children_infos : 'a t -> info list diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_completion.ml b/unikernel/duniverse/cmdliner/src/cmdliner_completion.ml new file mode 100644 index 00000000..4d4efea1 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_completion.ml @@ -0,0 +1,140 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* Output protocol *) + +let cons_if b v l = if b then v :: l else l + +type directive = +| Dirs | Files | Group of string * (string * string) list +| Restart | Message of string + +let pp_protocol ppf dirs = + let pp_line ppf s = Cmdliner_base.Fmt.(string ppf s; cut ppf ()) in + let pp_text ppf s = Cmdliner_base.Fmt.(pf ppf "@[%a@]@," styled_text s) in + let vnum = 1 (* Protocol version number *) in + let pp_item ppf (name, doc) = + pp_line ppf "item"; + pp_line ppf name; pp_text ppf doc; + pp_line ppf "item-end"; + in + let pp_dir ppf = function + | Dirs -> pp_line ppf "dirs" + | Files -> pp_line ppf "files" + | Restart -> pp_line ppf "restart" + | Group (name, items) -> + pp_line ppf "group"; + pp_line ppf name; + Cmdliner_base.Fmt.(list ~sep:nop pp_item) ppf items; + | Message msg -> + pp_line ppf "message"; pp_text ppf msg; pp_line ppf "message-end" + in + Cmdliner_base.Fmt.pf ppf "@[%d@,%a@]" vnum + Cmdliner_base.Fmt.(list ~sep:nop pp_dir) dirs + +let add_subcommands_group ~err_ppf ~subst eval comp directives = + if not (Cmdliner_def.Complete.subcmds comp) then directives else + let prefix = Cmdliner_def.Complete.token comp in + let maybe_item cmd = + let name = Cmdliner_def.Cmd_info.name cmd in + if not (Cmdliner_base.string_starts_with ~prefix name) then None else + (* FIXME subst is wrong here. *) + let doc = Cmdliner_def.Cmd_info.styled_doc ~errs:err_ppf ~subst cmd in + Some (name, doc) + in + let subcmds = Cmdliner_def.Eval.subcmds eval in + Group ("Subcommands", List.filter_map maybe_item subcmds) :: directives + +let add_options_group ~err_ppf ~subst eval comp directives = + let prefix = Cmdliner_def.Complete.token comp in + let maybe_items arg_info = + let names = Cmdliner_def.Arg_info.opt_names arg_info in + let subst = Cmdliner_def.Arg_info.doclang_subst ~subst arg_info in + let doc = Cmdliner_def.Arg_info.styled_doc ~errs:err_ppf ~subst arg_info in + let add_name n = + if not (Cmdliner_base.string_starts_with ~prefix n) then None else + Some (n, doc) + in + List.filter_map add_name names + in + let maybe_opt = prefix = "" || prefix.[0] = '-' in + if Cmdliner_def.Complete.after_dashdash comp || not maybe_opt + then directives else + let cmd_info = Cmdliner_def.Eval.cmd eval in + let set = Cmdliner_def.Cmd_info.args cmd_info in + if Cmdliner_def.Arg_info.Set.is_empty set then directives else + let options = Cmdliner_def.Arg_info.Set.elements set in + Group ("Options", List.concat (List.map maybe_items options)) :: directives + +let add_argument_value_directives directives eval arg_info comp cline = + let (Conv conv) = + let arg_infos = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd eval) in + Option.get (Cmdliner_def.Arg_info.Set.find_opt arg_info arg_infos) + in + let value_dirs = + let completion = Cmdliner_def.Arg_conv.completion conv in + match Cmdliner_def.Arg_completion.complete completion with + | Complete (ctx, func) -> + let ctx = match ctx with + | None -> None + | Some ctx -> + match (Cmdliner_term.parser ctx) eval cline with + | Ok ctx -> Some ctx + | Error _ -> None + | exception exn -> None + in + func ctx ~token:(Cmdliner_def.Complete.token comp) + in + match value_dirs with + | Error msg -> `Directives [Message msg] + | Ok ds -> + let pp = Cmdliner_def.Arg_conv.pp conv in + let rec loop values msgs ~files ~dirs ~restart ~raw = function + | [] -> + begin match raw with + | Some r -> `Raw r + | None -> + if Cmdliner_def.Complete.after_dashdash comp && restart + then `Directives [Restart] else + let dd = + cons_if dirs Dirs @@ + cons_if files Files @@ + cons_if (values <> []) (Group ("Values", List.rev values)) [] + in + `Directives (List.rev_append msgs (List.rev_append dd directives)) + end + | d :: ds -> + match d with + | Cmdliner_def.Arg_completion.String (s, doc) -> + loop ((s, doc) :: values) msgs ~files ~dirs ~restart ~raw ds + | Value (v, doc) -> + let s = Cmdliner_base.Fmt.str "@[%a@]" pp v in + loop ((s, doc) :: values) msgs ~files ~dirs ~restart ~raw ds + | Files -> loop values msgs ~files:true ~dirs ~restart ~raw ds + | Dirs -> loop values msgs ~files ~dirs:true ~restart ~raw ds + | Restart -> loop values msgs ~files ~dirs ~restart:true ~raw ds + | Message msg -> + loop values (Message msg :: msgs) ~files ~dirs ~restart ~raw ds + | Raw r -> loop values msgs ~files ~dirs ~restart ~raw:(Some r) ds + in + loop [] [] ~files:false ~dirs:false ~restart:false ~raw:None ds + +let output ~out_ppf ~err_ppf eval comp cline = + let subst = Cmdliner_def.Eval.doclang_subst eval in + let dirs = add_subcommands_group ~err_ppf ~subst eval comp [] in + let res = match Cmdliner_def.Complete.kind comp with + | Opt_value arg_info -> + add_argument_value_directives dirs eval arg_info comp cline + | Opt_name_or_pos_value arg_info -> + let dirs = add_options_group ~err_ppf ~subst eval comp dirs in + add_argument_value_directives dirs eval arg_info comp cline + | Opt_name -> + `Directives (add_options_group ~err_ppf ~subst eval comp dirs) + in + if out_ppf == Format.std_formatter + then set_binary_mode_out stdout true; + match res with + | `Raw raw -> Cmdliner_base.Fmt.pf out_ppf "%s@?" raw + | `Directives dirs -> Cmdliner_base.Fmt.pf out_ppf "%a@?" pp_protocol dirs diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_completion.mli b/unikernel/duniverse/cmdliner/src/cmdliner_completion.mli new file mode 100644 index 00000000..5124ffaf --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_completion.mli @@ -0,0 +1,9 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +val output : + out_ppf:Format.formatter -> err_ppf:Format.formatter -> + Cmdliner_def.Eval.t -> Cmdliner_def.Complete.t -> Cmdliner_def.Cline.t -> + unit diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_def.ml b/unikernel/duniverse/cmdliner/src/cmdliner_def.ml new file mode 100644 index 00000000..bac550e2 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_def.ml @@ -0,0 +1,560 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let strf = Printf.sprintf + +(* Exit codes *) + +module Exit = struct + type code = int + + let ok = 0 + let some_error = 123 + let cli_error = 124 + let internal_error = 125 + + type info = + { codes : code * code; (* min, max *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?(docs = Cmdliner_manpage.s_exit_status) ?(doc = "undocumented") ?max min + = + let max = match max with None -> min | Some max -> max in + { codes = (min, max); doc; docs } + + let info_codes i = i.codes + let info_code i = fst i.codes + let info_doc i = i.doc + let info_docs i = i.docs + let info_order i0 i1 = compare i0.codes i1.codes + let defaults = + [ info ok ~doc:"on success."; + info some_error + ~doc:"on indiscriminate errors reported on standard error."; + info cli_error ~doc:"on command line parsing errors."; + info internal_error ~doc:"on unexpected internal errors (bugs)."; ] + + let doclang_subst ~subst i = function + | "status" -> Some (string_of_int (info_code i)) + | "status_max" -> Some (string_of_int (snd i.codes)) + | id -> subst id +end + +(* Environment variables *) + +module Env = struct + type var = string + type info = (* information about an environment variable. *) + { id : int; (* unique id for the env var. *) + deprecated : string option; + var : string; (* the variable. *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?deprecated + ?(docs = Cmdliner_manpage.s_environment) ?(doc = "See option $(opt).") var + = + { id = Cmdliner_base.uid (); deprecated; var; doc; docs } + + let info_deprecated i = i.deprecated + let info_var i = i.var + let info_doc i = i.doc + let info_docs i = i.docs + let info_compare i0 i1 = Int.compare i0.id i1.id + + let doclang_subst ~subst i = function + | "env" -> Some (strf "$(b,%s)" (Cmdliner_manpage.escape i.var)) + | id -> subst id + + let styled_deprecated ~errs ~subst i = match i.deprecated with + | None -> "" | Some msg -> Cmdliner_manpage.doc_to_styled ~errs ~subst msg + + let styled_doc ~errs ~subst i = + Cmdliner_manpage.doc_to_styled ~errs ~subst i.doc + + module Set = Set.Make (struct type t = info let compare = info_compare end) +end + +(* Argument information *) + +module Arg_info = struct + type absence = Err | Val of string Lazy.t | Doc of string + type opt_kind = Flag | Opt | Opt_vopt of string + type pos_kind = (* information about a positional argument. *) + { pos_rev : bool; (* if [true] positions are counted from the end. *) + pos_start : int; (* start positional argument. *) + pos_len : int option } (* number of arguments or [None] if unbounded. *) + + let pos ~rev:pos_rev ~start:pos_start ~len:pos_len = + { pos_rev; pos_start; pos_len} + + let pos_rev p = p.pos_rev + let pos_start p = p.pos_start + let pos_len p = p.pos_len + let dumb_pos = pos ~rev:false ~start:(-1) ~len:None + + type t = (* information about a command line argument. *) + { id : int; (* unique id for the argument. *) + deprecated : string option; (* deprecation message *) + absent : absence; (* behaviour if absent. *) + env : Env.info option; (* environment variable for default value. *) + doc : string; (* help. *) + docv : string; (* variable name for the argument in help. *) + doc_envs : Env.info list; (* environment that needs to be added to docs *) + docs : string; (* title of help section where listed. *) + pos : pos_kind; (* positional arg kind. *) + opt_kind : opt_kind; (* optional arg kind. *) + opt_names : string list; (* names (for opt args). *) + opt_all : bool; } (* repeatable (for opt args). *) + + let make + ?deprecated ?(absent = "") ?docs ?(doc_envs = []) ?(docv = "") + ?(doc = "") ?env names + = + let dash n = if String.length n = 1 then "-" ^ n else "--" ^ n in + let opt_names = List.map dash names in + let docs = match docs with + | Some s -> s + | None -> + match names with + | [] -> Cmdliner_manpage.s_arguments + | _ -> Cmdliner_manpage.s_options + in + { id = Cmdliner_base.uid (); deprecated; absent = Doc absent; + env; doc; docv; doc_envs; docs; pos = dumb_pos; + opt_kind = Flag; opt_names; opt_all = false; } + + let id i = i.id + let deprecated i = i.deprecated + let absent i = i.absent + let env i = i.env + let doc i = i.doc + let docv i = i.docv + let doc_envs i = i.doc_envs + let docs i = i.docs + let pos_kind i = i.pos + let opt_kind i = i.opt_kind + let opt_names i = i.opt_names + let opt_all i = i.opt_all + let opt_name_sample i = + (* First long or short name (in that order) in the list; this + allows the client to control which name is shown *) + let rec find = function + | [] -> List.hd i.opt_names + | n :: ns -> if (String.length n) > 2 then n else find ns + in + find i.opt_names + + let make_req i = { i with absent = Err } + let make_all_opts i = { i with opt_all = true } + let make_opt ~docv ~absent ~kind:opt_kind i = + { i with absent; opt_kind; docv } + + let make_opt_all ~docv ~absent ~kind:opt_kind i = + { i with absent; opt_kind; opt_all = true; docv } + + let make_pos ~docv ~pos i = { i with pos; docv } + let make_pos_abs ~docv ~absent ~pos i = { i with absent; pos; docv } + + let is_opt i = i.opt_names <> [] + let is_pos i = i.opt_names = [] + let is_req i = i.absent = Err + + let pos_cli_order (a0 : t) (a1 : t) = (* best-effort order on the cli. *) + let c = Bool.compare (a0.pos.pos_rev) (a1.pos.pos_rev) in + if c <> 0 then c else + if a0.pos.pos_rev + then Int.compare a1.pos.pos_start a0.pos.pos_start + else Int.compare a0.pos.pos_start a1.pos.pos_start + + let rev_pos_cli_order a0 a1 = pos_cli_order a1 a0 + + let doclang_subst ~subst (i : t) = function + | "docv" -> + let docv = if i.docv = "" then "VAL" else i.docv in + Some (strf "$(i,%s)" (Cmdliner_manpage.escape docv)) + | "opt" when is_opt i -> + Some (strf "$(b,%s)" (Cmdliner_manpage.escape (opt_name_sample i))) + | id -> + match env i with + | Some e -> Env.doclang_subst ~subst e id + | None -> subst id + + let styled_deprecated ~errs ~subst (i : t) = match i.deprecated with + | None -> "" | Some msg -> Cmdliner_manpage.doc_to_styled ~errs ~subst msg + + let styled_doc ~errs ~subst (i : t) = + Cmdliner_manpage.doc_to_styled ~errs ~subst i.doc + + let compare (a0 : t) (a1 : t) = Int.compare a0.id a1.id + module Map = Map.Make (struct type nonrec t = t let compare = compare end) + + (* Due to terms appearing in the completion API, we have an annoying + recursive type definition which we resolve here. Most of these + types do not belong this module. *) + + type term_escape = + [ `Error of bool * string + | `Help of Cmdliner_manpage.format * string option ] + + type 'a completion_directive = + | Message of string | String of string * string | Value of 'a * string + | Files | Dirs | Restart | Raw of string + + type ('ctx, 'a) completion_func = + 'ctx option -> token:string -> ('a completion_directive list, string) result + + type 'a parser = string -> ('a, string) result + type 'a complete = + | Complete : 'ctx term option * ('ctx, 'a) completion_func -> 'a complete + + and 'a completion = { complete : 'a complete } + + and 'a conv = + { docv : string; + parser : 'a parser; + pp : 'a Cmdliner_base.Fmt.t; + completion : 'a completion; } + + and e_conv = Conv : 'a conv -> e_conv + and arg_set = e_conv Map.t + and cmd = + { name : string; (* name of the cmd. *) + version : string option; (* version (for --version). *) + deprecated : string option; (* deprecation message *) + doc : string; (* one line description of cmd. *) + docs : string; (* title of man section where listed (commands). *) + sdocs : string; (* standard options, title of section where listed. *) + exits : Exit.info list; (* exit codes for the cmd. *) + envs : Env.info list; (* env vars that influence the cmd. *) + man : Cmdliner_manpage.block list; (* man page text. *) + man_xrefs : Cmdliner_manpage.xref list; (* man cross-refs. *) + args : arg_set; (* Command arguments. *) + has_args : bool; (* [true] if has own parsing term. *) + children : cmd list; } (* Children, if any. *) + + and eval = (* information about the evaluation context. *) + { cmd : cmd; (* cmd being evaluated. *) + ancestors : cmd list; (* ancestors of cmd, root is last. *) + subcmds : cmd list; (* subcommands (if any) *) + env : string -> string option; (* environment variable lookup. *) + err_ppf : Format.formatter (* error formatter *) } + + and cline = cline_arg Map.t + and cline_arg = (* unconverted argument data as found on the command line. *) + | O of (int * string * (string option)) list (* (pos, name, value) of opt. *) + | P of string list + + and 'a term_parser = + eval -> cline -> ('a, [ `Parse of string | term_escape ]) result + + and 'a term = arg_set * 'a term_parser + + (* Sets of arguments stored as maps to their completion *) + + module Set = struct + include Map + type t = e_conv Map.t + let find_opt k m = try Some (Map.find k m) with Not_found -> None + let elements m = List.map fst (bindings m) + let union a b = + Map.merge (fun k v v' -> + match v, v' with + | Some v, _ | _, Some v -> Some v + | None, None -> assert false) a b + end +end + +(* Commands *) + +module Cmd_info = struct + type t = Arg_info.cmd + let make + ?deprecated ?(man_xrefs = [`Main]) ?(man = []) ?(envs = []) + ?(exits = Exit.defaults) ?(sdocs = Cmdliner_manpage.s_common_options) + ?(docs = Cmdliner_manpage.s_commands) ?(doc = "") ?version name : t + = + { name; version; deprecated; doc; docs; sdocs; exits; + envs; man; man_xrefs; args = Arg_info.Set.empty; + has_args = true; children = [] } + + let name (i : t) = i.name + let version (i : t) = i.version + let deprecated (i : t) = i.deprecated + let doc (i : t) = i.doc + let docs (i : t) = i.docs + let stdopts_docs (i : t) = i.sdocs + let exits (i : t) = i.exits + let envs (i : t) = i.envs + let man (i : t) = i.man + let man_xrefs (i : t) = i.man_xrefs + let args (i : t) = i.args + let has_args (i : t) = i.has_args + let children (i : t) = i.children + let add_args (i : t) args = { i with args = Arg_info.Set.union args i.args } + let with_children (i : t) ~args ~children = + let has_args, args = match args with + | None -> false, i.args + | Some args -> true, Arg_info.Set.union args i.args + in + { i with has_args; args; children } + + let styled_deprecated ~errs ~subst (i : t) = match i.deprecated with + | None -> "" | Some msg -> Cmdliner_manpage.doc_to_styled ~errs ~subst msg + + let styled_doc ~errs ~subst (i : t) = + Cmdliner_manpage.doc_to_styled ~errs ~subst i.doc + + let escaped_name (i : t) = Cmdliner_manpage.escape i.name +end + +(* Command lines *) + +module Cline = struct + type arg = Arg_info.cline_arg = + | O of (int * string * (string option)) list + | P of string list + + type t = Arg_info.cline + + let empty = Arg_info.Map.empty + let add = Arg_info.Map.add + let fold = Arg_info.Map.fold + let get_arg cline a : arg = + try Arg_info.Map.find a cline with Not_found -> assert false + + let get_opt_arg cline a = + match get_arg cline a with O l -> l | _ -> assert false + + let get_pos_arg cline a = + match get_arg cline a with P l -> l | _ -> assert false + + let actual_args cline a = match get_arg cline a with + | P args -> args + | O l -> + let extract_args (_pos, name, value) = + name :: (match value with None -> [] | Some v -> [v]) + in + List.concat (List.map extract_args l) + + (* Deprecations *) + + type deprecated = Arg_info.t * arg + + let deprecated ~env cline = + let add ~env info arg acc = + let deprecation_invoked = match (arg : arg) with + | O [] | P [] -> (* nothing on the cli for the argument *) + begin match Arg_info.env info with + | None -> false + | Some ienv -> + (* the parse uses the env var if defined which may be + deprecated *) + Option.is_some (Env.info_deprecated ienv) && + Option.is_some (env (Env.info_var ienv)) + end + | _ -> Option.is_some (Arg_info.deprecated info) + in + if deprecation_invoked then (info, arg) :: acc else acc + in + List.rev (fold (add ~env) cline []) + + let pp_deprecated ~subst ppf (info, arg) = + let open Cmdliner_base in + let plural l = if List.length l > 1 then "s" else "" in + let subst = Arg_info.doclang_subst ~subst info in + match (arg : arg) with + | O [] | P [] -> + let env = Option.get (Arg_info.env info) in + let msg = Env.styled_deprecated ~errs:ppf ~subst env in + Fmt.pf ppf "@[%a @[environment variable %a: %a@]@]" + Fmt.deprecated () Fmt.code (Env.info_var env) + Fmt.styled_text msg + | O os -> + let plural = plural os in + let names = List.map (fun (_, n, _) -> n) os in + let msg = Arg_info.styled_deprecated ~errs:ppf ~subst info in + Fmt.pf ppf "@[%a @[option%s %a: %a@]@]" + Fmt.deprecated () plural Fmt.(list ~sep:sp code_or_quote) names + Fmt.styled_text msg + | P args -> + let plural = plural args in + let msg = + Arg_info.styled_deprecated ~errs:ppf ~subst info + in + Fmt.pf ppf "@[%a @[argument%s %a: %a@]@]" + Fmt.deprecated () plural Fmt.(list ~sep:sp code_or_quote) args + Fmt.styled_text msg +end + +(* Evaluation *) + +module Eval = struct + type t = Arg_info.eval + + let make ~ancestors ~cmd ~subcmds ~env ~err_ppf : t = + { ancestors; cmd; subcmds; env; err_ppf } + + let cmd (i : t) = i.cmd + let ancestors (i : t) = i.ancestors + let subcmds (i : t) = i.subcmds + let env_var (i : t) v = i.env v + let err_ppf (i : t) = i.err_ppf + let main (i : t) = match List.rev i.ancestors with [] -> i.cmd | m :: _ -> m + let with_cmd (i : t) cmd = { i with cmd } + + let doclang_name n = strf "$(b,%s)" (Cmd_info.escaped_name n) + let doclang_names names = + strf "$(b,%s)" (Cmdliner_manpage.escape (String.concat " " names)) + + let doclang_subst (i : t) = function + | "tname" | "cmd.name" -> Some (doclang_name i.cmd) + | "mname" | "tool" -> Some (doclang_name (main i)) + | "cmd.parent" -> + let ancestors = ancestors i in + if ancestors = [] then Some (doclang_name (main i)) else + Some (doclang_names (List.rev_map Cmd_info.name ancestors)) + | "iname" | "cmd" -> + Some (doclang_names (List.rev_map Cmd_info.name (cmd i :: ancestors i))) + | _ -> None +end + +(* Terms *) + +module Term = struct + type escape = Arg_info.term_escape + type 'a parser = 'a Arg_info.term_parser + type 'a t = 'a Arg_info.term + let some (aset, parser) = + aset, (fun eval cline -> Result.map Option.some (parser eval cline)) +end + +module Arg_completion = struct + type 'a directive = 'a Arg_info.completion_directive = + | Message of string | String of string * string | Value of 'a * string + | Files | Dirs | Restart | Raw of string + + let value ?(doc = "") v = Value (v, doc) + let string ?(doc = "") s = String (s, doc) + let files = Files + let dirs = Dirs + let restart = Restart + let message msg = Message msg + let raw s = Raw s + + type ('ctx, 'a) func = + 'ctx option -> token:string -> ('a directive list, string) result + + type 'a complete = 'a Arg_info.complete = + | Complete : 'ctx Term.t option * ('ctx, 'a) func -> 'a complete + + type 'a t = 'a Arg_info.completion + + let make ?context func : 'a t = { complete = Complete (context, func) } + let complete (c : 'a t) = c.complete + + let complete_files : 'a t = + { complete = Complete (None, fun _ ~token:_ -> Ok [Files]) } + + let complete_dirs : 'a t = + { complete = Complete (None, fun _ ~token:_ -> Ok [Dirs]) } + + let complete_paths : 'a t = + { complete = Complete (None, fun _ ~token:_ -> Ok [Files; Dirs]) } + + let complete_restart : 'a t = + { complete = Complete (None, fun _ ~token:_ -> Ok [Restart]) } + + let complete_none : 'a t = + { complete = Complete (None, fun _ ~token:_ -> Ok []) } + + let directive_some : 'a directive -> 'a option directive = function + | Value (v, doc) -> Value (Some v, doc) + | (Message _ | String _ | Files | Dirs | Restart | Raw _ as v) -> v + + let complete_some (c : 'a t) : 'a option t = match c.complete with + | Complete (ctx, func) -> + let func ctx ~token = + let some_result directives = List.map directive_some directives in + Result.map some_result (func ctx ~token) + in + { complete = Complete (ctx, func) } +end + +(* Converters *) + +module Arg_conv = struct + type 'a parser = 'a Arg_info.parser + type 'a fmt = 'a Cmdliner_base.Fmt.t + type 'a t = 'a Arg_info.conv + + let make + ?(completion = Arg_completion.complete_none) ~docv ~parser ~pp () : 'a t = + { docv; parser; pp; completion } + + let of_conv ?completion ?docv ?parser ?pp (conv : 'a t) : 'a t + = + let completion = Option.value ~default:conv.completion completion in + let docv = Option.value ~default:conv.docv docv in + let parser = Option.value ~default:conv.parser parser in + let pp = Option.value ~default:conv.pp pp in + { docv; parser; pp; completion } + + let docv (c : 'a t) = c.docv + let parser (c : 'a t) = c.parser + let pp (c : 'a t) = c.pp + let completion (c : 'a t) = c.completion + + let none : 'a t = + { docv = ""; + parser = (fun _ -> assert false); + pp = (fun _ _ -> assert false); + completion = Arg_completion.complete_none } + + let some ?(none = "") conv = + let parser s = Result.map Option.some (parser conv s) in + let pp ppf v = match v with + | None -> Format.pp_print_string ppf none + | Some v -> pp conv ppf v + in + let completion = Arg_completion.complete_some (completion conv) in + { conv with parser; pp; completion } + + let some' ?none conv = + let parser s = Result.map Option.some (parser conv s) in + let pp ppf = function + | None -> (match none with None -> () | Some v -> (pp conv) ppf v) + | Some v -> pp conv ppf v + in + let completion = Arg_completion.complete_some conv.completion in + { conv with parser; pp; completion } +end + +(* Completion *) + +module Complete = struct + type kind = + | Opt_value of Arg_info.t + | Opt_name_or_pos_value of Arg_info.t + | Opt_name + + type t = + { token : string; + after_dashdash : bool; + subcmds : bool; (* Note this is adjusted in Cmdliner_eval *) + kind : kind } + + let make ?(after_dashdash = false) ?(subcmds = false) ~token kind = + { token; after_dashdash; subcmds; kind; } + + let token c = c.token + let after_dashdash c = c.after_dashdash + let subcmds c = c.subcmds + let kind c = c.kind + let add_subcmds c = { c with subcmds = true } +end diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_def.mli b/unikernel/duniverse/cmdliner/src/cmdliner_def.mli new file mode 100644 index 00000000..4d7e71f5 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_def.mli @@ -0,0 +1,304 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Core definitions. *) + +(** Exit codes. *) +module Exit : sig + type code = int + val ok : code + val some_error : code + val cli_error : code + val internal_error : code + + type info + val info : ?docs:string -> ?doc:string -> ?max:code -> code -> info + val info_code : info -> code + val info_codes : info -> code * code + val info_doc : info -> string + val info_docs : info -> string + val info_order : info -> info -> int + val defaults : info list + val doclang_subst : + subst:Cmdliner_manpage.subst -> info -> Cmdliner_manpage.subst + (** [doclang_subst ~subst info] adds the substitution of [info] to + [subst]. *) +end + +(** Environment variables. *) +module Env : sig + type var = string + type info + val info : ?deprecated:string -> ?docs:string -> ?doc:string -> var -> info + val info_var : info -> string + val info_doc : info -> string + val info_docs : info -> string + val info_deprecated : info -> string option + val doclang_subst : + subst:Cmdliner_manpage.subst -> info -> Cmdliner_manpage.subst + (** [doclang_subst ~subst info] adds the substitution of [info] to + [subst]. *) + + val styled_deprecated : + errs:Format.formatter -> subst:Cmdliner_manpage.subst -> info -> string + + val styled_doc : + errs:Format.formatter -> subst:Cmdliner_manpage.subst -> info -> string + + module Set : Set.S with type elt = info +end + +(** Argument information. *) +module Arg_info : sig + type absence = + | Err (** an error is reported. *) + | Val of string Lazy.t (** if <> "", takes the given default value. *) + | Doc of string + (** if <> "", a doc string interpreted in the doc markup language. *) + (** The type for what happens if the argument is absent from the cli. *) + + type opt_kind = + | Flag (** without value, just a flag. *) + | Opt (** with required value. *) + | Opt_vopt of string (** with optional value, takes given default. *) + (** The type for optional argument kinds. *) + + type pos_kind + val pos : rev:bool -> start:int -> len:int option -> pos_kind + val pos_rev : pos_kind -> bool + val pos_start : pos_kind -> int + val pos_len : pos_kind -> int option + + type t + val make : + ?deprecated:string -> ?absent:string -> ?docs:string -> + ?doc_envs:Env.info list -> ?docv:string -> ?doc:string -> + ?env:Env.info -> string list -> t + + val id : t -> int + val deprecated : t -> string option + val absent : t -> absence + val env : t -> Env.info option + val doc : t -> string + val docv : t -> string + val doc_envs : t -> Env.info list + val docs : t -> string + val opt_names : t -> string list (* has dashes *) + val opt_name_sample : t -> string (* warning must be an opt arg *) + val opt_kind : t -> opt_kind + val pos_kind : t -> pos_kind + + val make_req : t -> t + val make_all_opts : t -> t + val make_opt : docv:string -> absent:absence -> kind:opt_kind -> t -> t + val make_opt_all : docv:string -> absent:absence -> kind:opt_kind -> t -> t + val make_pos : docv:string -> pos:pos_kind -> t -> t + val make_pos_abs : docv:string -> absent:absence -> pos:pos_kind -> t -> t + + val is_opt : t -> bool + val is_pos : t -> bool + val is_req : t -> bool + + val pos_cli_order : t -> t -> int + val rev_pos_cli_order : t -> t -> int + + val compare : t -> t -> int + + val doclang_subst : + subst:Cmdliner_manpage.subst -> t -> Cmdliner_manpage.subst + (** [doclang_subst ~subst info] adds the substitution of [info] to + [subst]. Note this includes the substitutions for [env] if present. *) + + val styled_deprecated : + errs:Format.formatter -> subst:Cmdliner_manpage.subst -> t -> string + + val styled_doc : + errs:Format.formatter -> subst:Cmdliner_manpage.subst -> t -> string + + type 'a conv + type e_conv = Conv : 'a conv -> e_conv + + module Set : sig + type arg := t + type t + val is_empty : t -> bool + val empty : t + val add : arg -> e_conv -> t -> t + val choose : t -> arg * e_conv + val partition : (arg -> e_conv -> bool) -> t -> t * t + val filter : (arg -> e_conv -> bool) -> t -> t + val iter : (arg -> e_conv -> unit) -> t -> unit + val singleton : arg -> e_conv -> t + val fold : (arg -> e_conv -> 'acc -> 'acc) -> t -> 'acc -> 'acc + val elements : t -> arg list + val union : t -> t -> t + val find_opt : arg -> t -> e_conv option + end +end + +(** Command information. *) +module Cmd_info : sig + type t + val make : + ?deprecated:string -> ?man_xrefs:Cmdliner_manpage.xref list -> + ?man:Cmdliner_manpage.block list -> ?envs:Env.info list -> + ?exits:Exit.info list -> ?sdocs:string -> ?docs:string -> ?doc:string -> + ?version:string -> string -> t + + val name : t -> string + val version : t -> string option + val deprecated : t -> string option + val doc : t -> string + val docs : t -> string + val stdopts_docs : t -> string + val exits : t -> Exit.info list + val envs : t -> Env.info list + val man : t -> Cmdliner_manpage.block list + val man_xrefs : t -> Cmdliner_manpage.xref list + val args : t -> Arg_info.Set.t + val has_args : t -> bool + val children : t -> t list + val add_args : t -> Arg_info.Set.t -> t + val with_children : t -> args:Arg_info.Set.t option -> children:t list -> t + val styled_deprecated : + errs:Format.formatter -> subst:Cmdliner_manpage.subst -> t -> string + + val styled_doc : + errs:Format.formatter -> subst:Cmdliner_manpage.subst -> t -> string +end + +(** Untyped command line parses. *) +module Cline : sig + type arg = + | O of (int * string * (string option)) list (* (pos, name, value) of opt. *) + | P of string list (** *) + (** Unconverted argument data as found on the command line. *) + + type t (* command line, maps arg_infos to arg value. *) + val empty : t + val add : Arg_info.t -> arg -> t -> t + val get_arg : t -> Arg_info.t -> arg + val get_opt_arg : t -> Arg_info.t -> (int * string * (string option)) list + val get_pos_arg : t -> Arg_info.t -> string list + val actual_args : t -> Arg_info.t -> string list + (** Actual command line arguments from the command line *) + + val fold : (Arg_info.t -> arg -> 'b -> 'b) -> t -> 'b -> 'b + + (** {1:deprecations Deprecations} *) + + type deprecated + (** The type for deprecation invocations. This include both environment + variable deprecations and argument deprecations. *) + + val deprecated : + env:(string -> string option) -> t -> deprecated list + (** [deprecated ~env cli] are the deprecated invocations that occur + when parsing [cli]. *) + + val pp_deprecated : + subst:Cmdliner_manpage.subst -> deprecated Cmdliner_base.Fmt.t + (** [pp_deprecated] formats deprecations. *) +end + +(** Evaluation. *) +module Eval : sig + type t + val make : + ancestors:Cmd_info.t list -> cmd:Cmd_info.t -> subcmds:Cmd_info.t list -> + env:(string -> string option) -> err_ppf:Format.formatter -> t + + val cmd : t -> Cmd_info.t + val main : t -> Cmd_info.t + val ancestors : t -> Cmd_info.t list (* root is last *) + val subcmds : t -> Cmd_info.t list + val env_var : t -> string -> string option + val err_ppf : t -> Format.formatter + val with_cmd : t -> Cmd_info.t -> t + val doclang_subst : t -> Cmdliner_manpage.subst +end + +(** Terms, typed cli fragment definitions. *) +module Term : sig + type escape = + [ `Error of bool * string + | `Help of Cmdliner_manpage.format * string option ] + + type 'a parser = + Eval.t -> Cline.t -> ('a, [ `Parse of string | escape ]) result + + type 'a t = Arg_info.Set.t * 'a parser +end + +(** Completion strategies *) +module Arg_completion : sig + type 'a directive = + | Message of string | String of string * string | Value of 'a * string + | Files | Dirs | Restart | Raw of string + + val value : ?doc:string -> 'a -> 'a directive + val string : ?doc:string -> string -> 'a directive + val files : 'a directive + val dirs : 'a directive + val restart : 'a directive + val message : string -> 'a directive + val raw : string -> 'a directive + + type ('ctx, 'a) func = + 'ctx option -> token:string -> ('a directive list, string) result + + type 'a complete = + | Complete : 'ctx Term.t option * ('ctx, 'a) func -> 'a complete + + type 'a t + + val make : ?context:'ctx Term.t -> ('ctx, 'a) func -> 'a t + val complete : 'a t -> 'a complete + val complete_none : 'a t + val complete_files : 'a t + val complete_dirs : 'a t + val complete_paths : 'a t + val complete_restart : 'a t +end + +(** Textual OCaml value converters *) +module Arg_conv : sig + type 'a parser = string -> ('a, string) result + type 'a fmt = 'a Cmdliner_base.Fmt.t + type 'a t = 'a Arg_info.conv + val make : + ?completion:'a Arg_completion.t -> docv:string -> parser:'a parser -> + pp:'a fmt -> unit -> 'a t + + val of_conv : + ?completion:'a Arg_completion.t -> ?docv:string -> + ?parser:'a parser -> ?pp:'a fmt -> 'a t -> 'a t + + val docv : 'a t -> string + val parser : 'a t -> 'a parser + val pp : 'a t -> 'a fmt + val completion : 'a t -> 'a Arg_completion.t + + val some : ?none:string -> 'a t -> 'a option t + val some' : ?none:'a -> 'a t -> 'a option t + + val none : 'a t +end + +(** Complete instruction. *) +module Complete : sig + type kind = + | Opt_value of Arg_info.t + | Opt_name_or_pos_value of Arg_info.t + | Opt_name + + type t + val make : ?after_dashdash:bool -> ?subcmds:bool -> token:string -> kind -> t + val token : t -> string + val after_dashdash : t -> bool + val subcmds : t -> bool + val kind : t -> kind + val add_subcmds : t -> t +end diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_docgen.ml b/unikernel/duniverse/cmdliner/src/cmdliner_docgen.ml new file mode 100644 index 00000000..ef49a211 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_docgen.ml @@ -0,0 +1,393 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let rev_compare n0 n1 = compare n1 n0 +let strf = Printf.sprintf + +let order_args a0 a1 = + match Cmdliner_def.Arg_info.is_opt a0, Cmdliner_def.Arg_info.is_opt a1 with + | true, true -> (* optional by name *) + let key names = + let k = List.hd (List.sort rev_compare names) in + let k = String.lowercase_ascii k in + if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k + in + compare + (key @@ Cmdliner_def.Arg_info.opt_names a0) + (key @@ Cmdliner_def.Arg_info.opt_names a1) + | false, false -> (* positional by variable *) + compare + (String.lowercase_ascii @@ Cmdliner_def.Arg_info.docv a0) + (String.lowercase_ascii @@ Cmdliner_def.Arg_info.docv a1) + | true, false -> -1 (* positional first *) + | false, true -> 1 (* optional after *) + +let esc = Cmdliner_manpage.escape + +let sorted_items_to_blocks ~boilerplate:b items = + (* Items are sorted by section and then rev. sorted by appearance. + We gather them by section in correct order in a `Block and prefix + them with optional boilerplate *) + let boilerplate = match b with None -> (fun _ -> None) | Some b -> b in + let mk_block sec acc = match boilerplate sec with + | None -> (sec, `Blocks acc) + | Some b -> (sec, `Blocks (b :: acc)) + in + let rec loop secs sec acc = function + | (sec', it) :: its when sec' = sec -> loop secs sec (it :: acc) its + | (sec', it) :: its -> loop (mk_block sec acc :: secs) sec' [it] its + | [] -> (mk_block sec acc) :: secs + in + match items with + | [] -> [] + | (sec, it) :: its -> loop [] sec [it] its + +(* Command docs *) + +let invocation ?(sep = " ") ?(ancestors = []) cmd = + let names = List.rev_map Cmdliner_def.Cmd_info.name (cmd :: ancestors) in + esc @@ String.concat sep names + +let synopsis_pos_arg a = + let v = match Cmdliner_def.Arg_info.docv a with "" -> "ARG" | v -> v in + let v = strf "$(i,%s)" (esc v) in + let v = + (if Cmdliner_def.Arg_info.is_req a then strf "%s" else strf "[%s]") v + in + match Cmdliner_def.Arg_info.(pos_len @@ pos_kind a) with + | None -> v ^ "…" + | Some 1 -> v + | Some n -> + let rec loop n acc = if n <= 0 then acc else loop (n - 1) (v :: acc) in + String.concat " " (loop n []) + +let synopsis_opt_arg a n = + let var = match Cmdliner_def.Arg_info.docv a with "" -> "VAL" | v -> v in + match Cmdliner_def.Arg_info.opt_kind a with + | Cmdliner_def.Arg_info.Flag -> strf "$(b,%s)" (esc n) + | Cmdliner_def.Arg_info.Opt -> + if String.length n > 2 + then strf "$(b,%s)=$(i,%s)" (esc n) (esc var) + else strf "$(b,%s) $(i,%s)" (esc n) (esc var) + | Cmdliner_def.Arg_info.Opt_vopt _ -> + if String.length n > 2 + then strf "$(b,%s)[=$(i,%s)]" (esc n) (esc var) + else strf "$(b,%s) [$(i,%s)]" (esc n) (esc var) + +let deprecated cmd = match Cmdliner_def.Cmd_info.deprecated cmd with +| None -> "" | Some _ -> "(Deprecated) " + +let synopsis ?(show_help = false) ?ancestors cmd = + let show_help = if show_help then " [$(b,--help)]" else "" in + match Cmdliner_def.Cmd_info.children cmd with + | [] -> + let rev_cli_order (a0, _) (a1, _) = + Cmdliner_def.Arg_info.rev_pos_cli_order a0 a1 + in + let args = Cmdliner_def.Cmd_info.args cmd in + let oargs, pargs = + Cmdliner_def.Arg_info.(Set.partition (fun a _ -> is_opt a) args) + in + let oargs = + (* Keep only those that are listed in the s_options section and + that are not [--version] or [--help]. * *) + let keep a _ = + let drop_names n = n = "--help" || n = "--version" in + Cmdliner_def.Arg_info.docs a = Cmdliner_manpage.s_options && + not (List.exists drop_names (Cmdliner_def.Arg_info.opt_names a)) + in + let oargs = Cmdliner_def.Arg_info.Set.(elements (filter keep oargs)) in + let count = List.length oargs in + let any_option = "[$(i,OPTION)]…" in + if count = 0 || count > 3 then any_option else + let syn a = + let syn = + synopsis_opt_arg a (Cmdliner_def.Arg_info.opt_name_sample a) + in + if Cmdliner_def.Arg_info.is_req a + then syn + else strf "[%s]" syn + in + let oargs = List.sort order_args oargs in + let oargs = String.concat " " (List.map syn oargs) in + String.concat " " [oargs; any_option] + in + let pargs = + let pargs = Cmdliner_def.Arg_info.Set.elements pargs in + if pargs = [] then "" else + let pargs = List.map (fun a -> a, synopsis_pos_arg a) pargs in + let pargs = List.sort rev_cli_order pargs in + String.concat " " ("" (* add a space *) :: List.rev_map snd pargs) + in + strf "%s$(b,%s)%s %s%s" + (deprecated cmd) (invocation ?ancestors cmd) show_help oargs pargs + | _cmds -> + let subcmd = match Cmdliner_def.Cmd_info.has_args cmd with + | false -> "$(i,COMMAND)" | true -> "[$(i,COMMAND)]" + in + strf "%s$(b,%s)%s %s …" (deprecated cmd) (invocation ?ancestors cmd) + show_help subcmd + +let cmd_doc cmd = + let depr = match Cmdliner_def.Cmd_info.deprecated cmd with + | None -> "" | Some msg -> msg ^ " " + in + depr ^ Cmdliner_def.Cmd_info.doc cmd + +let cmd_docs ei = match Cmdliner_def.(Cmd_info.children (Eval.cmd ei)) with +| [] -> [] +| cmds -> + let add_cmd acc cmd = + let syn = synopsis cmd in + (Cmdliner_def.Cmd_info.docs cmd, `I (syn, cmd_doc cmd)) :: acc + in + let by_sec_by_rev_name (s0, `I (c0, _)) (s1, `I (c1, _)) = + let c = compare s0 s1 in + if c <> 0 then c else compare c1 c0 (* N.B. reverse *) + in + let cmds = List.fold_left add_cmd [] cmds in + let cmds = List.sort by_sec_by_rev_name cmds in + let cmds = (cmds :> (string * Cmdliner_manpage.block) list) in + sorted_items_to_blocks ~boilerplate:None cmds + +(* Argument docs *) + +let arg_man_item_label a = + let s = match Cmdliner_def.Arg_info.is_pos a with + | true -> strf "$(i,%s)" (esc @@ Cmdliner_def.Arg_info.docv a) + | false -> + let names = List.sort compare (Cmdliner_def.Arg_info.opt_names a) in + String.concat ", " (List.rev_map (synopsis_opt_arg a) names) + in + match Cmdliner_def.Arg_info.deprecated a with + | None -> s | Some _ -> "(Deprecated) " ^ s + +let arg_to_man_item ~errs ~subst ~buf a = + let subst = Cmdliner_def.Arg_info.doclang_subst ~subst a in + let or_env ~value a = match Cmdliner_def.Arg_info.env a with + | None -> "" + | Some e -> + let value = if value then " or" else "absent " in + strf "%s $(b,%s) env" value (esc @@ Cmdliner_def.Env.info_var e) + in + let absent = match Cmdliner_def.Arg_info.absent a with + | Cmdliner_def.Arg_info.Err -> "required" + | Cmdliner_def.Arg_info.Doc "" -> strf "%s" (or_env ~value:false a) + | Cmdliner_def.Arg_info.Doc s -> + let s = Cmdliner_manpage.subst_vars ~errs ~subst buf s in + strf "absent=%s%s" s (or_env ~value:true a) + | Cmdliner_def.Arg_info.Val v -> + match Lazy.force v with + | "" -> strf "%s" (or_env ~value:false a) + | v -> strf "absent=$(b,%s)%s" (esc v) (or_env ~value:true a) + in + let optvopt = match Cmdliner_def.Arg_info.opt_kind a with + | Cmdliner_def.Arg_info.Opt_vopt v -> strf "default=$(b,%s)" (esc v) + | _ -> "" + in + let argvdoc = match optvopt, absent with + | "", "" -> "" + | s, "" | "", s -> strf " (%s)" s + | s, s' -> strf " (%s) (%s)" s s' + in + let deprecated = match Cmdliner_def.Arg_info.deprecated a with + | None -> "" | Some msg -> msg ^ " " + in + let doc = deprecated ^ Cmdliner_def.Arg_info.doc a in + let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in + (Cmdliner_def.Arg_info.docs a, `I (arg_man_item_label a ^ argvdoc, doc)) + +let arg_docs ~errs ~subst ~buf ei = + let by_sec_by_arg a0 a1 = + let c = compare + (Cmdliner_def.Arg_info.docs a0) + (Cmdliner_def.Arg_info.docs a1) + in + if c <> 0 then c else + let c = + match + Cmdliner_def.Arg_info.deprecated a0, + Cmdliner_def.Arg_info.deprecated a1 + with + | None, None | Some _, Some _ -> 0 + | None, Some _ -> -1 | Some _, None -> 1 + in + if c <> 0 then c else order_args a0 a1 + in + let keep_arg a _ acc = + if not Cmdliner_def.Arg_info.(is_pos a && (docv a = "" || doc a = "")) + then (a :: acc) else acc + in + let args = Cmdliner_def.Cmd_info.args @@ Cmdliner_def.Eval.cmd ei in + let args = Cmdliner_def.Arg_info.Set.fold keep_arg args [] in + let args = List.sort by_sec_by_arg args in + let args = List.rev_map (arg_to_man_item ~errs ~subst ~buf) args in + sorted_items_to_blocks ~boilerplate:None args + +(* Exit statuses doc *) + +let exit_boilerplate sec = match sec = Cmdliner_manpage.s_exit_status with +| false -> None +| true -> Some (Cmdliner_manpage.s_exit_status_intro) + +let exit_docs ~errs ~subst ~buf ~has_sexit ei = + let by_sec (s0, _) (s1, _) = compare s0 s1 in + let add_exit_item acc einfo = + let subst = Cmdliner_def.Exit.doclang_subst ~subst einfo in + let min, max = Cmdliner_def.Exit.info_codes einfo in + let doc = Cmdliner_def.Exit.info_doc einfo in + let label = if min = max then strf "%d" min else strf "%d-%d" min max in + let item = `I (label, Cmdliner_manpage.subst_vars ~errs ~subst buf doc) in + (Cmdliner_def.Exit.info_docs einfo, item) :: acc + in + let exits = Cmdliner_def.Cmd_info.exits @@ Cmdliner_def.Eval.cmd ei in + let exits = List.sort Cmdliner_def.Exit.info_order exits in + let exits = List.fold_left add_exit_item [] exits in + let exits = List.stable_sort by_sec (* sort by section *) exits in + let boilerplate = if has_sexit then None else Some exit_boilerplate in + sorted_items_to_blocks ~boilerplate exits + +(* Environment doc *) + +let env_boilerplate sec = match sec = Cmdliner_manpage.s_environment with +| false -> None +| true -> Some (Cmdliner_manpage.s_environment_intro) + +let env_docs ~errs ~subst ~buf ~has_senv ei = + let add_env_item ~subst (seen, envs as acc) e = + if Cmdliner_def.Env.Set.mem e seen then acc else + let seen = Cmdliner_def.Env.Set.add e seen in + let var = strf "$(b,%s)" @@ esc (Cmdliner_def.Env.info_var e) in + let var, deprecated = match Cmdliner_def.Env.info_deprecated e with + | None -> var, "" | Some msg -> "(Deprecated) " ^ var, msg ^ " " in + let doc = deprecated ^ Cmdliner_def.Env.info_doc e in + let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in + let envs = (Cmdliner_def.Env.info_docs e, `I (var, doc)) :: envs in + seen, envs + in + let add_arg_envs a _ acc = + let envs = Cmdliner_def.Arg_info.doc_envs a in + let envs = match Cmdliner_def.Arg_info.env a with + | None -> envs | Some e -> e :: envs + in + let subst = Cmdliner_def.Arg_info.doclang_subst ~subst a in + List.fold_left (add_env_item ~subst) acc envs + in + let add_env acc e = + let subst = Cmdliner_def.Env.doclang_subst ~subst e in + add_env_item ~subst acc e + in + let by_sec_by_rev_name (s0, `I (v0, _)) (s1, `I (v1, _)) = + let c = compare s0 s1 in + if c <> 0 then c else compare v1 v0 (* N.B. reverse *) + in + (* Arg envs before term envs is important here: if the same is mentioned + both in an arg and in a term the substs of the arg are allowed. *) + let args = Cmdliner_def.Cmd_info.args @@ Cmdliner_def.Eval.cmd ei in + let tenvs = Cmdliner_def.Cmd_info.envs @@ Cmdliner_def.Eval.cmd ei in + let init = Cmdliner_def.Env.Set.empty, [] in + let acc = Cmdliner_def.Arg_info.Set.fold add_arg_envs args init in + let _, envs = List.fold_left add_env acc tenvs in + let envs = List.sort by_sec_by_rev_name envs in + let envs = (envs :> (string * Cmdliner_manpage.block) list) in + let boilerplate = if has_senv then None else Some env_boilerplate in + sorted_items_to_blocks ~boilerplate envs + +(* xref doc *) + +let xref_docs ~errs ei = + let main = Cmdliner_def.Eval.main ei in + let to_xref = function + | `Main -> Cmdliner_def.Cmd_info.name main, 1 + | `Tool tool -> tool, 1 + | `Page (name, sec) -> name, sec + | `Cmd c -> + (* N.B. we are handling only the first subcommand level here *) + let cmds = Cmdliner_def.Cmd_info.children main in + let mname = Cmdliner_def.Cmd_info.name main in + let is_cmd cmd = Cmdliner_def.Cmd_info.name cmd = c in + if List.exists is_cmd cmds then strf "%s-%s" mname c, 1 else + (Format.fprintf errs "xref %s: no such command name@." c; "doc-err", 0) + in + let xref_str (name, sec) = strf "%s(%d)" (esc name) sec in + let xrefs = Cmdliner_def.Cmd_info.man_xrefs @@ Cmdliner_def.Eval.cmd ei in + let xrefs = match main == Cmdliner_def.Eval.cmd ei with + | true -> List.filter (fun x -> x <> `Main) xrefs (* filter out default *) + | false -> xrefs + in + let xrefs = List.fold_left (fun acc x -> to_xref x :: acc) [] xrefs in + let xrefs = List.(rev_map xref_str (sort rev_compare xrefs)) in + if xrefs = [] then [] else + [Cmdliner_manpage.s_see_also, `P (String.concat ", " xrefs)] + +(* Man page construction *) + +let ensure_s_name ei sm = + if Cmdliner_manpage.(smap_has_section sm ~sec:s_name) then sm else + let cmd = Cmdliner_def.Eval.cmd ei in + let ancestors = Cmdliner_def.Eval.ancestors ei in + let tname = (deprecated cmd) ^ invocation ~sep:"-" ~ancestors cmd in + let tdoc = cmd_doc cmd in + let tagline = if tdoc = "" then "" else strf " - %s" tdoc in + let tagline = `P (strf "%s%s" tname tagline) in + Cmdliner_manpage.(smap_append_block sm ~sec:s_name tagline) + +let ensure_s_synopsis ei sm = + if Cmdliner_manpage.(smap_has_section sm ~sec:s_synopsis) then sm else + let cmd = Cmdliner_def.Eval.cmd ei in + let ancestors = Cmdliner_def.Eval.ancestors ei in + let synopsis = `P (synopsis ~ancestors cmd) in + Cmdliner_manpage.(smap_append_block sm ~sec:s_synopsis synopsis) + +let insert_cmd_man_docs ~errs ei sm = + let buf = Buffer.create 200 in + let subst = Cmdliner_def.Eval.doclang_subst ei in + let ins sm (sec, b) = Cmdliner_manpage.smap_append_block sm ~sec b in + let has_senv = Cmdliner_manpage.(smap_has_section sm ~sec:s_environment) in + let has_sexit = Cmdliner_manpage.(smap_has_section sm ~sec:s_exit_status) in + let sm = List.fold_left ins sm (cmd_docs ei) in + let sm = List.fold_left ins sm (arg_docs ~errs ~subst ~buf ei) in + let sm = List.fold_left ins sm (exit_docs ~errs ~subst ~buf ~has_sexit ei)in + let sm = List.fold_left ins sm (env_docs ~errs ~subst ~buf ~has_senv ei) in + let sm = List.fold_left ins sm (xref_docs ~errs ei) in + sm + +let text ~errs ei = + let man = Cmdliner_def.Cmd_info.man @@ Cmdliner_def.Eval.cmd ei in + let sm = Cmdliner_manpage.smap_of_blocks man in + let sm = ensure_s_name ei sm in + let sm = ensure_s_synopsis ei sm in + let sm = insert_cmd_man_docs ei ~errs sm in + Cmdliner_manpage.smap_to_blocks sm + +let title ei = + let main = Cmdliner_def.Eval.main ei in + let exec = String.capitalize_ascii (Cmdliner_def.Cmd_info.name main) in + let cmd = Cmdliner_def.Eval.cmd ei in + let ancestors = Cmdliner_def.Eval.ancestors ei in + let name = String.uppercase_ascii (invocation ~sep:"-" ~ancestors cmd) in + let center_header = esc @@ strf "%s Manual" exec in + let left_footer = + let version = match Cmdliner_def.Cmd_info.version main with + | None -> "" | Some v -> " " ^ v + in + esc @@ strf "%s%s" exec version + in + name, 1, "", left_footer, center_header + +let man ~errs ei = title ei, text ~errs ei + +let pp_man ~env ~errs fmt ppf ei = + let subst = Cmdliner_def.Eval.doclang_subst ei in + Cmdliner_manpage.print ~env ~errs ~subst fmt ppf (man ~errs ei) + +(* Plain synopsis for usage *) + +let styled_usage_synopsis ~errs ei = + let subst = Cmdliner_def.Eval.doclang_subst ei in + let cmd = Cmdliner_def.Eval.cmd ei in + let ancestors = Cmdliner_def.Eval.ancestors ei in + let synopsis = synopsis ~show_help:true ~ancestors cmd in + Cmdliner_manpage.doc_to_styled ~errs ~subst synopsis diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_docgen.mli b/unikernel/duniverse/cmdliner/src/cmdliner_docgen.mli new file mode 100644 index 00000000..7e37ffec --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_docgen.mli @@ -0,0 +1,12 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +val pp_man : + env:(string -> string option) -> + errs:Format.formatter -> Cmdliner_manpage.format -> Format.formatter -> + Cmdliner_def.Eval.t -> unit + +val styled_usage_synopsis : + errs:Format.formatter -> Cmdliner_def.Eval.t -> string diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_eval.ml b/unikernel/duniverse/cmdliner/src/cmdliner_eval.ml new file mode 100644 index 00000000..1227899f --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_eval.ml @@ -0,0 +1,349 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] +type 'a eval_exit = [ `Ok of 'a | `Exit of Cmdliner_def.Exit.code ] + +type eval_result_error = + [ Cmdliner_term.term_escape + | `Exn of exn * Printexc.raw_backtrace + | `Parse of string + | `Std_help of Cmdliner_manpage.format + | `Std_version ] + +type 'a eval_result = + ('a, [ eval_result_error + | `Complete of Cmdliner_def.Complete.t * Cmdliner_def.Cline.t]) result + +let err_help s = "Term error, help requested for unknown command " ^ s +let err_argv = "argv array must have at least one element" + +let add_stdopts eval = + let docs = Cmdliner_def.Cmd_info.stdopts_docs (Cmdliner_def.Eval.cmd eval) in + let vargs, vers = + match Cmdliner_def.Cmd_info.version (Cmdliner_def.Eval.main eval) with + | None -> Cmdliner_def.Arg_info.Set.empty, None + | Some _ -> + let vers = Cmdliner_arg.stdopt_version ~docs in + (Cmdliner_term.argset vers), Some vers + in + let help = Cmdliner_arg.stdopt_help ~docs in + let args = + Cmdliner_def.Arg_info.Set.union vargs (Cmdliner_term.argset help) + in + let cmd = Cmdliner_def.Cmd_info.add_args (Cmdliner_def.Eval.cmd eval) args in + help, vers, Cmdliner_def.Eval.with_cmd eval cmd + +let run_parser ~catch eval cl f = + try (f eval cl :> ('a, eval_result_error) result) with + | exn when catch -> + let bt = Printexc.get_raw_backtrace () in + Error (`Exn (exn, bt)) + +let try_eval_stdopts ~catch eval cline help version : 'a eval_result option = + match run_parser ~catch eval cline (Cmdliner_term.parser help) with + | Ok (Some fmt) -> Some (Error (`Std_help fmt)) + | Error (`Parse _) -> + (* only [FMT] errored, there was a `--help`, show help anyways *) + Some (Error (`Std_help `Auto)) + | Error _ as err -> (Some err :> 'a eval_result option) + | Ok None -> + match version with + | None -> None + | Some version -> + match (run_parser ~catch eval cline (Cmdliner_term.parser version)) + with + | Ok false -> None + | Ok true -> Some (Error (`Std_version)) + | Error _ as err -> (Some err :> 'a eval_result option) + +let do_help ~env help_ppf err_ppf eval fmt cmd_name = + let eval = match cmd_name with + | None (* help of main command requested *) -> + let env _ = assert false in + let cmd = Cmdliner_def.Eval.main eval in + let subcmds = Cmdliner_def.Eval.subcmds eval in + let eval' = + Cmdliner_def.Eval.make ~ancestors:[] ~cmd ~subcmds ~env ~err_ppf + in + begin match Cmdliner_def.Eval.ancestors eval with + | [] -> (* [ei] is an evaluation of main, [cmd] has stdopts *) eval' + | _ -> let _, _, eval' = add_stdopts eval' in eval' + end + | Some cmd -> + try + (* For now we simply keep backward compat. [cmd] should be + a name from main's children. *) + let main = Cmdliner_def.Eval.main eval in + let is_cmd t = Cmdliner_def.Cmd_info.name t = cmd in + let children = Cmdliner_def.Cmd_info.children main in + let cmd = List.find is_cmd children in + let _, _, eval = add_stdopts (Cmdliner_def.Eval.with_cmd eval cmd) in + eval + with Not_found -> invalid_arg (err_help cmd) + in + Cmdliner_docgen.pp_man ~env ~errs:err_ppf fmt help_ppf eval + +let do_result ~env help_ppf err_ppf eval = function +| Ok v -> Ok (`Ok v) +| Error res -> + match res with + | `Std_help fmt -> + Cmdliner_docgen.pp_man ~env ~errs:err_ppf fmt help_ppf eval; Ok `Help + | `Std_version -> + Cmdliner_msg.pp_version help_ppf eval; Ok `Version + | `Parse err -> + Cmdliner_msg.pp_usage_and_err err_ppf eval ~err; Error `Parse + | `Complete (comp, cline) -> + Cmdliner_completion.output ~out_ppf:help_ppf ~err_ppf eval comp cline; + Ok `Help + | `Help (fmt, cmd_name) -> + do_help ~env help_ppf err_ppf eval fmt cmd_name; Ok `Help + | `Exn (e, bt) -> + Cmdliner_msg.pp_backtrace err_ppf eval e bt; (Error `Exn) + | `Error (usage, err) -> + (if usage + then Cmdliner_msg.pp_usage_and_err err_ppf eval ~err + else Cmdliner_msg.pp_err err_ppf eval ~err); + Error `Term + +let do_deprecated_msgs ~env err_ppf cl eval = + let cmd_info = Cmdliner_def.Eval.cmd eval in + let deprecated = Cmdliner_def.Cline.deprecated ~env cl in + match Cmdliner_def.Cmd_info.deprecated cmd_info, deprecated with + | None, [] -> () + | depr_cmd, deprs -> + let open Cmdliner_base in + let pp_sep ppf () = + if Option.is_some depr_cmd && deprs <> [] then Fmt.cut ppf (); + in + let subst = Cmdliner_def.Eval.doclang_subst eval in + let pp_cmd_msg ppf cmd = + match + Cmdliner_def.Cmd_info.styled_deprecated ~subst ~errs:err_ppf cmd + with + | "" -> () + | msg -> + let name = Cmdliner_def.Cmd_info.name cmd in + Fmt.pf ppf "@[%a command %a:@[ %a@]@]" + Fmt.deprecated () Fmt.code_or_quote name Fmt.styled_text msg + in + let pp_deprs = Fmt.list (Cmdliner_def.Cline.pp_deprecated ~subst) in + Fmt.pf err_ppf "@[%a @[%a%a%a@]@]@." + Cmdliner_msg.pp_exec_msg eval pp_cmd_msg cmd_info + pp_sep () pp_deprs deprs + +let find_cmd_and_parser ~legacy_prefixes ~for_completion args cmd = + (* This finds the command to use if it's a group and [for_completion] + is [true] whether we may need to add the subcommand names to the + completions. *) + let stop ~ancestors ~cmd args = match (cmd : 'a Cmdliner_cmd.t) with + | Cmd (_, parser) -> ancestors, cmd, args, Ok parser + | Group (_, (Some parser, _)) -> ancestors, cmd, args, Ok parser + | Group (_, (None, children)) -> + let dom = Cmdliner_cmd.list_names children in + let err = Cmdliner_msg.err_cmd_missing ~dom in + let try_stdopts = true in + ancestors, cmd, args, Error (`Parse (try_stdopts, err)) + in + let rec loop ~ancestors ~current_cmd = function + | "--" :: _ | [] as args -> stop ~ancestors ~cmd:current_cmd args + | arg :: _ as args when for_completion && + Cmdliner_cline.has_complete_prefix arg -> + begin match current_cmd with + | Cmd _ -> (* arg completion *) stop ~ancestors ~cmd:current_cmd args + | Group (_, (parser, _)) -> + let is_opt = Cmdliner_cline.(is_opt (get_token_to_complete arg)) in + if not is_opt then ancestors, current_cmd, args, Error `Complete else + stop ~ancestors ~cmd:current_cmd args + end + | arg :: _ as args when Cmdliner_cline.is_opt arg -> + stop ~ancestors ~cmd:current_cmd args + | arg :: rest as args -> + match current_cmd with + | Cmd (i, parser) -> ancestors, current_cmd, args, Ok parser + | Group (i, (_, children)) -> + let cmd_index = Cmdliner_cmd.name_trie children in + match Cmdliner_trie.find ~legacy_prefixes cmd_index arg with + | Ok cmd -> loop ~ancestors:(i :: ancestors) ~current_cmd:cmd rest + | Error `Not_found -> + let all = Cmdliner_trie.ambiguities cmd_index "" in + let hints = Cmdliner_base.suggest arg all in + let dom = Cmdliner_cmd.list_names children in + let kind = "command" in + let err = Cmdliner_base.err_unknown ~kind ~dom ~hints arg in + let try_stdopts = + (* When one writes [cmd no_such_cmd --help] it's better + to show the unknown command error message rather + than get into the help of the parent command. Otherwise + one gets confused into thinking the command exists and/or + annoyed not to be reading the right man page. *) + false + in + ancestors, current_cmd, args, Error (`Parse (try_stdopts, err)) + | Error `Ambiguous (* Only on legacy prefixes *) -> + let ambs = Cmdliner_trie.ambiguities cmd_index arg in + let ambs = List.sort compare ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"command" arg ~ambs in + let try_stdopts = false in + ancestors, current_cmd, args, Error (`Parse (try_stdopts, err)) + in + loop ~ancestors:[] ~current_cmd:cmd args + +let cli_args_of_argv argv = match Array.to_list argv with +| exec :: "--__complete" :: args -> true, args +| exec :: args -> false, args +| [] -> invalid_arg err_argv + +let eval_value + ?help:(help_ppf = Format.std_formatter) + ?err:(err_ppf = Format.err_formatter) + ?(catch = true) ?(env = Sys.getenv_opt) ?(argv = Sys.argv) cmd + = + let legacy_prefixes = Cmdliner_trie.legacy_prefixes ~env in + let for_completion, args = cli_args_of_argv argv in + let ancestors, cmd, args, parser = + find_cmd_and_parser ~legacy_prefixes ~for_completion args cmd + in + let help, version, eval = + let subcmds = Cmdliner_cmd.get_children_infos cmd in + let cmd = Cmdliner_cmd.get_info cmd in + let eval = Cmdliner_def.Eval.make ~ancestors ~cmd ~subcmds ~env ~err_ppf in + add_stdopts eval + in + let cline = + let args_info = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd eval) in + Cmdliner_cline.create ~legacy_prefixes ~for_completion args_info args + in + let res = match parser with + | Error (`Parse (try_stdopts, msg)) -> + (* Command lookup error, we may still prioritize stdargs *) + begin match cline with + | `Complete c -> Error (`Complete c) + | `Error (_, cl) | `Ok cl -> + let stdopts = + if try_stdopts + then try_eval_stdopts ~catch eval cl help version else None + in + begin match stdopts with + | None -> Error (`Error (true, msg)) + | Some e -> e + end + end + | Error `Complete -> + begin match cline with + | `Complete (comp, cline) -> + let comp = Cmdliner_def.Complete.add_subcmds comp in + Error (`Complete (comp, cline)) + | `Ok _ | `Error _ -> assert false + end + | Ok parser -> + begin match cline with + | `Complete c -> Error (`Complete c) + | `Error (e, cl) -> + begin match try_eval_stdopts ~catch eval cl help version with + | Some e -> e + | None -> Error (`Error (true, e)) + end + | `Ok cl -> + match try_eval_stdopts ~catch eval cl help version with + | Some e -> e + | None -> + do_deprecated_msgs ~env err_ppf cl eval; + (run_parser ~catch eval cl parser :> 'a eval_result) + end + in + do_result ~env help_ppf err_ppf eval res + +let eval_peek_opts + ?(version_opt = false) ?(env = Sys.getenv_opt) ?(argv = Sys.argv) t + : 'a option * ('a eval_ok, eval_error) result + = + let legacy_prefixes = Cmdliner_trie.legacy_prefixes ~env in + let for_completion, args = cli_args_of_argv argv in + let version = if version_opt then Some "dummy" else None in + let cmd_info, parser = + let args, parser = Cmdliner_term.argset t, Cmdliner_term.parser t in + let cmd_info = Cmdliner_def.Cmd_info.make ?version "dummy" in + Cmdliner_def.Cmd_info.add_args cmd_info args, parser + in + let help, version, eval = + let err_ppf = Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()) in + let ancestors = [] and cmd = cmd_info and subcmds = [] in + let eval = Cmdliner_def.Eval.make ~ancestors ~cmd ~subcmds ~env ~err_ppf in + add_stdopts eval + in + let cline = + let arg_infos = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd eval) in + Cmdliner_cline.create + ~peek_opts:true ~legacy_prefixes ~for_completion arg_infos args + in + let v, ret = match cline with + | `Complete comp -> None, (Error (`Complete comp)) + | `Error (e, cl) -> + begin match try_eval_stdopts ~catch:true eval cl help version with + | Some e -> None, e + | None -> None, Error (`Error (true, e)) + end + | `Ok cl -> + let ret = run_parser ~catch:true eval cl parser in + let v = match ret with Ok v -> Some v | Error _ -> None in + begin match try_eval_stdopts ~catch:true eval cl help version with + | Some e -> v, e + | None -> v, (ret :> 'a eval_result) + end + in + let ret = match ret with + | Ok v -> Ok (`Ok v) + | Error `Std_help _ -> Ok `Help + | Error `Std_version -> Ok `Version + | Error `Parse _ -> Error `Parse + | Error `Help _ -> Ok `Help + | Error `Complete _ -> Ok `Help + | Error `Exn _ -> Error `Exn + | Error `Error _ -> Error `Term + in + (v, ret) + +let exit_status_of_result ?(term_err = Cmdliner_def.Exit.cli_error) = function +| Ok (`Ok _ | `Help | `Version) -> Cmdliner_def.Exit.ok +| Error `Term -> term_err +| Error `Parse -> Cmdliner_def.Exit.cli_error +| Error `Exn -> Cmdliner_def.Exit.internal_error + +let eval_value' ?help ?err ?catch ?env ?argv ?term_err cmd = + match eval_value ?help ?err ?catch ?env ?argv cmd with + | Ok (`Ok _ as v) -> v + | ret -> `Exit (exit_status_of_result ?term_err ret) + +let eval ?help ?err ?catch ?env ?argv ?term_err cmd = + exit_status_of_result ?term_err @@ + eval_value ?help ?err ?catch ?env ?argv cmd + +let eval' ?help ?err ?catch ?env ?argv ?term_err cmd = + match eval_value ?help ?err ?catch ?env ?argv cmd with + | Ok (`Ok c) -> c + | r -> exit_status_of_result ?term_err r + +let pp_err ppf cmd ~msg = + (* Here instead of Cmdliner_msgs to avoid circular dep *) + let name = Cmdliner_cmd.name cmd in + Cmdliner_base.Fmt.pf ppf "%s: @[%a@]@." name Cmdliner_base.Fmt.lines msg + +let eval_result + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_def.Exit.some_error + | r -> exit_status_of_result ?term_err r + +let eval_result' + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Ok c)) -> c + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_def.Exit.some_error + | r -> exit_status_of_result ?term_err r diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_eval.mli b/unikernel/duniverse/cmdliner/src/cmdliner_eval.mli new file mode 100644 index 00000000..882f6cc8 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_eval.mli @@ -0,0 +1,48 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Command evaluation *) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] +type 'a eval_exit = [ `Ok of 'a | `Exit of Cmdliner_def.Exit.code ] + +val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a Cmdliner_cmd.t -> + ('a eval_ok, eval_error) result + +val eval_value' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> 'a Cmdliner_cmd.t -> 'a eval_exit + +val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Cmdliner_term.t -> + 'a option * ('a eval_ok, eval_error) result + +val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> unit Cmdliner_cmd.t -> Cmdliner_def.Exit.code + +val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> int Cmdliner_cmd.t -> Cmdliner_def.Exit.code + +val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_def.Exit.code -> (unit, string) result Cmdliner_cmd.t -> + Cmdliner_def.Exit.code + +val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_def.Exit.code -> + (Cmdliner_def.Exit.code, string) result Cmdliner_cmd.t -> + Cmdliner_def.Exit.code diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_manpage.ml b/unikernel/duniverse/cmdliner/src/cmdliner_manpage.ml new file mode 100644 index 00000000..1ae74e53 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_manpage.ml @@ -0,0 +1,557 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* Manpages *) + +type section_name = string + +type block = + [ `S of section_name | `P of string | `Pre of string | `I of string * string + | `Noblank | `Blocks of block list ] + +type title = string * int * string * string * string + +type t = title * block list + +type xref = + [ `Main | `Cmd of string | `Tool of string | `Page of string * int ] + +(* Standard sections *) + +let s_name = "NAME" +let s_synopsis = "SYNOPSIS" +let s_description = "DESCRIPTION" +let s_commands = "COMMANDS" +let s_arguments = "ARGUMENTS" +let s_options = "OPTIONS" +let s_common_options = "COMMON OPTIONS" +let s_exit_status = "EXIT STATUS" +let s_exit_status_intro = `P "$(cmd) exits with:" + +let s_environment = "ENVIRONMENT" +let s_environment_intro = + `P "These environment variables affect the execution of $(cmd):" + +let s_files = "FILES" +let s_examples = "EXAMPLES" +let s_bugs = "BUGS" +let s_authors = "AUTHORS" +let s_see_also = "SEE ALSO" +let s_none = "cmdliner-none" + +(* Section order *) + +let s_created = "" +let order = + [| s_name; s_synopsis; s_description; s_created; s_commands; + s_arguments; s_options; s_common_options; s_exit_status; + s_environment; s_files; s_examples; s_bugs; s_authors; s_see_also; + s_none; |] + +let order_synopsis = 1 +let order_created = 3 + +let section_of_order i = order.(i) +let section_to_order ~on_unknown s = + let max = Array.length order - 1 in + let rec loop i = match i > max with + | true -> on_unknown + | false -> if order.(i) = s then i else loop (i + 1) + in + loop 0 + +(* Section maps + + Section maps, maps section names to their section order and reversed + content blocks (content is not reversed in `Block blocks). The sections + are listed in reversed order. Unknown sections get the order of the last + known section. *) + +type smap = (string * (int * block list)) list + +let smap_of_blocks bs = (* N.B. this flattens `Blocks, not t.r. *) + let rec loop s s_o rbs smap = function + | [] -> s, s_o, rbs, smap + | `S new_sec :: bs -> + let new_o = section_to_order ~on_unknown:s_o new_sec in + loop new_sec new_o [] ((s, (s_o, rbs)):: smap) bs + | `Blocks blist :: bs -> + let s, s_o, rbs, rmap = loop s s_o rbs smap blist (* not t.r. *) in + loop s s_o rbs rmap bs + | (`P _ | `Pre _ | `I _ | `Noblank as c) :: bs -> + loop s s_o (c :: rbs) smap bs + in + let first, (bs : block list) = match bs with + | `S s :: bs -> s, bs + | `Blocks (`S s :: blist) :: bs -> s, (`Blocks blist) :: bs + | _ -> "", bs + in + let first_o = section_to_order ~on_unknown:order_synopsis first in + let s, s_o, rc, smap = loop first first_o [] [] bs in + (s, (s_o, rc)) :: smap + +let smap_to_blocks smap = (* N.B. this leaves `Blocks content untouched. *) + let rec loop acc smap s = function + | b :: rbs -> loop (b :: acc) smap s rbs + | [] -> + let acc = if s = "" then acc else `S s :: acc in + match smap with + | [] -> acc + | (_, (_, [])) :: smap -> loop acc smap "" [] (* skip empty section *) + | (s, (_, rbs)) :: smap -> + if s = s_none + then loop acc smap "" [] (* skip *) + else loop acc smap s rbs + in + loop [] smap "" [] + +let smap_has_section smap ~sec = List.exists (fun (s, _) -> sec = s) smap +let smap_append_block smap ~sec b = + let o = section_to_order ~on_unknown:order_created sec in + let try_insert = + let rec loop max_lt_o left = function + | (s', (o, rbs)) :: right when s' = sec -> + Ok (List.rev_append ((sec, (o, b :: rbs)) :: left) right) + | (_, (o', _) as s) :: right -> + let max_lt_o = if o' < o then max o' max_lt_o else max_lt_o in + loop max_lt_o (s :: left) right + | [] -> + if max_lt_o <> -1 then Error max_lt_o else + Ok (List.rev ((sec, (o, [b])) :: left)) + in + loop (-1) [] smap + in + match try_insert with + | Ok smap -> smap + | Error insert_before -> + let rec loop left = function + | (s', (o', _)) :: _ as right when o' = insert_before -> + List.rev_append ((sec, (o, [b])) :: left) right + | s :: ss -> loop (s :: left) ss + | [] -> assert false + in + loop [] smap + +(* Formatting tools *) + +let strf = Printf.sprintf +module Fmt = Cmdliner_base.Fmt + +(* Cmdliner markup handling *) + +let err e fmt = Fmt.pf e ("cmdliner error: " ^^ fmt ^^ "@.") +let err_unescaped ~errs c s = err errs "unescaped %C in %S" c s +let err_malformed ~errs s = err errs "Malformed $(…) in %S" s +let err_unclosed ~errs s = err errs "Unclosed $(…) in %S" s +let err_undef ~errs id s = err errs "Undefined variable $(%s) in %S" id s +let err_illegal_esc ~errs c s = err errs "Illegal escape char %C in %S" c s +let err_markup ~errs dir s = + err errs "Unknown cmdliner markup $(%c,…) in %S" dir s + +let is_markup_dir = function 'i' | 'b' -> true | _ -> false +let is_markup_esc = function '$' | '\\' | '(' | ')' -> true | _ -> false +let markup_need_esc = function '\\' | '$' -> true | _ -> false +let markup_text_need_esc = function '\\' | '$' | ')' -> true | _ -> false + +let escape s = (* escapes [s] from doc language. *) + let max_i = String.length s - 1 in + let rec escaped_len i l = + if i > max_i then l else + if markup_text_need_esc s.[i] then escaped_len (i + 1) (l + 2) else + escaped_len (i + 1) (l + 1) + in + let escaped_len = escaped_len 0 0 in + if escaped_len = String.length s then s else + let b = Bytes.create escaped_len in + let rec loop i k = + if i > max_i then Bytes.unsafe_to_string b else + let c = String.unsafe_get s i in + if not (markup_text_need_esc c) + then (Bytes.unsafe_set b k c; loop (i + 1) (k + 1)) + else (Bytes.unsafe_set b k '\\'; Bytes.unsafe_set b (k + 1) c; + loop (i + 1) (k + 2)) + in + loop 0 0 + +let subst_vars ~errs ~subst b s = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let skip_escape k start i = + if i > max_i then err_unescaped ~errs '\\' s else k start (i + 1) + in + let rec skip_markup k start i = + if i > max_i then (err_unclosed ~errs s; k start i) else + match s.[i] with + | '\\' -> skip_escape (skip_markup k) start (i + 1) + | ')' -> k start (i + 1) + | c -> skip_markup k start (i + 1) + in + let rec add_subst start i = + if i > max_i then (err_unclosed ~errs s; loop start i) else + if s.[i] <> ')' then add_subst start (i + 1) else + let id = String.sub s start (i - start) in + let next = i + 1 in + begin match subst id with + | None -> err_undef ~errs id s; Buffer.add_string b "undefined"; + | Some v -> Buffer.add_string b v + end; + loop next next + and loop start i = + if i > max_i then flush start max_i else + let next = i + 1 in + match s.[i] with + | '\\' -> skip_escape loop start next + | '$' -> + if next > max_i then err_unescaped ~errs '$' s else + begin match s.[next] with + | '(' -> + let min = next + 2 in + if min > max_i then (err_unclosed ~errs s; loop start next) else + begin match s.[min] with + | ',' -> skip_markup loop start (min + 1) + | _ -> + let start_id = next + 1 in + flush start (i - 1); add_subst start_id start_id + end + | _ -> err_unescaped ~errs '$' s; loop start next + end; + | c -> loop start next + in + (Buffer.clear b; loop 0 0; Buffer.contents b) + +let add_markup_esc ~errs k b s start next target_need_escape target_escape = + let max_i = String.length s - 1 in + if next > max_i then err_unescaped ~errs '\\' s else + match s.[next] with + | c when not (is_markup_esc s.[next]) -> + err_illegal_esc ~errs c s; + k (next + 1) (next + 1) + | c -> + (if target_need_escape c then target_escape b c else Buffer.add_char b c); + k (next + 1) (next + 1) + +let add_markup_text ~errs k b s start target_need_escape target_escape = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let rec loop start i = + if i > max_i then (err_unclosed ~errs s; flush start max_i) else + let next = i + 1 in + match s.[i] with + | '\\' -> (* unescape *) + flush start (i - 1); + add_markup_esc ~errs loop b s start next + target_need_escape target_escape + | ')' -> flush start (i - 1); k next next + | c when markup_text_need_esc c -> + err_unescaped ~errs c s; flush start (i - 1); loop next next + | c when target_need_escape c -> + flush start (i - 1); target_escape b c; loop next next + | c -> loop start next + in + loop start start + +(* Plain text output *) + +let markup_to_plain ~styled ~errs b s = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let need_escape _ = false in + let escape _ _ = assert false in + let rec end_text start i = Buffer.add_string b "\x1B[m"; loop start i + and loop start i = + if i > max_i then flush start max_i else + let next = i + 1 in + match s.[i] with + | '\\' -> + flush start (i - 1); + add_markup_esc ~errs loop b s start next need_escape escape + | '$' -> + if next > max_i then err_unescaped ~errs '$' s else + begin match s.[next] with + | '(' -> + let min = next + 2 in + if min > max_i then (err_unclosed ~errs s; loop start next) else + begin match s.[min] with + | ',' -> + let markup = s.[min - 1] in + let start_data = min + 1 in + if not (is_markup_dir markup) + then (err_markup ~errs markup s; loop start next) else begin + flush start (i - 1); + if not styled then + add_markup_text ~errs loop b s start_data need_escape escape + else + begin + begin match markup with + | 'i' -> Buffer.add_string b "\x1B[04m"; + | 'b' -> Buffer.add_string b "\x1B[01m" + | _ -> assert false + end; + add_markup_text ~errs end_text b s start_data + need_escape escape + end + end + | _ -> + err_malformed ~errs s; loop start next + end + | _ -> err_unescaped ~errs '$' s; loop start next + end + | c when markup_need_esc c -> + err_unescaped ~errs c s; flush start (i - 1); loop next next + | c -> loop start next + in + (Buffer.clear b; loop 0 0; Buffer.contents b) + +let doc_to_plain ~errs ~subst b s = + markup_to_plain ~styled:false ~errs b (subst_vars ~errs ~subst b s) + +let doc_to_styled ?buffer:(b = Buffer.create 255) ~errs ~subst s = + let styled = Cmdliner_base.Fmt.styler () = Cmdliner_base.Fmt.Ansi in + markup_to_plain ~styled ~errs b (subst_vars ~errs ~subst b s) + + + +let p_indent = 7 (* paragraph indentation. *) +let l_indent = 4 (* label indentation. *) + +let pp_plain_blocks ~errs subst ppf ts = + let b = Buffer.create 1024 in + let markup t = doc_to_plain ~errs b ~subst t in + let pp_tokens ppf t = Fmt.tokens ~spaces:true ppf t in + let rec blank_line = function + | `Noblank :: ts -> loop ts + | ts -> Format.pp_print_cut ppf (); loop ts + and loop = function + | [] -> () + | t :: ts -> + match t with + | `Noblank -> loop ts + | `Blocks bs -> loop (bs @ ts) + | `P s -> + Fmt.pf ppf "%a@[%a@]@," Fmt.indent p_indent pp_tokens (markup s); + blank_line ts + | `S s -> Fmt.pf ppf "@[%a@]@," pp_tokens (markup s); loop ts + | `Pre s -> + Fmt.pf ppf "%a@[%a@]@," Fmt.indent p_indent Fmt.lines (markup s); + blank_line ts + | `I (label, s) -> + let label = markup label and s = markup s in + Fmt.pf ppf "@[%a@[%a@]" Fmt.indent p_indent pp_tokens label; + begin match s with + | "" -> Fmt.pf ppf "@]@," + | s -> + let ll = String.length label in + if ll < l_indent + then (Fmt.pf ppf "%a@[%a@]@]@," + Fmt.indent (l_indent - ll) pp_tokens s) + else (Fmt.pf ppf "@\n%a@[%a@]@]@," + Fmt.indent (p_indent + l_indent) pp_tokens s) + end; + blank_line ts + in + loop ts + +let pp_plain_page ~errs subst ppf (_, text) = + Fmt.pf ppf "@[%a@]" (pp_plain_blocks ~errs subst) text + +(* Groff output *) + +let markup_to_groff ~errs b s = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let need_escape = function '.' | '\'' | '-' | '\\' -> true | _ -> false in + let escape b c = Printf.bprintf b "\\N'%d'" (Char.code c) in + let rec end_text start i = Buffer.add_string b "\\fR"; loop start i + and loop start i = + if i > max_i then flush start max_i else + let next = i + 1 in + match s.[i] with + | '\\' -> + flush start (i - 1); + add_markup_esc ~errs loop b s start next need_escape escape + | '$' -> + if next > max_i then err_unescaped ~errs '$' s else + begin match s.[next] with + | '(' -> + let min = next + 2 in + if min > max_i then (err_unclosed ~errs s; loop start next) else + begin match s.[min] with + | ',' -> + let start_data = min + 1 in + flush start (i - 1); + begin match s.[min - 1] with + | 'i' -> Buffer.add_string b "\\fI" + | 'b' -> Buffer.add_string b "\\fB" + | markup -> err_markup ~errs markup s + end; + add_markup_text ~errs end_text b s start_data need_escape escape + | _ -> err_malformed ~errs s; loop start next + end + | _ -> err_unescaped ~errs '$' s; flush start (i - 1); loop next next + end + | c when markup_need_esc c -> + err_unescaped ~errs c s; flush start (i - 1); loop next next + | c when need_escape c -> + flush start (i - 1); escape b c; loop next next + | c -> loop start next + in + (Buffer.clear b; loop 0 0; Buffer.contents b) + +let doc_to_groff ~errs ~subst b s = + markup_to_groff ~errs b (subst_vars ~errs ~subst b s) + +let pp_groff_blocks ~errs subst ppf text = + let buf = Buffer.create 1024 in + let markup t = doc_to_groff ~errs ~subst buf t in + let pp_tokens ppf t = Fmt.tokens ~spaces:false ppf t in + let rec pp_block = function + | `Blocks bs -> List.iter pp_block bs (* not T.R. *) + | `P s -> Fmt.pf ppf "@\n.P@\n%a" pp_tokens (markup s) + | `Pre s -> Fmt.pf ppf "@\n.P@\n.nf@\n%a@\n.fi" Fmt.lines (markup s) + | `S s -> Fmt.pf ppf "@\n.SH %a" pp_tokens (markup s) + | `Noblank -> Fmt.pf ppf "@\n.sp -1" + | `I (l, s) -> + Fmt.pf ppf "@\n.TP 4@\n%a@\n%a" pp_tokens (markup l) pp_tokens (markup s) + in + List.iter pp_block text + +let pp_groff_page ~errs subst ppf ((n, s, a1, a2, a3), t) = + Fmt.pf ppf + ".\\\" Pipe this output to groff -m man -K utf8 -T utf8 | less -R@\n\ + .\\\"@\n\ + .mso an.tmac@\n\ + .TH \"%s\" %d \"%s\" \"%s\" \"%s\"@\n\ + .\\\" Disable hyphenation and ragged-right@\n\ + .nh@\n\ + .ad l\ + %a@?" + n s a1 a2 a3 (pp_groff_blocks ~errs subst) t + +(* Printing to a pager *) + +let pp_to_temp_file pp_v v = + try + let exec = Filename.basename Sys.argv.(0) in + let file, oc = Filename.open_temp_file exec "out" in + let ppf = Format.formatter_of_out_channel oc in + pp_v ppf v; Format.pp_print_flush ppf (); close_out oc; + at_exit (fun () -> try Sys.remove file with Sys_error e -> ()); + Some file + with Sys_error _ -> None + +let tmp_file_for_pager () = + try + let exec = Filename.basename Sys.argv.(0) in + let file = Filename.temp_file exec "tty" in + at_exit (fun () -> try Sys.remove file with Sys_error e -> ()); + Some file + with Sys_error _ -> None + +let find_cmd cmds = + let find_win32 (cmd, _args) = + (* `where` does not support full path lookups *) + if String.equal (Filename.basename cmd) cmd + then (Sys.command (strf "where %s 1> NUL 2> NUL" cmd) = 0) + else Sys.file_exists cmd + in + let find_posix (cmd, _args) = + Sys.command (strf "command -v %s 1>/dev/null 2>/dev/null" cmd) = 0 + in + let find = if Sys.win32 then find_win32 else find_posix in + try Some (List.find find cmds) with Not_found -> None + +let getenv_empty_is_none env var = match env var with +| None | Some "" -> None | Some _ as v -> v + +let find_pager env = + let cmds = ["less", ""; "more", ""] in + let cmds = match getenv_empty_is_none env "PAGER" with + | Some pager -> (pager, "") :: cmds | None -> cmds + in + let cmds = match getenv_empty_is_none env "MANPAGER" with + | Some manpager -> (manpager, "") :: cmds | None -> cmds + in + find_cmd cmds + +let pp_to_pager env print ppf v = match find_pager env with +| None -> print `Plain ppf v +| Some (pager, opts) -> + let pager = + let set_less_env = match env "LESS" with + | None -> if Sys.win32 then "set LESS=FRX && " else "LESS=FRX " + | Some _ -> "" (* Sys.command will pass it *) + in + set_less_env ^ pager ^ opts + in + let groffer = + let cmds = + ["mandoc", " -m man -K utf-8 -T utf8"; + "groff", " -m man -K utf8 -T utf8"; + "nroff", ""] + in + find_cmd cmds + in + let cmd = match groffer with + | None -> + begin match pp_to_temp_file (print `Plain) v with + | None -> None + | Some f -> Some (strf "%s < %s" pager f) + end + | Some (groffer, opts) -> + let groffer = groffer ^ opts in + begin match pp_to_temp_file (print `Groff) v with + | None -> None + | Some f when Sys.win32 -> + (* For some obscure reason the pipe below does not + work. We need to use a temporary file. + https://github.com/dbuenzli/cmdliner/issues/166 *) + begin match tmp_file_for_pager () with + | None -> None + | Some tmp -> + Some (strf "%s <%s >%s && %s <%s" groffer f tmp pager tmp) + end + | Some f -> + Some (strf "%s < %s | %s" groffer f pager) + end + in + match cmd with + | None -> print `Plain ppf v + | Some cmd -> if (Sys.command cmd) <> 0 then print `Plain ppf v + +(* Output *) + +type subst = string -> string option + +type format = [ `Auto | `Pager | `Plain | `Groff ] + +let rec print + ?(env = Sys.getenv_opt) ?(errs = Format.err_formatter) + ?(subst = fun x -> None) fmt ppf page + = + match fmt with + | `Pager -> pp_to_pager env (print ~env ~errs ~subst) ppf page + | `Plain -> pp_plain_page ~errs subst ppf page + | `Groff -> pp_groff_page ~errs subst ppf page + | `Auto -> + let fmt = + match env "TERM" with + | None when Sys.win32 -> `Pager + | None -> `Plain + | Some "dumb" -> `Plain + | _ -> `Pager + in + print ~env ~errs ~subst fmt ppf page diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_manpage.mli b/unikernel/duniverse/cmdliner/src/cmdliner_manpage.mli new file mode 100644 index 00000000..9b149ca2 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_manpage.mli @@ -0,0 +1,92 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Manpages. + + See {!Cmdliner.Manpage}. *) + +type section_name = string + +type block = + [ `S of section_name | `P of string | `Pre of string | `I of string * string + | `Noblank | `Blocks of block list ] + +val escape : string -> string +(** [escape s] escapes [s] from the doc language. *) + +type title = string * int * string * string * string + +type t = title * block list + +type xref = + [ `Main | `Cmd of string | `Tool of string | `Page of string * int ] + +(** {1 Standard section names} *) + +val s_name : section_name +val s_synopsis : section_name +val s_description : section_name +val s_commands : section_name +val s_arguments : section_name +val s_options : section_name +val s_common_options : section_name +val s_exit_status : section_name +val s_environment : section_name +val s_files : section_name +val s_bugs : section_name +val s_examples : section_name +val s_authors : section_name +val s_see_also : section_name +val s_none : section_name + +(** {1 Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap +val smap_of_blocks : block list -> smap +val smap_to_blocks : smap -> block list +val smap_has_section : smap -> sec:section_name -> bool +val smap_append_block : smap -> sec:section_name -> block -> smap +(** [smap_append_block smap sec b] appends [b] at the end of section + [sec] creating it at the right place if needed. *) + +(** {1 Content boilerplate} *) + +val s_exit_status_intro : block +val s_environment_intro : block + +(** {1 Output} *) + +type subst = string -> string option +(** The type for variable substitution functions. *) + +type format = [ `Auto | `Pager | `Plain | `Groff ] +val print : + ?env:(string -> string option) -> + ?errs:Format.formatter -> ?subst:subst -> format -> + Format.formatter -> t -> unit + +(** {1 Printers and escapes used by Cmdliner module} *) + +val subst_vars : + errs:Format.formatter -> subst:subst -> Buffer.t -> string -> string +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,…) intact. + + @raise Invalid_argument in case of illegal syntax. *) + +val doc_to_plain : + errs:Format.formatter -> subst:subst -> Buffer.t -> string -> string +(** [doc_to_plain b ~subst s] using [b], substitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain + text. + + Raises Invalid_argument in case of illegal syntax. *) + +val doc_to_styled : + ?buffer:Buffer.t -> errs:Format.formatter -> subst:subst -> string -> string +(** [doc_to_styled] is like {!doc_to_plain} but uses ANSI escapes. *) diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_msg.ml b/unikernel/duniverse/cmdliner/src/cmdliner_msg.ml new file mode 100644 index 00000000..877b53b2 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_msg.ml @@ -0,0 +1,106 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +module Fmt = Cmdliner_base.Fmt + +(* Environment variable errors *) + +let err_env_parse env ~err = + let var = Cmdliner_def.Env.info_var env in + Fmt.str "@[environment variable %a: %s@]" Fmt.code_or_quote var err + +(* Positional argument errors *) + +let err_pos_excess excess = + Fmt.str "@[%a, don't know what to do with %a@]" + Fmt.ereason "too many arguments" + Fmt.(list ~sep:comma code_or_quote) excess + +let err_pos_miss a = match Cmdliner_def.Arg_info.docv a with +| "" -> Fmt.str "@[a required argument is %a@]" Fmt.missing () +| v -> Fmt.str "@[required argument %a is %a@]" Fmt.code_var v Fmt.missing () + +let err_pos_misses = function +| [] -> assert false +| [a] -> err_pos_miss a +| args -> + let add_arg acc a = match Cmdliner_def.Arg_info.docv a with + | "" -> "ARG" :: acc + | argv -> argv :: acc + in + let rev_args = List.sort Cmdliner_def.Arg_info.rev_pos_cli_order args in + let args = List.fold_left add_arg [] rev_args in + Fmt.str "@[required arguments %a@ are@ %a@]" + Fmt.(list ~sep:comma code_var) args Fmt.missing () + +let err_pos_parse a ~err = match Cmdliner_def.Arg_info.docv a with +| "" -> err +| argv -> + match Cmdliner_def.Arg_info.(pos_len @@ pos_kind a) with + | Some 1 -> Fmt.str "@[%a argument: %s@]" Fmt.code_var argv err + | None | Some _ -> Fmt.str "@[%a… arguments: %s@]" Fmt.code_var argv err + +(* Optional argument errors *) + +let err_flag_value flag v = + Fmt.str "@[option %a is a flag, it@ %a@ %a@]" + Fmt.code_or_quote flag Fmt.ereason "cannot take the argument" + Fmt.code_or_quote v + +let err_opt_value_missing f = + Fmt.str "@[option %a %a@]" Fmt.code_or_quote f Fmt.ereason "needs an argument" + +let err_opt_parse f ~err = + Fmt.str "@[option %a: %a@]" Fmt.code_or_quote f Fmt.styled_text err + +let err_opt_repeated f f' = + if f = f' then + Fmt.str "@[option %a %a@]" + Fmt.code_or_quote f Fmt.ereason "cannot be repeated" + else + Fmt.str "@[options %a and %a@ %a@]" + Fmt.code_or_quote f Fmt.code_or_quote f' + Fmt.ereason "cannot be present at the same time" + +(* Argument errors *) + +let err_arg_missing a = + if Cmdliner_def.Arg_info.is_pos a then err_pos_miss a else + Fmt.str "@[required option %a is %a@]" + Fmt.code (Cmdliner_def.Arg_info.opt_name_sample a) Fmt.missing () + +let err_cmd_missing ~dom = + Fmt.str "@[required %a name is %a,@ must@ be@ %a@]" + Fmt.code_var "COMMAND" Fmt.missing () Cmdliner_base.pp_alts dom + +(* Other messages *) + +let pp_version ppf ei = + match Cmdliner_def.Cmd_info.version (Cmdliner_def.Eval.main ei) with + | None -> assert false + | Some v -> Fmt.pf ppf "@[%s@]@." v + +let exec_name ei = Cmdliner_def.Cmd_info.name (Cmdliner_def.Eval.main ei) + +let pp_exec_msg ppf ei = Fmt.pf ppf "%s:" (exec_name ei) + +let pp_err ppf ei ~err = + Fmt.pf ppf "@[%a @[%a@]@]@." pp_exec_msg ei Fmt.styled_text err + +let pp_usage_and_err ppf ei ~err = + Fmt.pf ppf "@[Usage: @[%a@]@]@." + Fmt.styled_text (Cmdliner_docgen.styled_usage_synopsis ~errs:ppf ei); + pp_err ppf ei ~err + +let pp_backtrace ppf ei e bt = + let bt = Printexc.raw_backtrace_to_string bt in + let bt = + let len = String.length bt in + if len > 0 then String.sub bt 0 (len - 1) (* remove final '\n' *) else bt + in + Fmt.pf ppf "@[%a @[internal error, %a:@\n%a@]@]@." + pp_exec_msg ei + Fmt.ereason "uncaught exception" + Fmt.lines (String.concat "\n" [Printexc.to_string e; bt]) diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_msg.mli b/unikernel/duniverse/cmdliner/src/cmdliner_msg.mli new file mode 100644 index 00000000..455f092e --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_msg.mli @@ -0,0 +1,45 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Messages for the end-user. *) + +(** {1:env_err Environment variable errors} *) + +val err_env_parse : Cmdliner_def.Env.info -> err:string -> string + +(** {1:pos_err Positional argument errors} *) + +val err_pos_excess : string list -> string +val err_pos_misses : Cmdliner_def.Arg_info.t list -> string +val err_pos_parse : Cmdliner_def.Arg_info.t -> err:string -> string + +(** {1:opt_err Optional argument errors} *) + +val err_flag_value : string -> string -> string +val err_opt_value_missing : string -> string +val err_opt_parse : string -> err:string -> string +val err_opt_repeated : string -> string -> string + +(** {1:arg_err Argument errors} *) + +val err_arg_missing : Cmdliner_def.Arg_info.t -> string +val err_cmd_missing : dom:string list -> string + +(** {1:msgs Other messages} *) + +val pp_version : Cmdliner_def.Eval.t Cmdliner_base.Fmt.t + + +val pp_exec_msg : Cmdliner_def.Eval.t Cmdliner_base.Fmt.t + +val pp_err : + Format.formatter -> Cmdliner_def.Eval.t -> err:string -> unit + +val pp_usage_and_err : + Format.formatter -> Cmdliner_def.Eval.t -> err:string -> unit + +val pp_backtrace : + Format.formatter -> Cmdliner_def.Eval.t -> exn -> Printexc.raw_backtrace -> + unit diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_term.ml b/unikernel/duniverse/cmdliner/src/cmdliner_term.ml new file mode 100644 index 00000000..c7728fad --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_term.ml @@ -0,0 +1,97 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +type term_escape = Cmdliner_def.Term.escape +type 'a parser = 'a Cmdliner_def.Term.parser +type +'a t = 'a Cmdliner_def.Term.t + +let make args p = (args, p) +let argset (args, _) = args +let parser (_, parser) = parser + +let const v = Cmdliner_def.Arg_info.Set.empty, (fun _ _ -> Ok v) +let app (args_f, f) (args_v, v) = + Cmdliner_def.Arg_info.Set.union args_f args_v, + fun ei cl -> match (f ei cl) with + | Error _ as e -> e + | Ok f -> + match v ei cl with + | Error _ as e -> e + | Ok v -> Ok (f v) + +let map f v = app (const f) v +let product v0 v1 = app (app (const (fun x y -> (x, y))) v0) v1 + +module Syntax = struct + let ( let+ ) v f = map f v + let ( and+ ) = product +end + +(* Terms *) + +let ( $ ) = app + +type 'a ret = [ `Ok of 'a | term_escape ] + +let ret (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (`Ok v) -> Ok v + | Ok (`Error _ as err) -> Error err + | Ok (`Help _ as help) -> Error help + | Error _ as e -> e + +let term_result ?(usage = false) (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Error (usage, e)) + | Error _ as e -> e + +let term_result' ?usage t = + let wrap = app (const (Result.map_error (fun e -> `Msg e))) t in + term_result ?usage wrap + +let cli_parse_result (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Parse e) + | Error _ as e -> e + +let cli_parse_result' t = + let wrap = app (const (Result.map_error (fun e -> `Msg e))) t in + cli_parse_result wrap + +let main_name = + Cmdliner_def.Arg_info.Set.empty, + (fun ei _ -> Ok (Cmdliner_def.Cmd_info.name @@ Cmdliner_def.Eval.main ei)) + +let choice_names = + Cmdliner_def.Arg_info.Set.empty, + (fun ei _ -> + (* N.B. this keeps everything backward compatible. We return the command + names of main's children *) + let name t = Cmdliner_def.Cmd_info.name t in + let choices = + Cmdliner_def.Cmd_info.children (Cmdliner_def.Eval.main ei) + in + Ok (List.rev_map name choices)) + +let with_used_args (al, v) : (_ * string list) t = + al, fun ei cl -> + match v ei cl with + | Ok x -> + let actual_args arg_info _ acc = + let args = Cmdliner_def.Cline.actual_args cl arg_info in + List.rev_append args acc + in + let used = + List.rev (Cmdliner_def.Arg_info.Set.fold actual_args al []) + in + Ok (x, used) + | Error _ as e -> e + + +let env = + Cmdliner_def.Arg_info.Set.empty, + (fun ei _ -> Ok (Cmdliner_def.Eval.env_var ei)) diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_term.mli b/unikernel/duniverse/cmdliner/src/cmdliner_term.mli new file mode 100644 index 00000000..871b3836 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_term.mli @@ -0,0 +1,48 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Terms *) + +type term_escape = + [ `Error of bool * string + | `Help of Cmdliner_manpage.format * string option ] + +type 'a parser = + Cmdliner_def.Eval.t -> Cmdliner_def.Cline.t -> + ('a, [ `Parse of string | term_escape ]) result +(** Type type for command line parser. given static information about + the command line and a command line to parse returns an OCaml value. *) + +type +'a t = 'a Cmdliner_def.Term.t +(** The type for terms. The list of arguments it can parse and the parsing + function that does so. *) + +val make : Cmdliner_def.Arg_info.Set.t -> 'a parser -> 'a t +val argset : 'a t -> Cmdliner_def.Arg_info.Set.t +val parser : 'a t -> 'a parser + +val const : 'a -> 'a t +val app : ('a -> 'b) t -> 'a t -> 'b t +val map : ('a -> 'b) -> 'a t -> 'b t +val product : 'a t -> 'b t -> ('a * 'b) t + +module Syntax : sig + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t +end + +val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t + +type 'a ret = [ `Ok of 'a | term_escape ] + +val ret : 'a ret t -> 'a t +val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t +val term_result' : ?usage:bool -> ('a, string) result t -> 'a t +val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t +val cli_parse_result' : ('a, string) result t -> 'a t +val main_name : string t +val choice_names : string list t +val with_used_args : 'a t -> ('a * string list) t +val env : (string -> string option) t diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_trie.ml b/unikernel/duniverse/cmdliner/src/cmdliner_trie.ml new file mode 100644 index 00000000..4b520ff4 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_trie.ml @@ -0,0 +1,91 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +module Cmap = Map.Make (Char) (* character maps. *) + +type 'a value = (* type for holding a bound value. *) +| Pre of 'a (* value is bound by the prefix of a key. *) +| Key of 'a (* value is bound by an entire key. *) +| Amb (* no value bound because of ambiguous prefix. *) +| Nil (* not bound (only for the empty trie). *) + +type 'a t = { v : 'a value; succs : 'a t Cmap.t } +let empty = { v = Nil; succs = Cmap.empty } +let is_empty t = t = empty + +(* N.B. If we replace a non-ambiguous key, it becomes ambiguous but it's + not important for our use. Also the following is not tail recursive but + the stack is bounded by key length. *) +let add t k d = + let rec loop t k len i d pre_d = match i = len with + | true -> + let t' = { v = Key d; succs = t.succs } in + begin match t.v with + | Key old -> `Replaced (old, t') + | _ -> `New t' + end + | false -> + let v = match t.v with + | Amb | Pre _ -> Amb | Key _ as v -> v | Nil -> pre_d + in + let t' = try Cmap.find k.[i] t.succs with Not_found -> empty in + match loop t' k len (i + 1) d pre_d with + | `New n -> `New { v; succs = Cmap.add k.[i] n t.succs } + | `Replaced (o, n) -> + `Replaced (o, { v; succs = Cmap.add k.[i] n t.succs }) + in + loop t k (String.length k) 0 d (Pre d (* allocate less *)) + +let find_node t k = + let rec aux t k len i = + if i = len then t else + aux (Cmap.find k.[i] t.succs) k len (i + 1) + in + aux t k (String.length k) 0 + +let find ~legacy_prefixes t k = match (find_node t k).v with +| Key v -> Ok v +| Pre v when legacy_prefixes -> Ok v +| Pre v -> Error `Not_found +| Amb when legacy_prefixes -> Error `Ambiguous +| Amb -> Error `Not_found +| Nil -> Error `Not_found +| exception Not_found -> Error `Not_found + +let ambiguities t p = (* ambiguities of [p] in [t]. *) + try + let t = find_node t p in + match t.v with + | Key _ | Pre _ | Nil -> [] + | Amb -> + let add_char s c = s ^ (String.make 1 c) in + let rem_char s = String.sub s 0 ((String.length s) - 1) in + let to_list m = Cmap.fold (fun k t acc -> (k,t) :: acc) m [] in + let rec aux acc p = function + | ((c, t) :: succs) :: rest -> + let p' = add_char p c in + let acc' = match t.v with + | Pre _ | Amb -> acc + | Key _ -> (p' :: acc) + | Nil -> assert false + in + aux acc' p' ((to_list t.succs) :: succs :: rest) + | [] :: [] -> acc + | [] :: rest -> aux acc (rem_char p) rest + | [] -> assert false + in + aux [] p (to_list t.succs :: []) + with Not_found -> [] + +let of_list l = + let add t (s, v) = match add t s v with `New t -> t | `Replaced (_, t) -> t in + List.fold_left add empty l + +let legacy_prefixes ~env = match env "CMDLINER_LEGACY_PREFIXES" with +| None -> false +| Some s -> + match String.lowercase_ascii s with + | "true" | "yes" | "y" | "1" -> true + | _ -> false diff --git a/unikernel/duniverse/cmdliner/src/cmdliner_trie.mli b/unikernel/duniverse/cmdliner/src/cmdliner_trie.mli new file mode 100644 index 00000000..ab79a794 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/cmdliner_trie.mli @@ -0,0 +1,22 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Tries. + + This implementation also maps any non ambiguous prefix of a + key to its value. *) + +type 'a t + +val empty : 'a t +val is_empty : 'a t -> bool +val add : 'a t -> string -> 'a -> [ `New of 'a t | `Replaced of 'a * 'a t ] +val find : + legacy_prefixes:bool -> 'a t -> string -> + ('a, [`Ambiguous | `Not_found ]) result +val ambiguities : 'a t -> string -> string list +val of_list : (string * 'a) list -> 'a t + +val legacy_prefixes : env:(string -> string option) -> bool diff --git a/unikernel/duniverse/cmdliner/src/dune b/unikernel/duniverse/cmdliner/src/dune new file mode 100644 index 00000000..70013010 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/dune @@ -0,0 +1,3 @@ +(library + (public_name cmdliner) + (wrapped false)) diff --git a/unikernel/duniverse/cmdliner/src/tool/bash-completion.sh b/unikernel/duniverse/cmdliner/src/tool/bash-completion.sh new file mode 100644 index 00000000..74bf8aa3 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/tool/bash-completion.sh @@ -0,0 +1,66 @@ +_cmdliner_generic() { + local prefix="${COMP_WORDS[COMP_CWORD]}" + local w=("${COMP_WORDS[@]}") # Keep COMP_WORDS intact for restart completion + w[COMP_CWORD]="--__complete=${COMP_WORDS[COMP_CWORD]}" + local line="${w[@]:0:1} --__complete ${w[@]:1}" + local version type group item text_line item_doc msg + { + read version + if [[ $version != "1" ]]; then + printf "\nUnsupported cmdliner completion protocol: $version" >&2 + return 1 + fi + while read type; do + if [[ $type == "group" ]]; then + read group + elif [[ $type == "dirs" ]] && (type compopt &> /dev/null); then + if [[ $prefix != -* ]]; then + COMPREPLY+=( $(compgen -d "$prefix") ) + fi + elif [[ $type == "files" ]] && (type compopt &> /dev/null); then + if [[ $prefix != -* ]]; then + COMPREPLY+=( $(compgen -f "$prefix") ) + fi + elif [[ $type == "message" ]]; then + msg=""; + while read text_line; do + if [[ "$text_line" == "message-end" ]]; then + msg=${msg#?} # remove first newline + break + fi + msg+=$'\n'"$text_line" + done + printf "$msg" >&2 + elif [[ $type == "item" ]]; then + read item; + item_doc=""; + while read text_line; do + if [[ "$text_line" == "item-end" ]]; then + item_doc=${item_doc#?} # remove first newline + break + fi + item_doc+=$'\n'"$text_line" + done + # Sadly it seems bash does not support doc strings, so we only + # add item to to the reply. If you know any better get in touch. + # Handle glued forms, the completion item is the full option + if [[ $group == "Values" ]]; then + if [[ $prefix == --* ]]; then + item="${prefix%%=*}=$item" + elif [[ $prefix == -* ]]; then + item="${prefix:0:2}$item" + fi + fi + COMPREPLY+=($item) + elif [[ $type == "restart" ]]; then + # N.B. only emitted if there is a -- token + for ((i = 0; i < ${#COMP_WORDS[@]}; i++)); do + if [[ "${COMP_WORDS[i]}" == "--" ]]; then + _comp_command_offset $((i+1)) + return + fi + done + fi + done } < <(eval $line) + return 0 +} diff --git a/unikernel/duniverse/cmdliner/src/tool/cmdliner_data.ml b/unikernel/duniverse/cmdliner/src/tool/cmdliner_data.ml new file mode 100644 index 00000000..d983164f --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/tool/cmdliner_data.ml @@ -0,0 +1,143 @@ +let bash_generic_completion = +{|_cmdliner_generic() { + local prefix="${COMP_WORDS[COMP_CWORD]}" + local w=("${COMP_WORDS[@]}") # Keep COMP_WORDS intact for restart completion + w[COMP_CWORD]="--__complete=${COMP_WORDS[COMP_CWORD]}" + local line="${w[@]:0:1} --__complete ${w[@]:1}" + local version type group item text_line item_doc msg + { + read version + if [[ $version != "1" ]]; then + printf "\nUnsupported cmdliner completion protocol: $version" >&2 + return 1 + fi + while read type; do + if [[ $type == "group" ]]; then + read group + elif [[ $type == "dirs" ]] && (type compopt &> /dev/null); then + if [[ $prefix != -* ]]; then + COMPREPLY+=( $(compgen -d "$prefix") ) + fi + elif [[ $type == "files" ]] && (type compopt &> /dev/null); then + if [[ $prefix != -* ]]; then + COMPREPLY+=( $(compgen -f "$prefix") ) + fi + elif [[ $type == "message" ]]; then + msg=""; + while read text_line; do + if [[ "$text_line" == "message-end" ]]; then + msg=${msg#?} # remove first newline + break + fi + msg+=$'\n'"$text_line" + done + printf "$msg" >&2 + elif [[ $type == "item" ]]; then + read item; + item_doc=""; + while read text_line; do + if [[ "$text_line" == "item-end" ]]; then + item_doc=${item_doc#?} # remove first newline + break + fi + item_doc+=$'\n'"$text_line" + done + # Sadly it seems bash does not support doc strings, so we only + # add item to to the reply. If you know any better get in touch. + # Handle glued forms, the completion item is the full option + if [[ $group == "Values" ]]; then + if [[ $prefix == --* ]]; then + item="${prefix%%=*}=$item" + elif [[ $prefix == -* ]]; then + item="${prefix:0:2}$item" + fi + fi + COMPREPLY+=($item) + elif [[ $type == "restart" ]]; then + # N.B. only emitted if there is a -- token + for ((i = 0; i < ${#COMP_WORDS[@]}; i++)); do + if [[ "${COMP_WORDS[i]}" == "--" ]]; then + _comp_command_offset $((i+1)) + return + fi + done + fi + done } < <(eval $line) + return 0 +} +|} + +let zsh_generic_completion = +{|function _cmdliner_generic { + local w=("${words[@]}") # Keep words intact for restart completion + local prefix="${words[CURRENT]}" + w[CURRENT]="--__complete=${words[CURRENT]}" + local line="${w[@]:0:1} --__complete ${w[@]:1}" + local -a completions + local version type group item text_line item_doc msg + eval $line | { + read -r version + if [[ $version != "1" ]]; then + _message -r "Unsupported cmdliner completion protocol: $version" + return 1 + fi + while IFS= read -r type; do + if [[ "$type" == "group" ]]; then + if [ -n "$completions" ]; then + _describe -V unsorted completions -U + completions=() + fi + read -r group + elif [[ "$type" == "message" ]]; then + msg=""; + while read text_line; do + if [[ "$text_line" == "message-end" ]]; then + msg=${msg#?} # remove first newline + break + fi + msg+=$'\n'"$text_line" + done + _message -r "$msg" + elif [[ "$type" == "item" ]]; then + read -r item; + item_doc=""; + while read -r text_line; do + if [[ "$text_line" == "item-end" ]]; then + item_doc=${item_doc#?} # remove first space + break + fi + # Sadly it seems impossible to make multiline + # doc strings. Get in touch if you know any better. + item_doc+=" $text_line" + done + # Handle glued forms, the completion item is the full option + if [[ "$group" == "Values" ]]; then + if [[ "$prefix" == --* ]]; then + item="${prefix%%=*}=${item}" + elif [[ "$prefix" == -* ]]; then + item="${prefix:0:2}${item}" + fi + fi + # item_doc="${item_doc//$'\e'\[(01m|04m|m)/}" + completions+=("${item}":"${item_doc}") + elif [[ "$type" == "dirs" ]]; then + _path_files -/ + elif [[ "$type" == "files" ]]; then + _path_files -f + elif [[ "$type" == "restart" ]]; then + # N.B. only emitted if there is a -- token + while [[ $words[1] != "--" ]]; do + shift words + (( CURRENT-- )) + done + shift words + (( CURRENT-- )) + _normal + fi + done + } + if [ -n "$completions" ]; then + _describe -V unsorted completions -U + fi +} +|} \ No newline at end of file diff --git a/unikernel/duniverse/cmdliner/src/tool/cmdliner_main.ml b/unikernel/duniverse/cmdliner/src/tool/cmdliner_main.ml new file mode 100644 index 00000000..443675ce --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/tool/cmdliner_main.ml @@ -0,0 +1,638 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let strf = Printf.sprintf +let error_to_failure = function Ok v -> v | Error e -> failwith e + +let find_sub ?(start = 0) ~sub s = + (* naive algorithm, worst case O(length sub * length s) *) + let len_sub = String.length sub in + let len_s = String.length s in + let max_idx_sub = len_sub - 1 in + let max_idx_s = if len_sub <> 0 then len_s - len_sub else len_s - 1 in + let rec loop i k = + if i > max_idx_s then None else + if k > max_idx_sub then Some i else + if k > 0 then + if String.get sub k = String.get s (i + k) + then loop i (k + 1) else loop (i + 1) 0 + else + if String.get sub 0 = String.get s i + then loop i 1 else loop (i + 1) 0 + in + loop start 0 + +let rec mkdir dir = (* Can be replaced by Sys.mkdir once we drop OCaml < 4.12 *) + (* On Windows -p does not exist we do it ourselves on all platforms. *) + let err_cmd exit cmd = + raise (Sys_error (strf "exited with %d: %s\n" exit cmd)) + in + let run_cmd args = + let cmd = String.concat " " (List.map Filename.quote args) in + let cmd = if Sys.win32 then strf {|"%s"|} cmd else cmd in + let exit = Sys.command cmd in + if exit = 0 then () else err_cmd exit cmd + in + let parent = Filename.dirname dir in + (if String.equal dir parent then () else mkdir (Filename.dirname dir)); + (if Sys.file_exists dir then () else run_cmd ["mkdir"; dir]) + +let read_file file = + (* In_channel is < 4.14 *) + let read file ic = + try + (* This fails on `stdin` or large files on 32-bit. Once we require + 4.14 In_channel.input_all handles these quirks. *) + let len = in_channel_length ic in + let buf = Bytes.create len in + really_input ic buf 0 len; close_in ic; + Ok (Bytes.unsafe_to_string buf) + with + | Sys_error e -> Error (Printf.sprintf "%s: %s" file e) + in + let binary_stdin () = set_binary_mode_in stdin true in + try match file with + | "-" -> binary_stdin (); read file stdin + | file -> + let ic = open_in_bin file in + let finally () = close_in_noerr ic in + Fun.protect ~finally @@ fun () -> read file ic + with Sys_error e -> Error e + +let write_file file s = + (* Out_channel is < 4.14 *) + let write file s oc = try Ok (output_string oc s) with + | Sys_error e -> Error (Printf.sprintf "%s: %s" file e) + in + let binary_stdout () = set_binary_mode_out stdout true in + try match file with + | "-" -> binary_stdout (); write file s stdout + | file -> + let oc = open_out_bin file in + let finally () = close_out_noerr oc in + Fun.protect ~finally @@ fun () -> write file s oc + with Sys_error e -> Error e + +let with_binary_stdout f = + try let () = set_binary_mode_out stdout true in f () with + | Sys_error e | Failure e -> prerr_endline e; Cmdliner.Cmd.Exit.some_error + +let exec_stdout tool ~args = + (* The cmd munging logic can be replaced by Filename.quote_command once we + drop OCaml < 4.10 *) + let quote_tool tool = + Filename.quote @@ + if Sys.win32 then String.map (function '/' -> '\\' | c -> c) tool else tool + in + try + let tmp = Filename.temp_file "cmd" "stdout" in + let tool = quote_tool tool and args = List.map Filename.quote args in + let cmd = String.concat " " (tool :: args) in + let exec = String.concat " > " [cmd; Filename.quote tmp] in + let exec = if Sys.win32 then strf {|"%s"|} exec else exec in + match Sys.command exec with + | 0 -> + let ic = open_in_bin tmp in + let finally () = + close_in_noerr ic; + try Sys.remove tmp with Sys_error _ -> () (* not that important *) + in + let len = in_channel_length ic in + Fun.protect ~finally @@ fun () -> + let stdout = really_input_string ic len in + Ok stdout + | exit -> Error (strf "%s: exited with %d" exec exit) + with + | Sys_error e -> Error e + +(* Opam .install file updating *) + +let update_opam_install_section ~opam_src ~section moves = + (* Can fail in all sorts of ways if the '$(section):' string appears + in the file moves of [opam_src] *) + let move_to_string (src, dst) = Printf.sprintf " %S {%S}" src dst in + let open_section ~section opam_src = + let section = section ^ ":" in + match find_sub ~sub:section opam_src with + | None -> (strf "%s\n%s [" opam_src section), " ]" + | Some start -> + match String.index_from_opt opam_src start '[' with + | None -> + failwith (strf "Could not open section %s in opam file" section) + | Some i -> + let j = i + 1 in + String.sub opam_src 0 j, + String.sub opam_src j (String.length opam_src - j) + in + let before, after = open_section ~section opam_src in + let moves = List.rev_map move_to_string moves in + let moves = String.concat "\n" ("" :: moves) in + String.concat "" [before; moves; after] + +let maybe_update_opam_install_file ~update_opam_install section moves = + match update_opam_install with + | None -> () + | Some "-" -> failwith "- is stdin, it cannot be updated" + | Some file -> + let opam_src = + if not (Sys.file_exists file) then "" else + read_file file |> error_to_failure + in + let src = update_opam_install_section ~opam_src ~section moves in + write_file file src |> error_to_failure + +(* Cmdliner based tool introspection. + + Note this is a bit hackish but does the job. At some point we could + investigate cleaner protocols with the `--cmdliner` reserved option. *) + +let split_toolname toolexec = + let tool, name = Scanf.sscanf toolexec "%s@:%s" (fun n e -> n, e) in + let name = + if name <> "" then name else + let name = Filename.basename tool in + match Filename.chop_suffix_opt ~suffix:".exe" tool with + | None -> name | Some name -> name + in + tool, name + +let get_tool_commands tool = + (* We get that by using the completion protocol, see doc/cli.mld *) + try + let subcommands cmd = + let rec find_subs = function + | "group" :: "Subcommands" :: lines -> + let rec subs acc = function + | "group" :: _ | [] -> acc + | "item" :: sub :: lines -> + let sub = if cmd = "" then sub else String.concat " " [cmd; sub]in + subs (sub :: acc) lines + | _ :: lines -> subs acc lines + in + subs [] lines + | _ :: lines -> find_subs lines + | [] -> [] + in + let subs = if cmd = "" then [] else String.split_on_char ' ' cmd in + let args = "--__complete" :: (subs @ ["--__complete="]) in + let comps = exec_stdout tool ~args |> error_to_failure in + let comps = String.split_on_char '\n' comps in + match comps with + | "1" :: comps -> find_subs comps + | version :: comps -> + failwith (strf "Unsupported cmdliner completion protocol: %S" version) + | [] -> + failwith "Could not parse cmdliner completion protocol" + in + let rec loop acc = function + | cmd :: cmds -> + let subs = subcommands cmd in + loop (if cmd <> "" then cmd :: acc else acc) (List.rev_append subs cmds) + | [] -> List.sort String.compare acc + in + Ok (loop [] [""]) + with Failure e -> Error e + +let get_tool_command_man tool ~name cmd = + let man_basename = + let exec = if cmd = "" then name else String.concat " " [name; cmd] in + (String.map (function ' ' -> '-' | c -> c) exec) + in + let add_section man = + let rec extract_section = function + | line :: lines -> + begin match Scanf.sscanf line ".TH %s %d" (fun _ n -> n) with + | n -> Ok (n, man_basename, man) + | exception Scanf.Scan_failure _ -> extract_section lines + end + | [] -> + Error (strf "%s command: Could not extract section from manual" + (tool ^ " " ^ cmd)) + in + extract_section (String.split_on_char '\n' man) + in + let subs = if cmd = "" then [] else String.split_on_char ' ' cmd in + let args = subs @ ["--help=groff"] in + match exec_stdout tool ~args with + | Error _ as e -> e + | Ok man -> add_section man + +let get_tool_manpages tool ~name = match get_tool_commands tool with +| Error _ as e -> e +| Ok cmds -> + try + let man cmd = get_tool_command_man tool ~name cmd |> error_to_failure in + Ok (List.sort compare (List.map man ("" :: cmds))) + with + | Failure e -> Error e + +(* File path actions *) + +let log_action act p = Printf.printf "%s \x1B[1m%s\x1B[0m\n%!" act p + +let mkdir ~dry_run p = + if not (Sys.file_exists p) then begin + log_action "Creating directory" p; + if not dry_run then mkdir p + end + +let write_file ~dry_run p contents = + log_action "Writing" p; + if not dry_run then begin match write_file p contents with + | Ok () -> () + | Error e -> failwith e + end + +(* Shells completion *) + +module type SHELL = sig + val name : string + val sharedir : string + val generic_script_name : string + val generic_completion : string + val tool_script_name : toolname:string -> string + val tool_completion : toolname:string -> string +end + +type shell = (module SHELL) + +module Bash = struct + let name = "bash" + let sharedir = "bash-completion/completions" + let generic_script_name = "_cmdliner_generic" + let generic_completion = Cmdliner_data.bash_generic_completion + let tool_script_name ~toolname = toolname + let tool_completion ~toolname = strf +{|if ! declare -F _cmdliner_generic > /dev/null; then + _completion_loader _cmdliner_generic +fi +complete -F _cmdliner_generic %s +|} toolname +end + +module Zsh = struct + let name = "zsh" + let sharedir = "zsh/site-functions" + let generic_script_name = "_cmdliner_generic" + let generic_completion = Cmdliner_data.zsh_generic_completion + let tool_script_name ~toolname = "_" ^ toolname + let tool_completion ~toolname = strf +{|#compdef %s +autoload _cmdliner_generic +_cmdliner_generic +|} toolname +end + +let shells : shell list = [(module Bash); (module Zsh)] + +let generic_completion (module Shell : SHELL) = + with_binary_stdout @@ fun () -> + print_string Shell.generic_completion; + Cmdliner.Cmd.Exit.ok + +let tool_completion (module Shell : SHELL) ~toolname = + with_binary_stdout @@ fun () -> + print_string (Shell.tool_completion ~toolname); + Cmdliner.Cmd.Exit.ok + +(* Install commands *) + +let install_generic_completion ~dry_run ~update_opam_install shells sharedir = + with_binary_stdout @@ fun () -> + let install ~dry_run sharedir acc (module Shell : SHELL) = + let rel_path = Filename.concat Shell.sharedir Shell.generic_script_name in + let dest = Filename.concat sharedir Shell.sharedir in + let path = Filename.concat sharedir rel_path in + mkdir ~dry_run dest; + write_file ~dry_run path Shell.generic_completion; + (path, rel_path) :: acc + in + try + let moves = List.fold_left (install ~dry_run sharedir) [] shells in + maybe_update_opam_install_file ~update_opam_install "share_root" moves; + Cmdliner.Cmd.Exit.ok + with Failure e -> prerr_endline e; Cmdliner.Cmd.Exit.some_error + +let install_tool_completion + ~dry_run ~update_opam_install ~shells ~toolnames ~sharedir + = + with_binary_stdout @@ fun () -> + let install ~dry_run ~toolnames sharedir acc (module Shell : SHELL) = + let write acc toolname = + let rel_path = + Filename.concat Shell.sharedir (Shell.tool_script_name ~toolname) + in + let path = Filename.concat sharedir rel_path in + write_file ~dry_run path (Shell.tool_completion ~toolname); + (path, rel_path) :: acc + in + mkdir ~dry_run (Filename.concat sharedir Shell.sharedir); + List.fold_left write acc toolnames + in + let moves = List.fold_left (install ~dry_run ~toolnames sharedir) [] shells in + try + maybe_update_opam_install_file ~update_opam_install "share_root" moves; + Cmdliner.Cmd.Exit.ok + with Failure e -> prerr_endline e; Cmdliner.Cmd.Exit.some_error + +let install_tool_manpages ~dry_run ~update_opam_install ~tools ~mandir = + (* Note this correctly handles manpages sections but at the moment + all manpages for tool and commands are in section 1. *) + let rec get_mans tool = + let tool, name = split_toolname tool in + get_tool_manpages tool ~name |> error_to_failure + in + try + let mans = List.sort compare (List.concat (List.map get_mans tools)) in + let rec install ~dry_run ~last_sec acc = function + | (sec, basename, man) :: mans -> + let secdir = strf "man%d" sec in + let rel_path = Filename.concat secdir (strf "%s.%d" basename sec) in + let path = Filename.concat mandir rel_path in + if last_sec <> sec then mkdir ~dry_run (Filename.concat mandir secdir); + write_file ~dry_run path man; + install ~dry_run ~last_sec:sec ((path, rel_path) :: acc) mans + | [] -> acc + in + let moves = install ~dry_run ~last_sec:(-1) [] mans in + maybe_update_opam_install_file ~update_opam_install "man" moves; + Cmdliner.Cmd.Exit.ok + with Failure e -> prerr_endline e; Cmdliner.Cmd.Exit.some_error + +let install_tool_support + ~dry_run ~update_opam_install tools shells ~prefix ~sharedir ~mandir + = + let sharedir = match sharedir with + | None -> Filename.concat prefix "share" | Some sharedir -> sharedir + in + let mandir = match mandir with + | None -> Filename.concat sharedir "man" | Some mandir -> mandir + in + let rc = install_tool_manpages ~dry_run ~update_opam_install ~tools ~mandir in + if rc <> Cmdliner.Cmd.Exit.ok then rc else + let toolnames = List.map snd (List.map split_toolname tools) in + install_tool_completion + ~dry_run ~update_opam_install ~shells ~toolnames ~sharedir + +(* Tool command listing command *) + +let tool_commands tool = match get_tool_commands tool with +| Ok subs -> List.iter print_endline subs; Cmdliner.Cmd.Exit.ok +| Error e -> prerr_endline e; Cmdliner.Cmd.Exit.some_error + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let dry_run = + let doc = "Do not install, output paths that would be written." in + Arg.(value & flag & info ["dry-run"] ~doc) + +let update_opam_install = + let doc = + "Update or create an opam $(b,.install) file $(docv) with install moves \ + from the installed files to the corresponding opam install sections. \ + Also performed if $(b,--dry-run) is specified." + in + Arg.(value & opt (some filepath) None & + info ["update-opam-install"] ~doc ~docv:"PKG.install") + +let prefix = + let doc = "$(docv) is the install prefix. For example $(b,/usr/local)." in + Arg.(required & pos ~rev:true 0 (some dirpath) None & + info [] ~doc ~docv:"PREFIX") + +let sharedir_doc = "$(docv) is the $(b,share) directory to install to." +let sharedir_docv = "SHAREDIR" +let sharedir_posn ~rev n = + Arg.(required & pos ~rev n (some dirpath) None & + info [] ~doc:sharedir_doc ~docv:sharedir_docv) + +let sharedir_pos0 = sharedir_posn ~rev:false 0 +let sharedir_poslast = sharedir_posn ~rev:true 0 +let sharedir_opt = + let absent = "$(i,PREFIX)$(b,/share)" in + Arg.(value & opt (some dirpath) None & + info ["sharedir"] ~doc:sharedir_doc ~docv:sharedir_docv ~absent) + +let mandir_doc = "$(docv) is the root $(b,man) directory to install to." +let mandir_docv = "MANDIR" +let mandir_poslast = + Arg.(required & pos ~rev:true 0 (some dirpath) None & + info [] ~doc:mandir_doc ~docv:mandir_docv) + +let mandir_opt = + let absent = "$(i,SHAREDIR)$(b,/man)" in + Arg.(value & opt (some dirpath) None & + info ["mandir"] ~doc:mandir_doc ~docv:mandir_docv ~absent) + +let shell_assoc = List.map (fun ((module S : SHELL) as s) -> S.name, s) shells +let shells_doc = Arg.doc_alts_enum shell_assoc +let shell_conv = Arg.enum ~docv:"SHELL" shell_assoc +let shell_doc = strf "$(docv) the shell to support, must be %s." shells_doc +let shells_opt = + let doc = shell_doc ^ " Repeatable." in + let absent = "All supported shells" in + Arg.(value & opt_all shell_conv shells & info ["s"; "shell"] ~absent ~doc) + +let shell_posn n = + Arg.(required & pos n (some shell_conv) None & info [] ~doc:shell_doc) + +let shell_pos0 = shell_posn 0 +let shell_pos1 = shell_posn 1 + +let toolname_posn n = + let doc = "$(docv) is the name of the tool to complete." in + Arg.(required & pos n (some filepath) None & info [] ~doc ~docv:"TOOLNAME") + +let toolname_pos0 = toolname_posn 0 +let toolname_pos1 = toolname_posn 1 +let toolnames_posleft = + let doc = "$(docv) is the name of the tool to complete. Repeatable." in + Arg.(non_empty & pos_left ~rev:true 0 string [] & + info [] ~doc ~docv:"TOOLNAME") + +let tools_posleft = + let doc = + "$(i,TOOLEXEC) is the tool executable. Searched in the $(b,PATH) unless \ + an explicit file path is specified. $(i,NAME) is the tool name, if \ + unspecified derived from $(i,TOOLEXEC) by taking the basename and \ + stripping any $(b,.exe) extension. Repeatable." + in + let docv = "TOOLEXEC[:NAME]" in + Arg.(non_empty & pos_left ~rev:true 0 filepath [] & info [] ~doc ~docv) + +let generic_completion_cmd = + let doc = "Output generic completion scripts" in + let man = + [ `S Manpage.s_description; + `P "$(cmd) outputs the generic cmdliner completion script for a given \ + shell. Examples:"; + `Pre "$(cmd) $(b,zsh)"; `Noblank; + `Pre "$(b,eval) $(b,\\$\\()$(cmd) $(b,zsh\\))"; + `P "The script needs to be loaded in a shell for tool specific \ + scripts output by the command $(b,tool-completion) to work. See \ + command $(b,install generic-completion) to install them."; + ] + in + Cmd.make (Cmd.info "generic-completion" ~doc ~man) @@ + let+ shell = shell_pos0 in + generic_completion shell + +let tool_commands_cmd = + let doc = "Output all subcommands of a cmdliner tool" in + let man = + [ `S Manpage.s_description; + `P "$(cmd) outputs all the subcommands of a given cmdliner based \ + tool, one per line. Examples:"; + `Pre "$(cmd) $(b,./mytool)"; `Noblank; + `Pre "$(cmd) $(b,cmdliner)"; + ] + in + Cmd.make (Cmd.info "tool-commands" ~doc ~man) @@ + let+ tool = + let doc = + "$(docv) is the tool executable. Searched in the $(b,PATH) unless \ + an explicit file path is specified." + in + Arg.(required & pos 0 (some filepath) None & info [] ~doc ~docv:"TOOLEXEC") + in + tool_commands tool + +let tool_completion_cmd = + let doc = "Output tool completion scripts" in + let man = + [ `S Manpage.s_description; + `P "$(cmd) outputs the tool specific completion script of a given shell. \ + Example:"; + `Pre "$(cmd) $(b,zsh mytool)"; + `P "Note that tool specific completion script need the corresponding \ + generic completion script output by $(b,generic-completion) to be \ + loaded in the shell. To install these scripts see command \ + $(b,install tool-completion)."; + ] + in + Cmd.make (Cmd.info "tool-completion" ~doc ~man) @@ + let+ shell = shell_pos0 and+ toolname = toolname_pos1 in + tool_completion shell ~toolname + +let install_generic_completion_cmd = + let doc = "Install generic completion scripts" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) installs the generic completion script of given shells in \ + a $(b,share) directory according to specific shell conventions. \ + Directories are created if needed. \ + Use option $(b,--dry-run) to see which paths would be written. \ + Examples:"; + `Pre "$(cmd) $(b,/usr/local/share) # All supported shells"; `Noblank; + `Pre "$(cmd) $(b,--shell zsh /usr/local/share)"; + `P "To inspect the actual scripts use the command \ + $(b,generic-completion)."; + ] + in + Cmd.make (Cmd.info "generic-completion" ~doc ~man) @@ + (* No let punning in < 4.13 *) + let+ dry_run = dry_run and+ shells = shells_opt + and+ update_opam_install = update_opam_install + and+ sharedir_pos0 = sharedir_pos0 in + install_generic_completion ~dry_run ~update_opam_install shells sharedir_pos0 + +let install_tool_completion_cmd = + let doc = "Install tool completion scripts" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) installs tool completion script of given tools and shells in \ + a $(b,share) directory according to specific shell conventions. \ + Directories are created if needed. \ + Use option $(b,--dry-run) to see which paths would be written. \ + Example:"; + `Pre "$(cmd) $(b,mytool) $(b,/usr/local/share) # All supported shells"; + `Noblank; + `Pre "$(cmd) $(b,--shell zsh mytool /usr/local/share)"; + `P "Note that the command $(b,install tool-support) also installs \ + completions like this command does. To inspect the actual scripts \ + use the command $(b,tool-completion)."; + ] + in + Cmd.make (Cmd.info "tool-completion" ~doc ~man) @@ + (* No let punning in < 4.13 *) + let+ dry_run = dry_run and+ shells = shells_opt + and+ update_opam_install = update_opam_install + and+ toolnames = toolnames_posleft and+ sharedir = sharedir_poslast in + install_tool_completion + ~dry_run ~update_opam_install ~shells ~toolnames ~sharedir + +let install_tool_manpages_cmd = + let doc = "Install tool and subcommand manpages" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) installs the manpages of the tool and its commands \ + according in directories of a $(b,man) directory. Directories are \ + created if needed. \ + Use option $(b,--dry-run) to see which paths would be written. \ + Example:"; + `Pre "$(cmd) $(b,./mytool) $(b,/usr/local/share/man)"; + `P "Note that the command $(b,install tool-support) also installs manpages \ + like this command does." + ] + in + Cmd.make (Cmd.info "tool-manpages" ~doc ~man) @@ + let+ dry_run = dry_run and+ update_opam_install = update_opam_install + and+ tools = tools_posleft and+ mandir = mandir_poslast in + install_tool_manpages ~dry_run ~update_opam_install ~tools ~mandir + +let install_tool_support_cmd = + let doc = "Install both tool completion and manpages" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) combines commands $(b,install tool-completion) and \ + $(b,install tool-manpages) to install all tool support files \ + in a given $(i,PREFIX) which is assumed to follow the Filesystem \ + Hierarchy Standard. + Use options $(b,--sharedir) and/or $(b,--mandir) if that is + not the case (e.g. in $(b,opam) as of writing). + Use option $(b,--dry-run) to see which paths would be written. \ + Example:"; + `Pre "$(cmd) $(b,./mytool /usr/local)"; `Noblank; + `Pre "$(cmd) $(b,--update-opam-install=mypkg.install) \\\\ \n\ + \ $(b,_build/mytool _build/prefix)"; + ] + in + Cmd.make (Cmd.info "tool-support" ~doc ~man) @@ + let+ dry_run = dry_run and+ update_opam_install = update_opam_install + and+ shells = shells_opt and+ tools = tools_posleft and+ sharedir = sharedir_opt + and+ mandir = mandir_opt and+ prefix = prefix in + install_tool_support + ~dry_run ~update_opam_install tools shells ~prefix ~sharedir ~mandir + +let install_cmd = + let doc = "Install support files for cmdliner tools" in + let man = + [ `S Manpage.s_description; + `P "$(cmd) subcommands install cmdliner support files. \ + See the library documentation or invoke \ + subcommands with $(b,--help) for more details."; ] + in + Cmd.group (Cmd.info "install" ~doc ~man) @@ + [install_generic_completion_cmd; install_tool_completion_cmd; + install_tool_manpages_cmd; install_tool_support_cmd] + +let cmd = + let doc = "Helper tool for cmdliner based tools" in + let default = Term.(ret (const (`Help (`Pager, None)))) in + let man = + [ `S Manpage.s_description; + `P "$(tool) is a helper for tools using the cmdliner command line \ + interface library. It helps with installing command line \ + completion scripts and manpages. See the library documentation or \ + invoke subcommands with $(b,--help) for more details."; ] + in + Cmd.group (Cmd.info "cmdliner" ~version:"v2.0.0+dune" ~doc ~man) ~default @@ + [generic_completion_cmd; tool_commands_cmd; tool_completion_cmd; install_cmd] + +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/src/tool/zsh-completion.sh b/unikernel/duniverse/cmdliner/src/tool/zsh-completion.sh new file mode 100644 index 00000000..04766cd2 --- /dev/null +++ b/unikernel/duniverse/cmdliner/src/tool/zsh-completion.sh @@ -0,0 +1,72 @@ +function _cmdliner_generic { + local w=("${words[@]}") # Keep words intact for restart completion + local prefix="${words[CURRENT]}" + w[CURRENT]="--__complete=${words[CURRENT]}" + local line="${w[@]:0:1} --__complete ${w[@]:1}" + local -a completions + local version type group item text_line item_doc msg + eval $line | { + read -r version + if [[ $version != "1" ]]; then + _message -r "Unsupported cmdliner completion protocol: $version" + return 1 + fi + while IFS= read -r type; do + if [[ "$type" == "group" ]]; then + if [ -n "$completions" ]; then + _describe -V unsorted completions -U + completions=() + fi + read -r group + elif [[ "$type" == "message" ]]; then + msg=""; + while read text_line; do + if [[ "$text_line" == "message-end" ]]; then + msg=${msg#?} # remove first newline + break + fi + msg+=$'\n'"$text_line" + done + _message -r "$msg" + elif [[ "$type" == "item" ]]; then + read -r item; + item_doc=""; + while read -r text_line; do + if [[ "$text_line" == "item-end" ]]; then + item_doc=${item_doc#?} # remove first space + break + fi + # Sadly it seems impossible to make multiline + # doc strings. Get in touch if you know any better. + item_doc+=" $text_line" + done + # Handle glued forms, the completion item is the full option + if [[ "$group" == "Values" ]]; then + if [[ "$prefix" == --* ]]; then + item="${prefix%%=*}=${item}" + elif [[ "$prefix" == -* ]]; then + item="${prefix:0:2}${item}" + fi + fi + # item_doc="${item_doc//$'\e'\[(01m|04m|m)/}" + completions+=("${item}":"${item_doc}") + elif [[ "$type" == "dirs" ]]; then + _path_files -/ + elif [[ "$type" == "files" ]]; then + _path_files -f + elif [[ "$type" == "restart" ]]; then + # N.B. only emitted if there is a -- token + while [[ $words[1] != "--" ]]; do + shift words + (( CURRENT-- )) + done + shift words + (( CURRENT-- )) + _normal + fi + done + } + if [ -n "$completions" ]; then + _describe -V unsorted completions -U + fi +} diff --git a/unikernel/duniverse/cmdliner/test/blueprint_cmds.ml b/unikernel/duniverse/cmdliner/test/blueprint_cmds.ml new file mode 100644 index 00000000..dd686b65 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/blueprint_cmds.ml @@ -0,0 +1,35 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +let hey () = Cmdliner.Cmd.Exit.ok +let ho () = Cmdliner.Cmd.Exit.ok + +open Cmdliner +open Cmdliner.Term.Syntax + +let flag = Arg.(value & flag & info ["flag"] ~doc:"The flag") +let infile = + let doc = "$(docv) is the input file. Use $(b,-) for $(b,stdin)." in + Arg.(value & pos 0 file "-" & info [] ~doc ~docv:"FILE") + +let hey_cmd = + let doc = "The hey command synopsis is TODO" in + Cmd.make (Cmd.info "hey" ~doc) @@ + let+ unit = Term.const () in + ho () + +let ho_cmd = + let doc = "The ho command synopsis is TODO" in + Cmd.make (Cmd.info "ho" ~doc) @@ + let+ unit = Term.const () in + ho unit + +let cmd = + let doc = "The tool synopsis is TODO" in + Cmd.group (Cmd.info "TODO-toolname" ~version:"v2.0.0+dune" ~doc) @@ + [hey_cmd; ho_cmd] + +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/blueprint_min.ml b/unikernel/duniverse/cmdliner/test/blueprint_min.ml new file mode 100644 index 00000000..a87a8c5c --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/blueprint_min.ml @@ -0,0 +1,18 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +let tool () = Cmdliner.Cmd.Exit.ok + +open Cmdliner +open Cmdliner.Term.Syntax + +let cmd = + let doc = "The tool synopsis is TODO" in + Cmd.make (Cmd.info "TODO-toolname" ~doc) @@ + let+ unit = Term.const () in + tool unit + +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/blueprint_tool.ml b/unikernel/duniverse/cmdliner/test/blueprint_tool.ml new file mode 100644 index 00000000..b662c75a --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/blueprint_tool.ml @@ -0,0 +1,33 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +let exit_todo = 1 + +let tool ~flag ~infile = exit_todo + +open Cmdliner +open Cmdliner.Term.Syntax + +let flag = Arg.(value & flag & info ["flag"] ~doc:"The flag") +let infile = + let doc = "$(docv) is the input file. Use $(b,-) for $(b,stdin)." in + Arg.(value & pos 0 file "-" & info [] ~doc ~docv:"FILE") + +let cmd = + let doc = "The tool synopsis is TODO" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) does TODO" ] + in + let exits = + Cmd.Exit.info exit_todo ~doc:"When there is stuff todo" :: + Cmd.Exit.defaults + in + Cmd.make (Cmd.info "TODO" ~version:"v2.0.0+dune" ~doc ~man ~exits) @@ + let+ flag and+ infile in + tool ~flag ~infile + +let main () = Cmd.eval' cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_chorus.ml b/unikernel/duniverse/cmdliner/test/example_chorus.ml new file mode 100644 index 00000000..46cb628d --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_chorus.ml @@ -0,0 +1,38 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +(* Implementation of the command *) + +let chorus ~count msg = for i = 1 to count do print_endline msg done + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let count = + let doc = "Repeat the message $(docv) times." in + Arg.(value & opt int 10 & info ["c"; "count"] ~doc ~docv:"COUNT") + +let msg = + let env = + let doc = "Overrides the default message to print." in + Cmd.Env.info "CHORUS_MSG" ~doc + in + let doc = "The message to print." in + Arg.(value & pos 0 string "Revolt!" & info [] ~env ~doc ~docv:"MSG") + +let chorus_cmd = + let doc = "Print a customizable message repeatedly" in + let man = [ + `S Manpage.s_bugs; + `P "Email bug reports to ." ] + in + Cmd.make (Cmd.info "chorus" ~version:"v2.0.0+dune" ~doc ~man) @@ + let+ count and+ msg in + chorus ~count msg + +let main () = Cmd.eval chorus_cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_cp.ml b/unikernel/duniverse/cmdliner/test/example_cp.ml new file mode 100644 index 00000000..bfecb999 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_cp.ml @@ -0,0 +1,58 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +(* Implementation, we check the dest argument and print the args *) + +let cp ~verbose ~recurse ~force srcs dest = + let many = List.length srcs > 1 in + if many && (not (Sys.file_exists dest) || not (Sys.is_directory dest)) + then `Error (false, dest ^ ": not a directory") else + `Ok (Printf.printf + "verbose = %B\nrecurse = %B\nforce = %B\nsrcs = %s\ndest = %s\n" + verbose recurse force (String.concat ", " srcs) dest) + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let verbose = + let doc = "Print file names as they are copied." in + Arg.(value & flag & info ["v"; "verbose"] ~doc) + +let recurse = + let doc = "Copy directories recursively." in + Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) + +let force = + let doc = "If a destination file cannot be opened, remove it and try again."in + Arg.(value & flag & info ["f"; "force"] ~doc) + +let srcs = + let doc = "Source file(s) to copy." in + Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc) + +let dest = + let doc = "Destination of the copy. Must be a directory if there is more \ + than one $(i,SOURCE)." in + let docv = "DEST" in + Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv ~doc) + +let cp_cmd = + let doc = "Copy files" in + let man_xrefs = + [`Tool "mv"; `Tool "scp"; `Page ("umask", 2); `Page ("symlink", 7)] + in + let man = [ + `S Manpage.s_bugs; + `P "Email them to ."; ] + in + Cmd.make (Cmd.info "cp" ~version:"v2.0.0+dune" ~doc ~man ~man_xrefs) @@ + Term.ret @@ + let+ verbose and+ recurse and+ force and+ srcs and+ dest in + cp ~verbose ~recurse ~force srcs dest + +let main () = Cmd.eval cp_cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_darcs.ml b/unikernel/duniverse/cmdliner/test/example_darcs.ml new file mode 100644 index 00000000..bb2e9612 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_darcs.ml @@ -0,0 +1,156 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +(* Implementations, just print the args. *) + +type verb = Normal | Quiet | Verbose +type copts = { debug : bool; verb : verb; prehook : string option } + +let str = Printf.sprintf +let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) +let opt_str_str = opt_str (fun s -> s) +let verb_str = function + | Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose" + +let pr_copts oc copts = Printf.fprintf oc + "debug = %B\nverbosity = %s\nprehook = %s\n" + copts.debug (verb_str copts.verb) (opt_str_str copts.prehook) + +let initialize copts repodir = Printf.printf + "%arepodir = %s\n" pr_copts copts repodir + +let record copts name email all ask_deps files = Printf.printf + "%aname = %s\nemail = %s\nall = %B\nask-deps = %B\nfiles = %s\n" + pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps + (String.concat ", " files) + +let help copts man_format cmds topic = match topic with +| None -> `Help (`Pager, None) (* help about the program. *) +| Some topic -> + let topics = "topics" :: "patterns" :: "environment" :: cmds in + let conv = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in + let parse = Cmdliner.Arg.Conv.parser conv in + match parse topic with + | Error e -> `Error (false, e) + | Ok t when t = "topics" -> List.iter print_endline topics; `Ok () + | Ok t when List.mem t cmds -> `Help (man_format, Some t) + | Ok t -> + let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in + `Ok (Cmdliner.Manpage.print man_format Format.std_formatter page) + +open Cmdliner +open Cmdliner.Term.Syntax + +(* Help sections common to all commands *) + +let help_secs = [ + `S Manpage.s_common_options; + `P "These options are common to all commands."; + `S "MORE HELP"; + `P "Use $(tool) $(i,COMMAND) --help for help on a single command.";`Noblank; + `P "Use $(tool) $(b,help patterns) for help on patch matching."; `Noblank; + `P "Use $(tool) $(b,help environment) for help on environment variables."; + `S Manpage.s_bugs; `P "Check bug reports at http://bugs.example.org.";] + +(* Options common to all commands *) + +let copts debug verb prehook = { debug; verb; prehook } +let copts_t = + let docs = Manpage.s_common_options in + let debug = + let doc = "Give only debug output." in + Arg.(value & flag & info ["debug"] ~docs ~doc) + in + let verb = + let doc = "Suppress informational output." in + let quiet = Quiet, Arg.info ["q"; "quiet"] ~docs ~doc in + let doc = "Give verbose output." in + let verbose = Verbose, Arg.info ["v"; "verbose"] ~docs ~doc in + Arg.(last & vflag_all [Normal] [quiet; verbose]) + in + let prehook = + let doc = "Specify command to run before this $(tool) command." in + Arg.(value & opt (some string) None & info ["prehook"] ~docs ~doc) + in + Term.(const copts $ debug $ verb $ prehook) + +(* Commands *) + +let sdocs = Manpage.s_common_options + +let initialize_cmd = + let repodir = + let doc = "Run the program in repository directory $(docv)." in + Arg.(value & opt file Filename.current_dir_name & info ["repodir"] + ~docv:"DIR" ~doc) + in + let doc = "make the current directory a repository" in + let man = [ + `S Manpage.s_description; + `P "Turns the current directory into a Darcs repository. Any + existing files and subdirectories become …"; + `Blocks help_secs; ] + in + Cmd.make (Cmd.info "initialize" ~doc ~sdocs ~man) @@ + let+ copts_t and+ repodir in + initialize copts_t repodir + +let record_cmd = + let pname = + let doc = "Name of the patch." in + Arg.(value & opt (some string) None & info ["m"; "patch-name"] ~docv:"NAME" + ~doc) + in + let author = + let doc = "Specifies the author's identity." in + Arg.(value & opt (some string) None & info ["A"; "author"] ~docv:"EMAIL" + ~doc) + in + let all = + let doc = "Answer yes to all patches." in + Arg.(value & flag & info ["a"; "all"] ~doc) + in + let ask_deps = + let doc = "Ask for extra dependencies." in + Arg.(value & flag & info ["ask-deps"] ~doc) + in + let files = Arg.(value & (pos_all file) [] & info [] ~docv:"FILE or DIR") in + let doc = "create a patch from unrecorded changes" in + let man = + [`S Manpage.s_description; + `P "Creates a patch from changes in the working tree. If you specify + a set of files…"; + `Blocks help_secs; ] + in + Cmd.make (Cmd.info "record" ~doc ~sdocs ~man) @@ + let+ copts_t and+ pname and+ author and+ all and+ ask_deps and+ files in + record copts_t pname author all ask_deps files + +let help_cmd = + let topic = + let doc = "The topic to get help on. $(b,topics) lists the topics." in + Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc) + in + let doc = "display help about darcs and darcs commands" in + let man = + [`S Manpage.s_description; + `P "Prints help about darcs commands and other subjects…"; + `Blocks help_secs; ] + in + Cmd.make (Cmd.info "help" ~doc ~man) @@ + Term.ret @@ + let+ copts_t and+ man_format = Arg.man_format + and+ choice_names = Term.choice_names and+ topic in + help copts_t man_format choice_names topic + +let main_cmd = + let doc = "a revision control system" in + let man = help_secs in + let info = Cmd.info "darcs" ~version:"v2.0.0+dune" ~doc ~sdocs ~man in + let default = Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)) in + Cmd.group info ~default [initialize_cmd; record_cmd; help_cmd] + +let main () = Cmd.eval main_cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_group.ml b/unikernel/duniverse/cmdliner/test/example_group.ml new file mode 100644 index 00000000..68e948bd --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_group.ml @@ -0,0 +1,9 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +open Cmdliner + +let main () = Cmd.eval Testing_cmdliner.sample_group_cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_revolt1.ml b/unikernel/duniverse/cmdliner/test/example_revolt1.ml new file mode 100644 index 00000000..2debce9b --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_revolt1.ml @@ -0,0 +1,13 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +let revolt () = print_endline "Revolt!" + +open Cmdliner + +let revolt_term = Term.app (Term.const revolt) (Term.const ()) +let revolt_cmd = Cmd.v (Cmd.info "revolt") revolt_term +let main () = Cmd.eval revolt_cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_revolt2.ml b/unikernel/duniverse/cmdliner/test/example_revolt2.ml new file mode 100644 index 00000000..0b48bda8 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_revolt2.ml @@ -0,0 +1,17 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +let revolt () = print_endline "Revolt!" + +open Cmdliner +open Cmdliner.Term.Syntax + +let cmd_revolt = + Cmd.make (Cmd.info "revolt") @@ + let+ () = Term.const () in + revolt () + +let main () = Cmd.eval cmd_revolt +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_rm.ml b/unikernel/duniverse/cmdliner/test/example_rm.ml new file mode 100644 index 00000000..c3b14c2c --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_rm.ml @@ -0,0 +1,65 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +(* Implementation of the command, we just print the args. *) + +type prompt = Always | Once | Never +let prompt_str = function +| Always -> "always" | Once -> "once" | Never -> "never" + +let rm ~prompt ~recurse files = + Printf.printf "prompt = %s\nrecurse = %B\nfiles = %s\n" + (prompt_str prompt) recurse (String.concat ", " files) + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let files = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILE") +let prompt = + let always = + let doc = "Prompt before every removal." in + Always, Arg.info ["i"] ~doc + in + let never = + let doc = "Ignore nonexistent files and never prompt." in + Never, Arg.info ["f"; "force"] ~doc + in + let once = + let doc = "Prompt once before removing more than three files, or when + removing recursively. Less intrusive than $(b,-i), while + still giving protection against most mistakes." + in + Once, Arg.info ["I"] ~doc + in + Arg.(last & vflag_all [Always] [always; never; once]) + +let recursive = + let doc = "Remove directories and their contents recursively." in + Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) + +let rm_cmd = + let doc = "Remove files or directories" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) removes each specified $(i,FILE). By default it does not + remove directories, to also remove them and their contents, use the + option $(b,--recursive) ($(b,-r) or $(b,-R))."; + `P "To remove a file whose name starts with a $(b,-), for example + $(b,-foo), use one of these commands:"; + `Pre "$(cmd) $(b,-- -foo)"; `Noblank; + `Pre "$(cmd) $(b,./-foo)"; + `P "$(cmd) removes symbolic links, not the files referenced by the + links."; + `S Manpage.s_bugs; `P "Report bugs to ."; + `S Manpage.s_see_also; `P "$(b,rmdir)(1), $(b,unlink)(2)" ] + in + Cmd.make (Cmd.info "rm" ~version:"v2.0.0+dune" ~doc ~man) @@ + let+ prompt and+ recursive and+ files in + rm ~prompt ~recurse:recursive files + +let main () = Cmd.eval rm_cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/example_tail.ml b/unikernel/duniverse/cmdliner/test/example_tail.ml new file mode 100644 index 00000000..9cc01175 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/example_tail.ml @@ -0,0 +1,89 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: CC0-1.0 + ---------------------------------------------------------------------------*) + +(* Implementation of the command, we just print the args. *) + +type loc = bool * int +type verb = Verbose | Quiet +type follow = Name | Descriptor + +let str = Printf.sprintf +let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) +let loc_str (rev, k) = if rev then str "%d" k else str "+%d" k +let follow_str = function Name -> "name" | Descriptor -> "descriptor" +let verb_str = function Verbose -> "verbose" | Quiet -> "quiet" + +let tail ~lines ~follow ~verb ~pid files = + Printf.printf + "lines = %s\nfollow = %s\nverb = %s\npid = %s\nfiles = %s\n" + (loc_str lines) (opt_str follow_str follow) (verb_str verb) + (opt_str string_of_int pid) (String.concat ", " files) + +(* Command line interface *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let loc_arg = + let parser s = + try + if s <> "" && s.[0] <> '+' + then Ok (true, int_of_string s) + else Ok (false, int_of_string (String.sub s 1 (String.length s - 1))) + with Failure _ -> Error "unable to parse integer" + in + let pp ppf p = Format.fprintf ppf "%s" (loc_str p) in + Arg.Conv.make ~docv:"N" ~parser ~pp () + +let lines = + let doc = "Output the last $(docv) lines or use $(i,+)$(docv) to start \ + output after the $(i,N)-1th line." + in + Arg.(value & opt loc_arg (true, 10) & info ["n"; "lines"] ~docv:"N" ~doc) + +let follow = + let doc = "Output appended data as the file grows. $(docv) specifies how \ + the file should be tracked, by its $(b,name) or by its \ + $(b,descriptor)." + in + let follow = Arg.enum ["name", Name; "descriptor", Descriptor] in + Arg.(value & opt (some follow) ~vopt:(Some Descriptor) None & + info ["f"; "follow"] ~docv:"ID" ~doc) + +let verb = + let quiet = + let doc = "Never output headers giving file names." in + Quiet, Arg.info ["q"; "quiet"; "silent"] ~doc + in + let verbose = + let doc = "Always output headers giving file names." in + Verbose, Arg.info ["v"; "verbose"] ~doc + in + Arg.(last & vflag_all [Quiet] [quiet; verbose]) + +let pid = + let doc = "With -f, terminate after process $(docv) dies." in + Arg.(value & opt (some int) None & info ["pid"] ~docv:"PID" ~doc) + +let files = Arg.(value & (pos_all non_dir_file []) & info [] ~docv:"FILE") + +let tail_cmd = + let doc = "Display the last part of a file" in + let man = [ + `S Manpage.s_description; + `P "$(cmd) prints the last lines of each $(i,FILE) to standard output. If + no file is specified reads standard input. The number of printed + lines can be specified with the $(b,-n) option."; + `S Manpage.s_bugs; + `P "Report them to ."; + `S Manpage.s_see_also; + `P "$(b,cat)(1), $(b,head)(1)" ] + in + Cmd.make (Cmd.info "tail" ~version:"v2.0.0+dune" ~doc ~man) @@ + let+ lines and+ follow and+ verb and+ pid and+ files in + tail ~lines ~follow ~verb ~pid files + +let main () = Cmd.eval tail_cmd +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/test_arg.ml b/unikernel/duniverse/cmdliner/test/test_arg.ml new file mode 100644 index 00000000..d87ece88 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/test_arg.ml @@ -0,0 +1,437 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner +open Cmdliner.Term.Syntax + +(* The tests have the following structure: + + let test = + let cmd = … (* A command definition *) in + (* A few snapshots of valid cli parses *) + parse … + (* A few snapshots of invalid cli parses *) + error … + (* A snapshot of a plain text version of the manual *) + Testing_cmdliner.snap_man … *) + +(* Positional arguments *) + +let test_pos_all = + Test.test "Arg.pos_all" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_pos_all" ~doc:"Test pos all") @@ + let+ all = Arg.(value & pos_all string [] & info [] ~docv:"THEARG") in + all + in + let parse = Testing_cmdliner.snap_parse Test.T.(list string) cmd in + let error err = Testing_cmdliner.snap_eval_error err cmd in + parse [] @@ __POS_OF__ []; + parse ["0"] @@ __POS_OF__ ["0"]; + parse ["--"; "0"] @@ __POS_OF__ ["0"]; + parse ["0";"1"] @@ __POS_OF__ ["0"; "1"]; + parse ["0";"--"; "1"] @@ __POS_OF__ ["0"; "1"]; + (**) + error `Term ["--opt"] @@ __POS_OF__ + "Usage: \u{001B}[01mtest_pos_all\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mTHEARG\u{001B}[m]…\n\ + test_pos_all: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--opt\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_pos_all - Test pos all + +SYNOPSIS + test_pos_all [OPTION]… [THEARG]… + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_pos_all exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let test_pos_left = + Test.test "Arg.pos_left" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_pos_left" ~doc:"Test pos left") @@ + let+ left = Arg.(value & pos_left 2 string [] & info [] ~docv:"LEFT") in + left + in + let parse = Testing_cmdliner.snap_parse Test.T.(list string) cmd in + let error err = Testing_cmdliner.snap_eval_error err cmd in + parse [] @@ __POS_OF__ []; + parse ["--"] @@ __POS_OF__ []; + parse ["0"] @@ __POS_OF__ ["0"]; + parse ["0"; "--"; "1" ] @@ __POS_OF__ ["0"; "1"]; + parse ["0"; "1" ] @@ __POS_OF__ ["0"; "1"]; + (**) + error `Term ["0"; "1"; "2"] @@ __POS_OF__ + "Usage: \u{001B}[01mtest_pos_left\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mLEFT\u{001B}[m] [\u{001B}[04mLEFT\u{001B}[m]\n\ + test_pos_left: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01m2\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_pos_left - Test pos left + +SYNOPSIS + test_pos_left [OPTION]… [LEFT] [LEFT] + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_pos_left exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let test_pos_req = + Test.test "Arg.required & Arg.pos" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_pos_req" ~doc:"Test pos req arguments") @@ + let+ r1 = Arg.(required & pos 0 (some string) None & info [] ~docv:"R1") + and+ r2 = Arg.(required & pos 1 (some string) None & info [] ~docv:"R2") + and+ r3 = Arg.(required & pos 2 (some string) None & info [] ~docv:"R3") + and+ right = + Arg.(non_empty & pos_right 2 string [] & info [] ~docv:"RIGHT") + in + r1, r2, r3, right + in + let t = Test.T.(t4 string string string (list string)) in + let parse = Testing_cmdliner.snap_parse t cmd in + parse ["r1"; "r2"; "r3"; "r4"] @@ __POS_OF__ ("r1", "r2", "r3", ["r4"]); + parse ["r1"; "r2"; "r3"; "r4"; "r5"] @@ __POS_OF__ + ("r1", "r2", "r3", ["r4"; "r5"]); + (**) + let error = Testing_cmdliner.snap_eval_error `Term cmd in + error [] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\ +test_pos_req: required arguments \u{001B}[04mR1\u{001B}[m, \u{001B}[04mR2\u{001B}[m, \u{001B}[04mR3\u{001B}[m, \u{001B}[04mRIGHT\u{001B}[m are \u{001B}[31mmissing\u{001B}[m\n"; + error ["r1"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\ +test_pos_req: required arguments \u{001B}[04mR2\u{001B}[m, \u{001B}[04mR3\u{001B}[m, \u{001B}[04mRIGHT\u{001B}[m are \u{001B}[31mmissing\u{001B}[m\n"; + error ["r1"; "r2"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\ +test_pos_req: required arguments \u{001B}[04mR3\u{001B}[m, \u{001B}[04mRIGHT\u{001B}[m are \u{001B}[31mmissing\u{001B}[m\n"; + error ["r1"; "r2"; "r3"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\ +test_pos_req: required argument \u{001B}[04mRIGHT\u{001B}[m is \u{001B}[31mmissing\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_pos_req - Test pos req arguments + +SYNOPSIS + test_pos_req [OPTION]… R1 R2 R3 RIGHT… + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_pos_req exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let test_pos_left_right = + Test.test "Arg.pos_{left,right}" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_pos" ~doc:"Test pos arguments") @@ + let+ l = Arg.(value & pos_left 2 string [] & info [] ~docv:"LEFT") + and+ t = Arg.(value & pos 2 string "undefined" & info [] ~docv:"TWO") + and+ r = Arg.(value & pos_right 2 string [] & info [] ~docv:"RIGHT") in + (l, t, r) + in + let t = Test.T.(t3 (list string) string (list string)) in + let snap = Testing_cmdliner.snap_parse t cmd in + snap [] @@ __POS_OF__ ([], "undefined", []); + snap ["0"] @@ __POS_OF__ (["0"], "undefined", []); + snap ["0"; "1"] @@ __POS_OF__ (["0"; "1"], "undefined", []); + snap ["0"; "1"; "2"] @@ __POS_OF__ (["0"; "1"], "2", []); + snap ["0"; "1"; "2"; "3"] @@ __POS_OF__ (["0"; "1"], "2", ["3"]); + snap ["0"; "1"; "2"; "3"; "4"] @@ __POS_OF__ (["0"; "1"], "2", ["3"; "4"]); + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_pos - Test pos arguments + +SYNOPSIS + test_pos [OPTION]… [LEFT] [LEFT] [TWO] [RIGHT]… + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_pos exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|} +; +() + +let test_pos_left_right_rev = + Test.test "Arg.pos_{left,right} ~rev:true" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_pos" ~doc:"Test pos arguments") @@ + let rev = true in + let+ l = Arg.(value & pos_left 2 ~rev string [] & info [] ~docv:"LEFT") + and+ t = Arg.(value & pos 2 ~rev string "undefined" & info [] ~docv:"TWO") + and+ r = Arg.(value & pos_right 2 ~rev string [] & info [] ~docv:"RIGHT") in + (l, t, r) + in + let t = Test.T.(t3 (list string) string (list string)) in + let snap = Testing_cmdliner.snap_parse t cmd in + snap [] @@ __POS_OF__ ([], "undefined", []); + snap ["0"] @@ __POS_OF__ ([], "undefined", ["0"]); + snap ["0"; "1"] @@ __POS_OF__ ([], "undefined", ["0"; "1"]); + snap ["0"; "1"; "2"] @@ __POS_OF__ ([], "0", ["1"; "2"]); + snap ["0"; "1"; "2"; "3"] @@ __POS_OF__ (["0"], "1", ["2"; "3"]); + snap ["0"; "1"; "2"; "3"; "4"] @@ __POS_OF__ (["0"; "1"], "2", ["3"; "4"]); + snap ["0"; "1"; "2"; "3"; "4"; "5"] @@ __POS_OF__ + (["0"; "1"; "2"], "3", ["4"; "5"]); + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_pos - Test pos arguments + +SYNOPSIS + test_pos [OPTION]… [LEFT]… [TWO] [RIGHT] [RIGHT] + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_pos exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +(* Optional arguments *) + +let test_opt_required = + Test.test "Arg.required & Arg.opt" @@ fun () -> + let cmd = + let doc = "Test optional required arguments (don't do this)" in + Cmd.make (Cmd.info "test_opt_req" ~doc) @@ + let+ req = + Arg.(required & opt (some string) None & info ["r"; "req"] ~docv:"ARG") + in + req + in + let snap = Testing_cmdliner.snap_parse Test.T.string cmd in + snap ["-ra"] @@ __POS_OF__ "a"; + snap ["--req"; "a"] @@ __POS_OF__ "a"; + (**) + let error err = Testing_cmdliner.snap_eval_error err cmd in + error `Parse [] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\ +test_opt_req: required option \u{001B}[01m--req\u{001B}[m is \u{001B}[31mmissing\u{001B}[m\n"; + error `Term ["a"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\ +test_opt_req: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01ma\u{001B}[m\n"; + error `Term ["-ra"; "a"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\ +test_opt_req: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01ma\u{001B}[m\n"; + error `Parse ["-r"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\ +test_opt_req: option \u{001B}[01m-r\u{001B}[m \u{001B}[31mneeds an argument\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_opt_req - Test optional required arguments (don't do this) + +SYNOPSIS + test_opt_req --req=ARG [OPTION]… + +OPTIONS + -r ARG, --req=ARG (required) + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_opt_req exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let test_arg_info_docv = + Test.test "Arg.info default's docv on strings" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_arg_docv" ~doc:"Test pos all") @@ + let+ all = Arg.(value & pos_all string [] & info []) + and+ opt = Arg.(value & opt string "bla" & info ["field"]) in + all, opt + in + let error err = Testing_cmdliner.snap_eval_error err cmd in + (**) + error `Term ["-z"; "a"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_arg_docv\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--field\u{001B}[m=\u{001B}[04mVAL\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mARG\u{001B}[m]…\n\ +test_arg_docv: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m-z\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_arg_docv - Test pos all + +SYNOPSIS + test_arg_docv [--field=VAL] [OPTION]… [ARG]… + +OPTIONS + --field=VAL (absent=bla) + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_arg_docv exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let test_conv_docv = + Test.test "Arg.Conv.docv" @@ fun () -> + let cmd = + let field = Arg.Conv.of_conv Arg.string ~docv:"FIELD" in + Cmd.make (Cmd.info "test_conv_docv" ~doc:"Test conv docv") @@ + let+ all = Arg.(value & pos_all field [] & info []) + and+ opt = Arg.(value & opt field "bla" & info ["field"]) in + all, opt + in + let error err = Testing_cmdliner.snap_eval_error err cmd in + (**) + error `Term ["-z"; "a"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_conv_docv\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--field\u{001B}[m=\u{001B}[04mFIELD\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mFIELD\u{001B}[m]…\n\ +test_conv_docv: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m-z\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_conv_docv - Test conv docv + +SYNOPSIS + test_conv_docv [--field=FIELD] [OPTION]… [FIELD]… + +OPTIONS + --field=FIELD (absent=bla) + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_conv_docv exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let test_arg_file = + Test.test "Arg.file" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_arg_file" ~doc:"Test conv docv") @@ + let+ all = Arg.(value & pos_all file [] & info []) in + all + in + let error err = Testing_cmdliner.snap_eval_error err cmd in + let parse = Testing_cmdliner.snap_parse Test.T.(list string) cmd in + parse ["-"] @@ __POS_OF__ ["-"]; + (**) + error `Term ["-z"; "a"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_arg_file\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mPATH\u{001B}[m]…\n\ +test_arg_file: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m-z\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_arg_file - Test conv docv + +SYNOPSIS + test_arg_file [OPTION]… [PATH]… + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_arg_file exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let main () = + let doc = "Test argument specifications" in + Test.main ~doc @@ fun () -> Test.autorun () + +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/test_cmd.ml b/unikernel/duniverse/cmdliner/test/test_cmd.ml new file mode 100644 index 00000000..0cd99795 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/test_cmd.ml @@ -0,0 +1,358 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner +open Cmdliner.Term.Syntax + +(* The tests have the following structure: + + let test = + let cmd = … (* A command definition *) in + (* A few snapshots of valid cli parses *) + parse … + (* A few snapshots of invalid cli parses *) + error … + (* A snapshot of a plain text version of the manual *) + Testing_cmdliner.snap_man … *) + +let test_groups = + Test.test "Cmd.group" @@ fun () -> + let cmd = Testing_cmdliner.sample_group_cmd in + let parse = Testing_cmdliner.snap_parse Test.T.unit cmd in + let error err = Testing_cmdliner.snap_eval_error err cmd in + let warning = Testing_cmdliner.snap_parse_warnings cmd in + parse ["birds"] @@ __POS_OF__ (); + parse ["birds"] @@ __POS_OF__ (); + parse ["birds"; "fly"] @@ __POS_OF__ (); + parse ["birds"; "land"] @@ __POS_OF__ (); + parse ["mammals"] @@ __POS_OF__ (); + (**) + warning ["camels"] @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n"; + (**) + error `Term [] @@ __POS_OF__ + "Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\ + test_group: required \u{001B}[04mCOMMAND\u{001B}[m name is \u{001B}[31mmissing\u{001B}[m, must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m,\n\ + \ \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m or \u{001B}[01mmammals\u{001B}[m\n"; + error `Term ["bla"] @@ __POS_OF__ "Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\ + test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mbla\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m\n\ + \ or \u{001B}[01mmammals\u{001B}[m\n"; + error `Parse ["birds"; "-k"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_group birds\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mCOMMAND\u{001B}[m] …\n\ +test_group: option \u{001B}[01m-k\u{001B}[m \u{001B}[31mneeds an argument\u{001B}[m\n"; + error `Term ["mammals"; "land"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_group mammals\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]…\n\ +test_group: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01mland\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_group + +SYNOPSIS + test_group COMMAND … + + Invoke command with test_group, the command name is test_group, the + parent is test_group and the tool name is test_group. + +COMMANDS + birds [COMMAND] … + Operate on birds. + + fishs [OPTION]… [NAME] + Operate on fishs. + + lookup [--kind=ENUM] [OPTION]… NAME + Lookup animal by name. + + mammals [OPTION]… + Operate on mammals. + + (Deprecated) camels [--bactrian] [OPTION]… [HERD] + Use mammals instead. Operate on camels. + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + test_group exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + Testing_cmdliner.snap_man ~args:["birds"; "--help=plain"] cmd @@ __POS_OF__ + {|NAME + test_group-birds - Operate on birds. + +SYNOPSIS + test_group birds [COMMAND] … + + Invoke command with test_group birds, the command name is birds, the + parent is test_group and the tool name is test_group. + +COMMANDS + fly [--speed=SPEED] [OPTION]… [BIRD] + Fly birds. + + land [OPTION]… [BIRD] + Land birds. + +OPTIONS + --can-fly=BOOL (absent=false) + BOOL indicates if the entity can fly. + + -k VAL, --kind=VAL + Kind of entity + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + test_group birds exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +SEE ALSO|}; + (); + Testing_cmdliner.snap_man ~args:["birds"; "fly"; "--help=plain"] cmd @@ + __POS_OF__ + {|NAME + test_group-birds-fly - Fly birds. + +SYNOPSIS + test_group birds fly [--speed=SPEED] [OPTION]… [BIRD] + + Invoke command with test_group birds fly, the command name is fly, the + parent is test_group birds and the tool name is test_group. + +ARGUMENTS + BIRD (absent=pigeon) + Use BIRD specie. + +OPTIONS + --speed=SPEED (absent=2) + Movement SPEED in m/s + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + test_group birds fly exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +SEE ALSO|}; + Testing_cmdliner.snap_man ~args:["birds"; "land"; "--help=plain"] cmd @@ + __POS_OF__ +{|NAME + test_group-birds-land - Land birds. + +SYNOPSIS + test_group birds land [OPTION]… [BIRD] + + Invoke command with test_group birds land, the command name is land, + the parent is test_group birds and the tool name is test_group. + +ARGUMENTS + BIRD (absent=pigeon) + Use BIRD specie. + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + test_group birds land exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +SEE ALSO|}; + (); + Testing_cmdliner.snap_man ~args:["fishs"; "--help=plain"] cmd @@ + __POS_OF__ + {|NAME + test_group-fishs - Operate on fishs. + +SYNOPSIS + test_group fishs [OPTION]… [NAME] + + Invoke command with test_group fishs, the command name is fishs, the + parent is test_group and the tool name is test_group. + +ARGUMENTS + NAME + Use fish named NAME. + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + test_group fishs exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +SEE ALSO|}; + Testing_cmdliner.snap_man ~args:["mammals"; "--help=plain"] cmd @@ + __POS_OF__ + {|NAME + test_group-mammals - Operate on mammals. + +SYNOPSIS + test_group mammals [OPTION]… + + Invoke command with test_group mammals, the command name is mammals, + the parent is test_group and the tool name is test_group. + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + test_group mammals exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +SEE ALSO|}; + Testing_cmdliner.snap_man ~args:["camels"; "--help=plain"] cmd @@ + __POS_OF__ + {|NAME + (Deprecated) test_group-camels - Use mammals instead. Operate on + camels. + +SYNOPSIS + (Deprecated) test_group camels [--bactrian] [OPTION]… [HERD] + + Invoke command with test_group camels, the command name is camels, the + parent is test_group and the tool name is test_group. + +ARGUMENTS + (Deprecated) HERD + Herds HERD are ignored. Find in herd HERD. + +OPTIONS + (Deprecated) -b, --bactrian (absent BACTRIAN env) + Use nothing instead of BACTRIAN, HA!. Specify a bactrian camel. + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + test_group camels exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +ENVIRONMENT + These environment variables affect the execution of test_group camels: + + (Deprecated) BACTRIAN + Use nothing instead of BACTRIAN, HA!. See option --bactrian. + +SEE ALSO|}; + () + +let test_std_opts = + Test.test "Standard options" @@ fun () -> + let cmd = Testing_cmdliner.sample_group_cmd in + let snap_version = Testing_cmdliner.snap_help (Ok `Version) cmd in + let ret ?__POS__ = + let env = Testing_cmdliner.env_dumb_term in + Testing_cmdliner.test_eval_result ?__POS__ ~env Test.T.unit cmd + in + snap_version ["--version"] @@ __POS_OF__ "X.Y.Z\n"; + snap_version ["--version"; "birds"] @@ __POS_OF__ "X.Y.Z\n"; + snap_version ["fishs"; "--version"; "birds"] @@ __POS_OF__ "X.Y.Z\n"; + ret ["--help"; "--version"] (Ok `Help) ~__POS__; + ret ["--help"; "--version"] (Ok `Help) ~__POS__; + ret ["fishs"; "--version"; "birds"; "--help"] (Ok `Help) ~__POS__; + ret ["--help"; "crow"] (Ok `Help) ~__POS__; + ret ["birds"; "--help"; "crow"] (Ok `Help) ~__POS__; + ret ["fishs"; "--"; "--help"] (Ok (`Ok ())) ~__POS__; + () + +let main () = + let doc = "Test command specifications" in + Test.main ~doc @@ fun () -> Test.autorun () + +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/test_completion.ml b/unikernel/duniverse/cmdliner/test/test_completion.ml new file mode 100644 index 00000000..51924ce2 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/test_completion.ml @@ -0,0 +1,635 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner +open Cmdliner.Term.Syntax + +(* The tests have the following structure: + + let test = + let cmd = … (* A command definition *) in + (* A few snapshots of completion protocol results *) + complete … *) + +let cmd = Testing_cmdliner.sample_group_cmd +let complete = Testing_cmdliner.snap_completion cmd + +let test_groups = + Test.test "Cmd.group completions" @@ fun () -> + complete ["--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n\ + group\n\ + Subcommands\n\ + item\n\ + birds\n\ + Operate on birds.\n\ + item-end\n\ + item\n\ + mammals\n\ + Operate on mammals.\n\ + item-end\n\ + item\n\ + fishs\n\ + Operate on fishs.\n\ + item-end\n\ + item\n\ + camels\n\ + Operate on camels.\n\ + item-end\n\ + item\n\ + lookup\n\ + Lookup animal by name.\n\ + item-end\n"; + complete ["birds"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + -k\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --kind\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --can-fly\n\ + \u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\ + item-end\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n\ + group\n\ + Subcommands\n\ + item\n\ + fly\n\ + Fly birds.\n\ + item-end\n\ + item\n\ + land\n\ + Land birds.\n\ + item-end\n"; + () + +let test_no_options_after_dashsash = + Test.test "no options after --" @@ fun () -> + complete ["birds"; "fly"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + --speed\n\ + Movement \u{001B}[04mSPEED\u{001B}[m in m/s\n\ + item-end\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + complete ["birds"; "fly"; "--"; "--__complete="] @@ __POS_OF__ + "1\n"; + () + +let test_opts_starts = + Test.test "complete optional argument names" @@ fun () -> + complete ["birds"; "--__complete=-"] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + -k\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --kind\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --can-fly\n\ + \u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\ + item-end\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n\ + group\n\ + Subcommands\n"; + complete ["birds"; "--__complete=--"] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + --kind\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --can-fly\n\ + \u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\ + item-end\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + () + +let test_opt_value = + Test.test "complete optional argument values" @@ fun () -> + (* Glued *) + complete ["birds"; "--__complete=--can-fly="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n\ + item\n\ + false\n\ + \n\ + item-end\n"; + (* next token *) + complete ["birds"; "--can-fly"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n\ + item\n\ + false\n\ + \n\ + item-end\n"; + complete ["birds"; "--can-fly=true"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + -k\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --kind\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --can-fly\n\ + \u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\ + item-end\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + complete ["birds"; "--can-fly"; "true"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + -k\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --kind\n\ + Kind of entity\n\ + item-end\n\ + item\n\ + --can-fly\n\ + \u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\ + item-end\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + () + +let test_context_sensitive = + Test.test "context sensitive completions" @@ fun () -> + complete ["lookup"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + sparrow\n\ + \n\ + item-end\n\ + item\n\ + parrot\n\ + \n\ + item-end\n\ + item\n\ + pigeon\n\ + \n\ + item-end\n\ + item\n\ + salmon\n\ + \n\ + item-end\n\ + item\n\ + trout\n\ + \n\ + item-end\n\ + item\n\ + piranha\n\ + \n\ + item-end\n\ + group\n\ + Options\n\ + item\n\ + -k\n\ + \u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or \u{001B}[01mfish\u{001B}[m\n\ + item-end\n\ + item\n\ + --kind\n\ + \u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or \u{001B}[01mfish\u{001B}[m\n\ + item-end\n\ + item\n\ + --version\n\ + Show version information.\n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + complete ["lookup"; "-kfish"; "--__complete=s"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + salmon\n\ + \n\ + item-end\n"; + complete ["lookup"; "-kbird"; "--__complete=p"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + parrot\n\ + \n\ + item-end\n\ + item\n\ + pigeon\n\ + \n\ + item-end\n"; + () + +let test_restart_restricted_tool = + Test.test "restart restricted tool" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_restart_restricted") @@ + let+ verb = Arg.(value & flag & info ["verbose"]) + and+ tool = + let tool = Arg.enum ~docv:"VCS" ["git", `Git; "hg", `Hg] in + Arg.(required & pos 0 (some tool) None & info []) + and+ args = + let arg = + let completion = Arg.Completion.complete_restart in + Arg.Conv.of_conv Arg.string ~docv:"ARG" ~completion + in + Arg.(value & pos_right 0 arg [] & info []) + in + () + in + let complete = Testing_cmdliner.snap_completion cmd in + complete ["--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + git\n\ + \n\ + item-end\n\ + item\n\ + hg\n\ + \n\ + item-end\n\ + group\n\ + Options\n\ + item\n\ + --verbose\n\ + \n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + complete ["--__complete=g"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + git\n\ + \n\ + item-end\n"; + (* Note no reset here: as there is no -- token *) + complete ["git"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + --verbose\n\ + \n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + complete ["--"; "git"; "--__complete="] @@ __POS_OF__ + "1\n\ + restart\n"; + () + +let test_restart_any_tool = + Test.test "restart any tool" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_restart") @@ + let arg ~docv = + let completion = Arg.Completion.complete_restart in + Arg.Conv.of_conv Arg.string ~docv:"TOOL" ~completion + in + let+ verb = Arg.(value & flag & info ["verbose"]) + and+ tool = Arg.(required & pos 0 (some (arg ~docv:"TOOL")) None & info []) + and+ args = Arg.(value & pos_right 0 (arg ~docv:"ARG") [] & info []) in + () + in + let complete = Testing_cmdliner.snap_completion cmd in + complete ["--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + --verbose\n\ + \n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + (* The following two do not restart because -- is missing *) + complete ["--__complete=gi"] @@ __POS_OF__ + "1\n"; + complete ["git"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Options\n\ + item\n\ + --verbose\n\ + \n\ + item-end\n\ + item\n\ + --help\n\ + Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\ + or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\ + is \u{001B}[01mdumb\u{001B}[m or undefined.\n\ + item-end\n"; + (* These must restart *) + complete ["--"; "--__complete=gi"] @@ __POS_OF__ + "1\n\ + restart\n"; + complete ["--"; "git"; "--__complete="] @@ __POS_OF__ + "1\n\ + restart\n"; + () + +let test_context = + Test.test "Context sensitive completion from optional argument" @@ fun () -> + let ctx = + Arg.(value & opt (some bool) None & info ["ctx"]) + in + let dep = + let complete ctx ~token:_ = match ctx with + | None -> Ok [Arg.Completion.string "ctx-parse-error"] + | Some None -> Ok [Arg.Completion.string "no-context"] + | Some (Some ctx) -> Ok [Arg.Completion.string (Bool.to_string ctx)] + in + let completion = Arg.Completion.make ~context:ctx complete in + Arg.Conv.of_conv Arg.string ~docv:"SPECIAL" ~completion + in + let () = (* test [dep] converter on an option *) + let cmd = + Cmd.make (Cmd.info "test_context") @@ + let+ lookup = Arg.(value & opt dep "nothing" & info ["dep"]) + and+ ctx in + () + in + let complete = Testing_cmdliner.snap_completion cmd in + complete ["--dep"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + no-context\n\ + \n\ + item-end\n"; + complete ["--ctx=hey"; "--dep"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + ctx-parse-error\n\ + \n\ + item-end\n"; + complete ["--ctx=true"; "--dep"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n"; + complete ["--dep"; "--__complete="; "--ctx=true"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n"; + in + let () = + let cmd = + Cmd.make (Cmd.info "test_context") @@ + let+ lookup = Arg.(value & pos 0 dep "nothing" & info []) + and+ ctx in + () + in + let complete = Testing_cmdliner.snap_completion cmd in + complete ["--__complete=a"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + no-context\n\ + \n\ + item-end\n"; + complete ["--ctx=hey"; "--__complete=a"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + ctx-parse-error\n\ + \n\ + item-end\n"; + complete ["--ctx=true"; "--__complete=a"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n"; + complete ["--__complete=a"; "--ctx=true"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n"; + in + () + +let test_context = + Test.test "Context sensitive completion from positional argument" @@ fun () -> + let ctx0 = Arg.(value & pos 0 (some bool) None & info []) in + let dep = + let complete ctx ~token:_ = match ctx with + | None -> Ok [Arg.Completion.string "ctx-parse-error"] + | Some None -> Ok [Arg.Completion.string "no-context"] + | Some (Some ctx) -> Ok [Arg.Completion.string (Bool.to_string ctx)] + in + let completion = Arg.Completion.make ~context:ctx0 complete in + Arg.Conv.of_conv Arg.string ~docv:"SPECIAL" ~completion + in + let () = (* test [dep] converter on an option *) + let cmd = + Cmd.make (Cmd.info "test_context") @@ + let+ lookup = Arg.(value & opt dep "nothing" & info ["dep"]) + and+ ctx0 in + () + in + let complete = Testing_cmdliner.snap_completion cmd in + complete ["--dep"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + no-context\n\ + \n\ + item-end\n"; + complete ["bla"; "--dep"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + ctx-parse-error\n\ + \n\ + item-end\n"; + complete ["true"; "--dep"; "--__complete="] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n"; + complete ["--dep"; "--__complete="; "true"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n"; + in + let () = + let cmd = + Cmd.make (Cmd.info "test_context") @@ + let+ lookup = Arg.(value & pos 1 dep "nothing" & info []) + and+ ctx0 in + () + in + let complete = Testing_cmdliner.snap_completion cmd in + complete ["hey"; "--__complete=a"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + ctx-parse-error\n\ + \n\ + item-end\n"; + complete ["true"; "--__complete=a"] @@ __POS_OF__ + "1\n\ + group\n\ + Values\n\ + item\n\ + true\n\ + \n\ + item-end\n"; + in + () + +let main () = + let doc = "Test completion" in + Test.main ~doc @@ fun () -> Test.autorun () + +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/test_deprecation.ml b/unikernel/duniverse/cmdliner/test/test_deprecation.ml new file mode 100644 index 00000000..fe5c7a13 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/test_deprecation.ml @@ -0,0 +1,63 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner +open Cmdliner.Term.Syntax + +let cmd = Testing_cmdliner.sample_group_cmd +let warning ?env = Testing_cmdliner.snap_parse_warnings ?env cmd +let test_env = function "BACTRIAN" -> Some "true" | var -> Sys.getenv_opt var + +let deprecated_command = + Test.test "Deprecated command" @@ fun () -> + warning ["camels"] @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n"; + () + +let deprecated_arg = + Test.test "Deprecated option argument" @@ fun () -> + warning ["camels"; "-b"] @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\ + \ \u{001B}[33mdeprecated\u{001B}[m option \u{001B}[01m-b\u{001B}[m: Use nothing instead of \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n"; + warning ["camels"; "--bactrian"] @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\ + \ \u{001B}[33mdeprecated\u{001B}[m option \u{001B}[01m--bactrian\u{001B}[m: Use nothing instead of \u{001B}[01mBACTRIAN\u{001B}[m,\n\ + \ \u{001B}[01mHA!\u{001B}[m.\n"; + () + +let deprecated_pos = + Test.test "Deprecated positional argument" @@ fun () -> + warning ["camels"; "bla"] @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\ + \ \u{001B}[33mdeprecated\u{001B}[m argument \u{001B}[01mbla\u{001B}[m: Herds \u{001B}[04mHERD\u{001B}[m are ignored.\n"; + () + +let deprecated_env = + Test.test "Deprecated env variable" @@ fun () -> + warning ~env:test_env ["camels"] @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\ + \ \u{001B}[33mdeprecated\u{001B}[m environment variable \u{001B}[01mBACTRIAN\u{001B}[m: Use nothing instead of\n\ + \ \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n"; + warning ~env:test_env ["camels"; "-b"] (* takes over env *) @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\ + \ \u{001B}[33mdeprecated\u{001B}[m option \u{001B}[01m-b\u{001B}[m: Use nothing instead of \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n"; + () + +let deprecated_combined = + Test.test "Deprecation combined" @@ fun () -> + warning ~env:test_env ["camels"; "bla"; ] @@ __POS_OF__ + "test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\ + \ \u{001B}[33mdeprecated\u{001B}[m argument \u{001B}[01mbla\u{001B}[m: Herds \u{001B}[04mHERD\u{001B}[m are ignored.\n\ + \ \u{001B}[33mdeprecated\u{001B}[m environment variable \u{001B}[01mBACTRIAN\u{001B}[m: Use nothing instead of\n\ + \ \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n"; + () + +let main () = + let doc = "Test deprecation messages" in + Test.main ~doc @@ fun () -> Test.autorun () + +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/test_legacy_prefix.ml b/unikernel/duniverse/cmdliner/test/test_legacy_prefix.ml new file mode 100644 index 00000000..37d39301 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/test_legacy_prefix.ml @@ -0,0 +1,68 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner +open Cmdliner.Term.Syntax + +let env ~legacy_prefixes:b = + let b = string_of_bool b in + function + | "CMDLINER_LEGACY_PREFIXES" -> Some b + | var -> Sys.getenv_opt var + +let legacy = env ~legacy_prefixes:true +let nolegacy = env ~legacy_prefixes:false + +let cmd = Testing_cmdliner.sample_group_cmd +let parse_legacy = Testing_cmdliner.snap_parse ~env:legacy Test.T.unit cmd +let error_nolegacy err = Testing_cmdliner.snap_eval_error ~env:nolegacy err cmd + +(* Note, we don't test Arg.conv since we cannot control it through eval's + env variable. *) + +(* The tests have the following structure: + + let test = + (* A few snapshots of valid cli parses *) + parse … + (* A few snapshots of invalid cli parses *) + error … *) + +let test_cmd = + Test.test "command names" @@ fun () -> + parse_legacy ["bir"] @@ __POS_OF__ (); + parse_legacy ["bir"; "fly"] @@ __POS_OF__ (); + parse_legacy ["mamma"] @@ __POS_OF__ (); + (**) + error_nolegacy `Term ["bir"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\ +test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mbir\u{001B}[m. Did you mean \u{001B}[01mbirds\u{001B}[m?\n"; + error_nolegacy `Term ["birds"; "fl"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_group birds\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mCOMMAND\u{001B}[m] …\n\ +test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mfl\u{001B}[m. Did you mean \u{001B}[01mfly\u{001B}[m?\n"; + error_nolegacy `Term ["mam"] @@ __POS_OF__ "Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\ + test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mmam\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m\n\ + \ or \u{001B}[01mmammals\u{001B}[m\n"; + () + +let test_cmd = + Test.test "option names" @@ fun () -> + parse_legacy ["birds"; "fly"; "--sp"; "3"] @@ __POS_OF__ (); + (**) + error_nolegacy `Term ["birds"; "fly"; "--sp"; ] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_group birds fly\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--speed\u{001B}[m=\u{001B}[04mSPEED\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mBIRD\u{001B}[m]\n\ +test_group: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--sp\u{001B}[m\n"; + error_nolegacy `Term ["birds"; "fly"; "--spe"; ] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_group birds fly\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--speed\u{001B}[m=\u{001B}[04mSPEED\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mBIRD\u{001B}[m]\n\ +test_group: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--spe\u{001B}[m. Did you mean \u{001B}[01m--speed\u{001B}[m?\n"; + () + +let main () = + let doc = "Test CMDLINER_LEGACY_PREFIXES behaviour" in + Test.main ~doc @@ fun () -> Test.autorun () + +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/test_man.ml b/unikernel/duniverse/cmdliner/test/test_man.ml new file mode 100644 index 00000000..80d74966 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/test_man.ml @@ -0,0 +1,406 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner +open Cmdliner.Term.Syntax + +let hey = + let doc = "Equivalent to set $(opt)." in + let env = Cmd.Env.info "TEST_ENV" ~doc in + let doc = "Set hey." in + Arg.(value & flag & info ["hey"; "y"] ~env ~doc) + +let repodir = + let doc = "See option $(opt)." in + let env = Cmd.Env.info "TEST_REPODDIR" ~doc in + let doc = "Run the program in repository directory $(docv)." in + Arg.(value & opt file Filename.current_dir_name & info ["repodir"] ~env + ~docv:"DIR" ~doc) + +let id = + let doc = "See option $(opt)." in + let env = Cmd.Env.info "TEST_ID" ~doc in + let doc = "Whatever $(docv) bla $(env) and $(opt)." in + Arg.(value & opt int ~vopt:10 0 & info ["id"; "i"] ~env ~docv:"ID)" ~doc) + +let miaouw = + let doc = "See option $(opt). These are term names $(tool) $(cmd.name)" in + let docs = "MIAOUW SECTION (non-standard unpositioned do not do this)" in + let env = Cmd.Env.info "TEST_MIAOUW" ~doc ~docs in + let doc = "Whatever this is the doc var $(docv) this is the env var $(env) \ + this is the opt $(opt) and this is $(i,italic) and this is + $(b,bold) and this $(b,\\$(opt\\)) is \\$(opt) in bold and this + \\$ is a dollar. $(tool) is the main command name, $(cmd.name) \ + is the subcommand name and $(cmd) the command invocation." + in + Arg.(value & opt string "miaouw" & info ["m";] ~env ~docv:"MIAOUW" ~doc) + +let test hey repodir id miaouw = + Format.printf "hey: %B@.repodir: %s@.id: %d@.miaouw: %s@." + hey repodir id miaouw + +let man_test_t = Term.(const test $ hey $ repodir $ id $ miaouw) + +let info = + let doc = "UTF-8 test: \u{1F42B} íöüóőúűéáăîâșț ÍÜÓŐÚŰÉÁĂÎÂȘȚ 雙峰駱駝" in + let envs = [ Cmd.Env.info "TEST_IT" ~doc:"This is $(env) for $(cmd.name)" ] in + let exits = (Cmd.Exit.info ~doc:"This is a $(status) for $(cmd.name)" 1 :: + Cmd.Exit.info ~doc:"Ranges from $(status) to $(status_max)" + ~max:10 2 :: + Cmd.Exit.defaults) + in + let man = [ + `S "THIS IS A SECTION FOR $(tool)"; + `P "$(cmd.name) subst at begin and end $(tool)"; + `P "$(i,italic) and $(b,bold)"; + `P "\\$ escaped \\$\\$ escaped \\$"; + `P "This does not fail \\$(a)"; + `P ". this is a paragraph starting with a dot."; + `P "' this is a paragraph starting with a quote."; + `P "This: \\\\(rs is a backslash for groff and you should not see a \\\\"; + `P "This: \\\\N'46' is a quote for groff and you should not see a '"; + `P "This: \\\\\" is a groff comment and it should not be one."; + `P "This is a non preformatted paragraph, filling will occur. This will + be properly layout on 80 columns."; + `Pre "This is a preformatted paragraph for $(tool) no filling will \ + occur do the $(i,ASCII) art $(b,here) this will overflow on 80 \ + columns \n\ + 01234556789\ + 01234556789\ + 01234556789\ + 01234556789\ + 01234556789\ + 01234556789\ + 01234556789\ + 01234556789\n\n\ + ... Should not break\n\ + a... Should not break\n\ + +---+\n\ + | /|\n\ + | / | ----> Let's swim to the moon.\n\ + |/ |\n\ + +---+"; + `P "These are escapes escaped \\$ \\( \\) \\\\"; + `P "() does not need to be escaped outside directives."; + `Blocks [ + `P "The following to paragraphs are spliced in."; + `P "This dollar needs escape \\$(var) this one as well $(b,\\$(bla\\))"; + `P "This is another paragraph \\$(bla) $(i,\\$(bla\\)) $(b,\\$\\(bla\\))"; + ]; + `Noblank; + `Pre "This is another preformatted paragraph.\n\ + There should be no blanks before and after it."; + `Noblank; + `P "Hey ho"; + `I ("label", "item label"); + `I ("lebal", "item lebal"); + `P "The last paragraph"; + `S Manpage.s_bugs; + `P "Email bug reports to .";] + in + let man_xrefs = [`Page ("ascii", 7); `Main; `Tool "grep";] in + Cmd.info "man_test" ~version:"v2.0.0+dune" ~doc ~envs ~exits ~man ~man_xrefs + +let cmd = Cmd.make info man_test_t + +let test_plain = + Test.test "plain text manpage" @@ fun () -> + Testing_cmdliner.snap_man cmd @@ __POS_OF__ + {|NAME + man_test - UTF-8 test: 🐫 íöüóőúűéáăîâșț + ÍÜÓŐÚŰÉÁĂÎÂȘȚ 雙峰駱駝 + +SYNOPSIS + man_test [OPTION]… + +THIS IS A SECTION FOR man_test + man_test subst at begin and end man_test + + italic and bold + + $ escaped $$ escaped $ + + This does not fail $(a) + + . this is a paragraph starting with a dot. + + ' this is a paragraph starting with a quote. + + This: \(rs is a backslash for groff and you should not see a \ + + This: \N'46' is a quote for groff and you should not see a ' + + This: \" is a groff comment and it should not be one. + + This is a non preformatted paragraph, filling will occur. This will be + properly layout on 80 columns. + + This is a preformatted paragraph for man_test no filling will occur do the ASCII art here this will overflow on 80 columns + 0123455678901234556789012345567890123455678901234556789012345567890123455678901234556789 + + ... Should not break + a... Should not break + +---+ + | /| + | / | ----> Let's swim to the moon. + |/ | + +---+ + + These are escapes escaped $ ( ) \ + + () does not need to be escaped outside directives. + + The following to paragraphs are spliced in. + + This dollar needs escape $(var) this one as well $(bla) + + This is another paragraph $(bla) $(bla) $(bla) + This is another preformatted paragraph. + There should be no blanks before and after it. + Hey ho + + label + item label + + lebal + item lebal + + The last paragraph + +MIAOUW SECTION (non-standard unpositioned do not do this) + TEST_MIAOUW + See option -m. These are term names man_test man_test + +OPTIONS + -i [ID)], --id[=ID)] (default=10) (absent=0 or TEST_ID env) + Whatever ID) bla TEST_ID and --id. + + -m MIAOUW (absent=miaouw or TEST_MIAOUW env) + Whatever this is the doc var MIAOUW this is the env var + TEST_MIAOUW this is the opt -m and this is italic and this is bold + and this $(opt) is $(opt) in bold and this $ is a dollar. man_test + is the main command name, man_test is the subcommand name and + man_test the command invocation. + + --repodir=DIR (absent=. or TEST_REPODDIR env) + Run the program in repository directory DIR. + + -y, --hey (absent TEST_ENV env) + Set hey. + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + + --version + Show version information. + +EXIT STATUS + man_test exits with: + + 0 on success. + + 1 This is a 1 for man_test + + 2-10 + Ranges from 2 to 10 + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. + + 125 on unexpected internal errors (bugs). + +ENVIRONMENT + These environment variables affect the execution of man_test: + + TEST_ENV + Equivalent to set --hey. + + TEST_ID + See option --id. + + TEST_IT + This is TEST_IT for man_test + + TEST_REPODDIR + See option --repodir. + +BUGS + Email bug reports to . + +SEE ALSO|} + +let test_groff = + Test.test "groff manpage" @@ fun () -> + Testing_cmdliner.snap_man ~args:["--help=groff"] cmd @@ __POS_OF__ + {|.\" Pipe this output to groff -m man -K utf8 -T utf8 | less -R +.\" +.mso an.tmac +.TH "MAN_TEST" 1 "" "Man_test v2.0.0+dune" "Man_test Manual" +.\" Disable hyphenation and ragged-right +.nh +.ad l +.SH NAME +.P +man_test \N'45' UTF\N'45'8 test: 🐫 íöüóőúűéáăîâșț ÍÜÓŐÚŰÉÁĂÎÂȘȚ 雙峰駱駝 +.SH SYNOPSIS +.P +\fBman_test\fR [\fIOPTION\fR]… +.SH THIS IS A SECTION FOR \fBman_test\fR +.P +\fBman_test\fR subst at begin and end \fBman_test\fR +.P +\fIitalic\fR and \fBbold\fR +.P +$ escaped $$ escaped $ +.P +This does not fail $(a) +.P +\N'46' this is a paragraph starting with a dot\N'46' +.P +\N'39' this is a paragraph starting with a quote\N'46' +.P +This: \N'92'(rs is a backslash for groff and you should not see a \N'92' +.P +This: \N'92'N\N'39'46\N'39' is a quote for groff and you should not see a \N'39' +.P +This: \N'92'" is a groff comment and it should not be one\N'46' +.P +This is a non preformatted paragraph, filling will occur\N'46' This will be properly layout on 80 columns\N'46' +.P +.nf +This is a preformatted paragraph for \fBman_test\fR no filling will occur do the \fIASCII\fR art \fBhere\fR this will overflow on 80 columns +0123455678901234556789012345567890123455678901234556789012345567890123455678901234556789 + +\N'46'\N'46'\N'46' Should not break +a\N'46'\N'46'\N'46' Should not break ++\N'45'\N'45'\N'45'+ +| /| +| / | \N'45'\N'45'\N'45'\N'45'> Let\N'39's swim to the moon\N'46' +|/ | ++\N'45'\N'45'\N'45'+ +.fi +.P +These are escapes escaped $ ( ) \N'92' +.P +() does not need to be escaped outside directives\N'46' +.P +The following to paragraphs are spliced in\N'46' +.P +This dollar needs escape $(var) this one as well \fB$(bla)\fR +.P +This is another paragraph $(bla) \fI$(bla)\fR \fB$(bla)\fR +.sp -1 +.P +.nf +This is another preformatted paragraph\N'46' +There should be no blanks before and after it\N'46' +.fi +.sp -1 +.P +Hey ho +.TP 4 +label +item label +.TP 4 +lebal +item lebal +.P +The last paragraph +.SH MIAOUW SECTION (non\N'45'standard unpositioned do not do this) +.TP 4 +\fBTEST_MIAOUW\fR +See option \fB\N'45'm\fR\N'46' These are term names \fBman_test\fR \fBman_test\fR +.SH OPTIONS +.TP 4 +\fB\N'45'i\fR [\fIID)\fR], \fB\N'45'\N'45'id\fR[=\fIID)\fR] (default=\fB10\fR) (absent=\fB0\fR or \fBTEST_ID\fR env) +Whatever \fIID)\fR bla \fBTEST_ID\fR and \fB\N'45'\N'45'id\fR\N'46' +.TP 4 +\fB\N'45'm\fR \fIMIAOUW\fR (absent=\fBmiaouw\fR or \fBTEST_MIAOUW\fR env) +Whatever this is the doc var \fIMIAOUW\fR this is the env var \fBTEST_MIAOUW\fR this is the opt \fB\N'45'm\fR and this is \fIitalic\fR and this is \fBbold\fR and this \fB$(opt)\fR is $(opt) in bold and this $ is a dollar\N'46' \fBman_test\fR is the main command name, \fBman_test\fR is the subcommand name and \fBman_test\fR the command invocation\N'46' +.TP 4 +\fB\N'45'\N'45'repodir\fR=\fIDIR\fR (absent=\fB\N'46'\fR or \fBTEST_REPODDIR\fR env) +Run the program in repository directory \fIDIR\fR\N'46' +.TP 4 +\fB\N'45'y\fR, \fB\N'45'\N'45'hey\fR (absent \fBTEST_ENV\fR env) +Set hey\N'46' +.SH COMMON OPTIONS +.TP 4 +\fB\N'45'\N'45'help\fR[=\fIFMT\fR] (default=\fBauto\fR) +Show this help in format \fIFMT\fR\N'46' The value \fIFMT\fR must be one of \fBauto\fR, \fBpager\fR, \fBgroff\fR or \fBplain\fR\N'46' With \fBauto\fR, the format is \fBpager\fR or \fBplain\fR whenever the \fBTERM\fR env var is \fBdumb\fR or undefined\N'46' +.TP 4 +\fB\N'45'\N'45'version\fR +Show version information\N'46' +.SH EXIT STATUS +.P +\fBman_test\fR exits with: +.TP 4 +0 +on success\N'46' +.TP 4 +1 +This is a 1 for \fBman_test\fR +.TP 4 +2\N'45'10 +Ranges from 2 to 10 +.TP 4 +123 +on indiscriminate errors reported on standard error\N'46' +.TP 4 +124 +on command line parsing errors\N'46' +.TP 4 +125 +on unexpected internal errors (bugs)\N'46' +.SH ENVIRONMENT +.P +These environment variables affect the execution of \fBman_test\fR: +.TP 4 +\fBTEST_ENV\fR +Equivalent to set \fB\N'45'\N'45'hey\fR\N'46' +.TP 4 +\fBTEST_ID\fR +See option \fB\N'45'\N'45'id\fR\N'46' +.TP 4 +\fBTEST_IT\fR +This is \fBTEST_IT\fR for \fBman_test\fR +.TP 4 +\fBTEST_REPODDIR\fR +See option \fB\N'45'\N'45'repodir\fR\N'46' +.SH BUGS +.P +Email bug reports to \N'46' +.SH SEE ALSO +.P +ascii(7), grep(1)|} + +let main () = + let doc = "Test manpage specifications" in + let test_help = + let doc = "Test manpage interactively as if --help[$(docv)] is invoked" in + let help_fmts = + ["auto", "=auto"; "pager", "=pager"; "groff", "=groff"; + "plain", "=plain"; "", ""] + in + let help_enum = Cmdliner.Arg.enum help_fmts and docv = "FMT" in + Arg.(value & opt ~vopt:(Some "") (some help_enum) None & + info ["test-help"] ~docv ~doc) + in + Test.main' test_help ~doc @@ function + | None -> + Test.log "Invoke with %a[=FMT] to test %a[=FMT] interactively" + Fmt.code "--test-help" Fmt.code "--help"; + Test.autorun () + | Some fmt -> + Test.set_main_exit @@ fun () -> + let argv = Array.of_list (Cmd.name cmd :: ["--help" ^ fmt ]) in + Cmd.eval ~argv (Cmd.v info man_test_t) + +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/test_term.ml b/unikernel/duniverse/cmdliner/test/test_term.ml new file mode 100644 index 00000000..4fdb7e7f --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/test_term.ml @@ -0,0 +1,159 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner +open Cmdliner.Term.Syntax + +(* The tests have the following structure: + + let test = + let cmd = … (* A command definition *) in + (* A few snapshots of valid cli parses *) + parse … + (* A few snapshots of invalid cli parses *) + error … + (* A snapshot of a plain text version of the manual *) + Testing_cmdliner.snap_man … *) + +let test_with_used_args = + Test.test "Term.with_used_args" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_with_used_args" ~doc:"Test cli arg capture") @@ + let args = + let+ a = Arg.(value & flag & info ["a"; "aaa"]) + and+ b = Arg.(value & opt (some string) None & info ["b"; "bbb"]) + and+ c = Arg.(value & pos_all string [] & info []) in + (a, b, c) + in + let+ parse, args = Term.with_used_args args in + args, parse + in + let t = Test.T.(t2 (list string) (t3 bool (option string) (list string))) in + let parse = Testing_cmdliner.snap_parse t cmd in + let error err = Testing_cmdliner.snap_eval_error err cmd in + parse [] @@ __POS_OF__ + ([], (false, None, [])); + (* Note some of these are bugs, see issue #204 *) + parse ["--"] @@ __POS_OF__ + ([], (false, None, [])); + parse ["hoho"; "-a"; "-bmsg"] @@ __POS_OF__ + (["-a"; "-b"; "msg"; "hoho"], (true, Some "msg", ["hoho"])); + parse ["hoho"; "-a"; "-bmsg"; "hihi"] @@ __POS_OF__ + (["-a"; "-b"; "msg"; "hoho"; "hihi"], (true, Some "msg", ["hoho"; "hihi"])); + parse ["--"; "hoho"; "-a"; "-bbla"; "hihi"] @@ __POS_OF__ + (["hoho"; "-a"; "-bbla"; "hihi"], + (false, None, ["hoho"; "-a"; "-bbla"; "hihi"])); + parse ["hoho"; "-a"; "--bbb=msg"; "hihi"] @@ __POS_OF__ + (["-a"; "--bbb"; "msg"; "hoho"; "hihi"], + (true, Some "msg", ["hoho"; "hihi"])); + (**) + error `Term ["--opt"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_with_used_args\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--aaa\u{001B}[m] [\u{001B}[01m--bbb\u{001B}[m=\u{001B}[04mVAL\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mARG\u{001B}[m]…\n\ +test_with_used_args: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--opt\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_with_used_args - Test cli arg capture + +SYNOPSIS + test_with_used_args [--aaa] [--bbb=VAL] [OPTION]… [ARG]… + +OPTIONS + -a, --aaa + + -b VAL, --bbb=VAL + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_with_used_args exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let term_duplication = + Test.test "Term.app duplicates" @@ fun () -> + let cmd = + Cmd.make (Cmd.info "test_term_dups" ~doc:"Test multiple term usage") @@ + let+ p = + let doc = "First pos argument should show up only once in the docs" in + Arg.(value & pos 0 string "popopo" & info [] ~doc ~docv:"POS") + and+ o = + let doc = "This should show up only once in the docs" in + Arg.(value & flag & info ["f"; "flag"] ~doc) + in + (p, p, o, o) + in + let t = Test.T.(t4 string string bool bool) in + let parse = Testing_cmdliner.snap_parse t cmd in + let error err = Testing_cmdliner.snap_eval_error err cmd in + parse [] @@ __POS_OF__ ("popopo", "popopo", false, false); + parse ["0"] @@ __POS_OF__ ("0", "0", false, false); + parse ["0"; "-f"] @@ __POS_OF__ ("0", "0", true, true); + (**) + error `Term ["0"; "1"] @@ __POS_OF__ +"Usage: \u{001B}[01mtest_term_dups\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--flag\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mPOS\u{001B}[m]\n\ +test_term_dups: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01m1\u{001B}[m\n"; + (**) + Testing_cmdliner.snap_man cmd @@ __POS_OF__ +{|NAME + test_term_dups - Test multiple term usage + +SYNOPSIS + test_term_dups [--flag] [OPTION]… [POS] + +ARGUMENTS + POS (absent=popopo) + First pos argument should show up only once in the docs + +OPTIONS + -f, --flag + This should show up only once in the docs + +COMMON OPTIONS + --help[=FMT] (default=auto) + Show this help in format FMT. The value FMT must be one of auto, + pager, groff or plain. With auto, the format is pager or plain + whenever the TERM env var is dumb or undefined. + +EXIT STATUS + test_term_dups exits with: + + 0 on success. + + 123 on indiscriminate errors reported on standard error. + + 124 on command line parsing errors. +|}; + () + +let test_env = + Test.test "Term.env" @@ fun () -> + let env = function "HEYHO" -> Some "Let's go" | _ -> None in + let cmd = + Cmd.make (Cmd.info "test_env" ~doc:"Test Term.env") @@ + let+ env = Term.env in + Test.(option T.string) (env "HEYHO") (Some "Let's go") + in + Testing_cmdliner.test_eval_result ~env Test.T.unit cmd [] (Ok (`Ok ())); + () + + +let main () = + let doc = "Test term specifications" in + Test.main ~doc @@ fun () -> Test.autorun () + +let () = if !Sys.interactive then () else exit (main ()) diff --git a/unikernel/duniverse/cmdliner/test/testing_cmdliner.ml b/unikernel/duniverse/cmdliner/test/testing_cmdliner.ml new file mode 100644 index 00000000..c159c036 --- /dev/null +++ b/unikernel/duniverse/cmdliner/test/testing_cmdliner.ml @@ -0,0 +1,199 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2025 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +open B0_std +open B0_testing +open Cmdliner + +(* Snapshotting command line evaluations *) + +let capture_fmt f = + let buf = Buffer.create 255 in + let fmt = Format.formatter_of_buffer buf in + let ret = f fmt in + ret, (Buffer.contents buf) + +let make_argv cmd args = Array.of_list (Cmd.name cmd :: args) +let env_dumb_term = function +| "TERM" -> Some "dumb" +| var -> Sys.getenv_opt var + +let t_eval_result ok = + let test_eval_error : Cmd.eval_error Test.T.t = + let pp ppf = function + | `Parse -> Fmt.string ppf "`Parse" + | `Term -> Fmt.string ppf "`Term" + | `Exn -> Fmt.string ppf "`Exn" + in + Test.T.make ~equal:(=) ~pp () + in + let test_eval_ok ok = + let pp ppf = function + | `Ok v -> Test.T.pp ok ppf v + | `Version -> Fmt.string ppf "`Version" + | `Help -> Fmt.string ppf "`Help" + in + let equal v0 v1 = match v0, v1 with + | `Ok v0, `Ok v1 -> Test.T.equal ok v0 v1 + | v0, v1 -> v0 = v1 + in + Test.T.make ~equal ~pp () + in + Test.T.result' ~ok:(test_eval_ok ok) ~error:test_eval_error + +let get_eval_value ?__POS__ = function +| Ok (`Ok v) -> v +| (Error _ | Ok `Version | Ok `Help) as v -> + Test.failstop ?__POS__ "Unexpected evalution: %a" + (Test.T.pp (t_eval_result Test.T.any)) v + +let test_eval_result ?__POS__ ?env t cmd args exp = + let argv = make_argv cmd args in + let (ret, _), _ = (* Ignore outputs *) + capture_fmt @@ fun err -> + capture_fmt @@ fun help -> + Cmd.eval_value ?env ~help ~err cmd ~argv + in + Test.eq ?__POS__ (t_eval_result t) ret exp + +let snap_parse ?env t cmd args exp = + let loc = Test.Snapshot.loc exp in + let argv = make_argv cmd args in + let ret = Cmd.eval_value ?env cmd ~argv in + Test.snap t (get_eval_value ~__POS__:loc ret) exp + +let snap_parse_warnings ?env cmd args exp = + let loc = Test.Snapshot.loc exp in + let argv = make_argv cmd args in + let ret, err = capture_fmt @@ fun err -> Cmd.eval_value ?env ~err cmd ~argv in + ignore (get_eval_value ~__POS__:loc ret); + Snap.lines err exp + +let snap_eval_error ?env error cmd args exp = + let loc = Test.Snapshot.loc exp in + let argv = make_argv cmd args in + let ret, err = capture_fmt @@ fun err -> Cmd.eval_value ?env ~err cmd ~argv in + Test.eq (t_eval_result Test.T.any) ret (Error error) ~__POS__:loc ; + Snap.lines err exp + +let snap_help ?env retv cmd args exp = + let loc = Test.Snapshot.loc exp in + let argv = make_argv cmd args in + let (ret, help), err = + capture_fmt @@ fun err -> + capture_fmt @@ fun help -> Cmd.eval_value ?env ~help ~err cmd ~argv + in + Test.string err ""; + Test.eq (t_eval_result Test.T.any) ret retv ~__POS__:loc; + Snap.lines help exp + +let snap_completion ?env cmd args exp = + snap_help ?env (Ok `Help) cmd ("--__complete" :: args) exp + +let snap_man ?env ?(args = ["--help=plain"]) cmd exp = + snap_help ?env (Ok `Help) cmd args exp + +(* Sample commands *) + +open Cmdliner +open Cmdliner.Term.Syntax + +let sample_group_cmd = + let man = [ `P "Invoke command with $(cmd), the command name is \ + $(cmd.name), the parent is $(cmd.parent) and the tool \ + name is $(tool)." ] in + let kind = + let doc = "Kind of entity" in + Arg.(value & opt (some string) None & info ["k";"kind"] ~doc) + in + let speed = + let doc = "Movement $(docv) in m/s" in + Arg.(value & opt int 2 & info ["speed"] ~doc ~docv:"SPEED") + in + let can_fly = + let doc = "$(docv) indicates if the entity can fly." in + Arg.(value & opt bool false & info ["can-fly"] ~doc) + in + let birds = + let bird = + let doc = "Use $(docv) specie." in + Arg.(value & pos 0 string "pigeon" & info [] ~doc ~docv:"BIRD") + in + let fly = + Cmd.make (Cmd.info "fly" ~doc:"Fly birds." ~man) @@ + let+ bird and+ speed in () + in + let land' = + Cmd.make (Cmd.info "land" ~doc:"Land birds." ~man) @@ + let+ bird in () + in + let info = Cmd.info "birds" ~doc:"Operate on birds." ~man in + Cmd.group ~default:Term.(const (fun _ _-> ()) $ kind $ can_fly) info @@ + [fly; land'] + in + let mammals = + let man_xrefs = [`Main; `Cmd "birds" ] and doc = "Operate on mammals." in + Cmd.make (Cmd.info "mammals" ~doc ~man_xrefs ~man) @@ + Term.(const (fun () -> ()) $ const ()) + in + let fishs = + let name' = + let doc = "Use fish named $(docv)." in + Arg.(value & pos 0 (some string) None & info [] ~doc ~docv:"NAME") + in + Cmd.make (Cmd.info "fishs" ~doc:"Operate on fishs." ~man) @@ + let+ name' in () + in + let camels = + let herd = + let doc = "Find in herd $(docv)." and docv = "HERD" in + let deprecated = "Herds $(docv) are ignored." in + Arg.(value & pos 0 (some string) None & info [] ~deprecated ~doc ~docv) + in + let bactrian = + let deprecated = "Use nothing instead of $(env), $(b,HA!)." in + let doc = "Specify a bactrian camel." in + let env = Cmd.Env.info "BACTRIAN" ~deprecated in + Arg.(value & flag & info ["bactrian"; "b"] ~deprecated ~env ~doc) + in + let deprecated = "Use $(b,mammals) instead." in + Cmd.make (Cmd.info "camels" ~deprecated ~doc:"Operate on camels." ~man) @@ + let+ bactrian and+ herd in () + in + let lookup = + let kind_opt = + let kinds = ["bird", `Bird; "fish", `Fish] in + let doc = + "$(docv) restricts the animal kind. Must be " ^ Arg.doc_alts_enum kinds + in + Arg.(value & opt (some (enum kinds)) None & info ["k"; "kind"] ~doc) + in + let name_conv = + let bird_names = ["sparrow"; "parrot"; "pigeon"] in + let fish_names = ["salmon"; "trout"; "piranha"] in + let completion = + let select ~token:prefix n = + if String.starts_with ~prefix n + then Some (Arg.Completion.string n) else None + in + let func kind ~token = match Option.join kind with + | None -> Ok (List.filter_map (select ~token) (bird_names @ fish_names)) + | Some `Bird -> Ok (List.filter_map (select ~token) bird_names) + | Some `Fish -> Ok (List.filter_map (select ~token) fish_names) + in + Arg.Completion.make ~context:kind_opt func + in + Arg.Conv.of_conv Arg.string ~completion + in + Cmd.make (Cmd.info "lookup" ~doc:"Lookup animal by name.") @@ + let+ kind_opt + and+ name = + let doc = "$(docv) is the animal name to lookup" and docv = "NAME" in + Arg.(required & pos 0 (some name_conv) None & info [] ~doc ~docv) + in + () + in + Cmd.group (Cmd.info "test_group" ~version:"X.Y.Z" ~man) @@ + [birds; mammals; fishs; camels; lookup] diff --git a/unikernel/duniverse/cppo/.github/PULL_REQUEST_TEMPLATE.md b/unikernel/duniverse/cppo/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 00000000..71e2a320 --- /dev/null +++ b/unikernel/duniverse/cppo/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,15 @@ + + + + +Fixes / closes #???? + + + + + +- [ ] Added / updated [**test-suite**](test). + + +- [ ] Added [**changelog**](Changes.md). diff --git a/unikernel/duniverse/cppo/.github/dependabot.yml b/unikernel/duniverse/cppo/.github/dependabot.yml new file mode 100644 index 00000000..ca79ca5b --- /dev/null +++ b/unikernel/duniverse/cppo/.github/dependabot.yml @@ -0,0 +1,6 @@ +version: 2 +updates: + - package-ecosystem: github-actions + directory: / + schedule: + interval: weekly diff --git a/unikernel/duniverse/cppo/.github/workflows/build.yml b/unikernel/duniverse/cppo/.github/workflows/build.yml new file mode 100644 index 00000000..14451a01 --- /dev/null +++ b/unikernel/duniverse/cppo/.github/workflows/build.yml @@ -0,0 +1,198 @@ +--- +name: Build +on: + push: + branches: + - master # forall push/merge in master + pull_request: + branches: + - "**" # forall submitted Pull Requests + +jobs: + build: + strategy: + fail-fast: false + matrix: + setup-version: + - v2 + - v3 + os: + - macos-13 + - macos-latest + - ubuntu-latest + - windows-latest + ocaml-version: + - 4.02.x + - 4.03.x + - 4.04.x + - 4.05.x + - 4.06.x + - 4.07.x + - 4.08.x + - 4.09.x + - 4.10.x + - 4.11.x + - 4.12.x + - 4.13.x + - 4.14.x + - 5.0.x + - 5.1.x + - 5.2.x + exclude: + - os: macos-13 + setup-version: v3 # opam uninstall fails + - os: macos-latest + setup-version: v2 + - os: macos-latest + ocaml-version: 4.02.x + - os: macos-latest + ocaml-version: 4.03.x + - os: macos-latest + ocaml-version: 4.04.x + - os: macos-latest + ocaml-version: 4.05.x + - os: macos-latest + ocaml-version: 4.06.x + - os: macos-latest + ocaml-version: 4.07.x + - os: macos-latest + ocaml-version: 4.08.x + - os: macos-latest + ocaml-version: 4.09.x + - os: macos-latest + ocaml-version: 4.11.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.02.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.03.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.04.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.05.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.06.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.07.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.08.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.09.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.10.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.11.x + - os: windows-latest + setup-version: v3 + ocaml-version: 4.12.x + - os: windows-latest + setup-version: v2 + ocaml-version: 5.0.x + - os: windows-latest + setup-version: v2 + ocaml-version: 5.1.x + - os: windows-latest + setup-version: v2 + ocaml-version: 5.2.x + + runs-on: ${{ matrix.os }} + + env: + SKIP_BUILD: | + dose + lilis + rotor + camlimages + freetds + frenetic + genprint + hdf5 + ocp-index-top + pa_ppx + pla + ppx_deriving_rpc + reed-solomon-erasure + setr + stdcompat + uwt + OPAMAUTOREMOVE: true + SKIP_TEST: | + 0install + bisect_ppx + cconv-ppx + decompress + extlib-compat + General + + steps: + - name: Prepare git + run: | + git config --global core.autocrlf false + git config --global init.defaultBranch master + + - name: Checkout code + uses: actions/checkout@v4 + + - name: Setup OCaml ${{ matrix.ocaml-version }} with v2 + if: matrix.setup-version == 'v2' + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-version }} + + - name: Setup OCaml ${{ matrix.ocaml-version }} with v3 + if: matrix.setup-version == 'v3' + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: ${{ matrix.ocaml-version }} + + - name: Install dependencies + run: opam install --deps-only . + + - name: List installed packages + run: opam list + + - name: Build locally + run: opam exec -- make + + - name: Upload the build artifact + uses: actions/upload-artifact@v4 + with: + name: ${{ matrix.os }}-${{ matrix.ocaml-version }}-cppo.exe + path: _build/default/src/cppo_main.exe + overwrite: true + + - name: Build, test, and install package + run: opam install -t . + + - name: Test dependants + if: > + (matrix.ocaml-version >= '4.05') && (matrix.os != 'windows-latest') + run: | + PACKAGES=`opam list -s --color=never --installable --depends-on cppo,cppo_ocamlbuild` + echo "Dependants:" $PACKAGES + for PACKAGE in $PACKAGES + do + echo $SKIP_BUILD | tr ' ' '\n' | grep ^$PACKAGE$ > /dev/null && + echo Skip $PACKAGE && continue + OPAMWITHTEST=true + echo $SKIP_TEST | tr ' ' '\n' | grep ^$PACKAGE$ > /dev/null && + OPAMWITHTEST=false + ([ $OPAMWITHTEST == false ] && + echo ::group::Build $PACKAGE) || + echo ::group::Build and test $PACKAGE + DEPS_FAILED=false + (opam depext $PACKAGE && + opam install --deps-only $PACKAGE) || DEPS_FAILED=true + [ $DEPS_FAILED == false ] && opam install $PACKAGE + echo ::endgroup:: + [ $DEPS_FAILED == false ] || echo Dependencies broken + done diff --git a/unikernel/duniverse/cppo/.gitignore b/unikernel/duniverse/cppo/.gitignore new file mode 100644 index 00000000..8f40142b --- /dev/null +++ b/unikernel/duniverse/cppo/.gitignore @@ -0,0 +1,6 @@ +*~ +_build +.merlin +*.install +.*.swp +*.opam diff --git a/unikernel/duniverse/cppo/.ocp-indent b/unikernel/duniverse/cppo/.ocp-indent new file mode 100644 index 00000000..fb580a5b --- /dev/null +++ b/unikernel/duniverse/cppo/.ocp-indent @@ -0,0 +1,22 @@ +# See https://github.com/OCamlPro/ocp-indent/blob/master/.ocp-indent for more + +# Indent for clauses inside a pattern-match (after the arrow): +# match foo with +# | _ -> +# ^^^^bar +# the default is 2, which aligns the pattern and the expression +match_clause = 4 + +# When nesting expressions on the same line, their indentation are in +# some cases stacked, so that it remains correct if you close them one +# at a line. This may lead to large indents in complex code though, so +# this parameter can be used to set a maximum value. Note that it only +# affects indentation after function arrows and opening parens at end +# of line. +# +# for example (left: `none`; right: `4`) +# let f = g (h (i (fun x -> # let f = g (h (i (fun x -> +# x) # x) +# ) # ) +# ) # ) +max_indent = 2 diff --git a/unikernel/duniverse/cppo/.travis.yml b/unikernel/duniverse/cppo/.travis.yml new file mode 100644 index 00000000..1f17d115 --- /dev/null +++ b/unikernel/duniverse/cppo/.travis.yml @@ -0,0 +1,16 @@ +language: c +sudo: required +install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh +script: bash -ex .travis-opam.sh +env: + global: + - PACKAGE=cppo + matrix: + - OCAML_VERSION=4.03 + - OCAML_VERSION=4.04 + - OCAML_VERSION=4.05 + - OCAML_VERSION=4.06 + - OCAML_VERSION=4.07 +os: + - linux + - osx diff --git a/unikernel/duniverse/cppo/CODEOWNERS b/unikernel/duniverse/cppo/CODEOWNERS new file mode 100644 index 00000000..9735ff31 --- /dev/null +++ b/unikernel/duniverse/cppo/CODEOWNERS @@ -0,0 +1,10 @@ +# We're looking for one or more volunteers to take the lead of cppo, +# with the help of ocaml-community. +# +# Call for volunteers: https://github.com/ocaml-community/meta/issues/27 +# About ocaml-community: https://github.com/ocaml-community/meta +# +# Interim maintainers who won't be very responsive :-( +* @mjambon @pmetzger +*.opam @liyishuai +.github/workflows/ @liyishuai diff --git a/unikernel/duniverse/cppo/Changes.md b/unikernel/duniverse/cppo/Changes.md new file mode 100644 index 00000000..9632b7f4 --- /dev/null +++ b/unikernel/duniverse/cppo/Changes.md @@ -0,0 +1,105 @@ +## v1.8.0 (2024-12-03) +- [+ui] A scope, delimited by `#scope ... #endscope`, + limits the effect of `#define`, `#def ... #enddef`, and `#undef`. +- [bug] Fix `cppo -version`, which used to print a blank line (#92). + +## v1.7.0 (2024-08-22) +- [+ui] Multi-line macros, without line terminators `\`, + can now be defined using `#def` and `#enddef`. + These macro definitions can be nested. +- [+ui] Higher-order macros: + a macro can now take a parameterized macro as a parameter. +- [compat] Better locations for some syntax error messages. + +## v1.6.9 (2022-05-19) +- [bug] Fix multiline string support (#81) + +## v1.6.8 (2021-09-17) +- [compat] Allow version strings without patch numbers, _e.g._ `8.13+beta1` + The patch number will be set to 0 upon empty, _i.e._ `(8, 13, 0)` + +## v1.6.7 (2020-12-21) +- [compat] Treat ~ and - the same in semver in order to parse + OCaml 4.12.0 pre-release versions. +- [compat] Restore 4.02.3 compatibility. + +## v1.6.6 (2019-05-27) +- [pkg] port build system to dune from jbuilder. +- [pkg] upgrade opam metadata to 2.0 format. +- [pkg] remove topkg and use dune-release. +- [compat] Use `String.capitalize_ascii` to remove warning. + +## v1.6.5 (2018-09-12) +- [bug] Fix 'asr' operator (#61) + +## v1.6.4 (2018-02-26) +- [compat] Tests should now work with older versions of jbuilder. + +## v1.6.3 (2018-02-21) +- [compat] Fix tests. + +## v1.6.1 (2018-01-25) +- [compat] Emit line directives always containing the file name, + as mandated starting with ocaml 4.07. + +## v1.6.0 (2017-08-07) +- [pkg] BREAKING: cppo and cppo_ocamlbuild are now two distinct opam + packages. + +## v1.5.0 (2017-04-24) +- [+ui] Added the `CAPITALIZE()` function. + +## v1.4.0 (2016-08-19) +- [compat] Cppo is now safe-string ready. + +## v1.3.2 (2016-04-20) +- [pkg] Cppo can now be built on MSVC. + +## v1.3.1 (2015-09-20) +- [bug] Possible to have #endif between two matching parenthesis. + +## v1.3.0 (2015-09-13) +- [+ui] Removed the need for escaping commas and parenthesis in macros. +- [+ui] Blanks is now allowed in argument list in macro definitions. +- [+ui] #directive with wrong arguments is now giving a proper error. +- [bug] Fixed expansion of __FILE__ and __LINE__. + +## v1.1.2 (2014-11-10) +- [+ui] Ocamlbuild_cppo: added the ocamlbuild flag `cppo_V(NAME:VERSION)`, + equivalent to `-V NAME:VERSION` (for _tags file). + +## v1.1.1 (2014-11-10) +- [+ui] Ocamlbuild_cppo: added the ocamlbuild flag `cppo_V_OCAML`, + equivalent to `-V OCAML:VERSION` (for _tags file). + +## v1.1.0 (2014-11-04) +- [+ui] Added the `-V NAME:VERSION` option. +- [+ui] Support for tuples in comparisons: tuples can be constructed + and compared, e.g. `#if (2 + 2, 5) < (4, 5)`. + +## v1.0.1 (2014-10-20) +- [+ui] `#elif` and `#else` can now be used in the same #if-#else statement. +- [bug] Fixed the Ocamlbuild flag `cppo_n`. + +## v1.0.0 (2014-09-06) +- [bug] OCaml comments are now better parsed. For example, (* '"' *) works. + +## v0.9.4 (2014-06-10) +- [+ui] Added the ocamlbuild_cppo plugin for Ocamlbuild. To use it: + `-plugin(cppo_ocamlbuild)`. + +## v0.9.3 (2012-02-03) +- [pkg] New way of building the tar.gz archive. + +## v0.9.2 (2011-08-12) +- [+ui] Added two predefined macros STRINGIFY and CONCAT for making + string literals and for building identifiers respectively. + +## v0.9.1 (2011-07-20) +- [+ui] Added support for processing sections of files using external programs + (#ext/#endext, -x option) +- [doc] Moved and extended documentation into the README file. + +## v0.9.0 (2009-11-17) + +- initial public release diff --git a/unikernel/duniverse/cppo/INSTALL.md b/unikernel/duniverse/cppo/INSTALL.md new file mode 100644 index 00000000..ce1da139 --- /dev/null +++ b/unikernel/duniverse/cppo/INSTALL.md @@ -0,0 +1,17 @@ +Installation instructions for cppo +================================== + +Building cppo requires GNU Make and a standard OCaml +installation. It can be installed with opam or manually as follows: + +Build: + +``` +make +``` + +Install: + +``` +make DESTDIR=/some/path install +``` diff --git a/unikernel/duniverse/cppo/LICENSE.md b/unikernel/duniverse/cppo/LICENSE.md new file mode 100644 index 00000000..c701b0ba --- /dev/null +++ b/unikernel/duniverse/cppo/LICENSE.md @@ -0,0 +1,24 @@ +Copyright (c) 2009-2011 Martin Jambon +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/unikernel/duniverse/cppo/Makefile b/unikernel/duniverse/cppo/Makefile new file mode 100644 index 00000000..9346f42f --- /dev/null +++ b/unikernel/duniverse/cppo/Makefile @@ -0,0 +1,67 @@ +.PHONY: all clean test check install uninstall release + +all: + @dune build + +clean: + @git clean -fX + +test: + @dune runtest + +check: test + +install: + @dune install + +uninstall: + @dune uninstall + +# To make a release: +# + check that [make test] succeeds +# + check that everything has been committed and pushed +# + check that the CI has succeeded +# + make sure that the package is not pinned: [opam pin remove cppo] +# + run [make release VERSION=X.Y.Z] + +release: +# Check if this is the master branch. + @ if [ "$$(git symbolic-ref --short HEAD)" != "master" ] ; then \ + echo "Error: this is not the master branch." ; \ + git branch ; \ + exit 1 ; \ + fi +# Check if everything has been committed. + @ if [ -n "$$(git status --porcelain)" ] ; then \ + echo "Error: there remain uncommitted changes." ; \ + git status ; \ + exit 1 ; \ + fi +# Make sure the current version can be compiled. + @ make clean + @ make test +# Check the current package description. + @ opam lint +# Make sure $(VERSION) is nonempty. + @ if [ -z "$(VERSION)" ] ; then \ + echo "Error: please use: make release VERSION=X.Y.Z" ; \ + exit 1 ; \ + fi +# Make sure a CHANGES entry with the current version seems to exist. + @ if ! grep "## v$(VERSION)" Changes.md >/dev/null ; then \ + echo "Error: Changes.md has no entry for version $(VERSION)." ; \ + exit 1 ; \ + fi +# Make sure the current version is mentioned in dune-project. + @ if ! grep "(version $(VERSION))" dune-project >/dev/null ; then \ + echo "Error: dune-project does not mention version $(VERSION)." ; \ + grep "(version" dune-project ; \ + exit 1 ; \ + fi +# Create a git tag. + @ git tag v$(VERSION) +# Upload. (This automatically makes a .tar.gz archive available on github.) + @ git push + @ git push --tags +# Publish an opam description. + @ opam publish --tag=v$(VERSION) -v $(VERSION) ocaml-community/cppo diff --git a/unikernel/duniverse/cppo/README.md b/unikernel/duniverse/cppo/README.md new file mode 100644 index 00000000..80a5c914 --- /dev/null +++ b/unikernel/duniverse/cppo/README.md @@ -0,0 +1,736 @@ +[![Build status](https://github.com/ocaml-community/cppo/actions/workflows/build.yml/badge.svg)](https://github.com/ocaml-community/cppo/actions/workflows/build.yml) + +Cppo: cpp for OCaml +=================== + +Cppo is an equivalent of the C preprocessor for OCaml programs. +It allows the definition of simple macros and file inclusion. + +Cppo is: + +* more OCaml-friendly than cpp +* easy to learn without consulting a manual +* reasonably fast +* simple to install and to maintain + +Meta +---- + +* Author: Martin Jambon +* OCaml-community maintainers: + - Martin Jambon ([**@mjambon**](https://github.com/mjambon)) + - Yishuai Li ([**@liyishuai**](https://github.com/liyishuai)) +* License: [BSD 3-Clause "New" or "Revised" License](LICENSE.md) +* Compatible OCaml versions: 4.02.3 or later +* Additional dependencies: + - [Dune](https://dune.build) 1.10 or later + - [OCamlbuild](https://github.com/ocaml/ocamlbuild) and [Findlib](http://projects.camlcity.org/projects/findlib.html), for Ocamlbuild plugin + +Building and installation instructions +-------------------------------------- + +The easiest way to install the latest released version of cppo +is via [OPAM](https://opam.ocaml.org/doc/Install.html): + +```shell +opam install cppo +``` + +To instead build and install manually, do: + +``` shell +git clone https://github.com/ocaml-community/cppo.git +cd cppo +make +make install +``` + +User guide +---------- + +Cppo is a preprocessor for programming languages that follow lexical rules +compatible with OCaml including OCaml-style comments `(* ... *)`. These include Ocamllex, Ocamlyacc, Menhir, and extensions of OCaml based on Camlp4, Camlp5, or ppx. Cppo should work with Bucklescript as well. It won't work so well with Reason code because Reason uses C-style comment delimiters `/*` and `*/`. + +Cppo supports a number of directives. A directive is a `#` sign placed +at the beginning of a line, possibly preceded by some whitespace, and followed +by a valid directive name or by a number: + +```ocaml +BLANK* "#" BLANK* ("def"|"enddef"|"define"|"undef" + |"scope"|"endscope" + |"if"|"ifdef"|"ifndef"|"else"|"elif"|"endif" + |"include" + |"warning"|"error" + |"ext"|"endext") ... +``` + +A macro definition that is delimited by `#def` and `#enddef` can span +several lines. There is no need for protecting line endings with +backslash characters `\`. + +A directive (other than `#def ... #enddef`) +can be split into multiple lines by placing a backslash character `\` at +the end of the line to be continued. In general, any special character +can be used as a normal character by preceding it with backslash. + + +File inclusion +-------------- + +```ocaml +#include "hello.ml" +``` + +This is how a source file `hello.ml` can be included. +Relative paths are searched first in the directory of the current file +and then in the search paths added on the command line using `-I`, if any. + + +Macros +------ + +This is a simple macro that doesn't take an argument ("object-like +macro" in the cpp jargon): + +```ocaml +#define Ms Mississippi + +match state with + Ms -> true + | _ -> false +``` + +After preprocessing by cppo, the code above becomes: + +```ocaml +match state with + Mississippi -> true + | _ -> false +``` + +If needed, defined macros can be undefined. This is required prior to +redefining a macro: + +```ocaml +#undef X +``` + +An important distinction with cpp is that only previously-defined +macros are accessible. Defining, undefining or redefining a macro has +no effect on how previous macros will expand. + +Macros can take arguments. That is, a macro can be parameterized; +this is known as a "function-like macro" in `cpp` jargon. +When a parameterized macro is defined +and when it is applied, +the opening parenthesis must stick to the macro's identifier: +that is, there must be no space in between. +For example, this text: + +```ocaml +#define debug(args) if !debugging then Printf.eprintf args else () + +debug("Testing %i" (1 + 1)) +``` + +is expanded into: + +```ocaml +if !debugging then Printf.eprintf "Testing %i" (1 + 1) else () +``` + +An ordinary macro, which takes no arguments, can be viewed as +a parameterized macro that takes zero arguments. However, the +syntax differs: when there is no argument, no parentheses are +used; when there is at least one argument, parentheses must be used. +Here is a summary of the valid syntaxes: + +```ocaml +#define FOO 42 (* Definition of an ordinary macro *) +FOO (* A use of an ordinary macro *) + +#define BAR() 42 (* Invalid! When parentheses are used, + there must be at least one parameter *) + +#define BAR(x) 42+x (* Definition of a parameterized macro *) +BAR(0) (* A use of this parameterized macro *) +BAR() (* Another valid use -- the argument is empty *) +``` + +All user-definable macros are constant. There are however two +predefined variable macros: `__FILE__` and `__LINE__` which take the value +of the position in the source file where the macro is being expanded. + +```ocaml +#define loc (Printf.sprintf "File %S, line %i" __FILE__ __LINE__) +``` + +Macros can be defined on the command line as follows: + +```ocaml +# preprocessing only +cppo -D 'VERSION 1.0' example.ml + +# preprocessing and compiling +ocamlopt -c -pp "cppo -D 'VERSION 1.0'" example.ml +``` + +Multi-line macros and nested macros +----------------------------------- + +A macro definition that begins with `#define` can span several lines. +In that case, the end of each line must be protected with a backslash +character, as in this example: + +```ocaml +#define repeat_until(action,condition) \ + action; \ + while not (condition) do \ + action \ + done +``` + +In other words, at the first line ending that is *not* preceded by a `\` +character, an `#enddefine` token is implicitly generated, +and the definition ends. + +This convention, which is inherited from C, causes two problems. First, +protecting every line ending with a `\` character is painful. Second, more +seriously, this convention does not allow macro definitions to be nested. +Indeed, if one attempts to nest two definitions that begin with `#define`, +then only one `#enddefine` token is generated; it is generated at the first +unprotected line ending. So, the beginnings and ends of definitions cannot +be correctly balanced. + +These problems are avoided by using an alternative syntax where the beginning +and end of a macro definition are explicitly marked by `#def` and `#enddef`. +Here is an example: + +```ocaml +#def repeat_until(action,condition) + action; + while not (condition) do + action + done +#enddef +``` + +With this syntax, a macro can span several lines: +there is no need to protect line endings with `\` characters. +Furthermore, this syntax allows macro definitions to be nested: +inside a macro definition that is delimited by `#def` and `#enddef`, +both `#def` and `#define` can be used. + +Higher-order macros +------------------- + +A parameterized macro can take a parameterized macro as a parameter: +this is known as a higher-order macro. + +To enable this feature, some annotations are required: +when a macro parameter is itself a parameterized macro, +it must be annotated with its type. + +A macro takes *n* arguments (where *n* can be zero) +and returns a piece of text. +So, to describe the type of a macro, it suffices to +describe the types of its *n* arguments. + +Thus, the syntax of types is +`τ ::= [τ ... τ]`. +That is, a type is a sequence of *n* types, + without separators, +surrounded with square brackets. +An ordinary macro, +which takes zero parameters, +has type `[]`. +This is the base type: in other words, it is the type of text. +For greater readability, +this type can also be written in the form of a single period, `.`. +Here are a few examples of types: + +```ocaml + . (* An ordinary unparameterized macro: in other words, text *) + [] (* Same as above. *) + [.] (* A parameterized macro that expects one piece of text *) + [..] (* A parameterized macro that expects two pieces of text *) + [[.].] (* A parameterized macro + whose first parameter is a parameterized macro of type [.] + and whose second parameter is a piece of text *) +``` + +In the definition of a parameterized macro `M`, +each parameter `X` can be annotated with a type +by writing `X : τ`. +This is optional: if no annotation is provided, +the base type `.` is assumed. +If a parameter `X` is annotated with a type `τ` other than the base type, +then, when the parameterized macro `M` is applied, +the actual argument `Y` that is supplied as an instance for `X` +must be the name of a macro of type `τ`. + +This is more easily explained via an example. In the following code, + +```ocaml +#define TWICE(e) (e + e) +#define APPLY(F : [.], e) (let x = (e) in F(x)) +let forty_two = + APPLY(TWICE,1+2+3+4+5+6) +``` + +`TWICE` is a parameterized macro of type `[.]`, and +`APPLY` is a higher-order macro, whose type is `[[.].]`. +Thus, the application `APPLY(TWICE, ...)` is valid. +This code is expanded into: + +```ocaml +let forty_two = + (let x = (1+2+3+4+5+6) in (x + x)) +``` + +Scopes +------ +When a block of text is delimited by `#scope ... #endscope`, +all macro definitions (`#define`, `#def ... #enddef`) +and undefinitions (`#undef`) +become local: +they take effect only within this block. + +```ocaml +(* Here, assume that the macro FOO is not defined. *) +#scope +#define FOO "FOO is now defined" +let x = FOO (* FOO expands to "FOO is now defined" *) +#endscope +(* Here, the macro FOO is again not defined. *) +#define FOO 42 +let y = FOO (* FOO expands to 42 *) +``` + +Scopes can be nested, +as illustrated by this example: + +```ocaml +#scope + #define HELLO "Hello, " + #scope + #define MAN "man" + let message1 = HELLO ^ MAN + #endscope + (* Here, MAN is no longer defined, but HELLO still is. *) + let message2 = HELLO ^ "world" +#endscope +``` + +Conditionals +------------ + +Here is a quick reference on conditionals available in cppo. If you +are not familiar with `#ifdef`, `#ifndef`, `#if`, `#else` and `#elif`, please +refer to the corresponding section in the cpp manual. + +```ocaml +#ifndef VERSION +#warning "VERSION is undefined" +#define VERSION "n/a" +#endif +#ifndef VERSION +#error "VERSION is undefined" +#endif +#if OCAML_MAJOR >= 3 && OCAML_MINOR >= 10 +... +#endif +#ifdef X +... +#elif defined Y +... +#else +... +#endif +``` + +The boolean expressions following `#if` and `#elif` may perform arithmetic +operations and tests over 64-bit ints. + +Boolean expressions: + +* `defined` ... followed by an identifier, returns true if such a macro exists +* `true` +* `false` +* `(` ... `)` +* ... `&&` ... +* ... `||` ... +* `not` ... + +Arithmetic comparisons used in boolean expressions: + +* ... `=` ... +* ... `<` ... +* ... `>` ... +* ... `<>` ... +* ... `<=` ... +* ... `>=` ... + +Arithmetic operators over signed 64-bit ints: + +* `(` ... `)` +* ... `+` ... +* ... `-` ... +* ... `*` ... +* ... `/` ... +* ... `mod` ... +* ... `lsl` ... +* ... `lsr` ... +* ... `asr` ... +* ... `land` ... +* ... `lor` ... +* ... `lxor` ... +* `lnot` ... + +Macro identifiers can be used in place of ints as long as they expand +to an int literal or a tuple of int literals, e.g.: + +```ocaml +#define one 1 + +#if one + one <> 2 +#error "Something's wrong." +#endif + +#define VERSION (1, 0, 5) +#if VERSION <= (1, 0, 2) +#error "Version 1.0.2 or greater is required." +#endif +``` + +Version strings (http://semver.org/) can also be passed to cppo on the +command line. This results in multiple variables being defined, all +sharing the same prefix. See the output of `cppo -help` (copied at the +bottom of this page). + +``` +$ cppo -V OCAML:`ocamlc -version` +#if OCAML_VERSION >= (4, 0, 0) +(* All is well. *) +#else + #error "This version of OCaml is not supported." +#endif +``` + +Output: +``` +# 2 "" +(* All is well. *) +``` + +Source file location +-------------------- + +Location directives are the same as in OCaml and are echoed in the +output. They consist of a line number optionally followed by a file name: + +```ocaml +# 123 +# 456 "source" +``` + +Messages +-------- + +Warnings and error messages can be produced by the preprocessor: + +```ocaml +#ifndef X + #warning "Assuming default value for X" + #define X 1 +#elif X = 0 + #error "X may not be null" +#endif +``` + +Calling an external processor +----------------------------- + +Cppo provides a mechanism for converting sections of a file using +and external program. Such a section must be placed between `#ext` and +`#endext` directives. + +```bash +$ cat foo +ABC +#ext lowercase +DEF +#endext +GHI +#ext lowercase +KLM +NOP +#endext +QRS + +$ cppo -x lowercase:'tr "[A-Z]" "[a-z]"' foo +# 1 "foo" +ABC +def +# 5 "foo" +GHI +klm +nop +# 10 "foo" +QRS +``` + +In the example above, `lowercase` is the name given on the +command-line to external command `'tr "[A-Z]" "[a-z]"'` that reads +input from stdin and writes its output to stdout. + + +Escaping +-------- + +The following characters can be escaped by a backslash when needed: + +```ocaml +( +) +, +# +``` + +In OCaml `#` is used for method calls. It is usually not a problem +because in order to be interpreted as a preprocessor directive, it +must be the first non-blank character of a line and be a known +directive. If an object has a define method and you want `#` to appear +first on a line, you would have to use `\#` instead: + +```ocaml +obj + \#define +``` + +Line directives in the usual format supported by OCaml are correctly +interpreted by cppo. + +Comments and string literals constitute single tokens even when they +span across multiple lines. Therefore newlines within string literals +and comments should remain as-is (no preceding backslash) even in a +macro body: + +```ocaml +#define welcome \ +"********** +*Welcome!* +********** +" +``` + +Concatenation +------------- + +`CONCAT()` is a predefined macro that takes two arguments, removes any +whitespace between and around them and fuses them into a single identifier. +The result of the concatenation must be a valid identifier of the +form [A-Za-z_][A-Za-z0-9_]+ or [A-Za-z], or empty. + +For example, + +```ocaml +#define x 123 +CONCAT(z, x) +``` + +expands into: + +```ocaml +z123 +``` + +However the following is illegal: + +```ocaml +#define x 123 +CONCAT(x, z) +``` + +because 123z does not form a valid identifier. + +`CONCAT(a,b)` is roughly equivalent to `a##b` in cpp syntax. + +CAPITALIZE +--------------- + +`CAPITALIZE()` is a predefined macro that takes one argument, +removes any leading and trailing whitespace, reduces each internal +whitespace sequence to a single space character and produces +a valid OCaml identifer with first character. + +For example, +```ocaml +#define EVENT(n,ty) external CONCAT(on,CAPITALIZE(n)) : ty = STRINGIFY(n) [@@bs.val] +EVENT(exit, unit -> unit) +``` +is expanded into: + +```ocaml +external onExit : unit -> unit = "exit" [@@bs.val] +``` + +Stringification +--------------- + +`STRINGIFY()` is a predefined macro that takes one argument, +removes any leading and trailing whitespace, reduces each internal +whitespace sequence to a single space character and produces +a valid OCaml string literal. + +For example, + +```ocaml +#define TRACE(f) Printf.printf ">>> %s\n" STRINGIFY(f); f +TRACE(print_endline) "Hello" +``` + +is expanded into: + +```ocaml +Printf.printf ">>> %s\n" "print_endline"; print_endline "Hello" +``` + +`STRINGIFY(x)` is the equivalent of `#x` in cpp syntax. + + +Ocamlbuild plugin +------------------ + +An ocamlbuild plugin is available. To use it, you can call ocamlbuild +with the argument `-plugin-tag package(cppo_ocamlbuild)` (only since +ocaml 4.01 and cppo >= 0.9.4). + +Starting from **cppo >= 1.6.0**, the `cppo_ocamlbuild` plugin is in a +separate OPAM package (`opam install cppo_ocamlbuild`). + +With Oasis : +``` +OCamlVersion: >= 4.01 +AlphaFeatures: ocamlbuild_more_args +XOCamlbuildPluginTags: package(cppo_ocamlbuild) +``` + +After that, you need to add in your `myocamlbuild.ml` : +```ocaml +let () = + Ocamlbuild_plugin.dispatch + (fun hook -> + Ocamlbuild_cppo.dispatcher hook ; + ) +``` + +By default the plugin will apply cppo on all files ending in `.cppo.ml` +`cppo.mli`, and `cppo.mlpack`, in order to produce `.ml`, `.mli`, +and`.mlpack` files. The following tags are available: +* `cppo_D(X)` ≡ `-D X` +* `cppo_U(X)` ≡ `-U X` +* `cppo_q` ≡ `-q` +* `cppo_s` ≡ `-s` +* `cppo_n` ≡ `-n` +* `cppo_x(NAME:CMD_TEMPLATE)` ≡ `-x NAME:CMD_TEMPLATE` +* The tag `cppo_I(foo)` can behave in two way: + * If `foo` is a directory, it's equivalent to `-I foo`. + * If `foo` is a file, it adds `foo` as a dependency and apply `-I + parent(foo)`. +* `cppo_V(NAME:VERSION)` ≡ `-V NAME:VERSION` +* `cppo_V_OCAML` ≡ `-V OCAML:VERSION`, where `VERSION` + is the version of OCaml that ocamlbuild uses. + +Balancing delimiters +-------------------- + +All delimiters, +including scope delimiters (`#scope` and `#endscope`), +delimiters of macro definitions (`#def` and `#enddef`), +and delimiters of conditional constructs (`#if`, `#endif`, etc.), +must be used in a well-balanced manner. + +This requirement does *not* apply separately to each category of delimiters. +instead, it applies to all categories of delimiters at once. +This is a stricter requirement. +Thus, for example, `#scope` cannot be followed with `#endif`, +and `#if` cannot be followed with `#endscope`. +In other words, +a scope cannot contain a fragment of a conditional construct, +and a conditional construct cannot contain a fragment of a macro definition. + + +Detailed command-line usage and options +--------------------------------------- + +``` +Usage: ./cppo [OPTIONS] [FILE1 [FILE2 ...]] +Options: + -D DEF + Equivalent of interpreting '#define DEF' before processing the + input + -U IDENT + Equivalent of interpreting '#undef IDENT' before processing the + input + -I DIR + Add directory DIR to the search path for included files + -V VAR:MAJOR.MINOR.PATCH-OPTPRERELEASE+OPTBUILD + Define the following variables extracted from a version string + (following the Semantic Versioning syntax http://semver.org/): + + VAR_MAJOR must be a non-negative int + VAR_MINOR must be a non-negative int + VAR_PATCH must be a non-negative int + VAR_PRERELEASE if the OPTPRERELEASE part exists + VAR_BUILD if the OPTBUILD part exists + VAR_VERSION is the tuple (MAJOR, MINOR, PATCH) + VAR_VERSION_STRING is the string MAJOR.MINOR.PATCH + VAR_VERSION_FULL is the original string + + Example: cppo -V OCAML:4.02.1 + + -o FILE + Output file + -q + Identify and preserve camlp4 quotations + -s + Output line directives pointing to the exact source location of + each token, including those coming from the body of macro + definitions. This behavior is off by default. + -n + Do not output any line directive other than those found in the + input (overrides -s). + -version + Print the version of the program and exit. + -x NAME:CMD_TEMPLATE + Define a custom preprocessor target section starting with: + #ext "NAME" + and ending with: + #endext + + NAME must be a lowercase identifier of the form [a-z][A-Za-z0-9_]* + + CMD_TEMPLATE is a command template supporting the following + special sequences: + %F file name (unescaped; beware of potential scripting attacks) + %B number of the first line + %E number of the last line + %% a single percent sign + + Filename, first line number and last line number are also + available from the following environment variables: + CPPO_FILE, CPPO_FIRST_LINE, CPPO_LAST_LINE. + + The command produced is expected to read the data lines from stdin + and to write its output to stdout. + -help Display this list of options + --help Display this list of options +``` + + +Contributing +------------ + +See our contribution guidelines at +https://github.com/mjambon/documents/blob/master/how-to-contribute.md diff --git a/unikernel/duniverse/cppo/appveyor.yml b/unikernel/duniverse/cppo/appveyor.yml new file mode 100644 index 00000000..456a4cc2 --- /dev/null +++ b/unikernel/duniverse/cppo/appveyor.yml @@ -0,0 +1,14 @@ + +environment: + matrix: + - OCAML_BRANCH: 4.05 + - OCAML_BRANCH: 4.06 + +install: + - appveyor DownloadFile "https://raw.githubusercontent.com/Chris00/ocaml-appveyor/master/install_ocaml.cmd" -FileName "C:\install_ocaml.cmd" + - C:\install_ocaml.cmd + +build_script: + - cd "%APPVEYOR_BUILD_FOLDER%" + - dune subst + - dune build -p cppo diff --git a/unikernel/duniverse/cppo/dune-project b/unikernel/duniverse/cppo/dune-project new file mode 100644 index 00000000..c9876fd3 --- /dev/null +++ b/unikernel/duniverse/cppo/dune-project @@ -0,0 +1,45 @@ +(lang dune 2.0) +(name cppo) +(version 1.8.0) + +(generate_opam_files true) + +(source (github ocaml-community/cppo)) +(license BSD-3-Clause) +(authors "Martin Jambon") +(maintainers + "Martin Jambon " + "Yishuai Li ") +(documentation "https://ocaml-community.github.io/cppo") + +(package + (name cppo) + (depends + (ocaml (>= 4.02.3)) + (dune (>= 2.0)) + base-unix) + (synopsis "Code preprocessor like cpp for OCaml") + (description "Cppo is an equivalent of the C preprocessor for OCaml programs. +It allows the definition of simple macros and file inclusion. + +Cppo is: + +* more OCaml-friendly than cpp +* easy to learn without consulting a manual +* reasonably fast +* simple to install and to maintain +")) + +(package + (name cppo_ocamlbuild) + (depends + ocaml + (dune (>= 2.0)) + ocamlbuild + ocamlfind) + (synopsis "Plugin to use cppo with ocamlbuild") + (description "This ocamlbuild plugin lets you use cppo in ocamlbuild projects. + +To use it, you can call ocamlbuild with the argument `-plugin-tag +package(cppo_ocamlbuild)` (only since ocaml 4.01 and cppo >= 0.9.4). +")) diff --git a/unikernel/duniverse/cppo/examples/Makefile b/unikernel/duniverse/cppo/examples/Makefile new file mode 100644 index 00000000..f9dd33fb --- /dev/null +++ b/unikernel/duniverse/cppo/examples/Makefile @@ -0,0 +1,8 @@ +.PHONY: all clean +all: + ../cppo debug.ml > debug.out + ../cppo french.ml > french.out + ocamllex lexer.mll + ../cppo lexer.ml > lexer.out +clean: + rm -f *.out lexer.ml diff --git a/unikernel/duniverse/cppo/examples/debug.ml b/unikernel/duniverse/cppo/examples/debug.ml new file mode 100644 index 00000000..d47b5122 --- /dev/null +++ b/unikernel/duniverse/cppo/examples/debug.ml @@ -0,0 +1,7 @@ +#ifdef DEBUG +#define debug(s) Printf.eprintf "[%S %i] %s\n%!" __FILE__ __LINE__ s +#else +#define debug(s) () +#endif + +debug("test") diff --git a/unikernel/duniverse/cppo/examples/dune b/unikernel/duniverse/cppo/examples/dune new file mode 100644 index 00000000..f4d9de7c --- /dev/null +++ b/unikernel/duniverse/cppo/examples/dune @@ -0,0 +1,32 @@ +(ocamllex lexer) + +(rule + (deps + (:< debug.ml)) + (targets debug.out) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (deps + (:< french.ml)) + (targets french.out) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (deps + (:< lexer.ml)) + (targets lexer.out) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(alias + (name DEFAULT) + (deps debug.out french.out lexer.out)) diff --git a/unikernel/duniverse/cppo/examples/french.ml b/unikernel/duniverse/cppo/examples/french.ml new file mode 100644 index 00000000..e173a1fe --- /dev/null +++ b/unikernel/duniverse/cppo/examples/french.ml @@ -0,0 +1,34 @@ +#define soit let +#define fonction function +#define fon fun +#define dans in +#define si if +#define alors then +#define sinon else + +#define Liste List +#define Affichef Printf +#define affichef printf + +#define separation split +#define tri sort + +soit rec separation x = fonction + y :: l -> + soit l1, l2 = separation x l dans + si y < x alors (y :: l1), l2 + sinon l1, (y :: l2) + | [] -> + [], [] + +soit rec tri = fonction + x :: l -> + soit l1, l2 = separation x l dans + tri l1 @ [x] @ tri l2 + | [] -> + [] + +soit () = + soit l = tri [ 5; 3; 7; 1; 7; 4; 99; 22 ] dans + Liste.iter (fon i -> Affichef.affichef "%i " i) l; + Affichef.affichef "\n" diff --git a/unikernel/duniverse/cppo/examples/lexer.mll b/unikernel/duniverse/cppo/examples/lexer.mll new file mode 100644 index 00000000..446e8eef --- /dev/null +++ b/unikernel/duniverse/cppo/examples/lexer.mll @@ -0,0 +1,9 @@ +(* Warning: ocamllex doesn't accept cppo directives + within the rules section. *) +rule token = parse + ['a'-'z']+ { `String (Lexing.lexeme lexbuf) } +{ +#ifndef NOFOO + let foo () = () +#endif +} diff --git a/unikernel/duniverse/cppo/ocamlbuild_plugin/_tags b/unikernel/duniverse/cppo/ocamlbuild_plugin/_tags new file mode 100644 index 00000000..dc946a1c --- /dev/null +++ b/unikernel/duniverse/cppo/ocamlbuild_plugin/_tags @@ -0,0 +1 @@ +true: package(ocamlbuild) diff --git a/unikernel/duniverse/cppo/ocamlbuild_plugin/dune b/unikernel/duniverse/cppo/ocamlbuild_plugin/dune new file mode 100644 index 00000000..b512a12f --- /dev/null +++ b/unikernel/duniverse/cppo/ocamlbuild_plugin/dune @@ -0,0 +1,6 @@ +(library + (name cppo_ocamlbuild) + (public_name cppo_ocamlbuild) + (wrapped false) + (synopsis "Cppo ocamlbuild plugin") + (libraries ocamlbuild)) diff --git a/unikernel/duniverse/cppo/ocamlbuild_plugin/ocamlbuild_cppo.ml b/unikernel/duniverse/cppo/ocamlbuild_plugin/ocamlbuild_cppo.ml new file mode 100644 index 00000000..f301c362 --- /dev/null +++ b/unikernel/duniverse/cppo/ocamlbuild_plugin/ocamlbuild_cppo.ml @@ -0,0 +1,35 @@ + +open Ocamlbuild_plugin + +let cppo_rules ext = + let dep = "%(name).cppo"-.-ext + and prod1 = "%(name: <*> and not <*.cppo>)"-.-ext + and prod2 = "%(name: <**/*> and not <**/*.cppo>)"-.-ext in + let cppo_rule prod env _build = + let dep = env dep in + let prod = env prod in + let tags = tags_of_pathname prod ++ "cppo" in + Cmd (S[A "cppo"; T tags; S [A "-o"; P prod]; P dep ]) + in + rule ("cppo: *.cppo."-.-ext^" -> *."-.-ext) ~dep ~prod:prod1 (cppo_rule prod1); + rule ("cppo: **/*.cppo."-.-ext^" -> **/*."-.-ext) ~dep ~prod:prod2 (cppo_rule prod2) + +let dispatcher = function + | After_rules -> begin + List.iter cppo_rules ["ml"; "mli"; "mlpack"]; + pflag ["cppo"] "cppo_D" (fun s -> S [A "-D"; A s]) ; + pflag ["cppo"] "cppo_U" (fun s -> S [A "-U"; A s]) ; + pflag ["cppo"] "cppo_I" (fun s -> + if Pathname.is_directory s then S [A "-I"; P s] + else S [A "-I"; P (Pathname.dirname s)] + ) ; + pdep ["cppo"] "cppo_I" (fun s -> + if Pathname.is_directory s then [] else [s]) ; + flag ["cppo"; "cppo_q"] (A "-q") ; + flag ["cppo"; "cppo_s"] (A "-s") ; + flag ["cppo"; "cppo_n"] (A "-n") ; + pflag ["cppo"] "cppo_x" (fun s -> S [A "-x"; A s]); + pflag ["cppo"] "cppo_V" (fun s -> S [A "-V"; A s]); + flag ["cppo"; "cppo_V_OCAML"] & S [A "-V"; A ("OCAML:" ^ Sys.ocaml_version)] + end + | _ -> () diff --git a/unikernel/duniverse/cppo/ocamlbuild_plugin/ocamlbuild_cppo.mli b/unikernel/duniverse/cppo/ocamlbuild_plugin/ocamlbuild_cppo.mli new file mode 100644 index 00000000..21243585 --- /dev/null +++ b/unikernel/duniverse/cppo/ocamlbuild_plugin/ocamlbuild_cppo.mli @@ -0,0 +1,9 @@ + +(** [cppo_rules extension] will add rules to Ocamlbuild so that + cppo is applied to files ending in "cppo.[extension]". + + By default rules are inserted for files ending with "ml", "mli" and + "mlpack". *) +val cppo_rules : string -> unit + +val dispatcher : Ocamlbuild_plugin.hook -> unit diff --git a/unikernel/duniverse/cppo/src/compat.ml b/unikernel/duniverse/cppo/src/compat.ml new file mode 100644 index 00000000..5cd4a1b5 --- /dev/null +++ b/unikernel/duniverse/cppo/src/compat.ml @@ -0,0 +1,7 @@ +if Filename.check_suffix Sys.argv.(1) ".ml" && + Scanf.sscanf Sys.ocaml_version "%d.%d" (fun a b -> (a, b)) < (4, 03) then + print_endline "\ +module String = struct + include String + let capitalize_ascii = capitalize +end" diff --git a/unikernel/duniverse/cppo/src/cppo_command.ml b/unikernel/duniverse/cppo/src/cppo_command.ml new file mode 100644 index 00000000..5c61028c --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_command.ml @@ -0,0 +1,63 @@ +open Printf + +type command_token = + [ `Text of string + | `Loc_file + | `Loc_first_line + | `Loc_last_line ] + +type command_template = command_token list + +let parse s : command_template = + let rec loop acc buf s len i = + if i >= len then + let s = Buffer.contents buf in + if s = "" then acc + else `Text s :: acc + else if i = len - 1 then ( + Buffer.add_char buf s.[i]; + `Text (Buffer.contents buf) :: acc + ) + else + let c = s.[i] in + if c = '%' then + let acc = + let s = Buffer.contents buf in + Buffer.clear buf; + if s = "" then acc + else + `Text s :: acc + in + let x = + match s.[i+1] with + 'F' -> `Loc_file + | 'B' -> `Loc_first_line + | 'E' -> `Loc_last_line + | '%' -> `Text "%" + | _ -> + failwith ( + sprintf "Invalid escape sequence in command template %S. \ + Use %%%% for a %% sign." s + ) + in + loop (x :: acc) buf s len (i + 2) + else ( + Buffer.add_char buf c; + loop acc buf s len (i + 1) + ) + in + let len = String.length s in + List.rev (loop [] (Buffer.create len) s len 0) + + +let subst (cmd : command_template) file first last = + let l = + List.map ( + function + `Text s -> s + | `Loc_file -> file + | `Loc_first_line -> string_of_int first + | `Loc_last_line -> string_of_int last + ) cmd + in + String.concat "" l diff --git a/unikernel/duniverse/cppo/src/cppo_command.mli b/unikernel/duniverse/cppo/src/cppo_command.mli new file mode 100644 index 00000000..af57d8cb --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_command.mli @@ -0,0 +1,11 @@ +type command_token = + [ `Text of string + | `Loc_file + | `Loc_first_line + | `Loc_last_line ] + +type command_template = command_token list + +val subst : command_template -> string -> int -> int -> string + +val parse : string -> command_template diff --git a/unikernel/duniverse/cppo/src/cppo_eval.ml b/unikernel/duniverse/cppo/src/cppo_eval.ml new file mode 100644 index 00000000..170eb34e --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_eval.ml @@ -0,0 +1,781 @@ +open Printf + +open Cppo_types + +module S = Set.Make (String) +module M = Map.Make (String) + +let find_opt name env = + try Some (M.find name env) + with Not_found -> None + +(* An environment entry. *) + +(* In a macro definition [EDef (loc, formals, body, env)], + + + [loc] is the location of the macro definition, + + [formals] is the list of formal parameters, + + [body] and [env] represent the closed body of the macro definition. *) + +type entry = + | EDef of loc * formals * body * env + +(* An environment is a map of (macro) names to environment entries. *) + +and env = + entry M.t + +let basic x : formal = + (x, base) + +let ident x = + `Ident (dummy_loc, x, []) + +let dummy_defun formals body env = + EDef (dummy_loc, List.map basic formals, body, env) + +let builtins : (string * (env -> entry)) list = [ + "STRINGIFY", + dummy_defun + ["x"] + (`Stringify (ident "x")) + ; + "CONCAT", + dummy_defun + ["x";"y"] + (`Concat (ident "x", ident "y")) + ; + "CAPITALIZE", + dummy_defun + ["x"] + (`Capitalize (ident "x")) + ; +] + +let is_reserved s = + s = "__FILE__" || + s = "__LINE__" || + List.exists (fun (s', _) -> s = s') builtins + +let builtin_env : env = + List.fold_left (fun env (s, f) -> M.add s (f env) env) M.empty builtins + +let line_directive buf pos = + let len = Buffer.length buf in + if len > 0 && Buffer.nth buf (len - 1) <> '\n' then + Buffer.add_char buf '\n'; + bprintf buf "# %i %S\n" + pos.Lexing.pos_lnum + pos.Lexing.pos_fname; + bprintf buf "%s" (String.make (pos.Lexing.pos_cnum - pos.Lexing.pos_bol) ' ') + +let rec add_sep sep last = function + [] -> [ last ] + | [x] -> [ x; last ] + | x :: l -> x :: sep :: add_sep sep last l + +(* Transform a list of actual macro arguments back into ordinary text, + after discovering that they are not macro arguments after all. *) +let text loc name (actuals : actuals) : node list = + match actuals with + | [] -> + [`Text (loc, false, name)] + | _ :: _ -> + `Text (loc, false, name ^ "(") :: + add_sep + (`Text (loc, false, ",")) + (`Text (loc, false, ")")) + actuals + +let trim_and_compact buf s = + let started = ref false in + let need_space = ref false in + for i = 0 to String.length s - 1 do + match s.[i] with + ' ' | '\t' | '\n' | '\r' -> + if !started then + need_space := true + | c -> + if !need_space then + Buffer.add_char buf ' '; + (match c with + '\"' -> Buffer.add_string buf "\\\"" + | '\\' -> Buffer.add_string buf "\\\\" + | c -> Buffer.add_char buf c); + started := true; + need_space := false + done + +let stringify buf s = + Buffer.add_char buf '\"'; + trim_and_compact buf s; + Buffer.add_char buf '\"' + +let trim_and_compact_string s = + let buf = Buffer.create (String.length s) in + trim_and_compact buf s; + Buffer.contents buf + +let trim_compact_and_capitalize_string s = + let buf = Buffer.create (String.length s) in + trim_and_compact buf s; + String.capitalize_ascii (Buffer.contents buf) + +let is_ident s = + let len = String.length s in + len > 0 + && + (match s.[0] with + 'A'..'Z' | 'a'..'z' -> true + | '_' when len > 1 -> true + | _ -> false) + && + (try + for i = 1 to len - 1 do + match s.[i] with + 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> () + | _ -> raise Exit + done; + true + with Exit -> + false) + +let concat loc x y = + let s = trim_and_compact_string x ^ trim_and_compact_string y in + if not (s = "" || is_ident s) then + error loc + (sprintf "CONCAT() does not expand into a valid identifier nor \ + into whitespace:\n%S" s) + else + if s = "" then " " + else " " ^ s ^ " " + +let int_expansion_error loc name = + error loc + (sprintf "\ +Variable %s found in cppo boolean expression must expand +into an int literal, into a tuple of int literals, +or into a variable with the same properties." + name) + +let rec int_expansion loc name (node : node) : string = + match node with + | `Text (_loc, _is_space, s) -> + s + | `Seq (_loc, nodes) -> + List.map (int_expansion loc name) nodes + |> String.concat "" + | _ -> + int_expansion_error loc name + +(* + Expand the contents of a variable used in a boolean expression. + + Ideally, we should first completely expand the contents bound + to the variable, and then parse the result as an int or an int tuple. + This is a bit complicated to do well, and we don't want to implement + a full programming language here either. + + Instead we only accept int literals, int tuple literals, and variables that + themselves expand into one those. + + In particular: + - We do not support arithmetic operations + - We do not support tuples containing variables such as (x, y) + + Example of contents that we support: + - 123 + - (1, 2, 3) + - x, where x expands into 123. +*) +let rec eval_ident env loc name = + let body = + match find_opt name env with + | Some (EDef (_loc, [], body, _env)) -> + body + | Some (EDef _) -> + error loc (sprintf "%S expects arguments" name) + | None -> + error loc (sprintf "Undefined identifier %S" name) + in + (try + match node_is_ident body with + | Some (loc, name) -> + (* single identifier that we expand recursively *) + eval_ident env loc name + | None -> + (* int literal or int tuple literal; variables not allowed *) + let s = int_expansion loc name body in + (match Cppo_lexer.int_tuple_of_string s with + Some [i] -> `Int i + | Some l -> `Tuple (loc, List.map (fun i -> `Int i) l) + | None -> + int_expansion_error loc name + ) + with Cppo_error _ -> + int_expansion_error loc name + ) + +let rec replace_idents env (x : arith_expr) : arith_expr = + match x with + | `Ident (loc, name) -> eval_ident env loc name + + | `Int x -> `Int x + | `Neg x -> `Neg (replace_idents env x) + | `Add (a, b) -> `Add (replace_idents env a, replace_idents env b) + | `Sub (a, b) -> `Sub (replace_idents env a, replace_idents env b) + | `Mul (a, b) -> `Mul (replace_idents env a, replace_idents env b) + | `Div (loc, a, b) -> `Div (loc, replace_idents env a, replace_idents env b) + | `Mod (loc, a, b) -> `Mod (loc, replace_idents env a, replace_idents env b) + | `Lnot a -> `Lnot (replace_idents env a) + | `Lsl (a, b) -> `Lsl (replace_idents env a, replace_idents env b) + | `Lsr (a, b) -> `Lsr (replace_idents env a, replace_idents env b) + | `Asr (a, b) -> `Asr (replace_idents env a, replace_idents env b) + | `Land (a, b) -> `Land (replace_idents env a, replace_idents env b) + | `Lor (a, b) -> `Lor (replace_idents env a, replace_idents env b) + | `Lxor (a, b) -> `Lxor (replace_idents env a, replace_idents env b) + | `Tuple (loc, l) -> `Tuple (loc, List.map (replace_idents env) l) + +let rec eval_int env (x : arith_expr) : int64 = + match x with + | `Ident (loc, name) -> eval_int env (eval_ident env loc name) + + | `Int x -> x + | `Neg x -> Int64.neg (eval_int env x) + | `Add (a, b) -> Int64.add (eval_int env a) (eval_int env b) + | `Sub (a, b) -> Int64.sub (eval_int env a) (eval_int env b) + | `Mul (a, b) -> Int64.mul (eval_int env a) (eval_int env b) + | `Div (loc, a, b) -> + (try Int64.div (eval_int env a) (eval_int env b) + with Division_by_zero -> + error loc "Division by zero") + + | `Mod (loc, a, b) -> + (try Int64.rem (eval_int env a) (eval_int env b) + with Division_by_zero -> + error loc "Division by zero") + + | `Lnot a -> Int64.lognot (eval_int env a) + + | `Lsl (a, b) -> + let n = eval_int env a in + let shift = eval_int env b in + let shift = + if shift >= 64L then 64L + else if shift <= -64L then -64L + else shift + in + Int64.shift_left n (Int64.to_int shift) + + | `Lsr (a, b) -> + let n = eval_int env a in + let shift = eval_int env b in + let shift = + if shift >= 64L then 64L + else if shift <= -64L then -64L + else shift + in + Int64.shift_right_logical n (Int64.to_int shift) + + | `Asr (a, b) -> + let n = eval_int env a in + let shift = eval_int env b in + let shift = + if shift >= 64L then 64L + else if shift <= -64L then -64L + else shift + in + Int64.shift_right n (Int64.to_int shift) + + | `Land (a, b) -> Int64.logand (eval_int env a) (eval_int env b) + | `Lor (a, b) -> Int64.logor (eval_int env a) (eval_int env b) + | `Lxor (a, b) -> Int64.logxor (eval_int env a) (eval_int env b) + | `Tuple (loc, l) -> + assert (List.length l <> 1); + error loc "Operation not supported on tuples" + +let rec compare_lists al bl = + match al, bl with + | a :: al, b :: bl -> + let c = Int64.compare a b in + if c <> 0 then c + else compare_lists al bl + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + +let compare_tuples env (a : arith_expr) (b : arith_expr) = + (* We replace the identifiers first to get a better error message + on such input: + + #define x (1, 2) + #if x >= (1, 2) + + since variables must represent a single int, not a tuple. + *) + let a = replace_idents env a in + let b = replace_idents env b in + match a, b with + | `Tuple (_, al), `Tuple (_, bl) when List.length al = List.length bl -> + let eval_list l = List.map (eval_int env) l in + compare_lists (eval_list al) (eval_list bl) + + | `Tuple (_loc1, al), `Tuple (loc2, bl) -> + error loc2 + (sprintf "Tuple of length %i cannot be compared to a tuple of length %i" + (List.length bl) (List.length al) + ) + + | `Tuple (loc, _), _ + | _, `Tuple (loc, _) -> + error loc "Tuple cannot be compared to an int" + + | a, b -> + Int64.compare (eval_int env a) (eval_int env b) + +let rec eval_bool env (x : bool_expr) = + match x with + `True -> true + | `False -> false + | `Defined s -> M.mem s env + | `Not x -> not (eval_bool env x) + | `And (a, b) -> eval_bool env a && eval_bool env b + | `Or (a, b) -> eval_bool env a || eval_bool env b + | `Eq (a, b) -> compare_tuples env a b = 0 + | `Lt (a, b) -> compare_tuples env a b < 0 + | `Gt (a, b) -> compare_tuples env a b > 0 + + +type globals = { + call_loc : Cppo_types.loc; + (* location used to set the value of + __FILE__ and __LINE__ global variables; + also used in the expansion of CONCAT *) + + mutable buf : Buffer.t; + (* buffer where the output is written *) + + included : S.t; + (* set of already-included files *) + + require_location : bool ref; + (* whether a line directive should be printed before outputting the next + token *) + + show_exact_locations : bool; + (* whether line directives should be printed even for expanded macro + bodies *) + + enable_loc : bool ref; + (* whether line directives should be printed *) + + g_preserve_quotations : bool; + (* identify and preserve camlp4 quotations *) + + incdirs : string list; + (* directories for finding included files *) + + current_directory : string; + (* directory containing the current file *) + + extensions : (string, Cppo_command.command_template) Hashtbl.t; + (* mapping from extension ID to pipeline command *) +} + +(* [preserving_enable_loc g action] saves [g.enable_loc], runs [action()], + then restores [g.enable_loc]. The result of [action()] is returned. *) +let preserving_enable_loc g action = + let enable_loc0 = !(g.enable_loc) in + let result = action() in + g.enable_loc := enable_loc0; + result + +let parse ~preserve_quotations file lexbuf = + let lexer_env = Cppo_lexer.init ~preserve_quotations file lexbuf in + try + Cppo_parser.main (Cppo_lexer.line lexer_env) lexbuf + with + Parsing.Parse_error -> + error (Cppo_lexer.long_loc lexer_env) "syntax error" + | Cppo_types.Cppo_error _ as e -> + raise e + | e -> + error (Cppo_lexer.long_loc lexer_env) (Printexc.to_string e) + +let plural n = + if abs n <= 1 then "" + else "s" + + +let maybe_print_location g pos = + if !(g.enable_loc) then + if !(g.require_location) then ( + line_directive g.buf pos + ) + +let expand_ext g loc id data = + let cmd_tpl = + try Hashtbl.find g.extensions id + with Not_found -> + error loc (sprintf "Undefined extension %s" id) + in + let p1, p2 = loc in + let file = p1.Lexing.pos_fname in + let first = p1.Lexing.pos_lnum in + let last = p2.Lexing.pos_lnum in + let cmd = Cppo_command.subst cmd_tpl file first last in + Unix.putenv "CPPO_FILE" file; + Unix.putenv "CPPO_FIRST_LINE" (string_of_int first); + Unix.putenv "CPPO_LAST_LINE" (string_of_int last); + let (ic, oc) as p = Unix.open_process cmd in + output_string oc data; + close_out oc; + (try + while true do + bprintf g.buf "%s\n" (input_line ic) + done + with End_of_file -> () + ); + match Unix.close_process p with + Unix.WEXITED 0 -> () + | Unix.WEXITED n -> + failwith (sprintf "Command %S exited with status %i" cmd n) + | _ -> + failwith (sprintf "Command %S failed" cmd) + +let check_arity loc name (formals : _ list) (actuals : _ list) = + let formals = List.length formals + and actuals = List.length actuals in + if formals <> actuals then + sprintf "%S expects %i argument%s but is applied to %i argument%s." + name formals (plural formals) actuals (plural actuals) + |> error loc + +(* [macro_of_node node] checks that [node] is a single identifier, + possibly surrounded with whitespace, and returns this identifier + as well as its location. *) +let macro_of_node (node : node) : loc * macro = + match node_is_ident node with + | Some (loc, x) -> + loc, x + | None -> + sprintf "The name of a macro is expected in this position" + |> error (node_loc node) + +(* [fetch loc x env] checks that the macro [x] exists in [env] + and fetches its definition. *) +let fetch loc (x : macro) env : entry = + match find_opt x env with + | None -> + sprintf "The macro '%s' is not defined" x + |> error loc + | Some def -> + def + +(* [entry_shape def] returns the shape of the macro that is defined + by the environment entry [def]. *) +let entry_shape (entry : entry) : shape = + let EDef (_loc, formals, _body, _env) = entry in + Shape (List.map snd formals) + +(* [check_shape loc expected provided] checks that the shapes + [expected] and [provided] are equal. *) +let check_shape loc expected provided = + if not (same_shape expected provided) then + sprintf "A macro of type %s was expected, but\n \ + a macro of type %s was provided" + (print_shape expected) (print_shape provided) + |> error loc + +(* [bind_one formal (loc, actual, env) accu] binds one formal parameter + to one actual argument, extending the environment [accu]. *) +let bind_one (formal : formal) (loc, actual, env) accu = + let (x : macro), (expected : shape) = formal in + (* Analyze the shape of this formal parameter. *) + match expected with + | Shape [] -> + (* This formal parameter has the base shape: it is an ordinary + parameter. It becomes an ordinary (unparameterized) macro: + the name [x] becomes bound to the closure [actual, env]. *) + M.add x (EDef (loc, [], actual, env)) accu + | _ -> + (* This formal parameter has a shape other than the base shape: + it is itself a parameterized macro. In that case, we expect + the actual parameter to be just a name [y]. *) + let loc, y = macro_of_node actual in + (* Check that the macro [y] exists, and fetch its definition. *) + let def = fetch loc y env in + (* Compute its shape. *) + let provided = entry_shape def in + (* Check that the shapes match. *) + check_shape loc expected provided; + (* Now bind [x] to the definition of [y]. *) + (* This is analogous to [let x = y] in OCaml. *) + M.add x def accu + +(* [bind_many formals (loc, actuals, env) accu] binds a tuple of formal + parameters to a tuple of actual arguments, extending the environment + [accu]. *) +let bind_many formals (loc, actuals, env) accu = + List.fold_left2 (fun accu formal actual -> + bind_one formal (loc, actual, env) accu + ) accu formals actuals + +let rec include_file g loc rel_file env = + let file = + if not (Filename.is_relative rel_file) then + if Sys.file_exists rel_file then + rel_file + else + error loc (sprintf "Included file %S does not exist" rel_file) + else + try + let dir = + List.find ( + fun dir -> + let file = Filename.concat dir rel_file in + Sys.file_exists file + ) (g.current_directory :: g.incdirs) + in + if dir = Filename.current_dir_name then + rel_file + else + Filename.concat dir rel_file + with Not_found -> + error loc (sprintf "Cannot find included file %S" rel_file) + in + if S.mem file g.included then + failwith (sprintf "Cyclic inclusion of file %S" file) + else + let ic = open_in file in + let lexbuf = Lexing.from_channel ic in + let l = parse ~preserve_quotations:g.g_preserve_quotations file lexbuf in + close_in ic; + expand_list { g with + included = S.add file g.included; + current_directory = Filename.dirname file + } env l + +and expand_list ?(top = false) g env l = + List.fold_left (expand_node ~top g) env l + +(* [expand_ident] is the special case of [expand_node] where the node is + an identifier [`Ident (loc, name, actuals)]. *) +and expand_ident ~top g env0 loc name (actuals : actuals) = + + (* Test whether there exists a definition for the macro [name]. *) + let def = find_opt name env0 in + match def with + | None -> + (* There is no definition for the macro [name], so this is not + a macro application after all. Transform it back into text, + and process it. *) + expand_list g env0 (text loc name actuals) + | Some def -> + expand_macro_application ~top g env0 loc name actuals def + +(* [expand_macro_application] is the special case of [expand_ident] where + it turns out that the identifier [name] is a macro. *) +and expand_macro_application ~top g env0 loc name actuals def = + + let g = + if top || g.call_loc == dummy_loc then + { g with call_loc = loc } + else g + in + + preserving_enable_loc g @@ fun () -> + + g.require_location := true; + + if not g.show_exact_locations then ( + (* error reports will point more or less to the point + where the code is included rather than the source location + of the macro definition *) + maybe_print_location g (fst loc); + g.enable_loc := false + ); + + let EDef (_loc, formals, body, env) = def in + (* Check that this macro is applied to a correct number of arguments. *) + check_arity loc name formals actuals; + (* Extend the macro's captured environment [env] with bindings of + formals to actuals. Each actual captures the environment [env0] + that exists here, at the macro application site. *) + let env = bind_many formals (loc, actuals, env0) env in + (* Process the macro's body in this extended environment. *) + let (_ : env) = expand_node g env body in + + g.require_location := true; + + (* Continue with our original environment. *) + env0 + +and expand_node ?(top = false) g env0 (x : node) = + match x with + + | `Ident (loc, name, actuals) -> + expand_ident ~top g env0 loc name actuals + + | `Def (loc, name, formals, body)-> + g.require_location := true; + if M.mem name env0 then + error loc (sprintf "%S is already defined" name) + else + M.add name (EDef (loc, formals, body, env0)) env0 + + | `Scope body -> + (* A [body] is just a [node]. We expand this node, and drop + the resulting environment; instead, we return the current + environment. *) + let env = expand_node ~top g env0 body in + ignore env; + env0 + + | `Undef (loc, name) -> + g.require_location := true; + if is_reserved name then + error loc + (sprintf "%S is a built-in variable that cannot be undefined" name) + else + M.remove name env0 + + | `Include (loc, file) -> + g.require_location := true; + let env = include_file g loc file env0 in + g.require_location := true; + env + + | `Ext (loc, id, data) -> + g.require_location := true; + expand_ext g loc id data; + g.require_location := true; + env0 + + | `Cond (_loc, test, if_true, if_false) -> + let l = + if eval_bool env0 test then if_true + else if_false + in + g.require_location := true; + let env = expand_list g env0 l in + g.require_location := true; + env + + | `Error (loc, msg) -> + error loc msg + + | `Warning (loc, msg) -> + warning loc msg; + env0 + + | `Text (loc, is_space, s) -> + if not is_space then ( + maybe_print_location g (fst loc); + g.require_location := false + ); + Buffer.add_string g.buf s; + env0 + + | `Seq (_loc, l) -> + expand_list g env0 l + + | `Stringify x -> + preserving_enable_loc g @@ fun () -> + g.enable_loc := false; + let buf0 = g.buf in + let local_buf = Buffer.create 100 in + g.buf <- local_buf; + ignore (expand_node g env0 x); + stringify buf0 (Buffer.contents local_buf); + g.buf <- buf0; + env0 + + | `Capitalize (x : node) -> + preserving_enable_loc g @@ fun () -> + g.enable_loc := false; + let buf0 = g.buf in + let local_buf = Buffer.create 100 in + g.buf <- local_buf; + ignore (expand_node g env0 x); + let xs = Buffer.contents local_buf in + let s = trim_compact_and_capitalize_string xs in + (* stringify buf0 (Buffer.contents local_buf); *) + Buffer.add_string buf0 s ; + g.buf <- buf0; + env0 + + | `Concat (x, y) -> + preserving_enable_loc g @@ fun () -> + g.enable_loc := false; + let buf0 = g.buf in + let local_buf = Buffer.create 100 in + g.buf <- local_buf; + ignore (expand_node g env0 x); + let xs = Buffer.contents local_buf in + Buffer.clear local_buf; + ignore (expand_node g env0 y); + let ys = Buffer.contents local_buf in + let s = concat g.call_loc xs ys in + Buffer.add_string buf0 s; + g.buf <- buf0; + env0 + + | `Line (loc, opt_file, n) -> + (* printing a line directive is not strictly needed *) + (match opt_file with + None -> + maybe_print_location g (fst loc); + bprintf g.buf "\n# %i\n" n + | Some file -> + bprintf g.buf "\n# %i %S\n" n file + ); + (* printing the location next time is needed because it just changed *) + g.require_location := true; + env0 + + | `Current_line loc -> + maybe_print_location g (fst loc); + g.require_location := true; + let pos, _ = g.call_loc in + bprintf g.buf " %i " pos.Lexing.pos_lnum; + env0 + + | `Current_file loc -> + maybe_print_location g (fst loc); + g.require_location := true; + let pos, _ = g.call_loc in + bprintf g.buf " %S " pos.Lexing.pos_fname; + env0 + + + + +let include_inputs + ~extensions + ~preserve_quotations + ~incdirs + ~show_exact_locations + ~show_no_locations + buf env l = + + let enable_loc = not show_no_locations in + List.fold_left ( + fun env (dir, file, open_, close) -> + let l = parse ~preserve_quotations file (open_ ()) in + close (); + let g = { + call_loc = dummy_loc; + buf = buf; + included = S.empty; + require_location = ref true; + show_exact_locations = show_exact_locations; + enable_loc = ref enable_loc; + g_preserve_quotations = preserve_quotations; + incdirs = incdirs; + current_directory = dir; + extensions = extensions; + } + in + expand_list ~top:true { g with included = S.add file g.included } env l + ) env l diff --git a/unikernel/duniverse/cppo/src/cppo_eval.mli b/unikernel/duniverse/cppo/src/cppo_eval.mli new file mode 100644 index 00000000..077a20de --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_eval.mli @@ -0,0 +1,20 @@ +(** The type signatures in this module are not yet for public consumption. + + Please don't rely on them in any way.*) + +module S : Set.S with type elt = string +module M : Map.S with type key = string + +type env + +val builtin_env : env + +val include_inputs + : extensions:(string, Cppo_command.command_template) Hashtbl.t + -> preserve_quotations:bool + -> incdirs:string list + -> show_exact_locations:bool + -> show_no_locations:bool + -> Buffer.t + -> env + -> (string * string * (unit -> Lexing.lexbuf) * (unit -> unit)) list -> env diff --git a/unikernel/duniverse/cppo/src/cppo_lexer.mll b/unikernel/duniverse/cppo/src/cppo_lexer.mll new file mode 100644 index 00000000..2fa9aa98 --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_lexer.mll @@ -0,0 +1,851 @@ +{ +open Printf +open Lexing + +open Cppo_types +open Cppo_parser + +let pos1 lexbuf = lexbuf.lex_start_p +let pos2 lexbuf = lexbuf.lex_curr_p +let loc lexbuf = (pos1 lexbuf, pos2 lexbuf) + +let lexer_error lexbuf descr = + error (loc lexbuf) descr + +let new_file lb name = + lb.lex_curr_p <- { lb.lex_curr_p with pos_fname = name } + +let lex_new_lines lb = + let n = ref 0 in + let s = lb.lex_buffer in + for i = lb.lex_start_pos to lb.lex_curr_pos do + if Bytes.get s i = '\n' then + incr n + done; + let p = lb.lex_curr_p in + lb.lex_curr_p <- + { p with + pos_lnum = p.pos_lnum + !n; + pos_bol = p.pos_cnum + } + +let count_new_lines lb n = + let p = lb.lex_curr_p in + lb.lex_curr_p <- + { p with + pos_lnum = p.pos_lnum + n; + pos_bol = p.pos_cnum + } + +(* must start a new line *) +let update_pos lb p added_chars added_breaks = + let cnum = p.pos_cnum + added_chars in + lb.lex_curr_p <- + { pos_fname = p.pos_fname; + pos_lnum = p.pos_lnum + added_breaks; + pos_bol = cnum; + pos_cnum = cnum } + +let set_lnum lb opt_file lnum = + let p = lb.lex_curr_p in + let cnum = p.pos_cnum in + let fname = + match opt_file with + None -> p.pos_fname + | Some file -> file + in + lb.lex_curr_p <- + { pos_fname = fname; + pos_bol = cnum; + pos_cnum = cnum; + pos_lnum = lnum } + +let shift lb n = + let p = lb.lex_curr_p in + lb.lex_curr_p <- { p with pos_cnum = p.pos_cnum + n } + +let read_hexdigit c = + match c with + '0'..'9' -> Char.code c - 48 + | 'A'..'F' -> Char.code c - 55 + | 'a'..'z' -> Char.code c - 87 + | _ -> invalid_arg "read_hexdigit" + +let read_hex2 c1 c2 = + Char.chr (read_hexdigit c1 * 16 + read_hexdigit c2) + +type env = { + preserve_quotations : bool; + mutable lexer : [ `Ocaml | `Test ]; + mutable line_start : bool; + mutable in_directive : bool; (* true while processing a directive, until the + final newline *) + buf : Buffer.t; + mutable token_start : Lexing.position; + lexbuf : Lexing.lexbuf; +} + +let new_line env = + env.line_start <- true; + count_new_lines env.lexbuf 1 + +let clear env = Buffer.clear env.buf + +let add env s = + env.line_start <- false; + Buffer.add_string env.buf s + +let add_char env c = + env.line_start <- false; + Buffer.add_char env.buf c + +let get env = Buffer.contents env.buf + +let long_loc e = (e.token_start, pos2 e.lexbuf) + +let cppo_directives = [ + "def"; + "define"; + "elif"; + "else"; + "enddef"; + "endif"; + "error"; + "if"; + "ifdef"; + "ifndef"; + "include"; + "undef"; + "warning"; +] + +let is_reserved_directive = + let tbl = Hashtbl.create 20 in + List.iter (fun s -> Hashtbl.add tbl s ()) cppo_directives; + fun s -> Hashtbl.mem tbl s + +let assert_ocaml_lexer e lexbuf = + match e.lexer with + | `Test -> + lexer_error lexbuf "Syntax error in boolean expression" + | `Ocaml -> + () + +} + +(* standard character classes used for macro identifiers *) +let upper = ['A'-'Z'] +let lower = ['a'-'z'] +let digit = ['0'-'9'] + +let identchar = upper | lower | digit | [ '_' '\'' ] + + +(* iso-8859-1 upper and lower characters used for ocaml identifiers *) +let oc_upper = ['A'-'Z' '\192'-'\214' '\216'-'\222'] +let oc_lower = ['a'-'z' '\223'-'\246' '\248'-'\255'] +let oc_identchar = oc_upper | oc_lower | digit | ['_' '\''] + +(* + Identifiers: ident is used for macro names and is a subset of oc_ident +*) +let ident = (lower | '_' identchar | upper) identchar* +let oc_ident = (oc_lower | '_' oc_identchar | oc_upper) oc_identchar* + + + +let hex = ['0'-'9' 'a'-'f' 'A'-'F'] +let oct = ['0'-'7'] +let bin = ['0'-'1'] + +let operator_char = + [ '!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +let infix_symbol = + ['=' '<' '>' '@' '^' '|' '&' '+' '-' '*' '/' '$' '%'] operator_char* +let prefix_symbol = ['!' '?' '~'] operator_char* + +let blank = [ ' ' '\t' ] +let space = [ ' ' '\t' '\r' '\n' ] + +let line = ( [^'\n'] | '\\' ('\r'? '\n') )* ('\n' | eof) + +let dblank0 = (blank | '\\' '\r'? '\n')* +let dblank1 = blank (blank | '\\' '\r'? '\n')* + +(* We use two different lexers: [ocaml_token] is used for ordinary + OCaml tokens; [test_token] is used inside the Boolean expression + that follows an #if directive. The field [e.lexer] indicates which + lexer is currently active. *) + +rule line e = parse + + (* A directive begins with a # symbol, which must appear at the beginning + of a line. *) + | blank* "#" as s + { + assert_ocaml_lexer e lexbuf; + clear e; + (* We systematically set [e.token_start], so that [long_loc e] will + correctly produce the location of the last token. *) + e.token_start <- pos1 lexbuf; + if e.line_start then ( + e.in_directive <- true; + add e s; + e.line_start <- false; + directive e lexbuf + ) + else + TEXT (loc lexbuf, false, s) + } + + | "" + { clear e; + (* We systematically set [e.token_start], so that [long_loc e] will + correctly produce the location of the last token. *) + e.token_start <- pos1 lexbuf; + match e.lexer with + | `Ocaml -> ocaml_token e lexbuf + | `Test -> test_token e lexbuf } + +and directive e = parse + + (* If #define is immediately followed with an opening parenthesis + (without any blank space) then this is interpreted as a parameterized + macro definition. The formal parameters are parsed by the lexer. *) + | blank* "define" dblank1 (ident as id) "(" + { let xs = formals1 lexbuf in + assert (xs <> []); + DEF (long_loc e, id, xs) } + + (* If #define is not followed with an opening parenthesis then this + is interpreted as an ordinary (non-parameterized) macro definition. *) + | blank* "define" dblank1 (ident as id) + { let xs = [] in + DEF (long_loc e, id, xs) } + + (* #def is identical to #define, except it does not set [e.in_directive], + so backslashes and newlines do not receive special treatment. The + end of the macro definition must be explicitly signaled by #enddef. *) + | blank* "def" dblank1 (ident as id) "(" + { e.in_directive <- false; + let xs = formals1 lexbuf in + assert (xs <> []); + DEF (long_loc e, id, xs) } + | blank* "def" dblank1 (ident as id) + { e.in_directive <- false; + let xs = [] in + DEF (long_loc e, id, xs) } + + (* #enddef ends a definition, which (we expect) has been opened by #def. + Because we use the same pair of tokens, namely [DEF] and [ENDEF], for + both kinds of definitions (#define and #def), it is in fact possible to + begin a definition with #define and end it with #enddef. We do not + document this fact, and users should not rely on it. *) + | blank* "enddef" + { blank_until_eol e lexbuf; + ENDEF (long_loc e) } + + | blank* "undef" dblank1 (ident as id) + { blank_until_eol e lexbuf; + UNDEF (long_loc e, id) } + + (* #scope opens a block, which we expect will be ended by #endscope. + It does not set [e.in_directive], so backslashes and newlines do + not receive special treatment. *) + | blank* "scope" dblank0 + { e.in_directive <- false; + SCOPE (long_loc e) } + + (* #endscope ends a block. *) + | blank* "endscope" + { blank_until_eol e lexbuf; + ENDSCOPE (long_loc e) } + + | blank* "if" dblank1 { e.lexer <- `Test; + IF (long_loc e) } + | blank* "elif" dblank1 { e.lexer <- `Test; + ELIF (long_loc e) } + + | blank* "ifdef" dblank1 (ident as id) + { blank_until_eol e lexbuf; + IFDEF (long_loc e, `Defined id) } + + | blank* "ifndef" dblank1 (ident as id) + { blank_until_eol e lexbuf; + IFDEF (long_loc e, `Not (`Defined id)) } + + | blank* "ext" dblank1 (ident as id) + { blank_until_eol e lexbuf; + clear e; + let s = read_ext e lexbuf in + EXT (long_loc e, id, s) } + + | blank* "define" dblank1 oc_ident + | blank* "undef" dblank1 oc_ident + | blank* "ifdef" dblank1 oc_ident + | blank* "ifndef" dblank1 oc_ident + | blank* "ext" dblank1 oc_ident + { error (loc lexbuf) + "Identifiers containing non-ASCII characters \ + may not be used as macro identifiers" } + + | blank* "else" + { blank_until_eol e lexbuf; + ELSE (long_loc e) } + + | blank* "endif" + { blank_until_eol e lexbuf; + ENDIF (long_loc e) } + + | blank* "include" dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + INCLUDE (long_loc e, get e) } + + | blank* "error" dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + ERROR (long_loc e, get e) } + + | blank* "warning" dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + WARNING (long_loc e, get e) } + + | blank* (['0'-'9']+ as lnum) dblank0 '\r'? '\n' + { e.in_directive <- false; + new_line e; + let here = long_loc e in + let fname = None in + let lnum = int_of_string lnum in + (* Apply line directive regardless of possible #if condition. *) + set_lnum lexbuf fname lnum; + LINE (here, None, lnum) } + + | blank* (['0'-'9']+ as lnum) dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + let here = long_loc e in + let fname = Some (get e) in + let lnum = int_of_string lnum in + (* Apply line directive regardless of possible #if condition. *) + set_lnum lexbuf fname lnum; + LINE (here, fname, lnum) } + + | blank* + { e.in_directive <- false; + add e (lexeme lexbuf); + TEXT (long_loc e, true, get e) } + + | blank* (['a'-'z']+ as s) + { if is_reserved_directive s then + error (loc lexbuf) "cppo directive with missing or wrong arguments"; + e.in_directive <- false; + add e (lexeme lexbuf); + TEXT (long_loc e, false, get e) } + + +and blank_until_eol e = parse + blank* eof + | blank* '\r'? '\n' { new_line e; + e.in_directive <- false } + | "" { lexer_error lexbuf "syntax error in directive" } + +and read_ext e = parse + blank* "#" blank* "endext" blank* ('\r'? '\n' | eof) + { let s = get e in + clear e; + new_line e; + e.in_directive <- false; + s } + + | (blank* as a) "\\" ("#" blank* "endext" blank* '\r'? '\n' as b) + { add e a; + add e b; + new_line e; + read_ext e lexbuf } + + | [^'\n']* '\n' as x + { add e x; + new_line e; + read_ext e lexbuf } + + | eof + { lexer_error lexbuf "End of file within #ext ... #endext" } + +and ocaml_token e = parse + "__LINE__" + { e.line_start <- false; + CURRENT_LINE (loc lexbuf) } + + | "__FILE__" + { e.line_start <- false; + CURRENT_FILE (loc lexbuf) } + + | ident as s + { e.line_start <- false; + IDENT (loc lexbuf, s) } + + | oc_ident as s + { e.line_start <- false; + TEXT (loc lexbuf, false, s) } + + | ident as s "(" + { e.line_start <- false; + FUNIDENT (loc lexbuf, s) } + + | "'\n'" + | "'\r\n'" + { new_line e; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + | "(" { e.line_start <- false; OP_PAREN (loc lexbuf) } + | ")" { e.line_start <- false; CL_PAREN (loc lexbuf) } + | "," { e.line_start <- false; COMMA (loc lexbuf) } + + | "\\)" { e.line_start <- false; TEXT (loc lexbuf, false, " )") } + | "\\," { e.line_start <- false; TEXT (loc lexbuf, false, " ,") } + | "\\(" { e.line_start <- false; TEXT (loc lexbuf, false, " (") } + | "\\#" { e.line_start <- false; TEXT (loc lexbuf, false, " #") } + + | '`' + | "!=" | "#" | "&" | "&&" | "(" | "*" | "+" | "-" + | "-." | "->" | "." | ".. :" | "::" | ":=" | ":>" | ";" | ";;" | "<" + | "<-" | "=" | ">" | ">]" | ">}" | "?" | "??" | "[" | "[<" | "[>" | "[|" + | "]" | "_" | "`" | "{" | "{<" | "|" | "|]" | "}" | "~" + | ">>" + | prefix_symbol + | infix_symbol + | "'" ([^ '\'' '\\'] + | '\\' (_ | digit digit digit | 'x' hex hex)) "'" + + { e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + | blank+ + { TEXT (loc lexbuf, true, lexeme lexbuf) } + + | '\\' ('\r'? '\n' as nl) + + { + new_line e; + if e.in_directive then + TEXT (loc lexbuf, true, nl) + else + TEXT (loc lexbuf, false, lexeme lexbuf) + } + + | '\r'? '\n' + { + new_line e; + if e.in_directive then ( + e.in_directive <- false; + ENDEF (loc lexbuf) + ) + else + TEXT (loc lexbuf, true, lexeme lexbuf) + } + + | "(*" + { clear e; + add e "(*"; + e.token_start <- pos1 lexbuf; + comment (loc lexbuf) e 1 lexbuf } + + | '"' + { clear e; + add e "\""; + e.token_start <- pos1 lexbuf; + string e lexbuf; + e.line_start <- false; + TEXT (long_loc e, false, get e) } + + | "<:" + | "<<" + { if e.preserve_quotations then ( + clear e; + add e (lexeme lexbuf); + e.token_start <- pos1 lexbuf; + quotation e lexbuf; + e.line_start <- false; + TEXT (long_loc e, false, get e) + ) + else ( + e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) + ) + } + + + | '-'? ( digit (digit | '_')* + | ("0x"| "0X") hex (hex | '_')* + | ("0o"| "0O") oct (oct | '_')* + | ("0b"| "0B") bin (bin | '_')* ) + + | '-'? digit (digit | '_')* ('.' (digit | '_')* )? + (['e' 'E'] ['+' '-']? digit (digit | '_')* )? + { e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + | blank+ + { TEXT (loc lexbuf, true, lexeme lexbuf) } + + | _ + { e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + (* At the end of the file, the lexer normally produces EOF. However, + if we are currently inside a definition (opened by #define) then + the lexer produces ENDEF followed by EOF. *) + | eof + { if e.in_directive then (e.in_directive <- false; ENDEF (loc lexbuf)) + else EOF } + + +and comment startloc e depth = parse + "(*" + { add e "(*"; + comment startloc e (depth + 1) lexbuf } + + | "*)" + { let depth = depth - 1 in + add e "*)"; + if depth > 0 then + comment startloc e depth lexbuf + else ( + e.line_start <- false; + TEXT (long_loc e, false, get e) + ) + } + | '"' + { add_char e '"'; + string e lexbuf; + comment startloc e depth lexbuf } + + | "'\n'" + | "'\r\n'" + { new_line e; + add e (lexeme lexbuf); + comment startloc e depth lexbuf } + + | "'" ([^ '\'' '\\'] + | '\\' (_ | digit digit digit | 'x' hex hex)) "'" + { add e (lexeme lexbuf); + comment startloc e depth lexbuf } + + | '\r'? '\n' + { + new_line e; + add e (lexeme lexbuf); + comment startloc e depth lexbuf + } + + | [^'(' '*' '"' '\'' '\r' '\n']+ + { + add e (lexeme lexbuf); + comment startloc e depth lexbuf + } + + | _ + { add e (lexeme lexbuf); + comment startloc e depth lexbuf } + + | eof + { error startloc "Unterminated comment reaching the end of file" } + + +and string e = parse + '"' + { add_char e '"' } + + | "\\\\" + | '\\' '"' + { add e (lexeme lexbuf); + string e lexbuf } + + | '\\' '\r'? '\n' + { + add e (lexeme lexbuf); + new_line e; + string e lexbuf + } + + | '\r'? '\n' + { + add e (lexeme lexbuf); + new_line e; + string e lexbuf + } + + | _ as c + { add_char e c; + string e lexbuf } + + | eof + { } + + +and eval_string e = parse + '"' + { } + + | '\\' (['\'' '\"' '\\'] as c) + { add_char e c; + eval_string e lexbuf } + + | '\\' '\r'? '\n' + { assert e.in_directive; + eval_string e lexbuf } + + | '\r'? '\n' + { assert e.in_directive; + lexer_error lexbuf "Unterminated string literal" } + + | '\\' (digit digit digit as s) + { add_char e (Char.chr (int_of_string s)); + eval_string e lexbuf } + + | '\\' 'x' (hex as c1) (hex as c2) + { add_char e (read_hex2 c1 c2); + eval_string e lexbuf } + + | '\\' 'b' + { add_char e '\b'; + eval_string e lexbuf } + + | '\\' 'n' + { add_char e '\n'; + eval_string e lexbuf } + + | '\\' 'r' + { add_char e '\r'; + eval_string e lexbuf } + + | '\\' 't' + { add_char e '\t'; + eval_string e lexbuf } + + | [^ '\"' '\\']+ + { add e (lexeme lexbuf); + eval_string e lexbuf } + + | eof + { lexer_error lexbuf "Unterminated string literal" } + + +and quotation e = parse + ">>" + { add e ">>" } + + | "\\>>" + { add e "\\>>"; + quotation e lexbuf } + + | '\\' '\r'? '\n' + { + if e.in_directive then ( + new_line e; + quotation e lexbuf + ) + else ( + add e (lexeme lexbuf); + new_line e; + quotation e lexbuf + ) + } + + | '\r'? '\n' + { + if e.in_directive then + lexer_error lexbuf "Unterminated quotation" + else ( + add e (lexeme lexbuf); + new_line e; + quotation e lexbuf + ) + } + + | [^'>' '\\' '\r' '\n']+ + { add e (lexeme lexbuf); + quotation e lexbuf } + + | eof + { lexer_error lexbuf "Unterminated quotation" } + +and test_token e = parse + "true" { TRUE } + | "false" { FALSE } + | "defined" { DEFINED } + | "(" { OP_PAREN (loc lexbuf) } + | ")" { CL_PAREN (loc lexbuf) } + | "&&" { AND } + | "||" { OR } + | "not" { NOT } + | "=" { EQ } + | "<" { LT } + | ">" { GT } + | "<>" { NE } + | "<=" { LE } + | ">=" { GE } + + | '-'? ( digit (digit | '_')* + | ("0x"| "0X") hex (hex | '_')* + | ("0o"| "0O") oct (oct | '_')* + | ("0b"| "0B") bin (bin | '_')* ) + { let s = Lexing.lexeme lexbuf in + try INT (Int64.of_string s) + with _ -> + error (loc lexbuf) + (sprintf "Integer constant %s is out the valid range for int64" s) + } + + | "+" { PLUS } + | "-" { MINUS } + | "*" { STAR } + | "/" { SLASH (loc lexbuf) } + | "mod" { MOD (loc lexbuf) } + | "lsl" { LSL } + | "lsr" { LSR } + | "asr" { ASR } + | "land" { LAND } + | "lor" { LOR } + | "lxor" { LXOR } + | "lnot" { LNOT } + + | "," { COMMA (loc lexbuf) } + + | ident + { IDENT (loc lexbuf, lexeme lexbuf) } + + | blank+ { test_token e lexbuf } + | '\\' '\r'? '\n' { new_line e; + test_token e lexbuf } + | '\r'? '\n' + | eof { assert e.in_directive; + e.in_directive <- false; + new_line e; + e.lexer <- `Ocaml; + ENDTEST (loc lexbuf) } + | _ { error (loc lexbuf) + (sprintf "Invalid token %s" (Lexing.lexeme lexbuf)) } + + +(* Parse just an int or a tuple of ints *) +and int_tuple = parse + | space* (([^'(']#space)+ as s) space* eof + { [Int64.of_string s] } + + | space* "(" { int_tuple_content lexbuf } + + | eof | _ { failwith "Not an int nor a tuple" } + +and int_tuple_content = parse + | space* (([^',' ')']#space)+ as s) space* "," + { let x = Int64.of_string s in + x :: int_tuple_content lexbuf } + + | space* (([^',' ')']#space)+ as s) space* ")" space* eof + { [Int64.of_string s] } + +(* -------------------------------------------------------------------------- *) + +(* Lists of formal macro parameters. *) + +(* [formals1] recognizes a nonempty comma-separated list of formal macro + parameters, ended with a closing parenthesis. *) + +and formals1 = parse + | blank+ + { formals1 lexbuf } + | ")" + { lexer_error lexbuf "A macro must have at least one formal parameter" } + | "" + { let x = formal lexbuf in + formals0 [x] lexbuf } + +(* [formals0 xs] recognizes a possibly empty list of comma-preceded formal + macro parameters, ended with a closing parenthesis. + [xs] is the accumulator. *) + +and formals0 xs = parse + | blank+ + { formals0 xs lexbuf } + | ")" + { List.rev xs } + | "," + { let x = formal lexbuf in + formals0 (x :: xs) lexbuf } + | _ + | eof + { lexer_error lexbuf "Invalid formal parameter list: expected ',' or ')'" } + +(* [formal] recognizes one formal macro parameter. It is either an identifier + [x] or an identifier annotated with a shape [x : sh]. *) + +and formal = parse + | blank+ + { formal lexbuf } + | (ident as x) blank* ":" + { (x, shape lexbuf) } + | ident as x + { (x, base) } + | _ + | eof + { lexer_error lexbuf "Invalid formal parameter: expected an identifier" } + +(* [shape] recognizes a shape. *) + +and shape = parse + | blank+ + { shape lexbuf } + | "." + (* The base shape can be written [] but we also allow . + as a more readable alternative. *) + { base } + | "[" + { Shape (shapes [] lexbuf) } + | _ + | eof + { lexer_error lexbuf "Invalid shape: expected '.' or '[' or ']'" } + (* A closing square bracket is valid if an opening square bracket + has been entered. We could keep track of this via an additional + parameter, but that seems overkill. *) + +(* [shapes shs] recognizes a possibly empty list of shapes, ended with + a closing square bracket. There is no separator between shapes. + [shs] is the accumulator. *) + +and shapes shs = parse + | blank+ + { shapes shs lexbuf } + | "]" + { List.rev shs } + | "" + { let sh = shape lexbuf in + shapes (sh :: shs) lexbuf } + +(* -------------------------------------------------------------------------- *) + +(* Initialization. *) + +{ + let init ~preserve_quotations file lexbuf = + new_file lexbuf file; + { + preserve_quotations = preserve_quotations; + lexer = `Ocaml; + line_start = true; + in_directive = false; + buf = Buffer.create 200; + token_start = Lexing.dummy_pos; + lexbuf = lexbuf; + } + + let int_tuple_of_string s = + try Some (int_tuple (Lexing.from_string s)) + with _ -> None +} diff --git a/unikernel/duniverse/cppo/src/cppo_main.ml b/unikernel/duniverse/cppo/src/cppo_main.ml new file mode 100644 index 00000000..98e9efba --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_main.ml @@ -0,0 +1,230 @@ +open Printf + +let add_extension tbl s = + let i = + try String.index s ':' + with Not_found -> + failwith "Invalid -x argument" + in + let id = String.sub s 0 i in + let raw_tpl = String.sub s (i+1) (String.length s - i - 1) in + let cmd_tpl = Cppo_command.parse raw_tpl in + if Hashtbl.mem tbl id then + failwith ("Multiple definitions for extension " ^ id) + else + Hashtbl.add tbl id cmd_tpl + +let semver_re = Str.regexp "\ +\\([0-9]+\\)\ +\\.\\([0-9]+\\)\ +\\(\\.\\([0-9]+\\)\\)?\ +\\([~-]\\([^+]*\\)\\)?\ +\\(\\+\\(.*\\)\\)?\ +\r?$" + +let parse_semver s = + if not (Str.string_match semver_re s 0) then + None + else + let major = Str.matched_group 1 s in + let minor = Str.matched_group 2 s in + let patch = try (Str.matched_group 4 s) with Not_found -> "0" in + let prerelease = try Some (Str.matched_group 6 s) with Not_found -> None in + let build = try Some (Str.matched_group 8 s) with Not_found -> None in + Some (major, minor, patch, prerelease, build) + +let define var s = + [sprintf "#define %s %s\n" var s] + +let opt_define var o = + match o with + | None -> [] + | Some s -> define var s + +let parse_version_spec s = + let error () = + failwith (sprintf "Invalid version specification: %S" s) + in + let prefix, version_full = + try + let len = String.index s ':' in + String.sub s 0 len, String.sub s (len+1) (String.length s - (len+1)) + with Not_found -> + error () + in + match parse_semver version_full with + | None -> + error () + | Some (major, minor, patch, opt_prerelease, opt_build) -> + let version = sprintf "(%s, %s, %s)" major minor patch in + let version_string = sprintf "%s.%s.%s" major minor patch in + List.flatten [ + define (prefix ^ "_MAJOR") major; + define (prefix ^ "_MINOR") minor; + define (prefix ^ "_PATCH") patch; + opt_define (prefix ^ "_PRERELEASE") opt_prerelease; + opt_define (prefix ^ "_BUILD") opt_build; + define (prefix ^ "_VERSION") version; + define (prefix ^ "_VERSION_STRING") version_string; + define (prefix ^ "_VERSION_FULL") s; + ] + +let main () = + let extensions = Hashtbl.create 10 in + let files = ref [] in + let header = ref [] in + let incdirs = ref [] in + let out_file = ref None in + let preserve_quotations = ref false in + let show_exact_locations = ref false in + let show_no_locations = ref false in + let options = [ + "-D", Arg.String (fun s -> header := ("#define " ^ s ^ "\n") :: !header), + "DEF + Equivalent of interpreting '#define DEF' before processing the + input, e.g. `cppo -D 'VERSION \"1.2.3\"'` (no equal sign)"; + + "-U", Arg.String (fun s -> header := ("#undef " ^ s ^ "\n") :: !header), + "IDENT + Equivalent of interpreting '#undef IDENT' before processing the + input"; + + "-I", Arg.String (fun s -> incdirs := s :: !incdirs), + "DIR + Add directory DIR to the search path for included files"; + + "-V", Arg.String (fun s -> header := parse_version_spec s @ !header), + "VAR:MAJOR.MINOR.PATCH-OPTPRERELEASE+OPTBUILD + Define the following variables extracted from a version string + (following the Semantic Versioning syntax http://semver.org/): + + VAR_MAJOR must be a non-negative int + VAR_MINOR must be a non-negative int + VAR_PATCH must be a non-negative int + VAR_PRERELEASE if the OPTPRERELEASE part exists + VAR_BUILD if the OPTBUILD part exists + VAR_VERSION is the tuple (MAJOR, MINOR, PATCH) + VAR_VERSION_STRING is the string MAJOR.MINOR.PATCH + VAR_VERSION_FULL is the original string + + Example: cppo -V OCAML:4.02.1 + + Note that cppo recognises both '-' and '~' preceding the pre-release + meaning -V OCAML:4.11.0+alpha1 sets OCAML_BUILD to alpha1 but + -V OCAML:4.12.0~alpha1 sets OCAML_PRERELEASE to alpha1. +"; + + "-o", Arg.String (fun s -> out_file := Some s), + "FILE + Output file"; + + "-q", Arg.Set preserve_quotations, + " + Identify and preserve camlp4 quotations"; + + "-s", Arg.Set show_exact_locations, + " + Output line directives pointing to the exact source location of + each token, including those coming from the body of macro + definitions. This behavior is off by default."; + + "-n", Arg.Set show_no_locations, + " + Do not output any line directive other than those found in the + input (overrides -s)."; + + "-version", Arg.Unit (fun () -> + print_endline Cppo_version.cppo_version; + exit 0), + " + Print the version of the program and exit."; + + "-x", Arg.String (fun s -> add_extension extensions s), + "NAME:CMD_TEMPLATE + Define a custom preprocessor target section starting with: + #ext \"NAME\" + and ending with: + #endext + + NAME must be a lowercase identifier of the form [a-z][A-Za-z0-9_]* + + CMD_TEMPLATE is a command template supporting the following + special sequences: + %F file name (unescaped; beware of potential scripting attacks) + %B number of the first line + %E number of the last line + %% a single percent sign + + Filename, first line number and last line number are also + available from the following environment variables: + CPPO_FILE, CPPO_FIRST_LINE, CPPO_LAST_LINE. + + The command produced is expected to read the data lines from stdin + and to write its output to stdout." + ] + in + let msg = sprintf "\ +Usage: %s [OPTIONS] [FILE1 [FILE2 ...]] +Options:" Sys.argv.(0) in + let add_file s = files := s :: !files in + Arg.parse options add_file msg; + + let inputs = + let preliminaries = + match List.rev !header with + [] -> [] + | l -> + let s = String.concat "" l in + [ Sys.getcwd (), + "", + (fun () -> Lexing.from_string s), + (fun () -> ()) ] + in + let main = + match List.rev !files with + [] -> [ Sys.getcwd (), + "", + (fun () -> Lexing.from_channel stdin), + (fun () -> ()) ] + | l -> + List.map ( + fun file -> + let ic = lazy (open_in file) in + Filename.dirname file, + file, + (fun () -> Lexing.from_channel (Lazy.force ic)), + (fun () -> close_in (Lazy.force ic)) + ) l + in + preliminaries @ main + in + + let env = Cppo_eval.builtin_env in + let buf = Buffer.create 10_000 in + let _env = + Cppo_eval.include_inputs + ~extensions + ~preserve_quotations: !preserve_quotations + ~incdirs: (List.rev !incdirs) + ~show_exact_locations: !show_exact_locations + ~show_no_locations: !show_no_locations + buf env inputs + in + match !out_file with + None -> + print_string (Buffer.contents buf); + flush stdout + | Some file -> + let oc = open_out file in + output_string oc (Buffer.contents buf); + close_out oc + +let () = + if not !Sys.interactive then + try + main () + with + | Cppo_types.Cppo_error msg + | Failure msg -> + eprintf "Error: %s\n%!" msg; + exit 1 diff --git a/unikernel/duniverse/cppo/src/cppo_parser.mly b/unikernel/duniverse/cppo/src/cppo_parser.mly new file mode 100644 index 00000000..6ca56ea5 --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_parser.mly @@ -0,0 +1,275 @@ +%{ + open Cppo_types +%} + +/* Directives */ +%token < Cppo_types.loc * string > UNDEF INCLUDE WARNING ERROR +%token < Cppo_types.loc * string * (string * Cppo_types.shape) list > DEF +%token < Cppo_types.loc * string option * int > LINE +%token < Cppo_types.loc * Cppo_types.bool_expr > IFDEF +%token < Cppo_types.loc * string * string > EXT +%token < Cppo_types.loc > ENDEF SCOPE ENDSCOPE IF ELIF ELSE ENDIF ENDTEST + +/* Boolean expressions in #if/#elif directives */ +%token TRUE FALSE DEFINED NOT AND OR EQ LT GT NE LE GE + PLUS MINUS STAR LNOT LSL LSR ASR LAND LOR LXOR +%token < Cppo_types.loc > OP_PAREN SLASH MOD +%token < int64 > INT + + +/* Regular program and shared terminals */ +%token < Cppo_types.loc > CL_PAREN COMMA CURRENT_LINE CURRENT_FILE +%token < Cppo_types.loc * string > IDENT FUNIDENT +%token < Cppo_types.loc * bool * string > TEXT /* bool means "is space" */ +%token EOF + +/* Priorities for boolean expressions */ +%left OR +%left AND + +/* Priorities for arithmetics */ +%left PLUS MINUS +%left STAR SLASH +%left MOD LSL LSR ASR LAND LOR LXOR +%nonassoc NOT +%nonassoc LNOT +%nonassoc UMINUS + +%start main +%type < Cppo_types.node list > main +%% + +main: +| unode main { $1 :: $2 } +| EOF { [] } +; + +unode_list0: +| unode unode_list0 { $1 :: $2 } +| { [] } +; + +body: +| unode_list0 + { let pos1 = Parsing.symbol_start_pos() + and pos2 = Parsing.symbol_end_pos() in + let loc = (pos1, pos2) in + (loc, $1) } + +pnode_list0: +| pnode pnode_list0 { $1 :: $2 } +| { [] } +; + +actual: +| pnode_list0 { let pos1 = Parsing.symbol_start_pos() + and pos2 = Parsing.symbol_end_pos() in + let loc = (pos1, pos2) in + `Seq (loc, $1) } +; + +/* node in which opening and closing parentheses don't need to match */ +unode: +| node { $1 } +| OP_PAREN { `Text ($1, false, "(") } +| CL_PAREN { `Text ($1, false, ")") } +| COMMA { `Text ($1, false, ",") } +; + +/* node in which parentheses must be closed */ +pnode: +| node { $1 } +| OP_PAREN pnode_or_comma_list0 CL_PAREN + { let nodes = + `Text ($1, false, "(") :: + $2 @ + `Text ($3, false, ")") :: + [] + in + let pos1, _ = $1 + and _, pos2 = $3 in + let loc = (pos1, pos2) in + `Seq (loc, nodes) } +; + +/* node without parentheses handling (need to use unode or pnode) */ +node: +| TEXT { `Text $1 } + +| IDENT { let loc, name = $1 in + `Ident (loc, name, []) } + +| FUNIDENT actuals1 CL_PAREN + { + (* macro application that receives at least one argument, + possibly empty. We cannot distinguish syntactically between + zero argument and one empty argument. + *) + let (pos1, _), name = $1 in + let _, pos2 = $3 in + assert ($2 <> []); + `Ident ((pos1, pos2), name, $2) } +| FUNIDENT error + { error (fst $1) "Invalid macro application" } + +| CURRENT_LINE { `Current_line $1 } +| CURRENT_FILE { `Current_file $1 } + +| DEF body ENDEF + { let (pos1, _), name, formals = $1 in + let loc, body = $2 in + (* Additional spacing is needed for cases like 'foo()bar' + where 'foo()' expands into 'abc', giving 'abcbar' + instead of 'abc bar'; + Also needed for '+foo()+' expanding into '++' instead + of '+ +'. *) + let safe_space = `Text ($3, true, " ") in + let body = body @ [safe_space] in + let body = `Seq (loc, body) in + let _, pos2 = $3 in + `Def ((pos1, pos2), name, formals, body) } + +| DEF body EOF + { let loc, _name, _formals = $1 in + error loc "This #def is never closed: perhaps #enddef is missing" } + /* We include this rule in order to produce a good error message + when a #def has no matching #enddef. */ + +| SCOPE body ENDSCOPE + { let body = `Seq $2 in + `Scope body } + +| SCOPE body EOF + { let loc = $1 in + error loc "This #scope is never closed: perhaps #endscope is missing" } + /* We include this rule in order to produce a good error message + when a #scope has no matching #endscope. */ + +| UNDEF + { `Undef $1 } +| WARNING + { `Warning $1 } +| ERROR + { `Error $1 } + +| INCLUDE + { `Include $1 } + +| EXT + { `Ext $1 } + +| IF test unode_list0 elif_list ENDIF + { let pos1, _ = $1 in + let _, pos2 = $5 in + let loc = (pos1, pos2) in + let test = $2 in + let if_true = $3 in + let if_false = + List.fold_right ( + fun (loc, test, if_true) if_false -> + [`Cond (loc, test, if_true, if_false) ] + ) $4 [] + in + `Cond (loc, test, if_true, if_false) + } + +| IF test unode_list0 elif_list error + { (* BUG? ocamlyacc fails to reduce that rule but not menhir *) + error $1 "missing #endif" } + +| IFDEF unode_list0 elif_list ENDIF + { let (pos1, _), test = $1 in + let _, pos2 = $4 in + let loc = (pos1, pos2) in + let if_true = $2 in + let if_false = + List.fold_right ( + fun (loc, test, if_true) if_false -> + [`Cond (loc, test, if_true, if_false) ] + ) $3 [] + in + `Cond (loc, test, if_true, if_false) + } + +| IFDEF unode_list0 elif_list error + { error (fst $1) "missing #endif" } + +| LINE { `Line $1 } +; + + +elif_list: + ELIF test unode_list0 elif_list + { let pos1, _ = $1 in + let pos2 = Parsing.rhs_end_pos 4 in + ((pos1, pos2), $2, $3) :: $4 } +| ELSE unode_list0 + { let pos1, _ = $1 in + let pos2 = Parsing.rhs_end_pos 2 in + [ ((pos1, pos2), `True, $2) ] } +| { [] } +; + +actuals1: + actual COMMA actuals1 { $1 :: $3 } +| actual { [ $1 ] } +; + +pnode_or_comma_list0: +| pnode pnode_or_comma_list0 { $1 :: $2 } +| COMMA pnode_or_comma_list0 { `Text ($1, false, ",") :: $2 } +| { [] } +; + +test: + bexpr ENDTEST { $1 } +; + +/* Boolean expressions after #if or #elif */ +bexpr: + | TRUE { `True } + | FALSE { `False } + | DEFINED IDENT { `Defined (snd $2) } + | OP_PAREN bexpr CL_PAREN { $2 } + | NOT bexpr { `Not $2 } + | bexpr AND bexpr { `And ($1, $3) } + | bexpr OR bexpr { `Or ($1, $3) } + | aexpr EQ aexpr { `Eq ($1, $3) } + | aexpr LT aexpr { `Lt ($1, $3) } + | aexpr GT aexpr { `Gt ($1, $3) } + | aexpr NE aexpr { `Not (`Eq ($1, $3)) } + | aexpr LE aexpr { `Not (`Gt ($1, $3)) } + | aexpr GE aexpr { `Not (`Lt ($1, $3)) } +; + +/* Arithmetic expressions within boolean expressions */ +aexpr: + | INT { `Int $1 } + | IDENT { `Ident $1 } + | OP_PAREN aexpr_list CL_PAREN + { match $2 with + | [x] -> x + | l -> + let pos1, _ = $1 in + let _, pos2 = $3 in + `Tuple ((pos1, pos2), l) + } + | aexpr PLUS aexpr { `Add ($1, $3) } + | aexpr MINUS aexpr { `Sub ($1, $3) } + | aexpr STAR aexpr { `Mul ($1, $3) } + | aexpr SLASH aexpr { `Div ($2, $1, $3) } + | aexpr MOD aexpr { `Mod ($2, $1, $3) } + | aexpr LSL aexpr { `Lsl ($1, $3) } + | aexpr LSR aexpr { `Lsr ($1, $3) } + | aexpr ASR aexpr { `Asr ($1, $3) } + | aexpr LAND aexpr { `Land ($1, $3) } + | aexpr LOR aexpr { `Lor ($1, $3) } + | aexpr LXOR aexpr { `Lxor ($1, $3) } + | LNOT aexpr { `Lnot $2 } + | MINUS aexpr %prec UMINUS { `Neg $2 } +; + +aexpr_list: + | aexpr COMMA aexpr_list { $1 :: $3 } + | aexpr { [$1] } +; diff --git a/unikernel/duniverse/cppo/src/cppo_types.ml b/unikernel/duniverse/cppo/src/cppo_types.ml new file mode 100644 index 00000000..271c1879 --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_types.ml @@ -0,0 +1,204 @@ +open Printf +open Lexing + +module String_set = Set.Make (String) +module String_map = Map.Make (String) + +type loc = position * position + +(* The name of a macro. *) +type macro = + string + +(* The shape of a macro. + + The abstract syntax of shapes is τ ::= [τ, ..., τ]. + That is, a macro takes a tuple of parameters, each + of which has a shape. The length of of this tuple + can be zero: this is the base case. *) +type shape = + | Shape of shape list + +(* Printing a shape. This code must be consistent with the shape + parser in [Cppo_lexer]. *) + +let rec print_shape (Shape shs) = + match shs with + | [] -> + (* As a special case, the base shape is ".". *) + "." + | _ -> + "[" ^ String.concat "" (List.map print_shape shs) ^ "]" + +(* Testing two shapes for equality. *) + +let same_shape : shape -> shape -> bool = + (=) + +(* The base shape. This is the shape of a basic macro, + which takes no parameters, and produces text. *) +let base = Shape [] + +type bool_expr = + [ `True + | `False + | `Defined of macro + | `Not of bool_expr (* not *) + | `And of (bool_expr * bool_expr) (* && *) + | `Or of (bool_expr * bool_expr) (* || *) + | `Eq of (arith_expr * arith_expr) (* = *) + | `Lt of (arith_expr * arith_expr) (* < *) + | `Gt of (arith_expr * arith_expr) (* > *) + (* syntax for additional operators: <>, <=, >= *) + ] + +and arith_expr = (* signed int64 *) + [ `Int of int64 + | `Ident of (loc * string) + (* must be bound to a valid int literal. + Expansion of macro functions is not supported. *) + + | `Tuple of (loc * arith_expr list) + (* tuple of 2 or more elements guaranteed by the syntax *) + + | `Neg of arith_expr (* - *) + | `Add of (arith_expr * arith_expr) (* + *) + | `Sub of (arith_expr * arith_expr) (* - *) + | `Mul of (arith_expr * arith_expr) (* * *) + | `Div of (loc * arith_expr * arith_expr) (* / *) + | `Mod of (loc * arith_expr * arith_expr) (* mod *) + + (* Bitwise operations on 64 bits *) + | `Lnot of arith_expr (* lnot *) + | `Lsl of (arith_expr * arith_expr) (* lsl *) + | `Lsr of (arith_expr * arith_expr) (* lsr *) + | `Asr of (arith_expr * arith_expr) (* asr *) + | `Land of (arith_expr * arith_expr) (* land *) + | `Lor of (arith_expr * arith_expr) (* lor *) + | `Lxor of (arith_expr * arith_expr) (* lxor *) + ] + +type node = + [ `Ident of (loc * string * actuals) + (* the list [actuals] is empty if and only if no parentheses + are used at this macro invocation site. *) + | `Def of (loc * macro * formals * body) + (* the list [formals] is empty if and only if no parentheses + are used at this macro definition site. *) + | `Scope of body + | `Undef of (loc * macro) + | `Include of (loc * string) + | `Ext of (loc * string * string) + | `Cond of (loc * bool_expr * node list * node list) + | `Error of (loc * string) + | `Warning of (loc * string) + | `Text of (loc * bool * string) (* bool is true for space tokens *) + | `Seq of (loc * node list) + | `Stringify of node + | `Capitalize of node + | `Concat of (node * node) + | `Line of (loc * string option * int) + | `Current_line of loc + | `Current_file of loc ] + +(* A formal macro parameter consists of an identifier (the name of this + parameter) and a shape (the shape of this parameter). In the concrete + syntax, if the shape is omitted, then the base shape is assumed. *) +and formal = + string * shape + +(* A tuple of formal macro parameters. *) +and formals = + formal list + +(* One actual macro argument. *) +and actual = + node + +(* A tuple of actual macro arguments. *) +and actuals = + actual list + +(* The body of a macro definition. *) +and body = + node + + +let string_of_loc (pos1, pos2) = + let line1 = pos1.pos_lnum + and start1 = pos1.pos_bol in + Printf.sprintf "File %S, line %i, characters %i-%i" + pos1.pos_fname line1 + (pos1.pos_cnum - start1) + (pos2.pos_cnum - start1) + + +exception Cppo_error of string + +let error loc s = + let msg = + sprintf "%s\nError: %s" (string_of_loc loc) s in + raise (Cppo_error msg) + +let warning loc s = + let msg = + sprintf "%s\nWarning: %s" (string_of_loc loc) s in + eprintf "%s\n%!" msg + +let dummy_loc = (Lexing.dummy_pos, Lexing.dummy_pos) + +let rec node_loc (node : node) : loc = + match node with + | `Ident (loc, _, _) + | `Def (loc, _, _, _) + | `Undef (loc, _) + | `Include (loc, _) + | `Ext (loc, _, _) + | `Cond (loc, _, _, _) + | `Error (loc, _) + | `Warning (loc, _) + | `Text (loc, _, _) + | `Seq (loc, _) + | `Line (loc, _, _) + | `Current_line loc + | `Current_file loc + -> loc + | `Scope node -> + node_loc node + | `Stringify _ + | `Capitalize _ + | `Concat (_, _) + -> dummy_loc + (* These cases are never produced by the parser. *) + +let rec is_whitespace_node node = + match node with + | `Text (_, is_whitespace, _) -> + is_whitespace + | `Seq (_loc, nodes) -> + is_whitespace_nodes nodes + | _ -> + false + +and is_whitespace_nodes nodes = + List.for_all is_whitespace_node nodes + +let is_not_whitespace_node node = + not (is_whitespace_node node) + +let dissolve (node : node) : node list = + match node with + | `Seq (_loc, nodes) -> + nodes + | _ -> + [node] + +let nodes_are_ident (nodes : node list) : (loc * string) option = + match List.filter is_not_whitespace_node nodes with + | [`Ident (loc, x, [])] -> + Some (loc, x) + | _ -> + None + +let node_is_ident (node : node) : (loc * string) option = + nodes_are_ident (dissolve node) diff --git a/unikernel/duniverse/cppo/src/cppo_types.mli b/unikernel/duniverse/cppo/src/cppo_types.mli new file mode 100644 index 00000000..1d75599a --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_types.mli @@ -0,0 +1,128 @@ +type loc = Lexing.position * Lexing.position + +exception Cppo_error of string + +(* The name of a macro. *) +type macro = + string + +(* The shape of a macro. + + The abstract syntax of shapes is τ ::= [τ, ..., τ]. + That is, a macro takes a tuple of parameters, each + of which has a shape. The length of of this tuple + can be zero: this is the base case. *) +type shape = + | Shape of shape list + +(* The base shape. This is the shape of a basic macro, + which takes no parameters, and produces text. *) +val base : shape + +(* Printing a shape. *) +val print_shape : shape -> string + +(* Testing two shapes for equality. *) +val same_shape : shape -> shape -> bool + +type bool_expr = + [ `True + | `False + | `Defined of macro + | `Not of bool_expr (* not *) + | `And of (bool_expr * bool_expr) (* && *) + | `Or of (bool_expr * bool_expr) (* || *) + | `Eq of (arith_expr * arith_expr) (* = *) + | `Lt of (arith_expr * arith_expr) (* < *) + | `Gt of (arith_expr * arith_expr) (* > *) + (* syntax for additional operators: <>, <=, >= *) + ] + +and arith_expr = (* signed int64 *) + [ `Int of int64 + | `Ident of (loc * string) + (* must be bound to a valid int literal. + Expansion of macro functions is not supported. *) + + | `Tuple of (loc * arith_expr list) + (* tuple of 2 or more elements guaranteed by the syntax *) + + | `Neg of arith_expr (* - *) + | `Add of (arith_expr * arith_expr) (* + *) + | `Sub of (arith_expr * arith_expr) (* - *) + | `Mul of (arith_expr * arith_expr) (* * *) + | `Div of (loc * arith_expr * arith_expr) (* / *) + | `Mod of (loc * arith_expr * arith_expr) (* mod *) + + (* Bitwise operations on 64 bits *) + | `Lnot of arith_expr (* lnot *) + | `Lsl of (arith_expr * arith_expr) (* lsl *) + | `Lsr of (arith_expr * arith_expr) (* lsr *) + | `Asr of (arith_expr * arith_expr) (* asr *) + | `Land of (arith_expr * arith_expr) (* land *) + | `Lor of (arith_expr * arith_expr) (* lor *) + | `Lxor of (arith_expr * arith_expr) (* lxor *) + ] + +type node = + [ `Ident of (loc * string * actuals) + (* the list [actuals] is empty if and only if no parentheses + are used at this macro invocation site. *) + | `Def of (loc * macro * formals * body) + (* the list [formals] is empty if and only if no parentheses + are used at this macro definition site. *) + | `Scope of body + | `Undef of (loc * macro) + | `Include of (loc * string) + | `Ext of (loc * string * string) + | `Cond of (loc * bool_expr * node list * node list) + | `Error of (loc * string) + | `Warning of (loc * string) + | `Text of (loc * bool * string) (* bool is true for space tokens *) + | `Seq of (loc * node list) + | `Stringify of node + | `Capitalize of node + | `Concat of (node * node) + | `Line of (loc * string option * int) + | `Current_line of loc + | `Current_file of loc ] + +(* A formal macro parameter consists of an identifier (the name of this + parameter) and a shape (the shape of this parameter). In the concrete + syntax, if the shape is omitted, then the base shape is assumed. *) +and formal = + string * shape + +(* A tuple of formal macro parameters. *) +and formals = + formal list + +(* One actual macro argument. *) +and actual = + node + +(* A tuple of actual macro arguments. *) +and actuals = + actual list + +(* The body of a macro definition. *) +and body = + node + +val dummy_loc : loc + +val error : loc -> string -> _ + +val warning : loc -> string -> unit + +(* [node_loc] extracts the location of a node. *) +val node_loc : node -> loc + +(* [is_whitespace_node] determines whether a node is just whitespace. *) +val is_whitespace_node : node -> bool +val is_whitespace_nodes : node list -> bool + +(* [node_is_ident node] tests whether [node] is a single identifier, + possibly surrounded with whitespace, and (if successful) returns + this identifier as well as its location. *) +val node_is_ident : node -> (loc * string) option diff --git a/unikernel/duniverse/cppo/src/cppo_version.mli b/unikernel/duniverse/cppo/src/cppo_version.mli new file mode 100644 index 00000000..7d20f68d --- /dev/null +++ b/unikernel/duniverse/cppo/src/cppo_version.mli @@ -0,0 +1 @@ +val cppo_version : string diff --git a/unikernel/duniverse/cppo/src/dune b/unikernel/duniverse/cppo/src/dune new file mode 100644 index 00000000..8cf871b4 --- /dev/null +++ b/unikernel/duniverse/cppo/src/dune @@ -0,0 +1,21 @@ +(ocamllex cppo_lexer) + +(ocamlyacc cppo_parser) + +(rule + (targets cppo_version.ml) + (action + (with-stdout-to + %{targets} + (echo "let cppo_version = \"%{version:cppo}\"")))) + +(executable + (name cppo_main) + (package cppo) + (public_name cppo) + (modules :standard \ compat) + (preprocess (per_module + ((action (progn + (run ocaml %{dep:compat.ml} %{input-file}) + (cat %{input-file}))) cppo_eval))) + (libraries unix str)) diff --git a/unikernel/duniverse/cppo/test/already_defined.cppo b/unikernel/duniverse/cppo/test/already_defined.cppo new file mode 100644 index 00000000..144455e0 --- /dev/null +++ b/unikernel/duniverse/cppo/test/already_defined.cppo @@ -0,0 +1,3 @@ +(* A macro is defined twice. *) +#define FOO "oh" +#define FOO "no" diff --git a/unikernel/duniverse/cppo/test/already_defined.ref b/unikernel/duniverse/cppo/test/already_defined.ref new file mode 100644 index 00000000..b222ea88 --- /dev/null +++ b/unikernel/duniverse/cppo/test/already_defined.ref @@ -0,0 +1,2 @@ +Error: File "already_defined.cppo", line 3, characters 0-17 +Error: "FOO" is already defined diff --git a/unikernel/duniverse/cppo/test/applied_to_none.cppo b/unikernel/duniverse/cppo/test/applied_to_none.cppo new file mode 100644 index 00000000..e5c1e77b --- /dev/null +++ b/unikernel/duniverse/cppo/test/applied_to_none.cppo @@ -0,0 +1,3 @@ +(* A parameterized macro is applied to no arguments. *) +#define FOO(x) x +FOO + 1 diff --git a/unikernel/duniverse/cppo/test/applied_to_none.ref b/unikernel/duniverse/cppo/test/applied_to_none.ref new file mode 100644 index 00000000..f339d527 --- /dev/null +++ b/unikernel/duniverse/cppo/test/applied_to_none.ref @@ -0,0 +1,2 @@ +Error: File "applied_to_none.cppo", line 3, characters 0-3 +Error: "FOO" expects 1 argument but is applied to 0 argument. diff --git a/unikernel/duniverse/cppo/test/arity_mismatch.cppo b/unikernel/duniverse/cppo/test/arity_mismatch.cppo new file mode 100644 index 00000000..2cad6a1f --- /dev/null +++ b/unikernel/duniverse/cppo/test/arity_mismatch.cppo @@ -0,0 +1,3 @@ +(* This test shows an arity mismatch error. *) +#define INCR(x) x+1 +INCR(x, y) diff --git a/unikernel/duniverse/cppo/test/arity_mismatch.ref b/unikernel/duniverse/cppo/test/arity_mismatch.ref new file mode 100644 index 00000000..dd88a1ba --- /dev/null +++ b/unikernel/duniverse/cppo/test/arity_mismatch.ref @@ -0,0 +1,2 @@ +Error: File "arity_mismatch.cppo", line 3, characters 0-10 +Error: "INCR" expects 1 argument but is applied to 2 arguments. diff --git a/unikernel/duniverse/cppo/test/arity_mismatch_indirect.cppo b/unikernel/duniverse/cppo/test/arity_mismatch_indirect.cppo new file mode 100644 index 00000000..e618a7e2 --- /dev/null +++ b/unikernel/duniverse/cppo/test/arity_mismatch_indirect.cppo @@ -0,0 +1,3 @@ +#define ID(X) X +#define APPLY(F : [.], X) F (* intentionally forgetting to apply F *) +APPLY(ID, 42) diff --git a/unikernel/duniverse/cppo/test/arity_mismatch_indirect.ref b/unikernel/duniverse/cppo/test/arity_mismatch_indirect.ref new file mode 100644 index 00000000..7491428c --- /dev/null +++ b/unikernel/duniverse/cppo/test/arity_mismatch_indirect.ref @@ -0,0 +1,2 @@ +Error: File "arity_mismatch_indirect.cppo", line 2, characters 26-27 +Error: "F" expects 1 argument but is applied to 0 argument. diff --git a/unikernel/duniverse/cppo/test/at_least_one_arg.cppo b/unikernel/duniverse/cppo/test/at_least_one_arg.cppo new file mode 100644 index 00000000..b8d6915e --- /dev/null +++ b/unikernel/duniverse/cppo/test/at_least_one_arg.cppo @@ -0,0 +1,2 @@ +(* A parameterized macro cannot have zero arguments. *) +#define FOO() "not ok" diff --git a/unikernel/duniverse/cppo/test/at_least_one_arg.ref b/unikernel/duniverse/cppo/test/at_least_one_arg.ref new file mode 100644 index 00000000..82f29252 --- /dev/null +++ b/unikernel/duniverse/cppo/test/at_least_one_arg.ref @@ -0,0 +1,2 @@ +Error: File "at_least_one_arg.cppo", line 2, characters 12-13 +Error: A macro must have at least one formal parameter diff --git a/unikernel/duniverse/cppo/test/capital.cppo b/unikernel/duniverse/cppo/test/capital.cppo new file mode 100644 index 00000000..fa85caae --- /dev/null +++ b/unikernel/duniverse/cppo/test/capital.cppo @@ -0,0 +1,6 @@ + + +#define EVENT(n,ty) external CONCAT(on,CAPITALIZE(n)) : ty = STRINGIFY(n) [@@bs.val] + + +EVENT(exit, unit -> unit) \ No newline at end of file diff --git a/unikernel/duniverse/cppo/test/capital.ref b/unikernel/duniverse/cppo/test/capital.ref new file mode 100644 index 00000000..adcc26e2 --- /dev/null +++ b/unikernel/duniverse/cppo/test/capital.ref @@ -0,0 +1,6 @@ + + + + +# 6 "capital.cppo" + external onExit : unit -> unit = "exit" [@@bs.val] \ No newline at end of file diff --git a/unikernel/duniverse/cppo/test/comment_in_formals.cppo b/unikernel/duniverse/cppo/test/comment_in_formals.cppo new file mode 100644 index 00000000..8172e988 --- /dev/null +++ b/unikernel/duniverse/cppo/test/comment_in_formals.cppo @@ -0,0 +1,2 @@ +#define FOO(x, (* a comment *) y) x+y +FOO(42, 23) diff --git a/unikernel/duniverse/cppo/test/comment_in_formals.ref b/unikernel/duniverse/cppo/test/comment_in_formals.ref new file mode 100644 index 00000000..b511bbb5 --- /dev/null +++ b/unikernel/duniverse/cppo/test/comment_in_formals.ref @@ -0,0 +1,2 @@ +Error: File "comment_in_formals.cppo", line 1, characters 15-16 +Error: Invalid formal parameter: expected an identifier diff --git a/unikernel/duniverse/cppo/test/comments.cppo b/unikernel/duniverse/cppo/test/comments.cppo new file mode 100644 index 00000000..5e335f1c --- /dev/null +++ b/unikernel/duniverse/cppo/test/comments.cppo @@ -0,0 +1,7 @@ +(* '"' *) + +#define BE_GONE + +(* "*)" +#define DONT_TOUCH_THIS +*) diff --git a/unikernel/duniverse/cppo/test/comments.ref b/unikernel/duniverse/cppo/test/comments.ref new file mode 100644 index 00000000..1d0dd1db --- /dev/null +++ b/unikernel/duniverse/cppo/test/comments.ref @@ -0,0 +1,8 @@ +# 1 "comments.cppo" +(* '"' *) + + +# 5 "comments.cppo" +(* "*)" +#define DONT_TOUCH_THIS +*) diff --git a/unikernel/duniverse/cppo/test/cond.cppo b/unikernel/duniverse/cppo/test/cond.cppo new file mode 100644 index 00000000..b5f0c49a --- /dev/null +++ b/unikernel/duniverse/cppo/test/cond.cppo @@ -0,0 +1,47 @@ +#if 1 = 1 +#else +#error "ignored #else (?)" +#endif + +#if true + banana +#elif false + apple + #error "ignored #elif (?)" +#endif + +#if false + earthworm + #error "" +#elif true + apricot +#endif + +#if false + cuckoo + #error "" +#else + #if false + egg + #error "" + #else + nest + #endif +#endif + +#define X 3 + +#if false + helicopter + #error "" +#elif false + ocean + #error "" +#else + #if X = 12 + sand + #error "" + #elif 4 * X = 12 + sea urchin + #endif +#endif diff --git a/unikernel/duniverse/cppo/test/cond.ref b/unikernel/duniverse/cppo/test/cond.ref new file mode 100644 index 00000000..a21ea217 --- /dev/null +++ b/unikernel/duniverse/cppo/test/cond.ref @@ -0,0 +1,17 @@ + + +# 7 "cond.cppo" + banana + + +# 17 "cond.cppo" + apricot + + +# 28 "cond.cppo" + nest + + + +# 45 "cond.cppo" + sea urchin diff --git a/unikernel/duniverse/cppo/test/def.cppo b/unikernel/duniverse/cppo/test/def.cppo new file mode 100644 index 00000000..d4b86ea2 --- /dev/null +++ b/unikernel/duniverse/cppo/test/def.cppo @@ -0,0 +1,88 @@ +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) +#def APPLY(F : [.], X : .) + (let __x = (X) in F(__x)) + (* Multiple lines permitted; no backslash required. *) +#enddef + +(* Some trivial tests. *) +#define ID(X) X +#define C 42 +let forty_one = APPLY(ID, 41) +let forty_two = APPLY(ID, C ) + +(* A [for]-loop macro. *) +#def LOOP(start, finish, body : [.]) +( + for __index = start to finish-1 do + body(__index) + done +) +#enddef + +(* A [for]-loop macro that performs unrolling. *) +#def UNROLLED_LOOP(start, finish, body : [.]) ( + (* #define can be nested inside #def. *) + #define BODY(i) APPLY(body, i) + (* #def can be nested inside #def. *) + #def INCREMENT(i, k) + i := !i + k + #enddef + let __finish = (finish) in + let __index = ref (start) in + while !__index + 2 <= __finish do + BODY(!__index); + BODY(!__index + 1); + INCREMENT(__index, 2) + done; + while !__index < __finish do + BODY(!__index); + INCREMENT(__index, 1) + done +) +#enddef + +(* In the examples that follow, #scope ... #endscope is used to + avoid the need to #undefine local macros such as BODY and F. *) + +(* Iteration over an array, with a normal loop. *) +let iter f a = + #scope + #define BODY(i) (f a.(i)) + LOOP(0, Array.length a, BODY) + #endscope + +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + #scope + #define BODY(i) (f a.(i)) + UNROLLED_LOOP(0, Array.length a, BODY) + #endscope + +(* Printing an array, with a normal loop. *) +let print_int_array a = + #scope + #define F(i) Printf.printf "%d" a.(i) + LOOP(0, Array.length a, F) + #endscope + +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) +#def DEFINE_ITER(iter, LOOP : [..[.]]) + #scope + #define BODY(i) (f a.(i)) + let iter f a = + LOOP(0, Array.length a, BODY) + #endscope +#enddef + +(* Some noise, which does not affect the above definitions. *) +#define BODY(i) "noise" + +DEFINE_ITER(iter, LOOP) +DEFINE_ITER(unrolled_iter, UNROLLED_LOOP) + +(* Just because we can, undefine BODY. *) +#undef BODY diff --git a/unikernel/duniverse/cppo/test/def.ref b/unikernel/duniverse/cppo/test/def.ref new file mode 100644 index 00000000..8d656aaf --- /dev/null +++ b/unikernel/duniverse/cppo/test/def.ref @@ -0,0 +1,152 @@ +# 1 "def.cppo" +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) + +# 10 "def.cppo" +(* Some trivial tests. *) +# 13 "def.cppo" +let forty_one = +# 13 "def.cppo" + + (let __x = ( 41) in __x ) + (* Multiple lines permitted; no backslash required. *) + +# 14 "def.cppo" +let forty_two = +# 14 "def.cppo" + + (let __x = ( 42 ) in __x ) + (* Multiple lines permitted; no backslash required. *) + + +# 16 "def.cppo" +(* A [for]-loop macro. *) + +# 25 "def.cppo" +(* A [for]-loop macro that performs unrolling. *) + +# 47 "def.cppo" +(* In the examples that follow, #scope ... #endscope is used to + avoid the need to #undefine local macros such as BODY and F. *) + +(* Iteration over an array, with a normal loop. *) +let iter f a = + + +# 54 "def.cppo" + +( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) + + +# 57 "def.cppo" +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + + +# 61 "def.cppo" + ( + (* #define can be nested inside #def. *) + (* #def can be nested inside #def. *) + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + (let __x = ( !__index + 1) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 2 + + done; + while !__index < __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 1 + + done +) + + +# 64 "def.cppo" +(* Printing an array, with a normal loop. *) +let print_int_array a = + + +# 68 "def.cppo" + +( + for __index = 0 to Array.length a-1 do + Printf.printf "%d" a.(__index) + done +) + + +# 71 "def.cppo" +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) + +# 81 "def.cppo" +(* Some noise, which does not affect the above definitions. *) + +# 84 "def.cppo" + + + let iter f a = + +( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) + + +# 85 "def.cppo" + + + let unrolled_iter f a = + ( + (* #define can be nested inside #def. *) + (* #def can be nested inside #def. *) + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + (let __x = ( !__index + 1) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 2 + + done; + while !__index < __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 1 + + done +) + + + +# 87 "def.cppo" +(* Just because we can, undefine BODY. *) diff --git a/unikernel/duniverse/cppo/test/define_on_last_line.cppo b/unikernel/duniverse/cppo/test/define_on_last_line.cppo new file mode 100644 index 00000000..6b8f0061 --- /dev/null +++ b/unikernel/duniverse/cppo/test/define_on_last_line.cppo @@ -0,0 +1,2 @@ +(* This #define is NOT ended by a new line, but is nevertheless accepted. *) +#define TWICE(e) e + e \ No newline at end of file diff --git a/unikernel/duniverse/cppo/test/dune b/unikernel/duniverse/cppo/test/dune new file mode 100644 index 00000000..b25eb46d --- /dev/null +++ b/unikernel/duniverse/cppo/test/dune @@ -0,0 +1,292 @@ +;; --------------------------------------------------------------------------- +;; Positive tests. + +(rule + (targets ext.out) + (deps + (:< ext.cppo) + source.sh) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} -x "rot13:tr '[a-z]' '[n-za-m]'" -x + "source:sh source.sh '%F' %B %E" %{<})))) + +(rule + (targets comments.out) + (deps + (:< comments.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets cond.out) + (deps + (:< cond.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets tuple.out) + (deps + (:< tuple.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets loc.out) + (deps + (:< loc.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets paren_arg.out) + (deps + (:< paren_arg.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets unmatched.out) + (deps + (:< unmatched.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets version.out) + (deps + (:< version.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} -V X:123.05.2-alpha.1+foo-2.1 -V COQ:8.13+beta1 -V OCAML:4.12.0~alpha1 %{<})))) + +(rule + (targets test.out) + (deps + (:< test.cppo) + incl.cppo + incl2.cppo) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets lexical.out) + (deps (:< lexical.cppo)) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + +(rule + (targets scope.out) + (deps (:< scope.cppo)) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + +(rule + (targets higher_order_macros.out) + (deps (:< higher_order_macros.cppo)) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + +(rule + (targets include_define_on_last_line.out) + (deps (:< include_define_on_last_line.cppo) define_on_last_line.cppo) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + +(rule + (targets def.out) + (deps (:< def.cppo)) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + +(rule (alias runtest) (package cppo) + (action (diff ext.ref ext.out))) + +(rule (alias runtest) (package cppo) + (action (diff comments.ref comments.out))) + +(rule (alias runtest) (package cppo) + (action (diff cond.ref cond.out))) + +(rule (alias runtest) (package cppo) + (action (diff tuple.ref tuple.out))) + +(rule (alias runtest) (package cppo) + (action (diff loc.ref loc.out))) + +(rule (alias runtest) (package cppo) + (action (diff paren_arg.ref paren_arg.out))) + +(rule (alias runtest) (package cppo) + (action (diff version.ref version.out))) + +(rule (alias runtest) (package cppo) + (action (diff unmatched.ref unmatched.out))) + +(rule (alias runtest) (package cppo) + (action (diff test.ref test.out))) + +(rule (alias runtest) (package cppo) + (action (diff lexical.ref lexical.out))) + +(rule (alias runtest) (package cppo) + (action (diff scope.ref scope.out))) + +(rule (alias runtest) (package cppo) + (action (diff higher_order_macros.ref higher_order_macros.out))) + +(rule (alias runtest) (package cppo) + (action (diff include_define_on_last_line.ref include_define_on_last_line.out))) + +(rule (alias runtest) (package cppo) + (action (diff def.ref def.out))) + +;; --------------------------------------------------------------------------- +;; Negative tests. + +(rule + (targets arity_mismatch.err) + (deps (:< arity_mismatch.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff arity_mismatch.ref arity_mismatch.err))) + +(rule + (targets applied_to_none.err) + (deps (:< applied_to_none.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff applied_to_none.ref applied_to_none.err))) + +(rule + (targets expects_no_args.err) + (deps (:< expects_no_args.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff expects_no_args.ref expects_no_args.err))) + +(rule + (targets already_defined.err) + (deps (:< already_defined.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff already_defined.ref already_defined.err))) + +(rule + (targets at_least_one_arg.err) + (deps (:< at_least_one_arg.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff at_least_one_arg.ref at_least_one_arg.err))) + +(rule + (targets comment_in_formals.err) + (deps (:< comment_in_formals.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff comment_in_formals.ref comment_in_formals.err))) + +(rule + (targets arity_mismatch_indirect.err) + (deps (:< arity_mismatch_indirect.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff arity_mismatch_indirect.ref arity_mismatch_indirect.err))) + +(rule + (targets expect_ident.err) + (deps (:< expect_ident.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff expect_ident.ref expect_ident.err))) + +(rule + (targets expect_ident_empty.err) + (deps (:< expect_ident_empty.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff expect_ident_empty.ref expect_ident_empty.err))) + +(rule + (targets undefined.err) + (deps (:< undefined.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff undefined.ref undefined.err))) + +(rule + (targets shape_mismatch.err) + (deps (:< shape_mismatch.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff shape_mismatch.ref shape_mismatch.err))) + +(rule + (targets int_expansion_error.err) + (deps (:< int_expansion_error.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff int_expansion_error.ref int_expansion_error.err))) + +(rule + (targets extraneous_enddef.err) + (deps (:< extraneous_enddef.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff extraneous_enddef.ref extraneous_enddef.err))) + +(rule + (targets missing_enddef.err) + (deps (:< missing_enddef.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff missing_enddef.ref missing_enddef.err))) + +(rule + (targets missing_endscope.err) + (deps (:< missing_endscope.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff missing_endscope.ref missing_endscope.err))) diff --git a/unikernel/duniverse/cppo/test/expect_ident.cppo b/unikernel/duniverse/cppo/test/expect_ident.cppo new file mode 100644 index 00000000..9e71434b --- /dev/null +++ b/unikernel/duniverse/cppo/test/expect_ident.cppo @@ -0,0 +1,6 @@ +let id x = x +#define ID(X) X +#define APPLY(F : [.], X) F(X) +APPLY(ID(id), 42) + (* invalid because APPLY expects a macro as an argument: + ID would be a valid argument; ID(id) is not. *) diff --git a/unikernel/duniverse/cppo/test/expect_ident.ref b/unikernel/duniverse/cppo/test/expect_ident.ref new file mode 100644 index 00000000..352e0808 --- /dev/null +++ b/unikernel/duniverse/cppo/test/expect_ident.ref @@ -0,0 +1,2 @@ +Error: File "expect_ident.cppo", line 4, characters 6-12 +Error: The name of a macro is expected in this position diff --git a/unikernel/duniverse/cppo/test/expect_ident_empty.cppo b/unikernel/duniverse/cppo/test/expect_ident_empty.cppo new file mode 100644 index 00000000..6ace89b7 --- /dev/null +++ b/unikernel/duniverse/cppo/test/expect_ident_empty.cppo @@ -0,0 +1,6 @@ +let id x = x +#define ID(X) X +#define APPLY(F : [.], X) F(X) +APPLY(, 42) + (* invalid because APPLY expects a macro as an argument: + an empty argument is not allowed. *) diff --git a/unikernel/duniverse/cppo/test/expect_ident_empty.ref b/unikernel/duniverse/cppo/test/expect_ident_empty.ref new file mode 100644 index 00000000..6f7522e1 --- /dev/null +++ b/unikernel/duniverse/cppo/test/expect_ident_empty.ref @@ -0,0 +1,2 @@ +Error: File "expect_ident_empty.cppo", line 4, characters 6-6 +Error: The name of a macro is expected in this position diff --git a/unikernel/duniverse/cppo/test/expects_no_args.cppo b/unikernel/duniverse/cppo/test/expects_no_args.cppo new file mode 100644 index 00000000..d48c0e55 --- /dev/null +++ b/unikernel/duniverse/cppo/test/expects_no_args.cppo @@ -0,0 +1,3 @@ +(* A non-parameterized macro is given actual arguments. *) +#define FOO "foo" +1 + FOO(42) diff --git a/unikernel/duniverse/cppo/test/expects_no_args.ref b/unikernel/duniverse/cppo/test/expects_no_args.ref new file mode 100644 index 00000000..d661b7b3 --- /dev/null +++ b/unikernel/duniverse/cppo/test/expects_no_args.ref @@ -0,0 +1,2 @@ +Error: File "expects_no_args.cppo", line 3, characters 4-11 +Error: "FOO" expects 0 argument but is applied to 1 argument. diff --git a/unikernel/duniverse/cppo/test/ext.cppo b/unikernel/duniverse/cppo/test/ext.cppo new file mode 100644 index 00000000..cb32573f --- /dev/null +++ b/unikernel/duniverse/cppo/test/ext.cppo @@ -0,0 +1,10 @@ +hello +#ext rot13 +abc +\#endext +def +#endext +goodbye + +#ext source +#endext diff --git a/unikernel/duniverse/cppo/test/ext.ref b/unikernel/duniverse/cppo/test/ext.ref new file mode 100644 index 00000000..4626b214 --- /dev/null +++ b/unikernel/duniverse/cppo/test/ext.ref @@ -0,0 +1,28 @@ +# 1 "ext.cppo" +hello +nop +#raqrkg +qrs +# 7 "ext.cppo" +goodbye + +# 9 +(* +hello +#ext rot13 +abc +\#endext +def +#endext +goodbye + +#ext source +#endext +*) +(* + Environment variables: + CPPO_FILE=ext.cppo + CPPO_FIRST_LINE=9 + CPPO_LAST_LINE=11 +*) +# 11 diff --git a/unikernel/duniverse/cppo/test/extraneous_enddef.cppo b/unikernel/duniverse/cppo/test/extraneous_enddef.cppo new file mode 100644 index 00000000..46f85d93 --- /dev/null +++ b/unikernel/duniverse/cppo/test/extraneous_enddef.cppo @@ -0,0 +1,4 @@ +#define FOO \ + 42 +(* The following #enddef is extraneous; it should not be there. *) +#enddef diff --git a/unikernel/duniverse/cppo/test/extraneous_enddef.ref b/unikernel/duniverse/cppo/test/extraneous_enddef.ref new file mode 100644 index 00000000..e78651f0 --- /dev/null +++ b/unikernel/duniverse/cppo/test/extraneous_enddef.ref @@ -0,0 +1,2 @@ +Error: File "extraneous_enddef.cppo", line 4, characters 0-8 +Error: syntax error diff --git a/unikernel/duniverse/cppo/test/higher_order_macros.cppo b/unikernel/duniverse/cppo/test/higher_order_macros.cppo new file mode 100644 index 00000000..2c87d9a4 --- /dev/null +++ b/unikernel/duniverse/cppo/test/higher_order_macros.cppo @@ -0,0 +1,69 @@ +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) +#define APPLY(F : [.], X : .)(let __x = (X) in F(__x)) + +(* Some trivial tests. *) +#define ID(X) X +#define C 42 +let forty_one = APPLY(ID, 41) +let forty_two = APPLY(ID, C ) + +(* A [for]-loop macro. *) +#define LOOP(start, finish, body : [.]) (\ + for __index = start to finish-1 do\ + body(__index)\ + done\ +) + +(* A [for]-loop macro that performs unrolling. *) +#define UNROLLED_LOOP(start, finish, body : [.]) (\ + let __finish = (finish) in\ + let __index = ref (start) in\ + while !__index + 2 <= __finish do\ + APPLY(body, !__index);\ + APPLY(body, !__index + 1);\ + __index := !__index + 2\ + done;\ + while !__index < __finish do\ + APPLY(body, !__index);\ + __index := !__index + 1\ + done\ +) + +(* In some of the examples that follow, #scope ... #endscope is used + to avoid the need to #undefine local macros such as BODY and F. *) + +(* Iteration over an array, with a normal loop. *) +let iter f a = + #scope + #define BODY(i) (f a.(i)) + LOOP(0, Array.length a, BODY) + #endscope + +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + #scope + #define BODY(i) (f a.(i)) + UNROLLED_LOOP(0, Array.length a, BODY) + #endscope + +(* Printing an array, with a normal loop. *) +let print_int_array a = + #define F(i) Printf.printf "%d" a.(i) + LOOP(0, Array.length a, F) + +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) +#define BODY(i) (f a.(i)) +#define DEFINE_ITER(iter, LOOP : [..[.]]) \ + let iter f a = \ + LOOP(0, Array.length a, BODY) +#undef BODY + +(* Some noise, which does not affect the above definitions. *) +#define BODY(i) "noise" + +DEFINE_ITER(iter, LOOP) +DEFINE_ITER(unrolled_iter, UNROLLED_LOOP) diff --git a/unikernel/duniverse/cppo/test/higher_order_macros.ref b/unikernel/duniverse/cppo/test/higher_order_macros.ref new file mode 100644 index 00000000..12f0ec2e --- /dev/null +++ b/unikernel/duniverse/cppo/test/higher_order_macros.ref @@ -0,0 +1,100 @@ +# 1 "higher_order_macros.cppo" +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) + +# 7 "higher_order_macros.cppo" +(* Some trivial tests. *) +# 10 "higher_order_macros.cppo" +let forty_one = +# 10 "higher_order_macros.cppo" + (let __x = ( 41) in __x ) +# 11 "higher_order_macros.cppo" +let forty_two = +# 11 "higher_order_macros.cppo" + (let __x = ( 42 ) in __x ) + +# 13 "higher_order_macros.cppo" +(* A [for]-loop macro. *) + +# 20 "higher_order_macros.cppo" +(* A [for]-loop macro that performs unrolling. *) + +# 35 "higher_order_macros.cppo" +(* In some of the examples that follow, #scope ... #endscope is used + to avoid the need to #undefine local macros such as BODY and F. *) + +(* Iteration over an array, with a normal loop. *) +let iter f a = + + +# 42 "higher_order_macros.cppo" + ( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) + +# 45 "higher_order_macros.cppo" +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + + +# 49 "higher_order_macros.cppo" + ( + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + (let __x = ( !__index + 1) in (f a.(__x)) ) ; + __index := !__index + 2 + done; + while !__index < __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + __index := !__index + 1 + done +) + +# 52 "higher_order_macros.cppo" +(* Printing an array, with a normal loop. *) +let print_int_array a = + +# 55 "higher_order_macros.cppo" + ( + for __index = 0 to Array.length a-1 do + Printf.printf "%d" a.(__index) + done +) + +# 57 "higher_order_macros.cppo" +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) + +# 65 "higher_order_macros.cppo" +(* Some noise, which does not affect the above definitions. *) + +# 68 "higher_order_macros.cppo" + + let iter f a = + ( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) +# 69 "higher_order_macros.cppo" + + let unrolled_iter f a = + ( + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + (let __x = ( !__index + 1) in (f a.(__x)) ) ; + __index := !__index + 2 + done; + while !__index < __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + __index := !__index + 1 + done +) diff --git a/unikernel/duniverse/cppo/test/incl.cppo b/unikernel/duniverse/cppo/test/incl.cppo new file mode 100644 index 00000000..a2ce8dbb --- /dev/null +++ b/unikernel/duniverse/cppo/test/incl.cppo @@ -0,0 +1,3 @@ +included + +#include "incl2.cppo" diff --git a/unikernel/duniverse/cppo/test/incl2.cppo b/unikernel/duniverse/cppo/test/incl2.cppo new file mode 100644 index 00000000..9766475a --- /dev/null +++ b/unikernel/duniverse/cppo/test/incl2.cppo @@ -0,0 +1 @@ +ok diff --git a/unikernel/duniverse/cppo/test/include_define_on_last_line.cppo b/unikernel/duniverse/cppo/test/include_define_on_last_line.cppo new file mode 100644 index 00000000..1b36ff02 --- /dev/null +++ b/unikernel/duniverse/cppo/test/include_define_on_last_line.cppo @@ -0,0 +1,3 @@ +#include "define_on_last_line.cppo" +(* Check that the definition of TWICE has been accepted: *) +let f x = TWICE(x) diff --git a/unikernel/duniverse/cppo/test/include_define_on_last_line.ref b/unikernel/duniverse/cppo/test/include_define_on_last_line.ref new file mode 100644 index 00000000..d8700f2c --- /dev/null +++ b/unikernel/duniverse/cppo/test/include_define_on_last_line.ref @@ -0,0 +1,7 @@ +# 1 "define_on_last_line.cppo" +(* This #define is NOT ended by a new line, but is nevertheless accepted. *) +# 2 "include_define_on_last_line.cppo" +(* Check that the definition of TWICE has been accepted: *) +let f x = +# 3 "include_define_on_last_line.cppo" + x + x diff --git a/unikernel/duniverse/cppo/test/int_expansion_error.cppo b/unikernel/duniverse/cppo/test/int_expansion_error.cppo new file mode 100644 index 00000000..809c9eae --- /dev/null +++ b/unikernel/duniverse/cppo/test/int_expansion_error.cppo @@ -0,0 +1,4 @@ +#define FOO 3+3 +#if FOO = 0 + let x = "Hello" +#endif diff --git a/unikernel/duniverse/cppo/test/int_expansion_error.ref b/unikernel/duniverse/cppo/test/int_expansion_error.ref new file mode 100644 index 00000000..7bd1d637 --- /dev/null +++ b/unikernel/duniverse/cppo/test/int_expansion_error.ref @@ -0,0 +1,4 @@ +Error: File "int_expansion_error.cppo", line 2, characters 4-7 +Error: Variable FOO found in cppo boolean expression must expand +into an int literal, into a tuple of int literals, +or into a variable with the same properties. diff --git a/unikernel/duniverse/cppo/test/lexical.cppo b/unikernel/duniverse/cppo/test/lexical.cppo new file mode 100644 index 00000000..d37958f0 --- /dev/null +++ b/unikernel/duniverse/cppo/test/lexical.cppo @@ -0,0 +1,27 @@ +(* This test shows that the definition of BAR captures the original + definition of FOO, so even if FOO is redefined, the expansion of + BAR does not change. *) +#define FOO "original definition" +#define BAR FOO +#undef FOO +#define FOO "new definition" +FOO (* expands to "new definition" *) +BAR (* expands to "original definition" *) + +(* This test shows that a formal parameter can shadow a previously + defined macro. *) +#define F(FOO) FOO +F(42) (* expands to 42 *) + +(* This test shows that two formal parameters can have the same + name. In that case, the second parameter shadows the first one. *) +#define G(X, X) X+X +G(42,23) (* expands to 23+23 *) + +(* This test shows that it is OK to pass an empty argument to a macro + that expects one parameter. This is interpreted as passing one + empty argument. *) +#define expect(x) show(x) +expect(42) +expect("23") +expect() diff --git a/unikernel/duniverse/cppo/test/lexical.ref b/unikernel/duniverse/cppo/test/lexical.ref new file mode 100644 index 00000000..d7d652f2 --- /dev/null +++ b/unikernel/duniverse/cppo/test/lexical.ref @@ -0,0 +1,36 @@ +# 1 "lexical.cppo" +(* This test shows that the definition of BAR captures the original + definition of FOO, so even if FOO is redefined, the expansion of + BAR does not change. *) +# 8 "lexical.cppo" + "new definition" +# 8 "lexical.cppo" + (* expands to "new definition" *) +# 9 "lexical.cppo" + "original definition" +# 9 "lexical.cppo" + (* expands to "original definition" *) + +(* This test shows that a formal parameter can shadow a previously + defined macro. *) +# 14 "lexical.cppo" + 42 +# 14 "lexical.cppo" + (* expands to 42 *) + +(* This test shows that two formal parameters can have the same + name. In that case, the second parameter shadows the first one. *) +# 19 "lexical.cppo" + 23+23 +# 19 "lexical.cppo" + (* expands to 23+23 *) + +(* This test shows that it is OK to pass an empty argument to a macro + that expects one parameter. This is interpreted as passing one + empty argument. *) +# 25 "lexical.cppo" + show(42) +# 26 "lexical.cppo" + show("23") +# 27 "lexical.cppo" + show() diff --git a/unikernel/duniverse/cppo/test/loc.cppo b/unikernel/duniverse/cppo/test/loc.cppo new file mode 100644 index 00000000..d7c2c521 --- /dev/null +++ b/unikernel/duniverse/cppo/test/loc.cppo @@ -0,0 +1,8 @@ +#define loc __FILE__ __LINE__ +loc +X(loc) +X(loc) +X(Y(loc)) + +#define F(x) loc +F() diff --git a/unikernel/duniverse/cppo/test/loc.ref b/unikernel/duniverse/cppo/test/loc.ref new file mode 100644 index 00000000..78bbfb72 --- /dev/null +++ b/unikernel/duniverse/cppo/test/loc.ref @@ -0,0 +1,21 @@ +# 2 "loc.cppo" + "loc.cppo" 2 +# 3 "loc.cppo" +X( +# 3 "loc.cppo" + "loc.cppo" 3 +# 3 "loc.cppo" +) +X( +# 4 "loc.cppo" + "loc.cppo" 4 +# 4 "loc.cppo" +) +X(Y( +# 5 "loc.cppo" + "loc.cppo" 5 +# 5 "loc.cppo" + )) + +# 8 "loc.cppo" + "loc.cppo" 8 diff --git a/unikernel/duniverse/cppo/test/missing_enddef.cppo b/unikernel/duniverse/cppo/test/missing_enddef.cppo new file mode 100644 index 00000000..de5c4ed6 --- /dev/null +++ b/unikernel/duniverse/cppo/test/missing_enddef.cppo @@ -0,0 +1,12 @@ +(* A common problem: *) + +#def TWICE(e) + e + e +(* missing #enddef here *) + +let f x = + TWICE(x) + +(* The error is detected by the parser at the end of the file, + but we are able to report the location of the #def as the + source of the problem. *) diff --git a/unikernel/duniverse/cppo/test/missing_enddef.ref b/unikernel/duniverse/cppo/test/missing_enddef.ref new file mode 100644 index 00000000..9d734439 --- /dev/null +++ b/unikernel/duniverse/cppo/test/missing_enddef.ref @@ -0,0 +1,2 @@ +Error: File "missing_enddef.cppo", line 3, characters 0-13 +Error: This #def is never closed: perhaps #enddef is missing diff --git a/unikernel/duniverse/cppo/test/missing_endscope.cppo b/unikernel/duniverse/cppo/test/missing_endscope.cppo new file mode 100644 index 00000000..f5d77b43 --- /dev/null +++ b/unikernel/duniverse/cppo/test/missing_endscope.cppo @@ -0,0 +1,14 @@ +(* A common problem: *) + +#scope +#def TWICE(e) + e + e +#enddef +(* missing #endscope here *) + +let f x = + TWICE(x) + +(* The error is detected by the parser at the end of the file, + but we are able to report the location of the #scope as the + source of the problem. *) diff --git a/unikernel/duniverse/cppo/test/missing_endscope.ref b/unikernel/duniverse/cppo/test/missing_endscope.ref new file mode 100644 index 00000000..f8b92b9c --- /dev/null +++ b/unikernel/duniverse/cppo/test/missing_endscope.ref @@ -0,0 +1,2 @@ +Error: File "missing_endscope.cppo", line 3, characters 0-6 +Error: This #scope is never closed: perhaps #endscope is missing diff --git a/unikernel/duniverse/cppo/test/paren_arg.cppo b/unikernel/duniverse/cppo/test/paren_arg.cppo new file mode 100644 index 00000000..f4c4803e --- /dev/null +++ b/unikernel/duniverse/cppo/test/paren_arg.cppo @@ -0,0 +1,3 @@ +#define F(x, y) +F((1, (2)), 34) +F((1\,\(2\)), 34) diff --git a/unikernel/duniverse/cppo/test/paren_arg.ref b/unikernel/duniverse/cppo/test/paren_arg.ref new file mode 100644 index 00000000..6555ca05 --- /dev/null +++ b/unikernel/duniverse/cppo/test/paren_arg.ref @@ -0,0 +1,4 @@ +# 2 "paren_arg.cppo" + <(1, (2))> < 34> +# 3 "paren_arg.cppo" + <(1 , (2 ))> < 34> diff --git a/unikernel/duniverse/cppo/test/scope.cppo b/unikernel/duniverse/cppo/test/scope.cppo new file mode 100644 index 00000000..b4ad4a4e --- /dev/null +++ b/unikernel/duniverse/cppo/test/scope.cppo @@ -0,0 +1,85 @@ +(* This example shows that the definition of FOO that is nested inside + the (multi-line) definition of BAR affects only the body of the + definition of BAR. It does not affect the text that follows a call + to BAR. So, a multi-line macro definition acts as a scope delimiter. *) + +#def BAR + #define FOO "definition of FOO inside BAR" + FOO (* expands to "definition of FOO inside BAR" *) +#enddef +#define FOO "definition of FOO at the top level" +FOO (* expands to "definition of FOO at the top level" *) +BAR +FOO (* expands to "definition of FOO at the top level" *) + +(* If one wishes to delimit a scope, without actually defining a macro, + one can use #scope ... #endscope. *) + +#scope + #define HELLO "first definition of HELLO" + HELLO (* expands to "first definition of HELLO" *) +#endscope +#scope + #define HELLO "second definition of HELLO" + HELLO (* expands to "second definition of HELLO" *) +#endscope +HELLO (* this does not expand *) + +(* The effect of #scope ... #endscope can be simulated by writing + #def DUMMY ... #enddef DUMMY #undef DUMMY + but this is a bit unnatural. *) + +#def DUMMY + #define HELLO "definition of HELLO inside the scope" + HELLO (* expands to "definition of HELLO inside the scope" *) +#enddef +DUMMY +#undef DUMMY +HELLO (* this does not expand *) + +(* Another simple example. *) + +#scope +#define HI "I am defined" +let x = HI (* expands to "I am defined" *) +#endscope +#define HI 42 +let y = HI (* expands to 42 *) + +(* Check that the effect of #undef is also local. + This example relies on the above definition of HI. *) + +#scope +#undef HI +let qwd = HI (* HI is not recognized as a macro and expands to itself *) +#endscope +let z = HI (* expands to 42 *) + +(* Scopes can be nested. *) + +#define LEVEL 0 +let x = LEVEL (* expands to 0 *) +#scope + #undef LEVEL + #define LEVEL 1 + let y = LEVEL (* expands to 1 *) + #scope + #undef LEVEL + #define LEVEL 2 + let z = LEVEL (* expands to 2 *) + #endscope + let _ = LEVEL (* expands to 1 *) +#endscope +let _ = LEVEL (* expands to 0 *) + +(* Another example of nesting. *) + +#scope + #define HELLO "Hello, " + #scope + #define MAN "man" + let message1 = HELLO ^ MAN + #endscope + (* Here, MAN is no longer defined, but HELLO still is. *) + let message2 = HELLO ^ "world" +#endscope diff --git a/unikernel/duniverse/cppo/test/scope.ref b/unikernel/duniverse/cppo/test/scope.ref new file mode 100644 index 00000000..4a41ad5e --- /dev/null +++ b/unikernel/duniverse/cppo/test/scope.ref @@ -0,0 +1,131 @@ +# 1 "scope.cppo" +(* This example shows that the definition of FOO that is nested inside + the (multi-line) definition of BAR affects only the body of the + definition of BAR. It does not affect the text that follows a call + to BAR. So, a multi-line macro definition acts as a scope delimiter. *) + +# 11 "scope.cppo" + "definition of FOO at the top level" +# 11 "scope.cppo" + (* expands to "definition of FOO at the top level" *) +# 12 "scope.cppo" + + "definition of FOO inside BAR" (* expands to "definition of FOO inside BAR" *) + +# 13 "scope.cppo" + "definition of FOO at the top level" +# 13 "scope.cppo" + (* expands to "definition of FOO at the top level" *) + +(* If one wishes to delimit a scope, without actually defining a macro, + one can use #scope ... #endscope. *) + + + +# 20 "scope.cppo" + "first definition of HELLO" +# 20 "scope.cppo" + (* expands to "first definition of HELLO" *) + + +# 24 "scope.cppo" + "second definition of HELLO" +# 24 "scope.cppo" + (* expands to "second definition of HELLO" *) +HELLO (* this does not expand *) + +(* The effect of #scope ... #endscope can be simulated by writing + #def DUMMY ... #enddef DUMMY #undef DUMMY + but this is a bit unnatural. *) + +# 36 "scope.cppo" + + "definition of HELLO inside the scope" (* expands to "definition of HELLO inside the scope" *) + +# 38 "scope.cppo" +HELLO (* this does not expand *) + +(* Another simple example. *) + + +# 44 "scope.cppo" +let x = +# 44 "scope.cppo" + "I am defined" +# 44 "scope.cppo" + (* expands to "I am defined" *) +# 47 "scope.cppo" +let y = +# 47 "scope.cppo" + 42 +# 47 "scope.cppo" + (* expands to 42 *) + +(* Check that the effect of #undef is also local. + This example relies on the above definition of HI. *) + + +# 54 "scope.cppo" +let qwd = HI (* HI is not recognized as a macro and expands to itself *) +let z = +# 56 "scope.cppo" + 42 +# 56 "scope.cppo" + (* expands to 42 *) + +(* Scopes can be nested. *) + +# 61 "scope.cppo" +let x = +# 61 "scope.cppo" + 0 +# 61 "scope.cppo" + (* expands to 0 *) + + +# 65 "scope.cppo" + let y = +# 65 "scope.cppo" + 1 +# 65 "scope.cppo" + (* expands to 1 *) + + +# 69 "scope.cppo" + let z = +# 69 "scope.cppo" + 2 +# 69 "scope.cppo" + (* expands to 2 *) + let _ = +# 71 "scope.cppo" + 1 +# 71 "scope.cppo" + (* expands to 1 *) +let _ = +# 73 "scope.cppo" + 0 +# 73 "scope.cppo" + (* expands to 0 *) + +(* Another example of nesting. *) + + + + +# 81 "scope.cppo" + let message1 = +# 81 "scope.cppo" + "Hello, " +# 81 "scope.cppo" + ^ +# 81 "scope.cppo" + "man" + +# 83 "scope.cppo" + (* Here, MAN is no longer defined, but HELLO still is. *) + let message2 = +# 84 "scope.cppo" + "Hello, " +# 84 "scope.cppo" + ^ "world" diff --git a/unikernel/duniverse/cppo/test/shape_mismatch.cppo b/unikernel/duniverse/cppo/test/shape_mismatch.cppo new file mode 100644 index 00000000..54c69cdf --- /dev/null +++ b/unikernel/duniverse/cppo/test/shape_mismatch.cppo @@ -0,0 +1,5 @@ +#define FOO 24 +#define APPLY(F : [.], X) F(X) +APPLY(FOO, 42) + (* invalid because APPLY expects a macro of type [.] + but FOO has type . *) diff --git a/unikernel/duniverse/cppo/test/shape_mismatch.ref b/unikernel/duniverse/cppo/test/shape_mismatch.ref new file mode 100644 index 00000000..0e49b4d3 --- /dev/null +++ b/unikernel/duniverse/cppo/test/shape_mismatch.ref @@ -0,0 +1,3 @@ +Error: File "shape_mismatch.cppo", line 3, characters 6-9 +Error: A macro of type [.] was expected, but + a macro of type . was provided diff --git a/unikernel/duniverse/cppo/test/source.sh b/unikernel/duniverse/cppo/test/source.sh new file mode 100755 index 00000000..660d161a --- /dev/null +++ b/unikernel/duniverse/cppo/test/source.sh @@ -0,0 +1,13 @@ +#! /bin/sh -e + +echo "# $2" +echo "(*" +cat "$1" +echo "*)" +echo "(*" +echo " Environment variables:" +echo " CPPO_FILE=$CPPO_FILE" +echo " CPPO_FIRST_LINE=$CPPO_FIRST_LINE" +echo " CPPO_LAST_LINE=$CPPO_LAST_LINE" +echo "*)" +echo "# $3" diff --git a/unikernel/duniverse/cppo/test/test.cppo b/unikernel/duniverse/cppo/test/test.cppo new file mode 100644 index 00000000..9a259bcc --- /dev/null +++ b/unikernel/duniverse/cppo/test/test.cppo @@ -0,0 +1,146 @@ +(* comment *) + +#define pi 3.14 +f(1) +#define f(x) x+pi +f(2) +#undef pi +f(3) + +#ifdef g +"g" is defined +#else +"g" is not defined +#endif + +#define a(x) b() +#define b(x) a() +a() + +debug("a") +debug("b") + +#define z 123 +#define y z +#define x y + +#if x lsl 1 = 2*123 + +#if 1 = 2 +#error "test" +#endif + +success +#else +failure +#endif + +#define test_multiline \ +"abc\ + xyz + def" \ +(* 123 \ + 789 + 456 *) +test_multiline + +#define test_args(x, y) x y +test_args("a","b") + +#define test_argc(x) x y +test_argc(aa\,bb) + +#define test_esc(x) x +test_esc(\,\)\() + +blah #define xyz +#ifdef xyz +#error "xyz should not have been defined" +#endif + +#define sticky1(x) _ +#define sticky2(x) sticky1()_ (* the 2 underscores should be space-separated *) +sticky2() + +#define empty1 +#define empty2 +empty1+ (* there should be some space between the pluses *) +empty2 + +(* (* nested comment with single single quote: ' *) "*)" *) + +#define arg +obj + \# define arg + +' (* lone single quote *) + +#define one 1 +one = 1 + +#undef x +#define x # +x is # + +#undef one +#define one 1 +#if (one+one = 100 + \ + 64 lsr 3 / 4 - lnot lnot 100) && \ + 1 + 3 * 5 = 16 && \ + 22 mod 7 = 1 && \ + lnot 0 = 0xffffffffffffffff && \ + -1 asr 100 = -1 && \ + -1 land (1 lsl 1 lsr 1) = 1 && \ + -1 lor 1 = -1 && \ + -2 lxor 1 = -1 && \ + lnot -1 = 0 && \ + true && not false && defined one && \ + (true || true && false) +good maths +#else +#error "math error" +#endif + + +#undef f +#undef g +#undef x +#undef y + +#define trace(f) \ +let f x = \ + printf "call %s\n%!" STRINGIFY(f); \ + let y = f x in \ + printf "return %s\n%!" STRINGIFY(f); \ + y \ +;; + +trace(g) + +#define field(name,type) \ + val mutable name : type option \ + method CONCAT(get_, name) = name \ + method CONCAT(set_, name) x = name <- Some x + +class foo () = +object + field(field_1, int) + field(field_2, string) +end + +#define DEBUG(x) \ + (if !debug then \ + eprintf "[debug] %s %i: " __FILE__ __LINE__; \ + eprintf x; \ + eprintf "\n") +DEBUG("test1 %i %i" x y) +DEBUG("test2 %i" x) + +#include "incl.cppo" +# 123456 + +#789 "test" +#include "incl.cppo" + +#define debug(s) Printf.eprintf "%S %i: %s\n%!" __FILE__ __LINE__ s + +end diff --git a/unikernel/duniverse/cppo/test/test.ref b/unikernel/duniverse/cppo/test/test.ref new file mode 100644 index 00000000..bf7ec115 --- /dev/null +++ b/unikernel/duniverse/cppo/test/test.ref @@ -0,0 +1,142 @@ +# 1 "test.cppo" +(* comment *) + +# 4 "test.cppo" +f(1) +# 6 "test.cppo" + 2+ 3.14 +# 8 "test.cppo" + 3+ 3.14 + +# 13 "test.cppo" +"g" is not defined + +# 18 "test.cppo" + b() + +# 20 "test.cppo" +debug("a") +debug("b") + + + + +# 33 "test.cppo" +success + +# 45 "test.cppo" + +"abc\ + xyz + def" +(* 123 \ + 789 + 456 *) + +# 48 "test.cppo" + "a" "b" + +# 51 "test.cppo" + aa ,bb 123 + +# 54 "test.cppo" + , ) ( + +# 56 "test.cppo" +blah #define xyz + +# 63 "test.cppo" + _ _ (* the 2 underscores should be space-separated *) + +# 67 "test.cppo" + + + (* there should be some space between the pluses *) + +# 69 "test.cppo" +(* (* nested comment with single single quote: ' *) "*)" *) + +# 72 "test.cppo" +obj + # define +# 73 "test.cppo" + + +# 75 "test.cppo" +' (* lone single quote *) + +# 78 "test.cppo" + 1 +# 78 "test.cppo" + = 1 + +# 82 "test.cppo" + # +# 82 "test.cppo" + is # + +# 98 "test.cppo" +good maths + + + + +# 117 "test.cppo" + +let g x = + printf "call %s\n%!" "g"; + let y = g x in + printf "return %s\n%!" "g"; + y +;; + + +# 124 "test.cppo" +class foo () = +object + +# 126 "test.cppo" + + val mutable field_1 : int option + method get_field_1 = field_1 + method set_field_1 x = field_1 <- Some x + +# 127 "test.cppo" + + val mutable field_2 : string option + method get_field_2 = field_2 + method set_field_2 x = field_2 <- Some x +# 128 "test.cppo" +end + +# 135 "test.cppo" + + (if !debug then + eprintf "[debug] %s %i: " "test.cppo" 135 ; + eprintf "test1 %i %i" x y; + eprintf "\n") +# 136 "test.cppo" + + (if !debug then + eprintf "[debug] %s %i: " "test.cppo" 136 ; + eprintf "test2 %i" x; + eprintf "\n") + +# 1 "incl.cppo" +included + +# 1 "incl2.cppo" +ok +# 139 "test.cppo" + +# 123456 + + +# 789 "test" +# 1 "incl.cppo" +included + +# 1 "incl2.cppo" +ok + + +# 793 "test" +end diff --git a/unikernel/duniverse/cppo/test/tuple.cppo b/unikernel/duniverse/cppo/test/tuple.cppo new file mode 100644 index 00000000..57423b89 --- /dev/null +++ b/unikernel/duniverse/cppo/test/tuple.cppo @@ -0,0 +1,38 @@ +#if (2 + 2, 5) < (4, 5) + mountain + #error "" +#else + pistachios +#endif + +#if (3 * 3) = 10 - 1 + trees +#else + rocks + #error "" +#endif + +#if (1) = (1) + waves +#else + sharks + #error "" +#endif + + +#define x 11 +#if (x, 2) <> (x, 4/2) + honey + #error "" +#else + bees +#endif + +#define tuple (0, -5, 3) +#define tuple2 tuple +#if (0, -5, x) > tuple2 + steamboat +#else + koalas + #error "" +#endif diff --git a/unikernel/duniverse/cppo/test/tuple.ref b/unikernel/duniverse/cppo/test/tuple.ref new file mode 100644 index 00000000..58df976e --- /dev/null +++ b/unikernel/duniverse/cppo/test/tuple.ref @@ -0,0 +1,20 @@ + +# 5 "tuple.cppo" + pistachios + + +# 9 "tuple.cppo" + trees + + +# 16 "tuple.cppo" + waves + + + +# 28 "tuple.cppo" + bees + + +# 34 "tuple.cppo" + steamboat diff --git a/unikernel/duniverse/cppo/test/undefined.cppo b/unikernel/duniverse/cppo/test/undefined.cppo new file mode 100644 index 00000000..d129be42 --- /dev/null +++ b/unikernel/duniverse/cppo/test/undefined.cppo @@ -0,0 +1,4 @@ +#define APPLY(F : [.], X) F(X) +APPLY(FOO, 42) + (* invalid because APPLY expects a macro as an argument: + but FOO is not defined. *) diff --git a/unikernel/duniverse/cppo/test/undefined.ref b/unikernel/duniverse/cppo/test/undefined.ref new file mode 100644 index 00000000..b9b12846 --- /dev/null +++ b/unikernel/duniverse/cppo/test/undefined.ref @@ -0,0 +1,2 @@ +Error: File "undefined.cppo", line 2, characters 6-9 +Error: The macro 'FOO' is not defined diff --git a/unikernel/duniverse/cppo/test/unmatched.cppo b/unikernel/duniverse/cppo/test/unmatched.cppo new file mode 100644 index 00000000..470cbd44 --- /dev/null +++ b/unikernel/duniverse/cppo/test/unmatched.cppo @@ -0,0 +1,14 @@ +#ifdef whatever + ( +#else + let a = 1 in + let b = 2 in + (a || +#endif + + b) + +#define F(x, y) (x + y) +F(1,(2+3)) +) +( diff --git a/unikernel/duniverse/cppo/test/unmatched.ref b/unikernel/duniverse/cppo/test/unmatched.ref new file mode 100644 index 00000000..ff2356a5 --- /dev/null +++ b/unikernel/duniverse/cppo/test/unmatched.ref @@ -0,0 +1,15 @@ + +# 4 "unmatched.cppo" + let a = 1 in + let b = 2 in + (a || + + +# 9 "unmatched.cppo" + b) + +# 12 "unmatched.cppo" + (1 + (2+3)) +# 13 "unmatched.cppo" +) +( diff --git a/unikernel/duniverse/cppo/test/version.cppo b/unikernel/duniverse/cppo/test/version.cppo new file mode 100644 index 00000000..a7a02240 --- /dev/null +++ b/unikernel/duniverse/cppo/test/version.cppo @@ -0,0 +1,34 @@ +#if X_VERSION < (123, 0, 0) + alligators + #error "" +#else + Cape buffalos +#endif + +#define v X_VERSION +#if v = (X_MAJOR, X_MINOR, X_PATCH) + onion rings +#else + gazpacho + #error "" +#endif + +major: X_MAJOR +minor: X_MINOR +patch: X_PATCH + +#ifdef X_PRERELEASE + prerelease: X_PRERELEASE +#else + #error "" +#endif + +#ifdef X_BUILD + build: X_BUILD +#else + #error "" +#endif + +Coq: COQ_VERSION + +OCaml pre-release: OCAML_PRERELEASE diff --git a/unikernel/duniverse/cppo/test/version.ref b/unikernel/duniverse/cppo/test/version.ref new file mode 100644 index 00000000..ea9ca7b6 --- /dev/null +++ b/unikernel/duniverse/cppo/test/version.ref @@ -0,0 +1,42 @@ + +# 5 "version.cppo" + Cape buffalos + + +# 10 "version.cppo" + onion rings + +# 16 "version.cppo" +major: +# 16 "version.cppo" + 123 +# 17 "version.cppo" +minor: +# 17 "version.cppo" + 05 +# 18 "version.cppo" +patch: +# 18 "version.cppo" + 2 + + +# 21 "version.cppo" + prerelease: +# 21 "version.cppo" + alpha.1 + + +# 27 "version.cppo" + build: +# 27 "version.cppo" + foo-2.1 + +# 32 "version.cppo" +Coq: +# 32 "version.cppo" + (8, 13, 0) + +# 34 "version.cppo" +OCaml pre-release: +# 34 "version.cppo" + alpha1 diff --git a/unikernel/duniverse/csexp/.github/CODEOWNERS b/unikernel/duniverse/csexp/.github/CODEOWNERS new file mode 100644 index 00000000..554300b9 --- /dev/null +++ b/unikernel/duniverse/csexp/.github/CODEOWNERS @@ -0,0 +1 @@ +* @diml \ No newline at end of file diff --git a/unikernel/duniverse/csexp/.gitignore b/unikernel/duniverse/csexp/.gitignore new file mode 100644 index 00000000..9965cf37 --- /dev/null +++ b/unikernel/duniverse/csexp/.gitignore @@ -0,0 +1,4 @@ +_opam +_build +*.install +.merlin diff --git a/unikernel/duniverse/csexp/.ocamlformat b/unikernel/duniverse/csexp/.ocamlformat new file mode 100644 index 00000000..b5dbb66c --- /dev/null +++ b/unikernel/duniverse/csexp/.ocamlformat @@ -0,0 +1,12 @@ +version=0.24.1 +profile=conventional +ocaml-version=4.08.0 +break-separators=before +dock-collection-brackets=false +doc-comments=before +let-and=sparse +type-decl=sparse +cases-exp-indent=2 +break-cases=fit-or-vertical +parse-docstrings=true +module-item-spacing=sparse diff --git a/unikernel/duniverse/csexp/CHANGES.md b/unikernel/duniverse/csexp/CHANGES.md new file mode 100644 index 00000000..43e5a767 --- /dev/null +++ b/unikernel/duniverse/csexp/CHANGES.md @@ -0,0 +1,64 @@ +# 1.5.2 + +- Fix `Csexp.serialised_length`. Previously, it would under count by 2 because + it did not take the parentheses into account. (#22, @jchavarri) + +# 1.5.1 + +- Drop dependency on result and compatibility with OCaml 4.02 (#17, + @rgrinberg) + +# 1.5.0 + +Replaced by 1.5.1 because of accidentally breaking compat with 4.03. + +# 1.4.0 + +- Add a `Csexp.t` type and extend `Csexp` to include the module from the functor + application (#14, @rgrinberg) + +# 1.3.2 + +- The project now builds with dune 1.11.0 and onward (#12, @voodoos) + +# 1.3.1 + +- Fix compatibility with 4.02.3 + +# 1.3.0 + +- Add a "feed" API for parsing. This new API let the user feed + characters one by one to the parser. It gives more control to the + user and the handling of IO errors is simpler and more + explicit. Finally, it allocates less (#9, @jeremiedimino) + +- Fixes `input_opt`; it was could never return [None] (#9, fixes #7, + @jeremiedimino) + +- Fixes `parse_many`; it was returning s-expressions in the wrong + order (#10, @rgrinberg) + +# 1.2.3 + +- Fix `parse_string_many`; it used to fail on all inputs (#6, @rgrinberg) + +# 1.2.2 + +- Fix compatibility with 4.02.3 + +# 1.2.1 + +- Remove inclusion of the `Result` module, which was accidentally + added in a previous PR. (#3, @rgrinberg) + +# 1.2.0 + +- Expose low level, monad agnostic parser. (#2, @mefyl) + +# 1.1.0 + +- Add compatibility up-to OCaml 4.02.3 (with disabled tests). (#1, @voodoos) + +# 1.0.0 + +- Initial release diff --git a/unikernel/duniverse/csexp/LICENSE.md b/unikernel/duniverse/csexp/LICENSE.md new file mode 100644 index 00000000..06829595 --- /dev/null +++ b/unikernel/duniverse/csexp/LICENSE.md @@ -0,0 +1,21 @@ +The MIT License + +Copyright (c) 2016 Jane Street Group, LLC + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/unikernel/duniverse/csexp/Makefile b/unikernel/duniverse/csexp/Makefile new file mode 100644 index 00000000..faa6ccda --- /dev/null +++ b/unikernel/duniverse/csexp/Makefile @@ -0,0 +1,31 @@ +INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) + +default: + dune runtest + +test: + dune runtest + +install: + dune install $(INSTALL_ARGS) + +uninstall: + dune uninstall $(INSTALL_ARGS) + +reinstall: uninstall install + +clean: + dune clean + +all-supported-ocaml-versions: + dune build @install @runtest --workspace dune-workspace.dev + +dune-release: + dune-release tag + dune-release distrib --skip-build --skip-lint --skip-tests +# See https://github.com/ocamllabs/dune-release/issues/206 + DUNE_RELEASE_DELEGATE=github-dune-release-delegate dune-release publish distrib --verbose + dune-release opam pkg + dune-release opam submit + +.PHONY: default install uninstall reinstall clean test diff --git a/unikernel/duniverse/csexp/README.md b/unikernel/duniverse/csexp/README.md new file mode 100644 index 00000000..b6c13631 --- /dev/null +++ b/unikernel/duniverse/csexp/README.md @@ -0,0 +1,33 @@ +Csexp - Canonical S-expressions +=============================== + +This project provides minimal support for parsing and printing +[S-expressions in canonical form][wikipedia], which is a very simple +and canonical binary encoding of S-expressions. + +[wikipedia]: https://en.wikipedia.org/wiki/Canonical_S-expressions + +Example +------- + +```ocaml +# #require "csexp";; +# module Sexp = struct type t = Atom of string | List of t list end;; +module Sexp : sig type t = Atom of string | List of t list end +# module Csexp = Csexp.Make(Sexp);; +module Csexp : + sig + val parse_string : string -> (Sexp.t, int * string) result + val parse_string_many : string -> (Sexp.t list, int * string) result + val input : in_channel -> (Sexp.t, string) result + val input_opt : in_channel -> (Sexp.t option, string) result + val input_many : in_channel -> (Sexp.t list, string) result + val serialised_length : Sexp.t -> int + val to_string : Sexp.t -> string + val to_buffer : Buffer.t -> Sexp.t -> unit + val to_channel : out_channel -> Sexp.t -> unit + end +# Csexp.to_string (List [ Atom "Hello"; Atom "world!" ]);; +- : string = "(5:Hello6:world!)" +``` + diff --git a/unikernel/duniverse/csexp/bench/csexp_bench.ml b/unikernel/duniverse/csexp/bench/csexp_bench.ml new file mode 100644 index 00000000..79fde996 --- /dev/null +++ b/unikernel/duniverse/csexp/bench/csexp_bench.ml @@ -0,0 +1,21 @@ +open StdLabels + +module Sexp = struct + type t = + | Atom of string + | List of t list +end + +module Csexp = Csexp.Make (Sexp) + +let atom = Sexp.Atom (String.make 128 'x') + +let rec gen_sexp depth = + if depth = 0 then atom + else + let x = gen_sexp (depth - 1) in + List [ x; x ] + +let s = Sys.opaque_identity (Csexp.to_string (gen_sexp 16)) + +let%bench "of_string" = ignore (Csexp.parse_string s : _ result) diff --git a/unikernel/duniverse/csexp/bench/dune b/unikernel/duniverse/csexp/bench/dune new file mode 100644 index 00000000..24cae7fb --- /dev/null +++ b/unikernel/duniverse/csexp/bench/dune @@ -0,0 +1,12 @@ +(library + (name csexp_bench) + (libraries csexp) + (library_flags -linkall) + (preprocess + (pps ppx_bench)) + (modules csexp_bench)) + +(executable + (name main) + (modules main) + (libraries core_bench.inline_benchmarks csexp_bench)) diff --git a/unikernel/duniverse/csexp/bench/main.ml b/unikernel/duniverse/csexp/bench/main.ml new file mode 100644 index 00000000..88e7fe25 --- /dev/null +++ b/unikernel/duniverse/csexp/bench/main.ml @@ -0,0 +1 @@ +let () = Inline_benchmarks_public.Runner.main ~libname:"csexp_bench" diff --git a/unikernel/duniverse/csexp/bench/runner.sh b/unikernel/duniverse/csexp/bench/runner.sh new file mode 100755 index 00000000..0089cf7f --- /dev/null +++ b/unikernel/duniverse/csexp/bench/runner.sh @@ -0,0 +1,4 @@ +#!/usr/bin/env sh +export BENCHMARKS_RUNNER=TRUE +export BENCH_LIB=csexp_bench +exec dune exec -- ./main.exe -fork -run-without-cross-library-inlining "$@" diff --git a/unikernel/duniverse/csexp/csexp.opam b/unikernel/duniverse/csexp/csexp.opam new file mode 100644 index 00000000..59b5f12e --- /dev/null +++ b/unikernel/duniverse/csexp/csexp.opam @@ -0,0 +1,51 @@ +version: "1.5.2" +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "Parsing and printing of S-expressions in Canonical form" +description: """ + +This library provides minimal support for Canonical S-expressions +[1]. Canonical S-expressions are a binary encoding of S-expressions +that is super simple and well suited for communication between +programs. + +This library only provides a few helpers for simple applications. If +you need more advanced support, such as parsing from more fancy input +sources, you should consider copying the code of this library given +how simple parsing S-expressions in canonical form is. + +To avoid a dependency on a particular S-expression library, the only +module of this library is parameterised by the type of S-expressions. + +[1] https://en.wikipedia.org/wiki/Canonical_S-expressions +""" +maintainer: ["Jeremie Dimino "] +authors: [ + "Quentin Hocquet " + "Jane Street Group, LLC " + "Jeremie Dimino " +] +license: "MIT" +homepage: "https://github.com/ocaml-dune/csexp" +doc: "https://ocaml-dune.github.io/csexp/" +bug-reports: "https://github.com/ocaml-dune/csexp/issues" +depends: [ + "dune" {>= "3.4"} + "ocaml" {>= "4.03.0"} + "odoc" {with-doc} +] +dev-repo: "git+https://github.com/ocaml-dune/csexp.git" +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" +# "@runtest" {with-test & ocaml:version >= "4.04"} + "@doc" {with-doc} + ] +] \ No newline at end of file diff --git a/unikernel/duniverse/csexp/csexp.opam.template b/unikernel/duniverse/csexp/csexp.opam.template new file mode 100644 index 00000000..d7691b5d --- /dev/null +++ b/unikernel/duniverse/csexp/csexp.opam.template @@ -0,0 +1,14 @@ +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" +# "@runtest" {with-test & ocaml:version >= "4.04"} + "@doc" {with-doc} + ] +] diff --git a/unikernel/duniverse/csexp/dune-project b/unikernel/duniverse/csexp/dune-project new file mode 100644 index 00000000..f2ca46c6 --- /dev/null +++ b/unikernel/duniverse/csexp/dune-project @@ -0,0 +1,40 @@ +(lang dune 3.4) +(name csexp) +(version 1.5.2) + +(license MIT) +(maintainers "Jeremie Dimino ") +(authors + "Quentin Hocquet " + "Jane Street Group, LLC " + "Jeremie Dimino ") +(source (github ocaml-dune/csexp)) +(documentation "https://ocaml-dune.github.io/csexp/") + +(generate_opam_files true) + +(package + (name csexp) + (depends + (ocaml (>= 4.03.0)) +; (ppx_expect :with-test) +; Disabled because of a dependency cycle +; (see https://github.com/ocaml-opam/opam-depext/issues/121) + ) + (synopsis "Parsing and printing of S-expressions in Canonical form") + (description " +This library provides minimal support for Canonical S-expressions +[1]. Canonical S-expressions are a binary encoding of S-expressions +that is super simple and well suited for communication between +programs. + +This library only provides a few helpers for simple applications. If +you need more advanced support, such as parsing from more fancy input +sources, you should consider copying the code of this library given +how simple parsing S-expressions in canonical form is. + +To avoid a dependency on a particular S-expression library, the only +module of this library is parameterised by the type of S-expressions. + +[1] https://en.wikipedia.org/wiki/Canonical_S-expressions +")) diff --git a/unikernel/duniverse/csexp/dune-workspace.dev b/unikernel/duniverse/csexp/dune-workspace.dev new file mode 100644 index 00000000..6525e9a3 --- /dev/null +++ b/unikernel/duniverse/csexp/dune-workspace.dev @@ -0,0 +1,6 @@ +(lang dune 1.0) + +;; This file is used by `make all-supported-ocaml-versions` +(context (opam (switch 4.03.0))) +(context (opam (switch 4.04.2))) +(context (opam (switch 4.08.1))) diff --git a/unikernel/duniverse/csexp/flake.lock b/unikernel/duniverse/csexp/flake.lock new file mode 100644 index 00000000..29ae4a36 --- /dev/null +++ b/unikernel/duniverse/csexp/flake.lock @@ -0,0 +1,58 @@ +{ + "nodes": { + "flake-utils": { + "locked": { + "lastModified": 1678901627, + "narHash": "sha256-U02riOqrKKzwjsxc/400XnElV+UtPUQWpANPlyazjH0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "93a2b84fc4b70d9e089d029deacc3583435c2ed6", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nix-filter": { + "locked": { + "lastModified": 1678109515, + "narHash": "sha256-C2X+qC80K2C1TOYZT8nabgo05Dw2HST/pSn6s+n6BO8=", + "owner": "numtide", + "repo": "nix-filter", + "rev": "aa9ff6ce4a7f19af6415fb3721eaa513ea6c763c", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "nix-filter", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1679628852, + "narHash": "sha256-mrBaaWvxYItnawGndPjQGMKpQK6nF8ljzuvm0DLgnr4=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "f3a0f82e577771b3cf116580b78c66e7b2a89d5c", + "type": "github" + }, + "original": { + "owner": "nixos", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nix-filter": "nix-filter", + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/unikernel/duniverse/csexp/flake.nix b/unikernel/duniverse/csexp/flake.nix new file mode 100644 index 00000000..2c15ec93 --- /dev/null +++ b/unikernel/duniverse/csexp/flake.nix @@ -0,0 +1,42 @@ +{ + description = "csexp Nix Flake"; + + inputs.nix-filter.url = "github:numtide/nix-filter"; + inputs.flake-utils.url = "github:numtide/flake-utils"; + inputs.nixpkgs.url = "github:nixos/nixpkgs"; + + outputs = { self, nixpkgs, flake-utils, nix-filter }: + flake-utils.lib.eachDefaultSystem (system: + let + pkgs = nixpkgs.legacyPackages."${system}"; + inherit (pkgs.ocamlPackages) buildDunePackage; + in + rec { + packages = rec { + default = csexp; + csexp = buildDunePackage { + pname = "csexp"; + version = "n/a"; + src = ./.; + duneVersion = "3"; + propagatedBuildInputs = with pkgs.ocamlPackages; [ ]; + checkInputs = with pkgs.ocamlPackages; [ + ppx_inline_test + ppx_expect + ]; + doCheck = true; + }; + }; + devShells.default = pkgs.mkShell { + inputsFrom = pkgs.lib.attrValues packages; + buildInputs = with pkgs.ocamlPackages; [ + dune-release + pkgs.ccls + ocaml-lsp + pkgs.ocamlformat + ppx_bench + core_bench + ]; + }; + }); +} diff --git a/unikernel/duniverse/csexp/src/csexp.ml b/unikernel/duniverse/csexp/src/csexp.ml new file mode 100644 index 00000000..78bfa2bf --- /dev/null +++ b/unikernel/duniverse/csexp/src/csexp.ml @@ -0,0 +1,418 @@ +module type Sexp = sig + type t = + | Atom of string + | List of t list +end + +module type Monad = sig + type 'a t + + val return : 'a -> 'a t + + val bind : 'a t -> ('a -> 'b t) -> 'b t +end + +module type S = sig + type sexp + + val parse_string : string -> (sexp, int * string) result + + val parse_string_many : string -> (sexp list, int * string) result + + val input : in_channel -> (sexp, string) result + + val input_opt : in_channel -> (sexp option, string) result + + val input_many : in_channel -> (sexp list, string) result + + val serialised_length : sexp -> int + + val to_string : sexp -> string + + val to_buffer : Buffer.t -> sexp -> unit + + val to_channel : out_channel -> sexp -> unit + + module Parser : sig + exception Parse_error of string + + val premature_end_of_input : string + + module Lexer : sig + type t + + val create : unit -> t + + type _ token = + | Await : [> `other ] token + | Lparen : [> `other ] token + | Rparen : [> `other ] token + | Atom : int -> [> `atom ] token + + val feed : t -> char -> [ `other | `atom ] token + + val feed_eoi : t -> unit + end + + module Stack : sig + type t = + | Empty + | Open of t + | Sexp of sexp * t + + val to_list : t -> sexp list + + val open_paren : t -> t + + val close_paren : t -> t + + val add_atom : string -> t -> t + + val add_token : [ `other ] Lexer.token -> t -> t + end + end + + module type Input = sig + type t + + module Monad : sig + type 'a t + + val return : 'a -> 'a t + + val bind : 'a t -> ('a -> 'b t) -> 'b t + end + + val read_string : t -> int -> (string, string) result Monad.t + + val read_char : t -> (char, string) result Monad.t + end + [@@deprecated "Use Parser module instead"] + + [@@@warning "-3"] + + module Make_parser (Input : Input) : sig + val parse : Input.t -> (sexp, string) result Input.Monad.t + + val parse_many : Input.t -> (sexp list, string) result Input.Monad.t + end + [@@deprecated "Use Parser module instead"] +end + +module Make (Sexp : Sexp) = struct + open Sexp + + module Parser = struct + exception Parse_error of string + + let parse_error msg = raise (Parse_error msg) + + let parse_errorf f = Format.ksprintf parse_error f + + let premature_end_of_input = "premature end of input" + + module Lexer = struct + type state = + | Init + | Parsing_length + + type t = + { mutable state : state + ; mutable n : int + } + + let create () = { state = Init; n = 0 } + + let int_of_digit c = Char.code c - Char.code '0' + + type _ token = + | Await : [> `other ] token + | Lparen : [> `other ] token + | Rparen : [> `other ] token + | Atom : int -> [> `atom ] token + + let feed t c = + match (t.state, c) with + | Init, '(' -> Lparen + | Init, ')' -> Rparen + | Init, '0' .. '9' -> + t.state <- Parsing_length; + t.n <- int_of_digit c; + Await + | Init, _ -> + parse_errorf "invalid character %C, expected '(', ')' or '0'..'9'" c + | Parsing_length, '0' .. '9' -> + let len = (t.n * 10) + int_of_digit c in + if len > Sys.max_string_length then + parse_error "atom too big to represent" + else ( + t.n <- len; + Await) + | Parsing_length, ':' -> + t.state <- Init; + Atom t.n + | Parsing_length, _ -> + parse_errorf + "invalid character %C while parsing atom length, expected '0'..'9' \ + or ':'" + c + + let feed_eoi t = + match t.state with + | Init -> () + | Parsing_length -> parse_error premature_end_of_input + end + + module L = Lexer + + module Stack = struct + type t = + | Empty + | Open of t + | Sexp of Sexp.t * t + + let open_paren stack = Open stack + + let close_paren = + let rec loop acc = function + | Empty -> + parse_error "right parenthesis without matching left parenthesis" + | Sexp (sexp, t) -> loop (sexp :: acc) t + | Open t -> Sexp (List acc, t) + in + fun t -> loop [] t + + let to_list = + let rec loop acc = function + | Empty -> acc + | Sexp (sexp, t) -> loop (sexp :: acc) t + | Open _ -> parse_error premature_end_of_input + in + fun t -> loop [] t + + let add_atom s stack = Sexp (Atom s, stack) + + let add_token (x : [ `other ] Lexer.token) stack = + match x with + | L.Await -> stack + | L.Lparen -> open_paren stack + | L.Rparen -> close_paren stack + end + end + + open Parser + + let feed_eoi_single lexer stack = + match + Lexer.feed_eoi lexer; + Stack.to_list stack + with + | exception Parse_error msg -> Error msg + | [ x ] -> Ok x + | [] -> Error premature_end_of_input + | _ :: _ :: _ -> assert false + + let feed_eoi_many lexer stack = + match + Lexer.feed_eoi lexer; + Stack.to_list stack + with + | exception Parse_error msg -> Error msg + | l -> Ok l + + let one_token s pos len lexer stack k = + match Lexer.feed lexer (String.unsafe_get s pos) with + | exception Parse_error msg -> Error (pos, msg) + | L.Atom atom_len -> ( + match String.sub s (pos + 1) atom_len with + | exception _ -> Error (len, premature_end_of_input) + | atom -> + let pos = pos + 1 + atom_len in + k s pos len lexer (Stack.add_atom atom stack)) + | (L.Await | L.Lparen | L.Rparen) as x -> ( + match Stack.add_token x stack with + | exception Parse_error msg -> Error (pos, msg) + | stack -> k s (pos + 1) len lexer stack) + [@@inlined always] + + let parse_string = + let rec loop s pos len lexer stack = + if pos = len then + match feed_eoi_single lexer stack with + | Error msg -> Error (pos, msg) + | Ok _ as ok -> ok + else one_token s pos len lexer stack cont + and cont s pos len lexer stack = + match stack with + | Stack.Sexp (sexp, Empty) -> + if pos = len then Ok sexp + else Error (pos, "data after canonical S-expression") + | stack -> loop s pos len lexer stack + in + fun s -> loop s 0 (String.length s) (Lexer.create ()) Empty + + let parse_string_many = + let rec loop s pos len lexer stack = + if pos = len then + match feed_eoi_many lexer stack with + | Error msg -> Error (pos, msg) + | Ok _ as ok -> ok + else one_token s pos len lexer stack loop + in + fun s -> loop s 0 (String.length s) (Lexer.create ()) Empty + + let one_token ic c lexer stack = + match Lexer.feed lexer c with + | L.Atom n -> ( + match really_input_string ic n with + | exception End_of_file -> raise (Parse_error premature_end_of_input) + | s -> Stack.add_atom s stack) + | (L.Await | L.Lparen | L.Rparen) as x -> Stack.add_token x stack + + let input_opt = + let rec loop ic lexer stack = + let c = input_char ic in + match one_token ic c lexer stack with + | Sexp (sexp, Empty) -> Ok (Some sexp) + | stack -> loop ic lexer stack + in + fun ic -> + let lexer = Lexer.create () in + match input_char ic with + | exception End_of_file -> Ok None + | c -> ( + try + match Lexer.feed lexer c with + | L.Atom _ -> assert false + | (L.Await | L.Lparen | L.Rparen) as x -> + loop ic lexer (Stack.add_token x Empty) + with + | Parse_error msg -> Error msg + | End_of_file -> Error premature_end_of_input) + + let input ic = + match input_opt ic with + | Ok None -> Error premature_end_of_input + | Ok (Some x) -> Ok x + | Error msg -> Error msg + + let input_many = + let rec loop ic lexer stack = + match input_char ic with + | exception End_of_file -> + Lexer.feed_eoi lexer; + Ok (Stack.to_list stack) + | c -> loop ic lexer (one_token ic c lexer stack) + in + fun ic -> + try loop ic (Lexer.create ()) Empty with Parse_error msg -> Error msg + + let serialised_length = + let rec loop acc t = + match t with + | Atom s -> + let len = String.length s in + let x = ref len in + let len_len = ref 1 in + while !x > 9 do + x := !x / 10; + incr len_len + done; + acc + !len_len + 1 + len + | List l -> 2 + List.fold_left loop acc l + in + fun t -> loop 0 t + + let to_buffer buf sexp = + let rec loop = function + | Atom str -> + Buffer.add_string buf (string_of_int (String.length str)); + Buffer.add_string buf ":"; + Buffer.add_string buf str + | List e -> + Buffer.add_char buf '('; + List.iter loop e; + Buffer.add_char buf ')' + in + loop sexp + + let to_string sexp = + let buf = Buffer.create (serialised_length sexp) in + to_buffer buf sexp; + Buffer.contents buf + + let to_channel oc sexp = + let rec loop = function + | Atom str -> + output_string oc (string_of_int (String.length str)); + output_char oc ':'; + output_string oc str + | List l -> + output_char oc '('; + List.iter loop l; + output_char oc ')' + in + loop sexp + + module type Input = sig + type t + + module Monad : Monad + + val read_string : t -> int -> (string, string) result Monad.t + + val read_char : t -> (char, string) result Monad.t + end + + module Make_parser (Input : Input) = struct + open Input.Monad + + let ( >>= ) = bind + + let ( >>=* ) m f = + m >>= function + | Error _ as err -> return err + | Ok x -> f x + + let one_token input c lexer stack = + match Lexer.feed lexer c with + | exception Parse_error msg -> return (Error msg) + | L.Atom n -> + Input.read_string input n >>=* fun s -> + return (Ok (Stack.add_atom s stack)) + | (L.Await | L.Lparen | L.Rparen) as x -> + return + (match Stack.add_token x stack with + | exception Parse_error msg -> Error msg + | stack -> Ok stack) + + let parse = + let rec loop input lexer stack = + Input.read_char input >>= function + | Error _ -> return (feed_eoi_single lexer stack) + | Ok c -> ( + one_token input c lexer stack >>=* function + | Sexp (sexp, Empty) -> return (Ok sexp) + | stack -> loop input lexer stack) + in + fun input -> loop input (Lexer.create ()) Empty + + let parse_many = + let rec loop input lexer stack = + Input.read_char input >>= function + | Error _ -> return (feed_eoi_many lexer stack) + | Ok c -> + one_token input c lexer stack >>=* fun stack -> loop input lexer stack + in + fun input -> loop input (Lexer.create ()) Empty + end +end + +module T = struct + type t = + | Atom of string + | List of t list +end + +include T +include Make (T) diff --git a/unikernel/duniverse/csexp/src/csexp.mli b/unikernel/duniverse/csexp/src/csexp.mli new file mode 100644 index 00000000..6add81d9 --- /dev/null +++ b/unikernel/duniverse/csexp/src/csexp.mli @@ -0,0 +1,378 @@ +(** Canonical S-expressions *) + +(** This module provides minimal support for reading and writing S-expressions + in canonical form. + + https://en.wikipedia.org/wiki/Canonical_S-expressions + + Note that because the canonical representation of S-expressions is so + simple, this module doesn't go out of his way to provide a fully generic + parser and printer and instead just provides a few simple functions. If you + are using fancy input sources, simply copy the parser and adapt it. The + format is so simple that it's pretty difficult to get it wrong by accident. + + To avoid a dependency on a particular S-expression library, the only module + of this library is parameterised by the type of S-expressions. + + {[ + let rec print = function + | Atom str -> Printf.printf "%d:%s" (String.length s) + | List l -> List.iter print l + ]} *) + +module type Sexp = sig + type t = + | Atom of string + | List of t list +end + +module type S = sig + (** {2 Parsing} *) + type sexp + + (** [parse_string s] parses a single S-expression encoded in canonical form in + [s]. It is an error for [s] to contain a S-expression followed by more + data. In case of error, the offset of the error as well as an error + message is returned. *) + val parse_string : string -> (sexp, int * string) result + + (** [parse_string s] parses a sequence of S-expressions encoded in canonical + form in [s] *) + val parse_string_many : string -> (sexp list, int * string) result + + (** Read exactly one canonical S-expressions from the given channel. Note that + this function never raises [End_of_file]. Instead, it returns [Error]. *) + val input : in_channel -> (sexp, string) result + + (** Same as [input] but returns [Ok None] if the end of file has already been + reached. If some more characters are available but the end of file is + reached before reading a complete S-expression, this function returns + [Error]. *) + val input_opt : in_channel -> (sexp option, string) result + + (** Read many S-expressions until the end of input is reached. *) + val input_many : in_channel -> (sexp list, string) result + + (** {2 Serialising} *) + + (** The length of the serialised representation of a S-expression *) + val serialised_length : sexp -> int + + (** [to_string sexp] converts S-expression [sexp] to a string in canonical + form. *) + val to_string : sexp -> string + + (** [to_buffer buf sexp] outputs the S-expression [sexp] converted to its + canonical form to buffer [buf]. *) + val to_buffer : Buffer.t -> sexp -> unit + + (** [output oc sexp] outputs the S-expression [sexp] converted to its + canonical form to channel [oc]. *) + val to_channel : out_channel -> sexp -> unit + + (** {3 Low level parser} + + For efficiently parsing from sources other than strings or input channel. + For instance in Lwt or Async programs. *) + + module Parser : sig + (** The [Parser] module offers an API that is a balance between sharing the + common logic of parsing canonical S-expressions while allowing to write + parsers that are as efficient as possible, both in terms of speed and + allocations. A carefully written parser using this API will be: + + - fast + - perform minimal allocations + - perform zero [caml_modify] (a slow function of the OCaml runtime that + is emitted when mutating a constructed value) + + {2 Lexers} + + To parse using this API, you must first create a lexer via + {!Lexer.create}. The lexer is responsible for scanning the input and + forming tokens. The user must feed characters read from the input one by + one to the lexer until it yields a token. For instance: + + {[ + # let lexer = Lexer.create ();; + val lexer : Lexer.t = + # Lexer.feed lexer '(';; + - : [ `atom | `other ] Lexer.token = Lparen + # Lexer.feed lexer ')';; + - : [ `atom | `other ] Lexer.token = Rparen + ]} + + When the lexer doesn't have enough to return a token, it simply returns + the special token {!Lexer.Await}: + + {[ + # Lexer.feed lexer '1';; + - : [ `atom | `other ] Lexer.token = Await + ]} + + Note that since atoms of canonical S-expressions do not need quoting, + they are always represented as a contiguous sequence of characters that + don't need further processing. To achieve maximum efficiency, the lexer + only returns the length of the atom and it is the responsibility of the + caller to extract the atom from the input source: + + {[ + # Lexer.feed lexer '2';; + - : [ `atom | `other ] Lexer.token = Await + # Lexer.feed lexer ':';; + - : [ `atom | `other ] Lexer.token = Atom 2 + ]} + + When getting [Atom n], the caller should then proceed to read the next + [n] characters of the input as a string. For instance, if the input is + an [in_channel] the caller should proceed with + [really_input_string ic n]. + + Finally, when the end of input is reached the user should call + {!Lexer.feed_eoi} to make sure the lexer is not awaiting more input. If + that is the case, {!Lexer.feed_eoi} will raise: + + {[ + # Lexer.feed lexer '1';; + - : [ `atom | `other ] Lexer.token = Await + # Lexer.feed_eoi lexer;; + Exception: Parse_error "premature end of input". + ]} + + {2 Parsing stacks} + + The lexer doesn't keep track of the structure of the S-expressions. In + order to construct a whole structured S-expressions, the caller must + maintain a parsing stack via the {!Stack} module. A {!Stack.t} value + simply represent a parsed prefix in reverse order. + + For instance, the prefix "1:x((1:y1:z)" will be represented as: + + {[ + Sexp (List [ Atom "y"; Atom "z" ], Open (Sexp (Atom "x", Empty))) + ]} + + The {!Stack} module offers various primitives to open or close + parentheses or insert an atom. And for convenience it provides a + function {!Stack.add_token} that takes the output of {!Lexer.feed} + directly: + + {[ + # Stack.add_token Rparen Empty;; + - : Stack.t = Open Empty + # Stack.add_token Lparen (Open Empty);; + - : Stack.t = Sexp (List [], Empty) + ]} + + Note that {!Stack.add_token} doesn't accept [Atom _]. This is enforced + at the type level by a GADT. The reason for this is that in order to + insert an atom, the user must have fetched the contents of the atom + themselves. In order to insert an atom into a stack, you can use the + function {!Stack.add_atom}: + + {[ + # Stack.add_atom "foo" (Open Empty);; + - : Stack.t = Sexp (Atom "foo", Open Empty) + ]} + + When parsing is finished, one may call the function {!Stack.to_list} in + order to extract all the toplevel S-expressions from the stack: + + {[ + # Stack.to_list (Sexp (Atom "x", Sexp (List [Atom "y"], Empty)));; + - : sexp list = [List [Atom "y"; Atom "x"]] + ]} + + If instead you want to stop parsing as soon a single full S-expression + has been discovered, you can match on the structure of the stack. If the + stack is of the form [Sexp (_, Empty)], then you know that exactly one + S-expression has been parsed and you can stop there. + + {2 Parsing errors} + + In order to reduce allocations to a minumim, parsing errors are reported + via the exception {!Parse_error}. It is the responsibility of the caller + to catch this exception and return it as an [Error _] value. Functions + that may raise [Parse_error] are documented as such. + + When extracting an atom and the input doesn't have enough characters + left, the user may raise [Parse_error premature_end_of_input]. This will + produce an error message similar to what the various high-level + functions of this library produce. + + {2 Building a parsing function} + + Parsing functions should always follow the following pattern: + + + create a lexer and start with an empty parsing stack + + iterate over the input, feeding the lexer characters one by one. When + the lexer returns [Atom n], fetch the next [n] characters from the + input to form an atom + + update the stack via [Stack.add_atom] or [Stack.add_token] + + if parsing the whole input, call [Lexer.feed_eoi] when the end of + input is reached, otherwise stop as soon as the stack is of the form + [Sexp (_, Empty)] - + + For instance, to parse a string as a list of S-expressions: + + {[ + module Sexp = struct + type t = + | Atom of string + | List of t list + end + + module Csexp = Csexp.Make (Sexp) + + let extract_atom s pos len = + match String.sub s pos len with + | exception _ -> + (* Turn out-of-bounds errors into [Parse_error] *) + raise (Parse_error premature_end_of_input) + | s -> s + + let parse_string = + let open Csexp.Parser in + let rec loop s pos len lexer stack = + if pos = len then ( + Lexer.feed_eoi lexer; + Stack.to_list stack) + else + match Lexer.feed lexer (String.unsafe_get s pos) with + | Atom atom_len -> + let atom = extract_atom s (pos + 1) atom_len in + loop s (pos + 1 + atom) len lexer (Stack.add_atom atom stack) + | (Await | Lparen | Rparen) as x -> + loop s (pos + 1) len lexer (Stack.add_token x stack) + in + fun s -> + match loop s 0 (String.length s) (Lexer.create ()) Empty with + | v -> Ok v + | exception Parse_error msg -> Error msg + ]} *) + + exception Parse_error of string + + (** Error message signaling the end of input was reached prematurely. You + can use this when extracting an atom from the input and the input + doesn't have enough characters. *) + val premature_end_of_input : string + + module Lexer : sig + (** Lexical analyser *) + + type t + + val create : unit -> t + + type _ token = + | Await : [> `other ] token + | Lparen : [> `other ] token + | Rparen : [> `other ] token + | Atom : int -> [> `atom ] token + + (** Feed a character to the parser. + + @raise Parse_error *) + val feed : t -> char -> [ `other | `atom ] token + + (** Feed the end of input to the parser. + + You should call this function when the end of input has been reached + in order to ensure that the lexer is not awaiting more input, which + would be an error. + + @raise Parse_error if the lexer is awaiting more input *) + val feed_eoi : t -> unit + end + + module Stack : sig + (** Parsing stack *) + + type t = + | Empty + | Open of t + | Sexp of sexp * t + + (** Extract the list of full S-expressions contained in a stack. + + For instance: + + {[ + # to_list (Sexp (Atom "y", Sexp (Atom "x", Empty)));; + - : Stack.t list = [Atom "x"; Atom "y"] + ]} + @raise Parse_error + if the stack contains open parentheses that has not been closed. *) + val to_list : t -> sexp list + + (** Add a left parenthesis. *) + val open_paren : t -> t + + (** Add a right parenthesis. Raise [Parse_error] if the stack contains no + opened parentheses. + + For instance: + + {[ + # close_paren (Sexp (Atom "y", Sexp (Atom "x", Open Empty)));; + - : Stack.t = Sexp (List [Atom "x"; Atom "y"], Empty) + ]} + @raise Parse_error if the stack contains no open open parenthesis. *) + val close_paren : t -> t + + (** Insert an atom in the parsing stack: + + {[ + # add_atom "foo" Empty;; + - : Stack.t = Sexp (Atom "foo", Empty) + ]} *) + val add_atom : string -> t -> t + + (** Add a token as returned by the lexer. + + @raise Parse_error *) + val add_token : [ `other ] Lexer.token -> t -> t + end + end + + (** {3 Deprecated low-level parser} *) + + (** The above are deprecated as the {!Input} signature does not allow to + distinguish between IO errors and end of input conditions. Additionally, + the use of monads tend to produce parsers that allocates a lot. + + It is recommended to use the {!Parser} module instead. *) + + module type Input = sig + type t + + module Monad : sig + type 'a t + + val return : 'a -> 'a t + + val bind : 'a t -> ('a -> 'b t) -> 'b t + end + + val read_string : t -> int -> (string, string) result Monad.t + + val read_char : t -> (char, string) result Monad.t + end + [@@deprecated "Use Parser module instead"] + + [@@@warning "-3"] + + module Make_parser (Input : Input) : sig + val parse : Input.t -> (sexp, string) result Input.Monad.t + + val parse_many : Input.t -> (sexp list, string) result Input.Monad.t + end + [@@deprecated "Use Parser module instead"] +end + +module Make (Sexp : Sexp) : S with type sexp := Sexp.t + +include Sexp + +include S with type sexp := t diff --git a/unikernel/duniverse/csexp/src/dune b/unikernel/duniverse/csexp/src/dune new file mode 100644 index 00000000..67403a78 --- /dev/null +++ b/unikernel/duniverse/csexp/src/dune @@ -0,0 +1,2 @@ +(library + (public_name csexp)) diff --git a/unikernel/duniverse/csexp/test/dune b/unikernel/duniverse/csexp/test/dune new file mode 100644 index 00000000..3284f4b3 --- /dev/null +++ b/unikernel/duniverse/csexp/test/dune @@ -0,0 +1,6 @@ +(library + (name csexp_tests) + (libraries csexp) + (inline_tests) + (preprocess + (pps ppx_expect))) diff --git a/unikernel/duniverse/csexp/test/test.ml b/unikernel/duniverse/csexp/test/test.ml new file mode 100644 index 00000000..fc14d904 --- /dev/null +++ b/unikernel/duniverse/csexp/test/test.ml @@ -0,0 +1,168 @@ +module Sexp = struct + type t = + | Atom of string + | List of t list +end + +module Csexp = Csexp.Make (Sexp) +open Csexp + +let roundtrip x = + let str = to_string x in + match parse_string str with + | Error (_, msg) -> failwith msg + | Ok exp -> + assert (exp = x); + print_string str + +let%expect_test _ = + roundtrip (Sexp.Atom "foo"); + [%expect {|3:foo|}] + +let%expect_test _ = + roundtrip (Sexp.List []); + [%expect {|()|}] + +let%expect_test _ = + roundtrip (Sexp.List [ Sexp.Atom "Hello"; Sexp.Atom "World!" ]); + [%expect {|(5:Hello6:World!)|}] + +let%expect_test _ = + roundtrip + (Sexp.List + [ Sexp.List + [ Sexp.Atom "metadata" + ; Sexp.List [ Sexp.Atom "foo"; Sexp.Atom "bar" ] + ] + ; Sexp.List + [ Sexp.Atom "produced-files" + ; Sexp.List + [ Sexp.List + [ Sexp.Atom "/tmp/coin" + ; Sexp.Atom + "/tmp/dune-memory/v2/files/b2/b295e63b0b8e8fae971d9c493be0d261.1" + ] + ] + ] + ]); + [%expect + {|((8:metadata(3:foo3:bar))(14:produced-files((9:/tmp/coin63:/tmp/dune-memory/v2/files/b2/b295e63b0b8e8fae971d9c493be0d261.1))))|}] + +let print_parsed r = + match r with + | Error msg -> Printf.printf "Error %S" msg + | Ok sexp -> Printf.printf "Ok %S" (Csexp.to_string sexp) + +let parse s = + match parse_string s with + | Ok x -> print_parsed (Ok x) + | Error (_, msg) -> print_parsed (Error msg) + +let%expect_test _ = + parse "(3:foo)"; + [%expect {| + Ok "(3:foo)" |}] + +let%expect_test _ = + parse ""; + [%expect {| Error "premature end of input" |}] + +let%expect_test _ = + parse "("; + [%expect {| Error "premature end of input" |}] + +let%expect_test _ = + parse "(a)"; + [%expect {| Error "invalid character 'a', expected '(', ')' or '0'..'9'" |}] + +let%expect_test _ = + parse "(:)"; + [%expect {| Error "invalid character ':', expected '(', ')' or '0'..'9'" |}] + +let%expect_test _ = + parse "(4:foo)"; + [%expect {| Error "premature end of input" |}] + +let%expect_test _ = + parse "(5:foo)"; + [%expect {| Error "premature end of input" |}] + +let%expect_test _ = + parse "(3:foo)"; + [%expect {| Ok "(3:foo)" |}] + +let sexp_then_stuff s = + let fn, oc = Filename.open_temp_file "csexp-test" "" ~mode:[ Open_binary ] in + let delete = lazy (Sys.remove fn) in + at_exit (fun () -> Lazy.force delete); + output_string oc s; + close_out oc; + let ic = open_in_bin fn in + Csexp.input ic |> print_parsed; + print_newline (); + print_char (input_char ic); + close_in ic; + Lazy.force delete + +let%expect_test _ = + sexp_then_stuff "(3:foo)(3:foo)"; + [%expect {| + Ok "(3:foo)" + ( |}] + +let%expect_test _ = + sexp_then_stuff "(3:foo)Additional_stuff"; + [%expect {| + Ok "(3:foo)" + A |}] + +let%expect_test _ = + parse "(3:foo)(3:foo)"; + [%expect {| Error "data after canonical S-expression" |}] + +let%expect_test _ = + parse "(3:foo)additional_stuff"; + [%expect {| Error "data after canonical S-expression" |}] + +let parse_many s = + match parse_string_many s with + | Error (_, msg) -> print_parsed (Error msg) + | Ok xs -> xs |> List.iter (fun x -> print_parsed (Ok x)) + +let%expect_test "parse_string_many - parse empty string" = + parse_many ""; + [%expect {| |}] + +let%expect_test "parse_string_many - parse a single csexp" = + parse_many "(3:foo)"; + [%expect {| Ok "(3:foo)" |}] + +let%expect_test "parse_string_many - parse many csexp" = + parse_many "(3:foo)(3:bar)"; + [%expect {| Ok "(3:foo)"Ok "(3:bar)" |}] + +let%expect_test "serialised_length" = + let csexp = Sexp.Atom "xxx" in + print_endline (Csexp.to_string csexp); + print_int (Csexp.serialised_length csexp); + [%expect {| + 3:xxx + 5 |}]; + let csexp = Sexp.List [] in + print_endline (Csexp.to_string csexp); + print_int (Csexp.serialised_length csexp); + [%expect {| + () + 2 |}]; + let csexp = Sexp.List [ Atom "xxx" ] in + print_endline (Csexp.to_string csexp); + print_int (Csexp.serialised_length csexp); + [%expect {| + (3:xxx) + 7 |}]; + let csexp = Sexp.List [ Atom "xxx"; Atom "xxx" ] in + print_endline (Csexp.to_string csexp); + print_int (Csexp.serialised_length csexp); + [%expect {| + (3:xxx3:xxx) + 12 |}] diff --git a/unikernel/duniverse/digestif/.github/workflows/test.yml b/unikernel/duniverse/digestif/.github/workflows/test.yml new file mode 100644 index 00000000..f45523e8 --- /dev/null +++ b/unikernel/duniverse/digestif/.github/workflows/test.yml @@ -0,0 +1,147 @@ +name: Cross-platform tests + +on: + pull_request: + push: + branches: + - 'master' + +jobs: + test-with-setup-ocaml: + strategy: + fail-fast: false + matrix: + os: + - windows-latest + - ubuntu-latest + - macos-latest + ocaml-compiler: + - '4.13.x' + runs-on: ${{ matrix.os }} + name: test-ocaml / ${{ matrix.os }}-${{ matrix.ocaml-compiler }} + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Hack Git CRLF for ocaml/setup-ocaml issue #529 + if: ${{ startsWith(matrix.os, 'windows-') }} + run: | + & "C:\Program Files\Git\bin\git.exe" config --system core.autocrlf input + + - name: OCaml ${{ matrix.ocaml-compiler }} with Dune cache + uses: ocaml/setup-ocaml@v2 + if: ${{ !startsWith(matrix.os, 'windows-') }} + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + dune-cache: true + - name: OCaml ${{ matrix.ocaml-compiler }} without Dune cache + uses: ocaml/setup-ocaml@v2 + if: ${{ startsWith(matrix.os, 'windows-') }} + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + dune-cache: false + - name: Install/build/test + run: | + opam install . --deps-only --with-test + opam exec -- dune build --display=short + opam exec -- dune runtest --display=short + + setup-dkml: + uses: 'diskuv/dkml-workflows/.github/workflows/setup-dkml.yml@v0' + permissions: {} # remove all rights of GITHUB_TOKEN when it is passed to setup-dkml.yml + with: + ocaml-compiler: 4.12.1 + + test-with-setup-dkml: + needs: setup-dkml + strategy: + fail-fast: false + matrix: + include: + - os: windows-2019 + abi-pattern: win32-windows_x86 + dkml-host-abi: windows_x86 + opam-root: D:/.opam + default_shell: msys2 {0} + msys2_system: MINGW32 + msys2_packages: mingw-w64-i686-pkg-config + bits: "32" + - os: windows-2019 + abi-pattern: win32-windows_x86_64 + dkml-host-abi: windows_x86_64 + opam-root: D:/.opam + default_shell: msys2 {0} + msys2_system: CLANG64 + msys2_packages: mingw-w64-clang-x86_64-pkg-config + bits: "64" + - os: macos-latest + abi-pattern: macos-darwin_all + dkml-host-abi: darwin_x86_64 + default_shell: sh + opam-root: /Users/runner/.opam + bits: "64" + - os: ubuntu-latest + abi-pattern: manylinux2014-linux_x86 + bits: "32" + default_shell: sh + dkml-host-abi: linux_x86 + opam-root: .ci/opamroot # local directory of $GITHUB_WORKSPACE so available to dockcross + - os: ubuntu-latest + abi-pattern: manylinux2014-linux_x86_64 + bits: "64" + default_shell: sh + dkml-host-abi: linux_x86_64 + opam-root: .ci/opamroot # local directory of $GITHUB_WORKSPACE so available to dockcross + runs-on: ${{ matrix.os }} + name: test-dkml / ${{ matrix.abi-pattern }} + defaults: + run: + shell: ${{ matrix.default_shell }} + env: + OPAMROOT: ${{ matrix.opam-root }} + COMPONENT: dkml-component-staging-opam${{ matrix.bits }} + steps: + - name: Checkout + uses: actions/checkout@v3 + + - uses: actions/download-artifact@v3 + with: + path: .ci/dist + + - name: Install MSYS2 (Windows) + if: startsWith(matrix.dkml-host-abi, 'windows_') + uses: msys2/setup-msys2@v2 + with: + msystem: ${{ matrix.msys2_system }} + update: true + install: >- + ${{ matrix.msys2_packages }} + wget + make + rsync + diffutils + patch + unzip + git + tar + + - name: Import build environments from setup-dkml + run: | + ${{ needs.setup-dkml.outputs.import_func }} + import ${{ matrix.abi-pattern }} + + - name: Cache Opam downloads by host + uses: actions/cache@v3 + with: + path: ${{ matrix.opam-root }}/download-cache + key: ${{ matrix.dkml-host-abi }} + + - name: Install/build/test + run: | + # Fix dependencies to work with MSVC + # - alcotest.1.4.0 works with MSVC; 1.5.0 does not + opamrun pin alcotest -k version 1.4.0 --no-action --yes + + opamrun install . --deps-only --with-test --yes + opamrun exec -- dune build --display=short + opamrun exec -- dune runtest --display=short diff --git a/unikernel/duniverse/digestif/.gitignore b/unikernel/duniverse/digestif/.gitignore new file mode 100644 index 00000000..2a19e772 --- /dev/null +++ b/unikernel/duniverse/digestif/.gitignore @@ -0,0 +1,17 @@ +_build +setup.data +setup.log +doc/*.html +*.native +*.byte +*.so +lib/decompress_conf.ml +*.tar.gz +_tests +lib_test/files +zpipe +c/dpipe +*.install +*~ +.merlin +_opam diff --git a/unikernel/duniverse/digestif/.ocamlformat b/unikernel/duniverse/digestif/.ocamlformat new file mode 100644 index 00000000..66247242 --- /dev/null +++ b/unikernel/duniverse/digestif/.ocamlformat @@ -0,0 +1,10 @@ +version = 0.21.0 +break-infix = fit-or-vertical +parse-docstrings = true +indicate-multiline-delimiters=no +nested-match=align +sequence-style=separator +break-before-in=auto +if-then-else=keyword-first +dock-collection-brackets=true +break-collection-expressions=wrap diff --git a/unikernel/duniverse/digestif/.test-mirage.sh b/unikernel/duniverse/digestif/.test-mirage.sh new file mode 100755 index 00000000..929f03fc --- /dev/null +++ b/unikernel/duniverse/digestif/.test-mirage.sh @@ -0,0 +1,10 @@ +#!/bin/sh + +set -ex + +opam install -y mirage +(cd mirage && mirage configure -t unix && make depends && mirage build && ./digestif_test && mirage clean && cd ..) || exit 1 +(cd mirage && mirage configure -t hvt && make depends && mirage build && mirage clean && cd ..) || exit 1 +if [ $(uname -m) = "amd64" ] || [ $(uname -m) = "x86_64" ]; then + (cd mirage && mirage configure -t xen && make depend && mirage build && mirage clean && cd ..) || exit 1 +fi diff --git a/unikernel/duniverse/digestif/.travis.yml b/unikernel/duniverse/digestif/.travis.yml new file mode 100644 index 00000000..b5fd0775 --- /dev/null +++ b/unikernel/duniverse/digestif/.travis.yml @@ -0,0 +1,18 @@ +language: c +install: + - wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh + - wget https://raw.githubusercontent.com/dinosaure/ocaml-travisci-skeleton/master/.travis-docgen.sh +script: bash -ex .travis-opam.sh +sudo: true +env: + global: + - PACKAGE=digestif + matrix: + - OCAML_VERSION=4.03 + - OCAML_VERSION=4.04 + - OCAML_VERSION=4.05 + - OCAML_VERSION=4.06 + - OCAML_VERSION=4.07 + - OCAML_VERSION=4.08 DEPOPTS="ocaml-freestanding" + - OCAML_VERSION=4.08 + - OCAML_VERSION=4.09 TESTS=false POST_INSTALL_HOOK=./.test-mirage.sh diff --git a/unikernel/duniverse/digestif/CHANGES.md b/unikernel/duniverse/digestif/CHANGES.md new file mode 100644 index 00000000..4f6fbebd --- /dev/null +++ b/unikernel/duniverse/digestif/CHANGES.md @@ -0,0 +1,169 @@ +### v1.3.0 2025-04-14 Paris (France) + +- Use `CAMLextern` rather than `extern` in `caml_*` forward declarations to + support bytecode linking on Windows (@jonahbeckford, #157) +- Add `x-maintenance-intent` into OPAM file (@hannesm, #158) +- Implement _feedable_ hmac (@reynir, #155) + +### v1.2.0 2024-03-18 Paris (France) + +- Update the description to include SHA3 (@Leonidas-from-XIV, #146) +- Add a new type `hash'`, a polymorphic variant (@reynir, @dinosaure, #150) +- Lint `fmt` dependency lower-bound (@reynir, #152) +- Add `get_into_bytes` function and a fuzzer about it (@reynir, @dinosaure, #149) + +### v1.1.4 2023-03-23 Paris (France) + +- Add a test about CVE-2022-37454 (@dinosaure, #143) +- Lint the distribution and delete the `pkg-config` dependency (@dinosuare, 1eff5c5) +- Fix primitives used for bytes and fix the support of `js_of_ocaml` 5 (@hhugo, #144) + +### v1.1.3 2022-10-20 Paris (France) + +- Support MSVC compiler (@jonahbeckford, #137) +- Fix CI on Windows (`test_conv.ml` requires `/dev/urandom`) (@dinosaure, #138) +- Fix threads support (@dinosaure, #140) +- Delete the META trick needed for MirageOS 3 when we install `digestif` (@dinosaure, #141) + This version of `digestif` breaks the compatibility with MirageOS 3 + and `ocaml-freestanding`. This PR should unlock the ability to + use `dune-cache`. + +### v1.1.2 2022-04-08 Paris (France) + +- Minor update on the README.md (@punchagan, #133) +- Support only OCaml >= 4.08, update with `ocamlformat.0.21.0` and remove `bigarray-compat` + dependency (@hannesm, #134) + +### v1.1.1 2022-03-28 Paradou (France) + +- Hide C functions (`sha3_keccakf`) (@hannesm, #125) +- Use `ocaml` to run `install.ml` instead of a shebang (@Nymphium, #127) +- Use `command -v` instead of `which` (@Numphium, #126) +- Add `@since` meta-data in documentation (@c-cube, @dinosaure, #128) +- Update the README.md (@dinosaure, @mimoo, #130) +- `ocaml-solo5` provides `__ocaml_solo5__` instead of `__ocaml_freestanding__` (@dinosaure, #131) + +### v1.1.0 2021-10-11 Paris (France) + +- Add Keccak256 module (ethereum padding) (@maxtori, @dinosaure, #118) +- Update README.md to include the documentation (@mimoo, @dinosaure, 65a5c12) +- Remove deprecated function from `fmt` library (@dinosaure, #121) +- **NOTE**: This version lost the support of OCaml 4.03 and OCaml 4.04. + +### v1.0.1 2020-02-08 Paris (France) + +- Fix `esy` support (@dinosaure, #115) +- Fix big-endian support (@dinosaure, #113) + +### v1.0.0 2020-11-02 Paris (France) + +- **breaking changes** Upgrade the library with MirageOS 3.9 (new layout of artifacts) + Add tests about compilation of unikernels (execution and link) + (#105, @dinosaure, @hannesm) +- Fix `esy` installation (#104, @dinosaure) +- **breaking changes** Better GADT (#103, @dinosaure) + As far as I can tell, nobody really use this part of `digestif`. + The idea is to provide a GADT which contains the type of the hash. + From third-part libraries point-of-view, it's better to _pattern-match_ with + such information instead to use a polymorphic variant (as before). +- **breaking changes** key used for HMAC is a constant `string` (#101, @dinosaure, @hannesm) + The key should not follow the same type as the digest value (`string`, `bytes`, `bigstring`). + This update restricts the user to user only constant key (as a `string`). + +### v0.9.0 2020-07-10 Paris (France) + +- Add sha3 implementation (#98), @lyrm, @dinosaure, @hannesm and @cfcs + +### v0.8.1 2020-06-15 Paris (France) + +- Move to `dune.2.6.0` (#97) +- Apply `ocamlformat.0.14.2` (#97) +- Fix tests according `alcotest.1.0.0` (#95) + +### v0.8.0 2019-20-09 Saint Louis (Sénégal) + +- Fake version to prioritize dune's variants instead of + old linking trick +- Use `stdlib-shims` to keep compatibility with < ocaml.4.07.0 + +### v0.7.3 2019-07-09 Paris (France) + +- Fix bug about specialization of BLAKE2{B,S} (#85, #86) + reported by @samoht, fixed by @dinosaure, reviewed by @hannes and @cfcs + +### v0.7.2 2019-05-16 Paris (France) + +- Add conflict with `< mirage-xen-posix.3.1.0` packages (@hannesm) +- Add a note on README.md about the linking-trick and order of dependencies (@rizo) +- Use experimental feature of variants with `dune` (@dinosaure, review @rgrinberg) + + `digestif` requires at least `dune.1.9.2` + +### v0.7.1 2018-11-15 Paris (France) + +- Cross compilation adjustments (@hannesm) (# 76) +- Add the WHIRLPOOL hash algorithm (@clecat) (#77) +- Backport fix on opam file (@dinosaure, @kit-ty-kate) + +### v0.7 2018-10-15 Paris (France) + +- Fixed HMAC on BLAKE2{S,B} (@emillon) (#46, #51) +- Fixed `convenient_of_hex` (@dinosaure, @hannesm, @cfcs) (#55) +- Add `of_raw_string`/`to_raw_string` (@samoht) (#57) +- Test `digestif` on solo5 and xen backends (@samoht) +- *breaking change*, commont type `t` is an abstract type (#58, #56) +- Fixed META file (@dinosaure, @g2p) (#75) +- New dependency `eqaf` (@dinosaure, @cfcs, @hannesm) (constant-time equal function) (#33, #34, #48, #50, #52, #65) +- Remove `Obj.magic` in common implementation (@dinosaure, @samoht) (#61, #62) +- Add conveniences functions in common implementation (@hcarty) (#63) +- Add option-returning functions in common implementation (@harcty) (#63) +- Verify length of string on `of_raw_string` function (@hcarty) (#63) +- Release runtime lock (@andersfugmann, @dinosaure, @cfcs) (#69, #70) +- Bounds check (@cfcs, @dinosaure) (#71, #72) +- Fixed linking problem (@andersfugmann, @g2p, @dinosaure) (#49, #53, #73, #74) +- Update OPAM file (@dinosaure) + +### v0.6.1 2018-07-24 Paris (France) + +- *breaking change* API: Digestif implements a true linking trick. End-user need + to explicitely link with `digestif.{c,ocaml}` and it needs to be the first of + your dependencies. +- move to `jbuilder`/`dune` + +### v0.6 2018-07-05 Paris (France) + +- *breaking change* API: + From a consensus between people who use `digestif`, we decide to delete `*.Bytes.*` and `*.Bigstring.*` sub-modules. + We replace it by `feed_{bytes,string,bigstring}` (`digest_`, and `hmac_` too) +- *breaking change* semantic: streaming and referentially transparent + Add `feedi_{bytes,string,bigstring}`, `digesti_{bytes,string,bigstring}` and `hmaci_{bytes,string,bigstring}` + (@hannesm, @cfcs) +- Constant time for `eq`/`neq` functions + (@cfcs) +- *breaking change* semantic on `compare` and `unsafe_compare`: + `compare` is not a lexicographical comparison function (rename to `unsafe_compare`) + (@cfcs) +- Add `consistent_of_hex` (@hannesm, @cfcs) + +### v0.4 2017-10-30 Mysore / ಮೈಸೂರು (India) + +- Add an automatised test suit +- Add the RIPEMD160 hash algorithm +- Add the BLAKE2S hash algorithm +- Update authors +- Add `feed_bytes` and `feed_bigstring` for `Bytes` and `Bigstring` + +### v0.3 2017-07-21 Phnom Penh (Cambodia) + +- Fixed issue #6 +- Make a new test suit + +### v0.2 2017-07-05 Phnom Penh (Cambodia) + +- Implementation of the hash function in pure OCaml +- Link improvement (à la `mtime`) to decide to use the C stub or the OCaml implementation +- Improvement of the common interface (pretty-print, type t, etc.) + +### v0.1 2017-05-12 Rạch Giá (Vietnam) + +- First release diff --git a/unikernel/duniverse/digestif/LICENSE.md b/unikernel/duniverse/digestif/LICENSE.md new file mode 100644 index 00000000..9b6640fc --- /dev/null +++ b/unikernel/duniverse/digestif/LICENSE.md @@ -0,0 +1,20 @@ +The MIT License (MIT) + +Copyright (c) 2014 oklm-wsh + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/unikernel/duniverse/digestif/Makefile b/unikernel/duniverse/digestif/Makefile new file mode 100644 index 00000000..02510840 --- /dev/null +++ b/unikernel/duniverse/digestif/Makefile @@ -0,0 +1,10 @@ +.PHONY: all clean test + +all: + dune build + +test: + dune runtest + +clean: + dune clean diff --git a/unikernel/duniverse/digestif/README.md b/unikernel/duniverse/digestif/README.md new file mode 100644 index 00000000..035f0050 --- /dev/null +++ b/unikernel/duniverse/digestif/README.md @@ -0,0 +1,119 @@ +Digestif - Hash algorithms in C and OCaml +========================================= + +Digestif is a toolbox which implements hashes: + + * MD5 + * SHA1 + * SHA2 + * SHA3 + * WHIRLPOOL + * BLAKE2B + * BLAKE2S + * RIPEMD160 + +Digestif uses a trick about linking and let the end-user to choose which +implementation he wants to use. We provide 2 implementations: + + * C implementation with `digestif.c` + * OCaml implementation with `digestif.ocaml` + +Both are well-tested. However, OCaml implementation is slower than the C +implementation. + +**Note**: The linking trick requires `digestif.c` or `digestif.ocaml` to be the +first of your dependencies. + +Documentation: https://mirage.github.io/digestif/ + +Contact: Romain Calascibetta `` + +## Install & Usage + +The library is available on [OPAM](https://opam.ocaml.org/packages/digestif/). You can install it via: +```sh +$ opam install digestif +``` + +This is a simple program which implements `sha1sum`: +```sh +$ cat >sha1sum.ml < Digestif.SHA1.get ctx + | len -> + let ctx = Digestif.SHA1.feed_bytes ctx ~off:0 ~len tmp in + go ctx + | exception End_of_file -> Digestif.SHA1.get ctx in + go Digestif.SHA1.empty + +let () = match Sys.argv with + | [| _; filename; |] when Sys.file_exists filename -> + let ic = open_in filename in + let hash = sum ic in + close_in ic ; print_endline (Digestif.SHA1.to_hex hash) + | [| _ |] -> + let hash = sum stdin in + print_endline (Digestif.SHA1.to_hex hash) + | _ -> Format.eprintf "%s []\n%!" Sys.argv.(0) +EOF +$ cat >dune <= 4.03.0 (may be less but need test) + * `base-bytes` meta-package + * `base-bigarray` meta-package + * `dune` to build the project + +If you want to compile the test program, you need: + + * `alcotest` + +## Credits + +This work is from the [nocrypto](https://github.com/mirleft/nocrypto) library +and the Vincent hanquez's work in +[ocaml-sha](https://github.com/vincenthz/ocaml-sha). + +All credits appear in the begin of files and this library is motivated by two +reasons: + * delete the dependancy with `nocrypto` if you don't use the encryption (and + common) part + * aggregate all hashes functions in one library diff --git a/unikernel/duniverse/digestif/digestif.opam b/unikernel/duniverse/digestif/digestif.opam new file mode 100644 index 00000000..a4a260e3 --- /dev/null +++ b/unikernel/duniverse/digestif/digestif.opam @@ -0,0 +1,61 @@ +version: "1.3.0" +opam-version: "2.0" +name: "digestif" +maintainer: [ "Eyyüb Sari " + "Romain Calascibetta " ] +authors: [ "Eyyüb Sari " + "Romain Calascibetta " ] +homepage: "https://github.com/mirage/digestif" +bug-reports: "https://github.com/mirage/digestif/issues" +dev-repo: "git+https://github.com/mirage/digestif.git" +doc: "https://mirage.github.io/digestif/" +license: "MIT" +synopsis: "Hashes implementations (SHA*, RIPEMD160, BLAKE2* and MD5)" +description: """ +Digestif is a toolbox to provide hashes implementations in C and OCaml. + +It uses the linking trick and user can decide at the end to use the C implementation or the OCaml implementation. + +We provides implementation of: + * MD5 + * SHA1 + * SHA224 + * SHA256 + * SHA384 + * SHA512 + * SHA3 + * Keccak-256 + * WHIRLPOOL + * BLAKE2B + * BLAKE2S + * RIPEMD160 +""" + +build: [ + [ "dune" "build" "-p" name "-j" jobs ] + [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} +] +install: [ + [ "dune" "install" "-p" name ] {with-test} + [ "ocaml" "./test/test_runes.ml" ] {with-test} +] + +depends: [ + "ocaml" {>= "4.08.0"} + "dune" {>= "2.6.0"} + "eqaf" + "fmt" {with-test & >= "0.8.7"} + "alcotest" {with-test} + "bos" {with-test} + "astring" {with-test} + "fpath" {with-test} + "rresult" {with-test} + "ocamlfind" {with-test} + "crowbar" {with-test} +] + +conflicts: [ + "mirage-xen" {< "6.0.0"} + "ocaml-freestanding" +] +x-maintenance-intent: [ "(latest)" ] \ No newline at end of file diff --git a/unikernel/duniverse/digestif/dune-project b/unikernel/duniverse/digestif/dune-project new file mode 100644 index 00000000..09f95228 --- /dev/null +++ b/unikernel/duniverse/digestif/dune-project @@ -0,0 +1,3 @@ +(lang dune 2.6) +(name digestif) +(version v1.3.0) diff --git a/unikernel/duniverse/digestif/fuzz/c/dune b/unikernel/duniverse/digestif/fuzz/c/dune new file mode 100644 index 00000000..bd215e05 --- /dev/null +++ b/unikernel/duniverse/digestif/fuzz/c/dune @@ -0,0 +1,6 @@ +(executable + (name fuzz) + (libraries digestif.c crowbar)) + +(rule + (copy# ../fuzz.ml fuzz.ml)) diff --git a/unikernel/duniverse/digestif/fuzz/dune b/unikernel/duniverse/digestif/fuzz/dune new file mode 100644 index 00000000..80dea013 --- /dev/null +++ b/unikernel/duniverse/digestif/fuzz/dune @@ -0,0 +1,25 @@ +(rule + (copy# fuzz.ml fuzz_c.ml)) + +(rule + (copy# fuzz.ml fuzz_ocaml.ml)) + +(executable + (name fuzz_c) + (modules fuzz_c) + (libraries digestif.c crowbar)) + +(executable + (name fuzz_ocaml) + (modules fuzz_ocaml) + (libraries digestif.ocaml crowbar)) + +(rule + (alias runtest) + (action + (run ./fuzz_ocaml.exe))) + +(rule + (alias runtest) + (action + (run ./fuzz_c.exe))) diff --git a/unikernel/duniverse/digestif/fuzz/fuzz.ml b/unikernel/duniverse/digestif/fuzz/fuzz.ml new file mode 100644 index 00000000..bc92c13a --- /dev/null +++ b/unikernel/duniverse/digestif/fuzz/fuzz.ml @@ -0,0 +1,32 @@ +open Crowbar + +type pack = Pack : 'a Digestif.hash -> pack + +let hash = + choose + [ + const (Pack Digestif.sha1); const (Pack Digestif.sha256); + const (Pack Digestif.sha512); + ] + +let with_get_into_bytes off len (type ctx) + (module Hash : Digestif.S with type ctx = ctx) (ctx : ctx) = + let buf = Bytes.create len in + let () = + try Hash.get_into_bytes ctx ~off buf + with Invalid_argument e -> ( + (* Skip if the invalid argument is valid; otherwise fail *) + match Bytes.sub buf off Hash.digest_size with + | _ -> failf "Hash.get_into_bytes: Invalid_argument %S" e + | exception Invalid_argument _ -> bad_test ()) in + Bytes.sub_string buf off Hash.digest_size + +let () = + add_test ~name:"get_into_bytes" [ hash; int8; range 1024; bytes ] + @@ fun (Pack hash) off len bytes -> + let (module Hash) = Digestif.module_of hash in + let ctx = Hash.empty in + let ctx = Hash.feed_string ctx bytes in + let a = with_get_into_bytes off len (module Hash) ctx in + let b = Hash.(to_raw_string (get ctx)) in + check_eq ~eq:String.equal a b diff --git a/unikernel/duniverse/digestif/fuzz/ocaml/dune b/unikernel/duniverse/digestif/fuzz/ocaml/dune new file mode 100644 index 00000000..c0b3d0ef --- /dev/null +++ b/unikernel/duniverse/digestif/fuzz/ocaml/dune @@ -0,0 +1,6 @@ +(executable + (name fuzz) + (libraries digestif.ocaml crowbar)) + +(rule + (copy# ../fuzz.ml fuzz.ml)) diff --git a/unikernel/duniverse/digestif/mirage/_tags b/unikernel/duniverse/digestif/mirage/_tags new file mode 100644 index 00000000..58fb109a --- /dev/null +++ b/unikernel/duniverse/digestif/mirage/_tags @@ -0,0 +1 @@ +true: package(digestif.c) diff --git a/unikernel/duniverse/digestif/mirage/config.ml b/unikernel/duniverse/digestif/mirage/config.ml new file mode 100644 index 00000000..1d5582e3 --- /dev/null +++ b/unikernel/duniverse/digestif/mirage/config.ml @@ -0,0 +1,5 @@ +open Mirage + +let main = foreign "Unikernel.Make" (console @-> job) +let packages = [ package "digestif" ] +let () = register ~packages "digestif-test" [ main $ default_console ] diff --git a/unikernel/duniverse/digestif/mirage/unikernel.ml b/unikernel/duniverse/digestif/mirage/unikernel.ml new file mode 100644 index 00000000..6bcd064d --- /dev/null +++ b/unikernel/duniverse/digestif/mirage/unikernel.ml @@ -0,0 +1,7 @@ +module Make (Console : Mirage_console.S) = struct + let log console fmt = Format.kasprintf (Console.log console) fmt + + let start console = + let hash = Digestif.SHA1.digest_string "Hello World!" in + log console "%a" Digestif.SHA1.pp hash +end diff --git a/unikernel/duniverse/digestif/src-c/digestif.ml b/unikernel/duniverse/digestif/src-c/digestif.ml new file mode 100644 index 00000000..c3cfa43f --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/digestif.ml @@ -0,0 +1,777 @@ +type bigstring = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +type 'a iter = ('a -> unit) -> unit +type 'a compare = 'a -> 'a -> int +type 'a equal = 'a -> 'a -> bool +type 'a pp = Format.formatter -> 'a -> unit + +module Native = Digestif_native +module By = Digestif_by +module Bi = Digestif_bi +module Eq = Digestif_eq +module Conv = Digestif_conv + +let failwith fmt = Format.ksprintf failwith fmt + +module type S = sig + val digest_size : int + + type ctx + type hmac + type t + + val empty : ctx + val init : unit -> ctx + val feed_bytes : ctx -> ?off:int -> ?len:int -> Bytes.t -> ctx + val feed_string : ctx -> ?off:int -> ?len:int -> String.t -> ctx + val feed_bigstring : ctx -> ?off:int -> ?len:int -> bigstring -> ctx + val feedi_bytes : ctx -> Bytes.t iter -> ctx + val feedi_string : ctx -> String.t iter -> ctx + val feedi_bigstring : ctx -> bigstring iter -> ctx + val get : ctx -> t + val hmac_init : key:string -> hmac + val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac + val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac + val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac + val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac + val hmac_feedi_string : hmac -> String.t iter -> hmac + val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac + val hmac_get : hmac -> t + val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t + val digest_string : ?off:int -> ?len:int -> String.t -> t + val digest_bigstring : ?off:int -> ?len:int -> bigstring -> t + val digesti_bytes : Bytes.t iter -> t + val digesti_string : String.t iter -> t + val digesti_bigstring : bigstring iter -> t + val digestv_bytes : Bytes.t list -> t + val digestv_string : String.t list -> t + val digestv_bigstring : bigstring list -> t + val hmac_bytes : key:string -> ?off:int -> ?len:int -> Bytes.t -> t + val hmac_string : key:string -> ?off:int -> ?len:int -> String.t -> t + val hmac_bigstring : key:string -> ?off:int -> ?len:int -> bigstring -> t + val hmaci_bytes : key:string -> Bytes.t iter -> t + val hmaci_string : key:string -> String.t iter -> t + val hmaci_bigstring : key:string -> bigstring iter -> t + val hmacv_bytes : key:string -> Bytes.t list -> t + val hmacv_string : key:string -> String.t list -> t + val hmacv_bigstring : key:string -> bigstring list -> t + val unsafe_compare : t compare + val equal : t equal + val pp : t pp + val of_hex : string -> t + val of_hex_opt : string -> t option + val consistent_of_hex : string -> t + val consistent_of_hex_opt : string -> t option + val to_hex : t -> string + val of_raw_string : string -> t + val of_raw_string_opt : string -> t option + val to_raw_string : t -> string + val get_into_bytes : ctx -> ?off:int -> bytes -> unit +end + +module type MAC = sig + type t + + val mac_bytes : key:string -> ?off:int -> ?len:int -> Bytes.t -> t + val mac_string : key:string -> ?off:int -> ?len:int -> String.t -> t + val mac_bigstring : key:string -> ?off:int -> ?len:int -> bigstring -> t + val maci_bytes : key:string -> Bytes.t iter -> t + val maci_string : key:string -> String.t iter -> t + val maci_bigstring : key:string -> bigstring iter -> t + val macv_bytes : key:string -> Bytes.t list -> t + val macv_string : key:string -> String.t list -> t + val macv_bigstring : key:string -> bigstring list -> t +end + +module type Foreign = sig + open Native + + module Bigstring : sig + val init : ctx -> unit + val update : ctx -> ba -> int -> int -> unit + val finalize : ctx -> ba -> int -> unit + end + + module Bytes : sig + val init : ctx -> unit + val update : ctx -> st -> int -> int -> unit + val finalize : ctx -> st -> int -> unit + end + + val ctx_size : unit -> int +end + +module type Desc = sig + val block_size : int + val digest_size : int +end + +module Unsafe (F : Foreign) (D : Desc) = struct + let block_size = D.block_size + and digest_size = D.digest_size + and ctx_size = F.ctx_size () + + let init () = + let t = By.create ctx_size in + F.Bytes.init t ; + t + + let empty = + let buf = Bytes.create ctx_size in + F.Bytes.init buf ; + buf + + let unsafe_feed_bytes t ?off ?len buf = + let off, len = + match (off, len) with + | Some off, Some len -> (off, len) + | Some off, None -> (off, By.length buf - off) + | None, Some len -> (0, len) + | None, None -> (0, By.length buf) in + if off < 0 || len < 0 || off > By.length buf - len + then invalid_arg "offset out of bounds" + else F.Bytes.update t buf off len + + let unsafe_feed_string t ?off ?len buf = + unsafe_feed_bytes t ?off ?len (Bytes.unsafe_of_string buf) + + let unsafe_feed_bigstring t ?off ?len buf = + let off, len = + match (off, len) with + | Some off, Some len -> (off, len) + | Some off, None -> (off, Bi.length buf - off) + | None, Some len -> (0, len) + | None, None -> (0, Bi.length buf) in + if off < 0 || len < 0 || off > Bi.length buf - len + then invalid_arg "offset out of bounds" + else F.Bigstring.update t buf off len + + let unsafe_get t = + let res = By.create digest_size in + By.fill res 0 digest_size '\000' ; + F.Bytes.finalize t res 0 ; + res + + let get_into_bytes t ?(off = 0) buf = + if off < 0 || off >= Bytes.length buf + then invalid_arg "offset out of bounds" ; + if Bytes.length buf - off < digest_size + then invalid_arg "destination too small" ; + F.Bytes.finalize (Native.dup t) buf off +end + +module Core (F : Foreign) (D : Desc) = struct + type t = string + type ctx = Native.ctx + + include Unsafe (F) (D) + include Conv.Make (D) + include Eq.Make (D) + + let get t = + let t = Native.dup t in + unsafe_get t |> By.unsafe_to_string + + let feed_bytes t ?off ?len buf = + let t = Native.dup t in + unsafe_feed_bytes t ?off ?len buf ; + t + + let feed_string t ?off ?len buf = + let t = Native.dup t in + unsafe_feed_string t ?off ?len buf ; + t + + let feed_bigstring t ?off ?len buf = + let t = Native.dup t in + unsafe_feed_bigstring t ?off ?len buf ; + t + + let feedi_bytes t iter = + let t = Native.dup t in + let feed buf = unsafe_feed_bytes t buf in + iter feed ; + t + + let feedi_string t iter = + let t = Native.dup t in + let feed buf = unsafe_feed_string t buf in + iter feed ; + t + + let feedi_bigstring t iter = + let t = Native.dup t in + let feed buf = unsafe_feed_bigstring t buf in + iter feed ; + t + + let digest_bytes ?off ?len buf = feed_bytes empty ?off ?len buf |> get + let digest_string ?off ?len buf = feed_string empty ?off ?len buf |> get + let digest_bigstring ?off ?len buf = feed_bigstring empty ?off ?len buf |> get + let digesti_bytes iter = feedi_bytes empty iter |> get + let digesti_string iter = feedi_string empty iter |> get + let digesti_bigstring iter = feedi_bigstring empty iter |> get + let digestv_bytes lst = digesti_bytes (fun f -> List.iter f lst) + let digestv_string lst = digesti_string (fun f -> List.iter f lst) + let digestv_bigstring lst = digesti_bigstring (fun f -> List.iter f lst) +end + +module Make (F : Foreign) (D : Desc) = struct + include Core (F) (D) + + type hmac = ctx * string + + let bytes_opad = By.make block_size '\x5c' + let bytes_ipad = By.make block_size '\x36' + + let rec norm_bytes key = + match Stdlib.compare (String.length key) block_size with + | 1 -> norm_bytes (digest_string key) + | -1 -> By.rpad (By.unsafe_of_string key) block_size '\000' + | _ -> By.of_string key + + let hmac_init ~key = + let key = norm_bytes key in + let outer = Native.XOR.Bytes.xor key bytes_opad in + let inner = Native.XOR.Bytes.xor key bytes_ipad in + let ctx = feed_bytes empty inner in + (ctx, Bytes.unsafe_to_string outer) + + let hmac_feed_bytes (t, outer) ?off ?len buf = + (feed_bytes t ?off ?len buf, outer) + + let hmac_feed_string (t, outer) ?off ?len buf = + (feed_string t ?off ?len buf, outer) + + let hmac_feed_bigstring (t, outer) ?off ?len buf = + (feed_bigstring t ?off ?len buf, outer) + + let hmac_get (ctx, outer) = + feed_string (feed_string empty outer) (get ctx) |> get + + let hmac_feedi_bytes (t, outer) iter = (feedi_bytes t iter, outer) + let hmac_feedi_string (t, outer) iter = (feedi_string t iter, outer) + let hmac_feedi_bigstring (t, outer) iter = (feedi_bigstring t iter, outer) + + let hmaci_bytes ~key iter = + let t = hmac_init ~key in + hmac_feedi_bytes t iter |> hmac_get + + let hmaci_string ~key iter = + let t = hmac_init ~key in + hmac_feedi_string t iter |> hmac_get + + let hmaci_bigstring ~key iter = + let t = hmac_init ~key in + hmac_feedi_bigstring t iter |> hmac_get + + let hmac_bytes ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> By.sub buf off len + | Some off, None -> By.sub buf off (By.length buf - off) + | None, Some len -> By.sub buf 0 len + | None, None -> buf in + hmaci_bytes ~key (fun f -> f buf) + + let hmac_string ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> String.sub buf off len + | Some off, None -> String.sub buf off (String.length buf - off) + | None, Some len -> String.sub buf 0 len + | None, None -> buf in + hmaci_string ~key (fun f -> f buf) + + let hmac_bigstring ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> Bi.sub buf off len + | Some off, None -> Bi.sub buf off (Bi.length buf - off) + | None, Some len -> Bi.sub buf 0 len + | None, None -> buf in + hmaci_bigstring ~key (fun f -> f buf) + + let hmacv_bytes ~key bufs = hmaci_bytes ~key (fun f -> List.iter f bufs) + let hmacv_string ~key bufs = hmaci_string ~key (fun f -> List.iter f bufs) + + let hmacv_bigstring ~key bufs = + hmaci_bigstring ~key (fun f -> List.iter f bufs) +end + +(* XXX(dinosaure): this interface provide a new function to set digest size and + key. See #20. *) +module type Foreign_BLAKE2 = sig + open Native + + module Bigstring : sig + val update : ctx -> ba -> int -> int -> unit + val finalize : ctx -> ba -> int -> unit + val with_outlen_and_key : ctx -> int -> ba -> int -> int -> unit + end + + module Bytes : sig + val update : ctx -> st -> int -> int -> unit + val finalize : ctx -> st -> int -> unit + val with_outlen_and_key : ctx -> int -> st -> int -> int -> unit + end + + val max_outlen : unit -> int + val ctx_size : unit -> int + val key_size : unit -> int +end + +module Make_BLAKE2 (F : Foreign_BLAKE2) (D : Desc) = struct + let () = + if D.digest_size > F.max_outlen () + then + failwith "Invalid digest_size:%d to make a BLAKE2{S,B} implementation" + D.digest_size + + include + Make + (struct + module Bigstring = struct + let init ctx = + F.Bigstring.with_outlen_and_key ctx D.digest_size Bi.empty 0 0 + + let update = F.Bigstring.update + let finalize = F.Bigstring.finalize + end + + module Bytes = struct + let init ctx = + F.Bytes.with_outlen_and_key ctx D.digest_size By.empty 0 0 + + let update = F.Bytes.update + let finalize = F.Bytes.finalize + end + + let ctx_size () = F.ctx_size () + end) + (D) + + type outer = t + + module Keyed = struct + type t = outer + + let key_size = F.key_size () + + let maci_bytes ~key iter : t = + if String.length key > key_size + then invalid_arg "BLAKE2{S,B}.Keyed.maci_bytes: invalid key" ; + let ctx = By.create ctx_size in + F.Bytes.with_outlen_and_key ctx digest_size (By.unsafe_of_string key) 0 + (String.length key) ; + feedi_bytes ctx iter |> get + + let maci_string ~key iter = + if String.length key > key_size + then invalid_arg "BLAKE2{S,B}.Keyed.maci_string: invalid key" ; + let ctx = By.create ctx_size in + F.Bytes.with_outlen_and_key ctx digest_size (By.unsafe_of_string key) 0 + (String.length key) ; + feedi_string ctx iter |> get + + let maci_bigstring ~key iter = + if String.length key > key_size + then invalid_arg "BLAKE2{S,B}.Keyed.maci_bigstring: invalid key" ; + let ctx = By.create ctx_size in + F.Bytes.with_outlen_and_key ctx digest_size (By.unsafe_of_string key) 0 + (String.length key) ; + feedi_bigstring ctx iter |> get + + let mac_bytes ~key ?off ?len buf : t = + let buf = + match (off, len) with + | Some off, Some len -> By.sub buf off len + | Some off, None -> By.sub buf off (By.length buf - off) + | None, Some len -> By.sub buf 0 len + | None, None -> buf in + maci_bytes ~key (fun f -> f buf) + + let mac_string ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> String.sub buf off len + | Some off, None -> String.sub buf off (String.length buf - off) + | None, Some len -> String.sub buf 0 len + | None, None -> buf in + maci_string ~key (fun f -> f buf) + + let mac_bigstring ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> Bi.sub buf off len + | Some off, None -> Bi.sub buf off (Bi.length buf - off) + | None, Some len -> Bi.sub buf 0 len + | None, None -> buf in + maci_bigstring ~key (fun f -> f buf) + + let macv_bytes ~key bufs = maci_bytes ~key (fun f -> List.iter f bufs) + let macv_string ~key bufs = maci_string ~key (fun f -> List.iter f bufs) + + let macv_bigstring ~key bufs = + maci_bigstring ~key (fun f -> List.iter f bufs) + end +end + +module MD5 : S = + Make + (Native.MD5) + (struct + let digest_size, block_size = (16, 64) + end) + +module SHA1 : S = + Make + (Native.SHA1) + (struct + let digest_size, block_size = (20, 64) + end) + +module SHA224 : S = + Make + (Native.SHA224) + (struct + let digest_size, block_size = (28, 64) + end) + +module SHA256 : S = + Make + (Native.SHA256) + (struct + let digest_size, block_size = (32, 64) + end) + +module SHA384 : S = + Make + (Native.SHA384) + (struct + let digest_size, block_size = (48, 128) + end) + +module SHA512 : S = + Make + (Native.SHA512) + (struct + let digest_size, block_size = (64, 128) + end) + +module SHA3_224 : S = + Make + (Native.SHA3_224) + (struct + let digest_size, block_size = (28, 144) + end) + +module SHA3_256 : S = + Make + (Native.SHA3_256) + (struct + let digest_size, block_size = (32, 136) + end) + +module KECCAK_256 : S = + Make + (Native.KECCAK_256) + (struct + let digest_size, block_size = (32, 136) + end) + +module SHA3_384 : S = + Make + (Native.SHA3_384) + (struct + let digest_size, block_size = (48, 104) + end) + +module SHA3_512 : S = + Make + (Native.SHA3_512) + (struct + let digest_size, block_size = (64, 72) + end) + +module WHIRLPOOL : S = + Make + (Native.WHIRLPOOL) + (struct + let digest_size, block_size = (64, 64) + end) + +module BLAKE2B : sig + include S + module Keyed : MAC with type t = t +end = + Make_BLAKE2 + (Native.BLAKE2B) + (struct + let digest_size, block_size = (64, 128) + end) + +module BLAKE2S : sig + include S + module Keyed : MAC with type t = t +end = + Make_BLAKE2 + (Native.BLAKE2S) + (struct + let digest_size, block_size = (32, 64) + end) + +module RMD160 : S = + Make + (Native.RMD160) + (struct + let digest_size, block_size = (20, 64) + end) + +module Make_BLAKE2B (D : sig + val digest_size : int +end) : S = struct + include + Make_BLAKE2 + (Native.BLAKE2B) + (struct + let digest_size, block_size = (D.digest_size, 128) + end) +end + +module Make_BLAKE2S (D : sig + val digest_size : int +end) : S = struct + include + Make_BLAKE2 + (Native.BLAKE2S) + (struct + let digest_size, block_size = (D.digest_size, 64) + end) +end + +type 'k hash = + | MD5 : MD5.t hash + | SHA1 : SHA1.t hash + | RMD160 : RMD160.t hash + | SHA224 : SHA224.t hash + | SHA256 : SHA256.t hash + | SHA384 : SHA384.t hash + | SHA512 : SHA512.t hash + | SHA3_224 : SHA3_224.t hash + | SHA3_256 : SHA3_256.t hash + | KECCAK_256 : KECCAK_256.t hash + | SHA3_384 : SHA3_384.t hash + | SHA3_512 : SHA3_512.t hash + | WHIRLPOOL : WHIRLPOOL.t hash + | BLAKE2B : BLAKE2B.t hash + | BLAKE2S : BLAKE2S.t hash + +let md5 = MD5 +let sha1 = SHA1 +let rmd160 = RMD160 +let sha224 = SHA224 +let sha256 = SHA256 +let sha384 = SHA384 +let sha512 = SHA512 +let sha3_224 = SHA3_224 +let sha3_256 = SHA3_256 +let keccak_256 = KECCAK_256 +let sha3_384 = SHA3_384 +let sha3_512 = SHA3_512 +let whirlpool = WHIRLPOOL +let blake2b = BLAKE2B +let blake2s = BLAKE2S + +type hash' = + [ `MD5 + | `SHA1 + | `RMD160 + | `SHA224 + | `SHA256 + | `SHA384 + | `SHA512 + | `SHA3_224 + | `SHA3_256 + | `KECCAK_256 + | `SHA3_384 + | `SHA3_512 + | `WHIRLPOOL + | `BLAKE2B + | `BLAKE2S ] + +let hash_to_hash' : type a. a hash -> hash' = function + | MD5 -> `MD5 + | SHA1 -> `SHA1 + | RMD160 -> `RMD160 + | SHA224 -> `SHA224 + | SHA256 -> `SHA256 + | SHA384 -> `SHA384 + | SHA512 -> `SHA512 + | SHA3_224 -> `SHA3_224 + | SHA3_256 -> `SHA3_256 + | KECCAK_256 -> `KECCAK_256 + | SHA3_384 -> `SHA3_384 + | SHA3_512 -> `SHA3_512 + | WHIRLPOOL -> `WHIRLPOOL + | BLAKE2B -> `BLAKE2B + | BLAKE2S -> `BLAKE2S + +let module_of_hash' : hash' -> (module S) = function + | `MD5 -> (module MD5) + | `SHA1 -> (module SHA1) + | `RMD160 -> (module RMD160) + | `SHA224 -> (module SHA224) + | `SHA256 -> (module SHA256) + | `SHA384 -> (module SHA384) + | `SHA512 -> (module SHA512) + | `SHA3_224 -> (module SHA3_224) + | `SHA3_256 -> (module SHA3_256) + | `KECCAK_256 -> (module KECCAK_256) + | `SHA3_384 -> (module SHA3_384) + | `SHA3_512 -> (module SHA3_512) + | `WHIRLPOOL -> (module WHIRLPOOL) + | `BLAKE2B -> (module BLAKE2B) + | `BLAKE2S -> (module BLAKE2S) + +let module_of : type k. k hash -> (module S with type t = k) = function + | MD5 -> (module MD5) + | SHA1 -> (module SHA1) + | RMD160 -> (module RMD160) + | SHA224 -> (module SHA224) + | SHA256 -> (module SHA256) + | SHA384 -> (module SHA384) + | SHA512 -> (module SHA512) + | SHA3_224 -> (module SHA3_224) + | SHA3_256 -> (module SHA3_256) + | KECCAK_256 -> (module KECCAK_256) + | SHA3_384 -> (module SHA3_384) + | SHA3_512 -> (module SHA3_512) + | WHIRLPOOL -> (module WHIRLPOOL) + | BLAKE2B -> (module BLAKE2B) + | BLAKE2S -> (module BLAKE2S) + +type 'hash t = 'hash + +let digest_bytes : type k. k hash -> Bytes.t -> k t = + fun hash buf -> + let module H = (val module_of hash) in + H.digest_bytes buf + +let digest_string : type k. k hash -> String.t -> k t = + fun hash buf -> + let module H = (val module_of hash) in + H.digest_string buf + +let digest_bigstring : type k. k hash -> bigstring -> k t = + fun hash buf -> + let module H = (val module_of hash) in + H.digest_bigstring buf + +let digesti_bytes : type k. k hash -> Bytes.t iter -> k t = + fun hash iter -> + let module H = (val module_of hash) in + H.digesti_bytes iter + +let digesti_string : type k. k hash -> String.t iter -> k t = + fun hash iter -> + let module H = (val module_of hash) in + H.digesti_string iter + +let digesti_bigstring : type k. k hash -> bigstring iter -> k t = + fun hash iter -> + let module H = (val module_of hash) in + H.digesti_bigstring iter + +let hmaci_bytes : type k. k hash -> key:string -> Bytes.t iter -> k t = + fun hash ~key iter -> + let module H = (val module_of hash) in + H.hmaci_bytes ~key iter + +let hmaci_string : type k. k hash -> key:string -> String.t iter -> k t = + fun hash ~key iter -> + let module H = (val module_of hash) in + H.hmaci_string ~key iter + +let hmaci_bigstring : type k. k hash -> key:string -> bigstring iter -> k t = + fun hash ~key iter -> + let module H = (val module_of hash) in + H.hmaci_bigstring ~key iter + +(* XXX(dinosaure): unsafe part to avoid overhead. *) + +let unsafe_compare : type k. k hash -> k t -> k t -> int = + fun hash a b -> + let module H = (val module_of hash) in + H.unsafe_compare a b + +let equal : type k. k hash -> k t equal = + fun hash a b -> + let module H = (val module_of hash) in + H.equal a b + +let pp : type k. k hash -> k t pp = + fun hash ppf t -> + let module H = (val module_of hash) in + H.pp ppf t + +let consistent_of_hex : type k. k hash -> string -> k t = + fun hash hex -> + let module H = (val module_of hash) in + H.consistent_of_hex hex + +let consistent_of_hex_opt : type k. k hash -> string -> k t option = + fun hash hex -> + let module H = (val module_of hash) in + H.consistent_of_hex_opt hex + +let of_hex : type k. k hash -> string -> k t = + fun hash hex -> + let module H = (val module_of hash) in + H.of_hex hex + +let of_hex_opt : type k. k hash -> string -> k t option = + fun hash hex -> + let module H = (val module_of hash) in + H.of_hex_opt hex + +let to_hex : type k. k hash -> k t -> string = + fun hash t -> + let module H = (val module_of hash) in + H.to_hex t + +let of_raw_string : type k. k hash -> string -> k t = + fun hash s -> + let module H = (val module_of hash) in + H.of_raw_string s + +let of_raw_string_opt : type k. k hash -> string -> k t option = + fun hash s -> + let module H = (val module_of hash) in + H.of_raw_string_opt s + +let to_raw_string : type k. k hash -> k t -> string = + fun hash t -> + let module H = (val module_of hash) in + H.to_raw_string t + +let of_digest (type hash) (module H : S with type t = hash) (hash : H.t) : + hash t = + hash + +let of_md5 hash = hash +let of_sha1 hash = hash +let of_rmd160 hash = hash +let of_sha224 hash = hash +let of_sha256 hash = hash +let of_sha384 hash = hash +let of_sha512 hash = hash +let of_sha3_224 hash = hash +let of_sha3_256 hash = hash +let of_keccak_256 hash = hash +let of_sha3_384 hash = hash +let of_sha3_512 hash = hash +let of_whirlpool hash = hash +let of_blake2b hash = hash +let of_blake2s hash = hash diff --git a/unikernel/duniverse/digestif/src-c/digestif_native.ml b/unikernel/duniverse/digestif/src-c/digestif_native.ml new file mode 100644 index 00000000..7535e374 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/digestif_native.ml @@ -0,0 +1,535 @@ +(* Copyright (c) 2014-2016 David Kaloper Meršinjak + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY + SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION + OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN + CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) + +module By = Digestif_by +module Bi = Digestif_bi + +type off = int +type size = int +type ba = Bi.t +type st = By.t +type ctx = By.t + +let dup : ctx -> ctx = By.copy + +module MD5 = struct + type kind = [ `MD5 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_md5_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_md5_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_md5_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_md5_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_md5_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_md5_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_md5_ctx_size" [@@noalloc] +end + +module SHA1 = struct + type kind = [ `SHA1 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha1_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha1_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha1_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha1_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha1_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha1_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha1_ctx_size" [@@noalloc] +end + +module SHA224 = struct + type kind = [ `SHA224 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha224_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha224_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha224_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha224_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha224_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha224_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha224_ctx_size" [@@noalloc] +end + +module SHA256 = struct + type kind = [ `SHA256 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha256_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha256_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha256_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha256_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha256_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha256_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha256_ctx_size" [@@noalloc] +end + +module SHA384 = struct + type kind = [ `SHA384 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha384_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha384_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha384_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha384_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha384_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha384_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha384_ctx_size" [@@noalloc] +end + +module SHA512 = struct + type kind = [ `SHA512 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha512_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha512_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha512_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha512_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha512_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha512_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha512_ctx_size" [@@noalloc] +end + +module SHA3_224 = struct + type kind = [ `SHA3_224 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha3_224_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha3_224_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha3_224_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha3_224_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha3_224_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha3_224_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha3_224_ctx_size" + [@@noalloc] +end + +module SHA3_256 = struct + type kind = [ `SHA3_256 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha3_256_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha3_256_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha3_256_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha3_256_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha3_256_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha3_256_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha3_256_ctx_size" + [@@noalloc] +end + +module KECCAK_256 = struct + type kind = [ `KECCAK_256 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha3_256_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha3_256_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_keccak_256_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha3_256_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha3_256_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_keccak_256_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha3_256_ctx_size" + [@@noalloc] +end + +module SHA3_384 = struct + type kind = [ `SHA3_384 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha3_384_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha3_384_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha3_384_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha3_384_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha3_384_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha3_384_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha3_384_ctx_size" + [@@noalloc] +end + +module SHA3_512 = struct + type kind = [ `SHA3_512 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_sha3_512_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_sha3_512_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_sha3_512_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_sha3_512_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_sha3_512_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_sha3_512_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_sha3_512_ctx_size" + [@@noalloc] +end + +module WHIRLPOOL = struct + type kind = [ `WHIRLPOOL ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_whirlpool_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_whirlpool_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_whirlpool_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_whirlpool_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_whirlpool_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_whirlpool_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_whirlpool_ctx_size" + [@@noalloc] +end + +module BLAKE2B = struct + type kind = [ `BLAKE2B ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_blake2b_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_blake2b_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_blake2b_ba_finalize" + [@@noalloc] + + external with_outlen_and_key : ctx -> size -> ba -> off -> size -> unit + = "caml_digestif_blake2b_ba_init_with_outlen_and_key" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_blake2b_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_blake2b_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_blake2b_st_finalize" + [@@noalloc] + + external with_outlen_and_key : ctx -> size -> st -> off -> size -> unit + = "caml_digestif_blake2b_st_init_with_outlen_and_key" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_blake2b_ctx_size" [@@noalloc] + external key_size : unit -> int = "caml_digestif_blake2b_key_size" [@@noalloc] + + external max_outlen : unit -> int = "caml_digestif_blake2b_max_outlen" + [@@noalloc] + + external digest_size : ctx -> int = "caml_digestif_blake2b_digest_size" + [@@noalloc] +end + +module BLAKE2S = struct + type kind = [ `BLAKE2S ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_blake2s_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_blake2s_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_blake2s_ba_finalize" + [@@noalloc] + + external with_outlen_and_key : ctx -> size -> ba -> off -> size -> unit + = "caml_digestif_blake2s_ba_init_with_outlen_and_key" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_blake2s_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_blake2s_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_blake2s_st_finalize" + [@@noalloc] + + external with_outlen_and_key : ctx -> size -> st -> off -> size -> unit + = "caml_digestif_blake2s_st_init_with_outlen_and_key" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_blake2s_ctx_size" [@@noalloc] + external key_size : unit -> int = "caml_digestif_blake2s_key_size" [@@noalloc] + + external max_outlen : unit -> int = "caml_digestif_blake2s_max_outlen" + [@@noalloc] + + external digest_size : ctx -> int = "caml_digestif_blake2s_digest_size" + [@@noalloc] +end + +module RMD160 = struct + type kind = [ `RMD160 ] + + module Bigstring = struct + external init : ctx -> unit = "caml_digestif_rmd160_ba_init" [@@noalloc] + + external update : ctx -> ba -> off -> size -> unit + = "caml_digestif_rmd160_ba_update" + + external finalize : ctx -> ba -> off -> unit + = "caml_digestif_rmd160_ba_finalize" + [@@noalloc] + end + + module Bytes = struct + external init : ctx -> unit = "caml_digestif_rmd160_st_init" [@@noalloc] + + external update : ctx -> st -> off -> size -> unit + = "caml_digestif_rmd160_st_update" + [@@noalloc] + + external finalize : ctx -> st -> off -> unit + = "caml_digestif_rmd160_st_finalize" + [@@noalloc] + end + + external ctx_size : unit -> int = "caml_digestif_rmd160_ctx_size" [@@noalloc] +end + +let imin (a : int) (b : int) = if a < b then a else b + +module XOR = struct + module Bigstring = struct + external xor_into : ba -> off -> ba -> off -> size -> unit + = "caml_digestif_ba_xor_into" + [@@noalloc] + + let xor_into a b n = + if n > imin (Bi.length a) (Bi.length b) + then + raise (Invalid_argument "Native.Bigstring.xor_into: buffers to small") + else xor_into a 0 b 0 n + + let xor a b = + let l = imin (Bi.length a) (Bi.length b) in + let r = Bi.copy (Bi.sub b 0 l) in + xor_into a r l ; + r + end + + module Bytes = struct + external xor_into : st -> off -> st -> off -> size -> unit + = "caml_digestif_st_xor_into" + [@@noalloc] + + let xor_into a b n = + if n > imin (By.length a) (By.length b) + then + raise (Invalid_argument "Native.Bigstring.xor_into: buffers to small") + else xor_into a 0 b 0 n + + let xor a b = + let l = imin (By.length a) (By.length b) in + let r = By.copy (By.sub b 0 l) in + xor_into a r l ; + r + end +end diff --git a/unikernel/duniverse/digestif/src-c/dune b/unikernel/duniverse/digestif/src-c/dune new file mode 100644 index 00000000..03ccb473 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/dune @@ -0,0 +1,19 @@ +(library + (name digestif_c) + (public_name digestif.c) + (implements digestif) + (libraries eqaf) + (private_modules digestif_native digestif_eq digestif_conv digestif_by + digestif_bi) + (foreign_stubs + (language c) + (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 sha3 whirlpool misc + stubs) + (flags + (:standard -I./native/))) + (flags + (:standard -no-keep-locs))) + +(include_subdirs unqualified) + +(copy_files# ../src/*.ml) diff --git a/unikernel/duniverse/digestif/src-c/native/bitfn.h b/unikernel/duniverse/digestif/src-c/native/bitfn.h new file mode 100644 index 00000000..b025b04f --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/bitfn.h @@ -0,0 +1,325 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#ifndef BITFN_H +#define BITFN_H + +#include +#include + +#if !defined(__cpluplus) && (!defined(__STDC_VERSION__) || __STDC_VERSION__ < 199901L) + #if defined(_MSC_VER) + #define __INLINE __inline + #elif defined(__GNUC__) + #define __INLINE __inline__ + #else + #define __INLINE + #endif +#else + #define __INLINE inline +#endif + +static __INLINE void secure_zero_memory(void *v, size_t n) +{ + static void *(*const volatile memset_v)(void *, int, size_t) = &memset; + memset_v(v, 0, n); +} + +#ifndef NO_INLINE_ASM +/**********************************************************/ +# if (defined(__i386__)) +# define ARCH_HAS_SWAP32 +static __INLINE uint32_t bitfn_swap32(uint32_t a) +{ + __asm__ ("bswap %0" : "=r" (a) : "0" (a)); + return a; +} +/**********************************************************/ +# elif (defined(__arm__)) +# define ARCH_HAS_SWAP32 +static __INLINE uint32_t bitfn_swap32(uint32_t a) +{ + uint32_t tmp = a; + __asm__ volatile ("eor %1, %0, %0, ror #16\n" + "bic %1, %1, #0xff0000\n" + "mov %0, %0, ror #8\n" + "eor %0, %0, %1, lsr #8\n" + : "=r" (a), "=r" (tmp) : "0" (a), "1" (tmp)); + return a; +} +/**********************************************************/ +# elif defined(__x86_64__) +# define ARCH_HAS_SWAP32 +# define ARCH_HAS_SWAP64 +static __INLINE uint32_t bitfn_swap32(uint32_t a) +{ + __asm__ ("bswap %0" : "=r" (a) : "0" (a)); + return a; +} + +static __INLINE uint64_t bitfn_swap64(uint64_t a) +{ + __asm__ ("bswap %0" : "=r" (a) : "0" (a)); + return a; +} + +# endif +#endif /* NO_INLINE_ASM */ +/**********************************************************/ + +#ifndef ARCH_HAS_ROL32 +static __INLINE uint32_t rol32(uint32_t word, uint32_t shift) +{ + return (word << shift) | (word >> (32 - shift)); +} +#endif + +#ifndef ARCH_HAS_ROR32 +static __INLINE uint32_t ror32(uint32_t word, uint32_t shift) +{ + return (word >> shift) | (word << (32 - shift)); +} +#endif + +#ifndef ARCH_HAS_ROL64 +static __INLINE uint64_t rol64(uint64_t word, uint32_t shift) +{ + return (word << shift) | (word >> (64 - shift)); +} +#endif + +#ifndef ARCH_HAS_ROR64 +static __INLINE uint64_t ror64(uint64_t word, uint32_t shift) +{ + return (word >> shift) | (word << (64 - shift)); +} +#endif + +#ifndef ARCH_HAS_SWAP32 +static __INLINE uint32_t bitfn_swap32(uint32_t a) +{ + return (a << 24) | ((a & 0xff00) << 8) | ((a >> 8) & 0xff00) | (a >> 24); +} +#endif + +#ifndef ARCH_HAS_ARRAY_SWAP32 +static __INLINE void array_swap32(uint32_t *d, uint32_t *s, uint32_t nb) +{ + while (nb--) + *d++ = bitfn_swap32(*s++); +} +#endif + +#ifndef ARCH_HAS_SWAP64 +static __INLINE uint64_t bitfn_swap64(uint64_t a) +{ + return ((uint64_t) bitfn_swap32((uint32_t) (a >> 32))) | + (((uint64_t) bitfn_swap32((uint32_t) a)) << 32); +} +#endif + +#ifndef ARCH_HAS_ARRAY_SWAP64 +static __INLINE void array_swap64(uint64_t *d, uint64_t *s, uint32_t nb) +{ + while (nb--) + *d++ = bitfn_swap64(*s++); +} +#endif + +#ifndef ARCH_HAS_MEMORY_ZERO +static __INLINE void memory_zero(void *ptr, uint32_t len) +{ + uint32_t *ptr32 = ptr; + uint8_t *ptr8; + int i; + + for (i = 0; (uint32_t) i < len / 4; i++) + *ptr32++ = 0; + if (len % 4) { + ptr8 = (uint8_t *) ptr32; + for (i = len % 4; i >= 0; i--) + ptr8[i] = 0; + } +} +#endif + +#ifndef ARCH_HAS_ARRAY_COPY32 +static __INLINE void array_copy32(uint32_t *d, uint32_t *s, uint32_t nb) +{ + while (nb--) *d++ = *s++; +} +#endif + +#ifndef ARCH_HAS_ARRAY_COPY64 +static __INLINE void array_copy64(uint64_t *d, uint64_t *s, uint32_t nb) +{ + while (nb--) *d++ = *s++; +} +#endif + +static __INLINE uint64_t load64( const void *src ) +{ +#if defined(NATIVE_LITTLE_ENDIAN) + uint64_t w; + memcpy(&w, src, sizeof w); + return w; +#else + const uint8_t *p = ( const uint8_t * )src; + return (( uint64_t )( p[0] ) << 0) | + (( uint64_t )( p[1] ) << 8) | + (( uint64_t )( p[2] ) << 16) | + (( uint64_t )( p[3] ) << 24) | + (( uint64_t )( p[4] ) << 32) | + (( uint64_t )( p[5] ) << 40) | + (( uint64_t )( p[6] ) << 48) | + (( uint64_t )( p[7] ) << 56) ; +#endif +} + +static __INLINE uint32_t load32( const void *src ) +{ +#if defined(NATIVE_LITTLE_ENDIAN) + uint32_t w; + memcpy(&w, src, sizeof w); + return w; +#else + const uint8_t *p = ( const uint8_t * )src; + return (( uint32_t )( p[0] ) << 0) | + (( uint32_t )( p[1] ) << 8) | + (( uint32_t )( p[2] ) << 16) | + (( uint32_t )( p[3] ) << 24) ; +#endif +} + +static __INLINE void store32( void *dst, uint32_t w ) +{ +#if defined(NATIVE_LITTLE_ENDIAN) + memcpy(dst, &w, sizeof w); +#else + uint8_t *p = ( uint8_t * )dst; + p[0] = (uint8_t)(w >> 0); + p[1] = (uint8_t)(w >> 8); + p[2] = (uint8_t)(w >> 16); + p[3] = (uint8_t)(w >> 24); +#endif +} + +static __INLINE void store64( void *dst, uint64_t w ) +{ +#if defined(NATIVE_LITTLE_ENDIAN) + memcpy(dst, &w, sizeof w); +#else + uint8_t *p = ( uint8_t * )dst; + p[0] = (uint8_t)(w >> 0); + p[1] = (uint8_t)(w >> 8); + p[2] = (uint8_t)(w >> 16); + p[3] = (uint8_t)(w >> 24); + p[4] = (uint8_t)(w >> 32); + p[5] = (uint8_t)(w >> 40); + p[6] = (uint8_t)(w >> 48); + p[7] = (uint8_t)(w >> 56); +#endif +} + +#ifdef __MINGW32__ + # define LITTLE_ENDIAN 1234 + # define BYTE_ORDER LITTLE_ENDIAN +#elif defined(__FreeBSD__) || defined(__DragonFly__) || defined(__NetBSD__) + # include +#elif defined(__OpenBSD__) || defined(__SVR4) + # include +#elif defined(__APPLE__) + # include +#elif defined( BSD ) && ( BSD >= 199103 ) + # include +#elif defined( __QNXNTO__ ) && defined( __LITTLEENDIAN__ ) + # define LITTLE_ENDIAN 1234 + # define BYTE_ORDER LITTLE_ENDIAN +#elif defined( __QNXNTO__ ) && defined( __BIGENDIAN__ ) + # define BIG_ENDIAN 1234 + # define BYTE_ORDER BIG_ENDIAN +#elif defined(_MSC_VER) + # define LITTLE_ENDIAN 1234 + # define BYTE_ORDER LITTLE_ENDIAN +#else + # include +#endif +/* big endian to cpu */ +#if LITTLE_ENDIAN == BYTE_ORDER + +# define be32_to_cpu(a) bitfn_swap32(a) +# define cpu_to_be32(a) bitfn_swap32(a) +# define le32_to_cpu(a) (a) +# define cpu_to_le32(a) (a) +# define be64_to_cpu(a) bitfn_swap64(a) +# define cpu_to_be64(a) bitfn_swap64(a) +# define le64_to_cpu(a) (a) +# define cpu_to_le64(a) (a) + +# define cpu_to_le32_array(d, s, l) array_copy32(d, s, l) +# define le32_to_cpu_array(d, s, l) array_copy32(d, s, l) +# define cpu_to_be32_array(d, s, l) array_swap32(d, s, l) +# define be32_to_cpu_array(d, s, l) array_swap32(d, s, l) + +# define cpu_to_le64_array(d, s, l) array_copy64(d, s, l) +# define le64_to_cpu_array(d, s, l) array_copy64(d, s, l) +# define cpu_to_be64_array(d, s, l) array_swap64(d, s, l) +# define be64_to_cpu_array(d, s, l) array_swap64(d, s, l) + +# define ror32_be(a, s) rol32(a, s) +# define rol32_be(a, s) ror32(a, s) + +# define ARCH_IS_LITTLE_ENDIAN + +#elif BIG_ENDIAN == BYTE_ORDER + +# define be32_to_cpu(a) (a) +# define cpu_to_be32(a) (a) +# define be64_to_cpu(a) (a) +# define cpu_to_be64(a) (a) +# define le64_to_cpu(a) bitfn_swap64(a) +# define cpu_to_le64(a) bitfn_swap64(a) +# define le32_to_cpu(a) bitfn_swap32(a) +# define cpu_to_le32(a) bitfn_swap32(a) + +# define cpu_to_le32_array(d, s, l) array_swap32(d, s, l) +# define le32_to_cpu_array(d, s, l) array_swap32(d, s, l) +# define cpu_to_be32_array(d, s, l) array_copy32(d, s, l) +# define be32_to_cpu_array(d, s, l) array_copy32(d, s, l) + +# define cpu_to_le64_array(d, s, l) array_swap64(d, s, l) +# define le64_to_cpu_array(d, s, l) array_swap64(d, s, l) +# define cpu_to_be64_array(d, s, l) array_copy64(d, s, l) +# define be64_to_cpu_array(d, s, l) array_copy64(d, s, l) + +# define ror32_be(a, s) ror32(a, s) +# define rol32_be(a, s) rol32(a, s) + +# define ARCH_IS_BIG_ENDIAN + +#else +# error "endian not supported" +#endif + +#endif /* !BITFN_H */ diff --git a/unikernel/duniverse/digestif/src-c/native/blake2.c b/unikernel/duniverse/digestif/src-c/native/blake2.c new file mode 100644 index 00000000..e69de29b diff --git a/unikernel/duniverse/digestif/src-c/native/blake2b.c b/unikernel/duniverse/digestif/src-c/native/blake2b.c new file mode 100644 index 00000000..16188401 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/blake2b.c @@ -0,0 +1,220 @@ +#include +#include "blake2b.h" +#include "bitfn.h" + +static const uint64_t IV[8] = +{ + 0x6a09e667f3bcc908ULL, 0xbb67ae8584caa73bULL, + 0x3c6ef372fe94f82bULL, 0xa54ff53a5f1d36f1ULL, + 0x510e527fade682d1ULL, 0x9b05688c2b3e6c1fULL, + 0x1f83d9abfb41bd6bULL, 0x5be0cd19137e2179ULL +}; + +static const uint8_t sigma[12][16] = +{ + { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 } , + { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 } , + { 11, 8, 12, 0, 5, 2, 15, 13, 10, 14, 3, 6, 7, 1, 9, 4 } , + { 7, 9, 3, 1, 13, 12, 11, 14, 2, 6, 5, 10, 4, 0, 15, 8 } , + { 9, 0, 5, 7, 2, 4, 10, 15, 14, 1, 11, 12, 6, 8, 3, 13 } , + { 2, 12, 6, 10, 0, 11, 8, 3, 4, 13, 7, 5, 15, 14, 1, 9 } , + { 12, 5, 1, 15, 14, 13, 4, 10, 0, 7, 6, 3, 9, 2, 8, 11 } , + { 13, 11, 7, 14, 12, 1, 3, 9, 5, 0, 15, 4, 8, 6, 2, 10 } , + { 6, 15, 14, 9, 11, 3, 0, 8, 12, 2, 13, 7, 1, 4, 10, 5 } , + { 10, 2, 8, 4, 7, 6, 1, 5, 15, 11, 9, 14, 3, 12, 13 , 0 } , + { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 } , + { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 } +}; + +#include + +static const struct blake2b_param P[] = + { { BLAKE2B_OUTBYTES /* digest_length */ + , 0 /* key_length */ + , 1 /* fanout */ + , 1 /* depth */ + , 0 /* leaf_length */ + , 0 /* node_offset */ + , 0 /* xof_length */ + , 0 /* node_depth */ + , 0 /* inner_length */ + , { 0 } /* reserver[14] */ + , { 0 } /* salt[BLAKE2B_SLATBYTES] */ + , { 0 } /* personal[BLAKE2B_PERSONALBYTES] */ } }; + +static void blake2b_increment_counter( struct blake2b_ctx *ctx, const uint64_t inc ) +{ + ctx->t[0] += inc; + ctx->t[1] += ( ctx->t[0] < inc ); +} + +static void blake2b_set_lastnode( struct blake2b_ctx *ctx ) +{ + ctx->f[1] = (uint64_t)-1; +} + +static void blake2b_set_lastblock( struct blake2b_ctx *ctx ) +{ + if( ctx->last_node ) blake2b_set_lastnode( ctx ); + + ctx->f[0] = (uint64_t)-1; +} + +#define G(r,i,a,b,c,d) \ + do { \ + a = a + b + m[sigma[r][2*i+0]]; \ + d = ror64(d ^ a, 32); \ + c = c + d; \ + b = ror64(b ^ c, 24); \ + a = a + b + m[sigma[r][2*i+1]]; \ + d = ror64(d ^ a, 16); \ + c = c + d; \ + b = ror64(b ^ c, 63); \ + } while(0) + +#define R(r) \ + do { \ + G(r,0,v[ 0],v[ 4],v[ 8],v[12]); \ + G(r,1,v[ 1],v[ 5],v[ 9],v[13]); \ + G(r,2,v[ 2],v[ 6],v[10],v[14]); \ + G(r,3,v[ 3],v[ 7],v[11],v[15]); \ + G(r,4,v[ 0],v[ 5],v[10],v[15]); \ + G(r,5,v[ 1],v[ 6],v[11],v[12]); \ + G(r,6,v[ 2],v[ 7],v[ 8],v[13]); \ + G(r,7,v[ 3],v[ 4],v[ 9],v[14]); \ + } while(0) + +static void blake2b_compress(struct blake2b_ctx *ctx, const uint8_t block[BLAKE2B_BLOCKBYTES]) +{ + uint64_t m[16]; + uint64_t v[16]; + size_t i; + + for( i = 0; i < 16; ++i ) { + m[i] = load64( block + i * sizeof( m[i] ) ); + } + + for( i = 0; i < 8; ++i ) { + v[i] = ctx->h[i]; + } + + v[ 8] = IV[0]; + v[ 9] = IV[1]; + v[10] = IV[2]; + v[11] = IV[3]; + v[12] = IV[4] ^ ctx->t[0]; + v[13] = IV[5] ^ ctx->t[1]; + v[14] = IV[6] ^ ctx->f[0]; + v[15] = IV[7] ^ ctx->f[1]; + + R( 0 ); + R( 1 ); + R( 2 ); + R( 3 ); + R( 4 ); + R( 5 ); + R( 6 ); + R( 7 ); + R( 8 ); + R( 9 ); + R( 10 ); + R( 11 ); + + for( i = 0; i < 8; ++i ) + ctx->h[i] = ctx->h[i] ^ v[i] ^ v[i + 8]; +} + +#undef G +#undef R + +void digestif_blake2b_update( struct blake2b_ctx *ctx, uint8_t *data, uint32_t inlen ) +{ + const unsigned char * in = (const unsigned char *) data; + + if( inlen > 0 ) + { + size_t left = ctx->buflen; + size_t fill = BLAKE2B_BLOCKBYTES - left; + + if( inlen > fill ) + { + ctx->buflen = 0; + memcpy( ctx->buf + left, in, fill ); + blake2b_increment_counter( ctx, BLAKE2B_BLOCKBYTES ); + blake2b_compress( ctx, ctx->buf ); + in += fill; + inlen -= fill; + + while (inlen > BLAKE2B_BLOCKBYTES) + { + blake2b_increment_counter( ctx, BLAKE2B_BLOCKBYTES ); + blake2b_compress( ctx, in ); + in += BLAKE2B_BLOCKBYTES; + inlen -= BLAKE2B_BLOCKBYTES; + } + } + + memcpy( ctx->buf + ctx->buflen, in, inlen ); + ctx->buflen += inlen; + } +} + +void digestif_blake2b_init_with_outlen_and_key(struct blake2b_ctx *ctx, size_t outlen, const void *key, size_t keylen) +{ + struct blake2b_param P[1]; + const unsigned char * p = ( const uint8_t * )( P ); + size_t i; + + memset( ctx, 0, sizeof( struct blake2b_ctx ) ); + + P->digest_length = (uint8_t) outlen; + P->key_length = (uint8_t) keylen; + P->fanout = 1; + P->depth = 1; + P->leaf_length = 0; + P->node_offset = 0; + P->xof_length = 0; + P->node_depth = 0; + P->inner_length = 0; + + memset( P->reserved, 0, sizeof( P->reserved ) ); + memset( P->salt, 0, sizeof( P->salt ) ); + memset( P->personal, 0, sizeof( P->personal ) ); + + for( i = 0; i < 8; ++i ) + ctx->h[i] = IV[i] ^ load64(p + sizeof(uint64_t) * i); + + ctx->outlen = P->digest_length; + + if( keylen > 0 ) + { + uint8_t block[BLAKE2B_BLOCKBYTES]; + memset( block, 0, BLAKE2B_BLOCKBYTES ); + memcpy( block, key, keylen ); + digestif_blake2b_update( ctx, block, BLAKE2B_BLOCKBYTES ); + secure_zero_memory( block, BLAKE2B_BLOCKBYTES ); + } +} + +void digestif_blake2b_init(struct blake2b_ctx *ctx) +{ + digestif_blake2b_init_with_outlen_and_key(ctx, BLAKE2B_OUTBYTES, NULL, 0); +} + +void digestif_blake2b_finalize( struct blake2b_ctx *ctx, uint8_t *out ) +{ + uint8_t buffer[BLAKE2B_OUTBYTES] = { 0 }; + size_t i; + + blake2b_increment_counter( ctx, ctx->buflen ); + blake2b_set_lastblock( ctx ); + memset( ctx->buf + ctx->buflen, 0, BLAKE2B_BLOCKBYTES - ctx->buflen ); + blake2b_compress( ctx, ctx->buf ); + + for( i = 0; i < 8; ++i ) + store64(buffer + sizeof( ctx->h[i] ) * i, ctx->h[i]); + + secure_zero_memory( out, ctx->outlen * sizeof(uint8_t) ); + memcpy( out, buffer, (ctx->outlen < BLAKE2B_OUTBYTES) ? ctx->outlen : BLAKE2B_OUTBYTES ); + secure_zero_memory( buffer, sizeof(buffer) ); +} diff --git a/unikernel/duniverse/digestif/src-c/native/blake2b.h b/unikernel/duniverse/digestif/src-c/native/blake2b.h new file mode 100644 index 00000000..a42c2705 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/blake2b.h @@ -0,0 +1,56 @@ +#ifndef CRYPTOHASH_BLAKE2B_H +#define CRYPTOHASH_BLAKE2B_H + +#include + +#if defined(_MSC_VER) +#define PACKED(x) __pragma(pack(push, 1)) x __pragma(pack(pop)) +#else +#define PACKED(x) x __attribute((packed)) +#endif + +enum blake2b_constant +{ + BLAKE2B_BLOCKBYTES = 128, + BLAKE2B_OUTBYTES = 64, + BLAKE2B_KEYBYTES = 64, + BLAKE2B_SALTBYTES = 16, + BLAKE2B_PERSONALBYTES = 16 +}; + +struct blake2b_ctx +{ + uint64_t h[8]; + uint64_t t[2]; + uint64_t f[2]; + uint8_t buf[BLAKE2B_BLOCKBYTES]; + size_t buflen; + size_t outlen; + uint8_t last_node; +}; + +PACKED(struct blake2b_param +{ + uint8_t digest_length; /* 1 */ + uint8_t key_length; /* 2 */ + uint8_t fanout; /* 3 */ + uint8_t depth; /* 4 */ + uint32_t leaf_length; /* 8 */ + uint32_t node_offset; /* 12 */ + uint32_t xof_length; /* 16 */ + uint8_t node_depth; /* 17 */ + uint8_t inner_length; /* 18 */ + uint8_t reserved[14]; /* 32 */ + uint8_t salt[BLAKE2B_SALTBYTES]; /* 48 */ + uint8_t personal[BLAKE2B_PERSONALBYTES]; /* 64 */ +}); + +#define BLAKE2B_DIGEST_SIZE BLAKE2B_BLOCKBYTES +#define BLAKE2B_CTX_SIZE (sizeof(struct blake2b_ctx)) + +void digestif_blake2b_init(struct blake2b_ctx *ctx); +void digestif_blake2b_init_with_outlen_and_key(struct blake2b_ctx *ctx, size_t outlen, const void *key, size_t keylen); +void digestif_blake2b_update(struct blake2b_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_blake2b_finalize(struct blake2b_ctx *ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/blake2s.c b/unikernel/duniverse/digestif/src-c/native/blake2s.c new file mode 100644 index 00000000..a76a0856 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/blake2s.c @@ -0,0 +1,213 @@ +#include +#include "blake2s.h" +#include "bitfn.h" + +static const uint32_t IV[8] = +{ + 0x6A09E667UL, 0xBB67AE85UL, 0x3C6EF372UL, 0xA54FF53AUL, + 0x510E527FUL, 0x9B05688CUL, 0x1F83D9ABUL, 0x5BE0CD19UL +}; + +static const uint8_t sigma[10][16] = +{ + { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 } , + { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 } , + { 11, 8, 12, 0, 5, 2, 15, 13, 10, 14, 3, 6, 7, 1, 9, 4 } , + { 7, 9, 3, 1, 13, 12, 11, 14, 2, 6, 5, 10, 4, 0, 15, 8 } , + { 9, 0, 5, 7, 2, 4, 10, 15, 14, 1, 11, 12, 6, 8, 3, 13 } , + { 2, 12, 6, 10, 0, 11, 8, 3, 4, 13, 7, 5, 15, 14, 1, 9 } , + { 12, 5, 1, 15, 14, 13, 4, 10, 0, 7, 6, 3, 9, 2, 8, 11 } , + { 13, 11, 7, 14, 12, 1, 3, 9, 5, 0, 15, 4, 8, 6, 2, 10 } , + { 6, 15, 14, 9, 11, 3, 0, 8, 12, 2, 13, 7, 1, 4, 10, 5 } , + { 10, 2, 8, 4, 7, 6, 1, 5, 15, 11, 9, 14, 3, 12, 13 , 0 } , +}; + +#include + +static const struct blake2s_param P[] = + { { BLAKE2S_OUTBYTES /* digest_length */ + , 0 /* key_length */ + , 1 /* fanout */ + , 1 /* depth */ + , 0 /* leaf_length */ + , 0 /* node_offset */ + , 0 /* xof_length */ + , 0 /* node_depth */ + , 0 /* inner_length */ + , { 0 } /* salt */ + , { 0 } /* personal */ } }; + +static void blake2s_increment_counter( struct blake2s_ctx *ctx, const uint32_t inc ) +{ + ctx->t[0] += inc; + ctx->t[1] += ( ctx->t[0] < inc ); +} + +static void blake2s_set_lastnode( struct blake2s_ctx *ctx ) +{ + ctx->f[1] = (uint32_t)-1; +} + +static void blake2s_set_lastblock( struct blake2s_ctx *ctx ) +{ + if( ctx->last_node ) blake2s_set_lastnode( ctx ); + + ctx->f[0] = (uint32_t)-1; +} + +#define G(r,i,a,b,c,d) \ + do { \ + a = a + b + m[sigma[r][2*i+0]]; \ + d = ror32(d ^ a, 16); \ + c = c + d; \ + b = ror32(b ^ c, 12); \ + a = a + b + m[sigma[r][2*i+1]]; \ + d = ror32(d ^ a, 8); \ + c = c + d; \ + b = ror32(b ^ c, 7); \ + } while(0) + +#define ROUND(r) \ + do { \ + G(r,0,v[ 0],v[ 4],v[ 8],v[12]); \ + G(r,1,v[ 1],v[ 5],v[ 9],v[13]); \ + G(r,2,v[ 2],v[ 6],v[10],v[14]); \ + G(r,3,v[ 3],v[ 7],v[11],v[15]); \ + G(r,4,v[ 0],v[ 5],v[10],v[15]); \ + G(r,5,v[ 1],v[ 6],v[11],v[12]); \ + G(r,6,v[ 2],v[ 7],v[ 8],v[13]); \ + G(r,7,v[ 3],v[ 4],v[ 9],v[14]); \ + } while(0) + +static void blake2s_compress(struct blake2s_ctx *ctx, const uint8_t block[BLAKE2S_BLOCKBYTES]) +{ + uint32_t m[16]; + uint32_t v[16]; + size_t i; + + for( i = 0; i < 16; ++i ) { + m[i] = load32( block + i * sizeof( m[i] ) ); + } + + for( i = 0; i < 8; ++i ) { + v[i] = ctx->h[i]; + } + + v[ 8] = IV[0]; + v[ 9] = IV[1]; + v[10] = IV[2]; + v[11] = IV[3]; + v[12] = ctx->t[0] ^ IV[4]; + v[13] = ctx->t[1] ^ IV[5]; + v[14] = ctx->f[0] ^ IV[6]; + v[15] = ctx->f[1] ^ IV[7]; + + ROUND( 0 ); + ROUND( 1 ); + ROUND( 2 ); + ROUND( 3 ); + ROUND( 4 ); + ROUND( 5 ); + ROUND( 6 ); + ROUND( 7 ); + ROUND( 8 ); + ROUND( 9 ); + + for( i = 0; i < 8; ++i ) + ctx->h[i] = ctx->h[i] ^ v[i] ^ v[i + 8]; +} + +#undef G +#undef ROUND + +void digestif_blake2s_update( struct blake2s_ctx *ctx, uint8_t *data, uint32_t inlen ) +{ + const unsigned char * in = (const unsigned char *) data; + + if( inlen > 0 ) + { + size_t left = ctx->buflen; + size_t fill = BLAKE2S_BLOCKBYTES - left; + + if( inlen > fill ) + { + ctx->buflen = 0; + memcpy( ctx->buf + left, in, fill ); + blake2s_increment_counter( ctx, BLAKE2S_BLOCKBYTES ); + blake2s_compress( ctx, ctx->buf ); + in += fill; + inlen -= fill; + + while (inlen > BLAKE2S_BLOCKBYTES) + { + blake2s_increment_counter( ctx, BLAKE2S_BLOCKBYTES ); + blake2s_compress( ctx, in ); + in += BLAKE2S_BLOCKBYTES; + inlen -= BLAKE2S_BLOCKBYTES; + } + } + + memcpy( ctx->buf + ctx->buflen, in, inlen ); + ctx->buflen += inlen; + } +} + +void digestif_blake2s_init_with_outlen_and_key(struct blake2s_ctx *ctx, size_t outlen, const void *key, size_t keylen) +{ + struct blake2s_param P[1]; + const unsigned char * p = ( const uint8_t * )( P ); + size_t i; + + memset( ctx, 0, sizeof( struct blake2s_ctx ) ); + + P->digest_length = (uint8_t) outlen; + P->key_length = (uint8_t) keylen; + P->fanout = 1; + P->depth = 1; + P->leaf_length = 0; + P->node_offset = 0; + P->xof_length = 0; + P->node_depth = 0; + P->inner_length = 0; + + memset( P->salt, 0, sizeof( P->salt ) ); + memset( P->personal, 0, sizeof( P->personal ) ); + + for( i = 0; i < 8; ++i ) + ctx->h[i] = IV[i] ^ load32(p + sizeof(uint32_t) * i); + + ctx->outlen = P->digest_length; + + if( keylen > 0 ) + { + uint8_t block[BLAKE2S_BLOCKBYTES]; + memset( block, 0, BLAKE2S_BLOCKBYTES ); + memcpy( block, key, keylen ); + digestif_blake2s_update( ctx, block, BLAKE2S_BLOCKBYTES ); + secure_zero_memory( block, BLAKE2S_BLOCKBYTES ); + } +} + +void digestif_blake2s_init(struct blake2s_ctx *ctx) +{ + digestif_blake2s_init_with_outlen_and_key(ctx, BLAKE2S_OUTBYTES, NULL, 0); +} + +void digestif_blake2s_finalize( struct blake2s_ctx *ctx, uint8_t *out ) +{ + uint8_t buffer[BLAKE2S_OUTBYTES] = { 0 }; + size_t i; + + blake2s_increment_counter( ctx, ctx->buflen ); + blake2s_set_lastblock( ctx ); + memset( ctx->buf + ctx->buflen, 0, BLAKE2S_BLOCKBYTES - ctx->buflen ); + blake2s_compress( ctx, ctx->buf ); + + for( i = 0; i < 8; ++i ) + store32(buffer + sizeof( ctx->h[i] ) * i, ctx->h[i]); + + secure_zero_memory( out, ctx->outlen * sizeof(uint8_t) ); + memcpy( out, buffer, (ctx->outlen < BLAKE2S_OUTBYTES) ? ctx->outlen : BLAKE2S_OUTBYTES ); + secure_zero_memory( buffer, sizeof(buffer) ); +} + diff --git a/unikernel/duniverse/digestif/src-c/native/blake2s.h b/unikernel/duniverse/digestif/src-c/native/blake2s.h new file mode 100644 index 00000000..9898e934 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/blake2s.h @@ -0,0 +1,55 @@ +#ifndef CRYPTOHASH_BLAKE2S_H +#define CRYPTOHASH_BLAKE2S_H + +#include + +#if defined(_MSC_VER) +#define PACKED(x) __pragma(pack(push, 1)) x __pragma(pack(pop)) +#else +#define PACKED(x) x __attribute((packed)) +#endif + +enum blake2s_constant +{ + BLAKE2S_BLOCKBYTES = 64, + BLAKE2S_OUTBYTES = 32, + BLAKE2S_KEYBYTES = 32, + BLAKE2S_SALTBYTES = 8, + BLAKE2S_PERSONALBYTES = 8 +}; + +struct blake2s_ctx +{ + uint32_t h[8]; + uint32_t t[2]; + uint32_t f[2]; + uint8_t buf[BLAKE2S_BLOCKBYTES]; + size_t buflen; + size_t outlen; + uint8_t last_node; +}; + +PACKED(struct blake2s_param +{ + uint8_t digest_length; /* 1 */ + uint8_t key_length; /* 2 */ + uint8_t fanout; /* 3 */ + uint8_t depth; /* 4 */ + uint32_t leaf_length; /* 8 */ + uint32_t node_offset; /* 12 */ + uint16_t xof_length; /* 14 */ + uint8_t node_depth; /* 15 */ + uint8_t inner_length; /* 16 */ + uint8_t salt[BLAKE2S_SALTBYTES]; /* 24 */ + uint8_t personal[BLAKE2S_PERSONALBYTES]; /* 32 */ +}); + +#define BLAKE2S_DIGEST_SIZE BLAKE2S_BLOCKBYTES +#define BLAKE2S_CTX_SIZE (sizeof(struct blake2s_ctx)) + +void digestif_blake2s_init(struct blake2s_ctx *ctx); +void digestif_blake2s_init_with_outlen_and_key(struct blake2s_ctx *ctx, size_t outlen, const void *key, size_t keylen); +void digestif_blake2s_update(struct blake2s_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_blake2s_finalize(struct blake2s_ctx *ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/digestif.h b/unikernel/duniverse/digestif/src-c/native/digestif.h new file mode 100644 index 00000000..c7e4570f --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/digestif.h @@ -0,0 +1,76 @@ +/* + * Copyright (c) 2014-2016 David Kaloper Meršinjak + * + * Permission to use, copy, modify, and/or distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#if !defined(H__DIGESTIF) +#define H__DIGESTIF + +#include +#include +#include + +#include "bitfn.h" + +#if defined (__x86_64__) && defined (ACCELERATE) +#include +#endif + +#if defined (__x86_64__) && defined (ACCELERATE) && defined (__SSE2__) +#define __digestif_SSE2 +#endif + +#ifndef __unused +# if defined(_MSC_VER) && _MSC_VER >= 1500 +# define __unused(x) __pragma( warning (push) ) \ + __pragma( warning (disable:4189 ) ) \ + x \ + __pragma( warning (pop)) +# else +# define __unused(x) x __attribute__((unused)) +# endif +#endif +#define __unit() value __unused(unit) + +typedef unsigned long u_long; + +#define _ba_uint8_off(ba, off) ((uint8_t*) Caml_ba_data_val (ba) + Long_val (off)) +#define _ba_uint32_off(ba, off) ((uint32_t*) Caml_ba_data_val (ba) + Long_val (off)) +#define _ba_ulong_off(ba, off) ((u_long*) Caml_ba_data_val (ba) + Long_val (off)) + +#define _st_uint8_off(st, off) ((uint8_t*) String_val (st) + Long_val (off)) +#define _st_uint32_off(st, off) ((uint32_t*) String_val (st) + Long_val (off)) +#define _st_ulong_off(st, off) ((u_long*) String_val (st) + Long_val (off)) + +#define _ba_uint8(ba) _ba_uint8_off (ba, 0) +#define _ba_uint32(ba) _ba_uint32_off (ba, 0) +#define _ba_ulong(ba) _ba_ulong_off (ba, 0) + +#define _st_uint8(st) _st_uint8_off(st, 0) +#define _st_uint32(st) _st_uint32_off(st, 0) +#define _st_ulong(st) _st_ulong_off (st, 0) + +#define _ba_uint8_option_off(ba, off) (Is_block(ba) ? _ba_uint8_off(Field(ba, 0), off) : 0) +#define _ba_uint8_option(ba) _ba_uint8_option_off (ba, 0) + +#define _st_uint8_option_off(st, off) (Is_block(st) ? _st_uint8_off(Field(st, 0), off) : 0) +#define _st_uint8_option(st) _ba_uint8_option_off (st, 0) + +#define __define_bc_6(f) \ + CAMLprim value f ## _bc (value *v, int __unused(c) ) { return f(v[0], v[1], v[2], v[3], v[4], v[5]); } + +#define __define_bc_7(f) \ + CAMLprim value f ## _bc (value *v, int __unused(c) ) { return f(v[0], v[1], v[2], v[3], v[4], v[5], v[6]); } + +#endif /* H__DIGESTIF */ diff --git a/unikernel/duniverse/digestif/src-c/native/md5.c b/unikernel/duniverse/digestif/src-c/native/md5.c new file mode 100644 index 00000000..1e5e9d7b --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/md5.c @@ -0,0 +1,178 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include +#include +#include "bitfn.h" +#include "md5.h" + +void digestif_md5_init(struct md5_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->sz = 0ULL; + ctx->h[0] = 0x67452301; + ctx->h[1] = 0xefcdab89; + ctx->h[2] = 0x98badcfe; + ctx->h[3] = 0x10325476; +} + +#define f1(x, y, z) (z ^ (x & (y ^ z))) +#define f2(x, y, z) f1(z, x, y) +#define f3(x, y, z) (x ^ y ^ z) +#define f4(x, y, z) (y ^ (x | ~z)) +#define R(f, a, b, c, d, i, k, s) a += f(b, c, d) + w[i] + k; a = rol32(a, s); a += b + +static void md5_do_chunk(struct md5_ctx *ctx, uint32_t *buf) +{ + uint32_t a, b, c, d; +#ifdef ARCH_IS_BIG_ENDIAN + uint32_t w[16]; + cpu_to_le32_array(w, buf, 16); +#else + uint32_t *w = buf; +#endif + a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; + + R(f1, a, b, c, d, 0, 0xd76aa478, 7); + R(f1, d, a, b, c, 1, 0xe8c7b756, 12); + R(f1, c, d, a, b, 2, 0x242070db, 17); + R(f1, b, c, d, a, 3, 0xc1bdceee, 22); + R(f1, a, b, c, d, 4, 0xf57c0faf, 7); + R(f1, d, a, b, c, 5, 0x4787c62a, 12); + R(f1, c, d, a, b, 6, 0xa8304613, 17); + R(f1, b, c, d, a, 7, 0xfd469501, 22); + R(f1, a, b, c, d, 8, 0x698098d8, 7); + R(f1, d, a, b, c, 9, 0x8b44f7af, 12); + R(f1, c, d, a, b, 10, 0xffff5bb1, 17); + R(f1, b, c, d, a, 11, 0x895cd7be, 22); + R(f1, a, b, c, d, 12, 0x6b901122, 7); + R(f1, d, a, b, c, 13, 0xfd987193, 12); + R(f1, c, d, a, b, 14, 0xa679438e, 17); + R(f1, b, c, d, a, 15, 0x49b40821, 22); + + R(f2, a, b, c, d, 1, 0xf61e2562, 5); + R(f2, d, a, b, c, 6, 0xc040b340, 9); + R(f2, c, d, a, b, 11, 0x265e5a51, 14); + R(f2, b, c, d, a, 0, 0xe9b6c7aa, 20); + R(f2, a, b, c, d, 5, 0xd62f105d, 5); + R(f2, d, a, b, c, 10, 0x02441453, 9); + R(f2, c, d, a, b, 15, 0xd8a1e681, 14); + R(f2, b, c, d, a, 4, 0xe7d3fbc8, 20); + R(f2, a, b, c, d, 9, 0x21e1cde6, 5); + R(f2, d, a, b, c, 14, 0xc33707d6, 9); + R(f2, c, d, a, b, 3, 0xf4d50d87, 14); + R(f2, b, c, d, a, 8, 0x455a14ed, 20); + R(f2, a, b, c, d, 13, 0xa9e3e905, 5); + R(f2, d, a, b, c, 2, 0xfcefa3f8, 9); + R(f2, c, d, a, b, 7, 0x676f02d9, 14); + R(f2, b, c, d, a, 12, 0x8d2a4c8a, 20); + + R(f3, a, b, c, d, 5, 0xfffa3942, 4); + R(f3, d, a, b, c, 8, 0x8771f681, 11); + R(f3, c, d, a, b, 11, 0x6d9d6122, 16); + R(f3, b, c, d, a, 14, 0xfde5380c, 23); + R(f3, a, b, c, d, 1, 0xa4beea44, 4); + R(f3, d, a, b, c, 4, 0x4bdecfa9, 11); + R(f3, c, d, a, b, 7, 0xf6bb4b60, 16); + R(f3, b, c, d, a, 10, 0xbebfbc70, 23); + R(f3, a, b, c, d, 13, 0x289b7ec6, 4); + R(f3, d, a, b, c, 0, 0xeaa127fa, 11); + R(f3, c, d, a, b, 3, 0xd4ef3085, 16); + R(f3, b, c, d, a, 6, 0x04881d05, 23); + R(f3, a, b, c, d, 9, 0xd9d4d039, 4); + R(f3, d, a, b, c, 12, 0xe6db99e5, 11); + R(f3, c, d, a, b, 15, 0x1fa27cf8, 16); + R(f3, b, c, d, a, 2, 0xc4ac5665, 23); + + R(f4, a, b, c, d, 0, 0xf4292244, 6); + R(f4, d, a, b, c, 7, 0x432aff97, 10); + R(f4, c, d, a, b, 14, 0xab9423a7, 15); + R(f4, b, c, d, a, 5, 0xfc93a039, 21); + R(f4, a, b, c, d, 12, 0x655b59c3, 6); + R(f4, d, a, b, c, 3, 0x8f0ccc92, 10); + R(f4, c, d, a, b, 10, 0xffeff47d, 15); + R(f4, b, c, d, a, 1, 0x85845dd1, 21); + R(f4, a, b, c, d, 8, 0x6fa87e4f, 6); + R(f4, d, a, b, c, 15, 0xfe2ce6e0, 10); + R(f4, c, d, a, b, 6, 0xa3014314, 15); + R(f4, b, c, d, a, 13, 0x4e0811a1, 21); + R(f4, a, b, c, d, 4, 0xf7537e82, 6); + R(f4, d, a, b, c, 11, 0xbd3af235, 10); + R(f4, c, d, a, b, 2, 0x2ad7d2bb, 15); + R(f4, b, c, d, a, 9, 0xeb86d391, 21); + + ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d; +} + +void digestif_md5_update(struct md5_ctx *ctx, uint8_t *data, uint32_t len) +{ + uint32_t index, to_fill; + + index = (uint32_t) (ctx->sz & 0x3f); + to_fill = 64 - index; + + ctx->sz += len; + + if (index && len >= to_fill) { + memcpy(ctx->buf + index, data, to_fill); + md5_do_chunk(ctx, (uint32_t *) ctx->buf); + len -= to_fill; + data += to_fill; + index = 0; + } + + /* process as much 64-block as possible */ + for (; len >= 64; len -= 64, data += 64) + md5_do_chunk(ctx, (uint32_t *) data); + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +void digestif_md5_finalize(struct md5_ctx *ctx, uint8_t *out) +{ + static uint8_t padding[64] = { 0x80, }; + uint64_t bits; + uint32_t index, padlen; + uint32_t *p = (uint32_t *) out; + + /* add padding and update data with it */ + bits = cpu_to_le64(ctx->sz << 3); + + /* pad out to 56 */ + index = (uint32_t) (ctx->sz & 0x3f); + padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); + digestif_md5_update(ctx, padding, padlen); + + /* append length */ + digestif_md5_update(ctx, (uint8_t *) &bits, sizeof(bits)); + + /* output hash */ + p[0] = cpu_to_le32(ctx->h[0]); + p[1] = cpu_to_le32(ctx->h[1]); + p[2] = cpu_to_le32(ctx->h[2]); + p[3] = cpu_to_le32(ctx->h[3]); +} diff --git a/unikernel/duniverse/digestif/src-c/native/md5.h b/unikernel/duniverse/digestif/src-c/native/md5.h new file mode 100644 index 00000000..72b3228a --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/md5.h @@ -0,0 +1,44 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#ifndef CRYPTOHASH_MD5_H +#define CRYPTOHASH_MD5_H + +#include + +struct md5_ctx +{ + uint64_t sz; + uint8_t buf[64]; + uint32_t h[4]; +}; + +#define MD5_DIGEST_SIZE 16 +#define MD5_CTX_SIZE sizeof(struct md5_ctx) + +void digestif_md5_init(struct md5_ctx *ctx); +void digestif_md5_update(struct md5_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_md5_finalize(struct md5_ctx *ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/misc.c b/unikernel/duniverse/digestif/src-c/native/misc.c new file mode 100644 index 00000000..b7eec3b8 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/misc.c @@ -0,0 +1,40 @@ +#include "digestif.h" + +#define u_long_s sizeof (unsigned long) + +static inline void xor_into (uint8_t *src, uint8_t *dst, size_t n) { +#if defined (__digestif_SSE2__) + while (n >= 16) { + _mm_storeu_si128 ( + (__m128i*) dst, + _mm_xor_si128 ( + _mm_loadu_si128 ((__m128i*) src), + _mm_loadu_si128 ((__m128i*) dst))); + src += 16; + dst += 16; + n -= 16; + } +#endif + while (n >= u_long_s) { + *((u_long *) dst) ^= *((u_long *) src); + src += u_long_s; + dst += u_long_s; + n -= u_long_s; + } + while (n-- > 0) { + *dst = *(src ++) ^ *dst; + dst++; + } +} + +CAMLprim value +caml_digestif_ba_xor_into (value b1, value off1, value b2, value off2, value n) { + xor_into (_ba_uint8_off (b1, off1), _ba_uint8_off (b2, off2), Int_val (n)); + return Val_unit; +} + +CAMLprim value +caml_digestif_st_xor_into (value b1, value off1, value b2, value off2, value n) { + xor_into (_st_uint8_off (b1, off1), _st_uint8_off (b2, off2), Int_val (n)); + return Val_unit; +} diff --git a/unikernel/duniverse/digestif/src-c/native/ripemd160.c b/unikernel/duniverse/digestif/src-c/native/ripemd160.c new file mode 100644 index 00000000..de1bfc35 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/ripemd160.c @@ -0,0 +1,310 @@ +#include "ripemd160.h" +#include "bitfn.h" + +// adapted by Pieter Wuille in 2012; all changes are in the public domain +// modified by Ryan Castellucci in 2015; all changes are in the public domain +// modified by Romain Calascibetta in 2017; all changes are in the public domain + +/* + * + * RIPEMD160.c : RIPEMD-160 implementation + * + * Written in 2008 by Dwayne C. Litzenberger + * + * =================================================================== + * The contents of this file are dedicated to the public domain. To + * the extent that dedication to the public domain is not available, + * everyone is granted a worldwide, perpetual, royalty-free, + * non-exclusive license to exercise all rights associated with the + * contents of this file for any purpose whatsoever. + * No rights are reserved. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS + * BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN + * ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + * SOFTWARE. + * =================================================================== + * + * Country of origin: Canada + * + * This implementation (written in C) is based on an implementation the author + * wrote in Python. + * + * This implementation was written with reference to the RIPEMD-160 + * specification, which is available at: + * http://homes.esat.kuleuven.be/~cosicart/pdf/AB-9601/ + * + * It is also documented in the _Handbook of Applied Cryptography_, as + * Algorithm 9.55. It's on page 30 of the following PDF file: + * http://www.cacr.math.uwaterloo.ca/hac/about/chap9.pdf + * + * The RIPEMD-160 specification doesn't really tell us how to do padding, but + * since RIPEMD-160 is inspired by MD4, you can use the padding algorithm from + * RFC 1320. + * + * According to http://www.users.zetnet.co.uk/hopwood/crypto/scan/md.html: + * "RIPEMD-160 is big-bit-endian, little-byte-endian, and left-justified." + */ + +#include +#include + +/* Initial values for the chaining variables. + * This is just 0123456789ABCDEFFEDCBA9876543210F0E1D2C3 in little-endian. */ +static const uint32_t initial_h[5] = { 0x67452301u, 0xEFCDAB89u, 0x98BADCFEu, 0x10325476u, 0xC3D2E1F0u }; + +/* Ordering of message words. Based on the permutations rho(i) and pi(i), defined as follows: + * + * rho(i) := { 7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8 }[i] 0 <= i <= 15 + * + * pi(i) := 9*i + 5 (mod 16) + * + * Line | Round 1 | Round 2 | Round 3 | Round 4 | Round 5 + * -------+-----------+-----------+-----------+-----------+----------- + * left | id | rho | rho^2 | rho^3 | rho^4 + * right | pi | rho pi | rho^2 pi | rho^3 pi | rho^4 pi + */ + +/* Left line */ +static const uint8_t RL[5][16] = { + { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 }, /* Round 1: id */ + { 7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8 }, /* Round 2: rho */ + { 3, 10, 14, 4, 9, 15, 8, 1, 2, 7, 0, 6, 13, 11, 5, 12 }, /* Round 3: rho^2 */ + { 1, 9, 11, 10, 0, 8, 12, 4, 13, 3, 7, 15, 14, 5, 6, 2 }, /* Round 4: rho^3 */ + { 4, 0, 5, 9, 7, 12, 2, 10, 14, 1, 3, 8, 11, 6, 15, 13 } /* Round 5: rho^4 */ +}; + +/* Right line */ +static const uint8_t RR[5][16] = { + { 5, 14, 7, 0, 9, 2, 11, 4, 13, 6, 15, 8, 1, 10, 3, 12 }, /* Round 1: pi */ + { 6, 11, 3, 7, 0, 13, 5, 10, 14, 15, 8, 12, 4, 9, 1, 2 }, /* Round 2: rho pi */ + { 15, 5, 1, 3, 7, 14, 6, 9, 11, 8, 12, 2, 10, 0, 4, 13 }, /* Round 3: rho^2 pi */ + { 8, 6, 4, 1, 3, 11, 15, 0, 5, 12, 2, 13, 9, 7, 10, 14 }, /* Round 4: rho^3 pi */ + { 12, 15, 10, 4, 1, 5, 8, 7, 6, 2, 13, 14, 0, 3, 9, 11 } /* Round 5: rho^4 pi */ +}; + +/* + * Shifts - Since we don't actually re-order the message words according to + * the permutations above (we could, but it would be slower), these tables + * come with the permutations pre-applied. + */ + +/* Shifts, left line */ +static const uint8_t SL[5][16] = { + { 11, 14, 15, 12, 5, 8, 7, 9, 11, 13, 14, 15, 6, 7, 9, 8 }, /* Round 1 */ + { 7, 6, 8, 13, 11, 9, 7, 15, 7, 12, 15, 9, 11, 7, 13, 12 }, /* Round 2 */ + { 11, 13, 6, 7, 14, 9, 13, 15, 14, 8, 13, 6, 5, 12, 7, 5 }, /* Round 3 */ + { 11, 12, 14, 15, 14, 15, 9, 8, 9, 14, 5, 6, 8, 6, 5, 12 }, /* Round 4 */ + { 9, 15, 5, 11, 6, 8, 13, 12, 5, 12, 13, 14, 11, 8, 5, 6 } /* Round 5 */ +}; + +/* Shifts, right line */ +static const uint8_t SR[5][16] = { + { 8, 9, 9, 11, 13, 15, 15, 5, 7, 7, 8, 11, 14, 14, 12, 6 }, /* Round 1 */ + { 9, 13, 15, 7, 12, 8, 9, 11, 7, 7, 12, 7, 6, 15, 13, 11 }, /* Round 2 */ + { 9, 7, 15, 11, 8, 6, 6, 14, 12, 13, 5, 14, 13, 13, 7, 5 }, /* Round 3 */ + { 15, 5, 8, 11, 14, 14, 6, 14, 6, 9, 12, 9, 12, 5, 15, 8 }, /* Round 4 */ + { 8, 5, 12, 9, 12, 5, 14, 6, 8, 13, 6, 5, 15, 13, 11, 11 } /* Round 5 */ +}; + +/* static padding for 256 bit input */ +static const uint8_t pad256[32] = { + 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + /* length 256 bits, little endian uint64_t */ + 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 +}; + +/* Boolean functions */ + +#define F1(x, y, z) ((x) ^ (y) ^ (z)) +#define F2(x, y, z) (((x) & (y)) | (~(x) & (z))) +#define F3(x, y, z) (((x) | ~(y)) ^ (z)) +#define F4(x, y, z) (((x) & (z)) | ((y) & ~(z))) +#define F5(x, y, z) ((x) ^ ((y) | ~(z))) + +/* Round constants, left line */ +static const uint32_t KL[5] = { + 0x00000000u, /* Round 1: 0 */ + 0x5A827999u, /* Round 2: floor(2**30 * sqrt(2)) */ + 0x6ED9EBA1u, /* Round 3: floor(2**30 * sqrt(3)) */ + 0x8F1BBCDCu, /* Round 4: floor(2**30 * sqrt(5)) */ + 0xA953FD4Eu /* Round 5: floor(2**30 * sqrt(7)) */ +}; + +/* Round constants, right line */ +static const uint32_t KR[5] = { + 0x50A28BE6u, /* Round 1: floor(2**30 * cubert(2)) */ + 0x5C4DD124u, /* Round 2: floor(2**30 * cubert(3)) */ + 0x6D703EF3u, /* Round 3: floor(2**30 * cubert(5)) */ + 0x7A6D76E9u, /* Round 4: floor(2**30 * cubert(7)) */ + 0x00000000u /* Round 5: 0 */ +}; + +void digestif_rmd160_init(struct rmd160_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->h[0] = 0x67452301UL; + ctx->h[1] = 0xefcdab89UL; + ctx->h[2] = 0x98badcfeUL; + ctx->h[3] = 0x10325476UL; + ctx->h[4] = 0xc3d2e1f0UL; + + ctx->sz[0] = 0; + ctx->sz[1] = 0; + + ctx->n = 0; +} + +/* The RIPEMD160 compression function. */ +static inline void rmd160_compress(struct rmd160_ctx *ctx, uint32_t *buf) +{ + uint8_t w, round; + uint32_t T; + uint32_t AL, BL, CL, DL, EL; /* left line */ + uint32_t AR, BR, CR, DR, ER; /* right line */ + uint32_t X[16]; + + /* Byte-swap the buffer if we're on a big-endian machine */ + cpu_to_le32_array(X, buf, 16); + + /* Load the left and right lines with the initial state */ + AL = AR = ctx->h[0]; + BL = BR = ctx->h[1]; + CL = CR = ctx->h[2]; + DL = DR = ctx->h[3]; + EL = ER = ctx->h[4]; + + /* Round 1 */ + round = 0; + for (w = 0; w < 16; w++) { /* left line */ + T = rol32(AL + F1(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; + AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; + } + for (w = 0; w < 16; w++) { /* right line */ + T = rol32(AR + F5(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; + AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; + } + + /* Round 2 */ + round++; + for (w = 0; w < 16; w++) { /* left line */ + T = rol32(AL + F2(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; + AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; + } + for (w = 0; w < 16; w++) { /* right line */ + T = rol32(AR + F4(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; + AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; + } + + /* Round 3 */ + round++; + for (w = 0; w < 16; w++) { /* left line */ + T = rol32(AL + F3(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; + AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; + } + for (w = 0; w < 16; w++) { /* right line */ + T = rol32(AR + F3(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; + AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; + } + + /* Round 4 */ + round++; + for (w = 0; w < 16; w++) { /* left line */ + T = rol32(AL + F4(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; + AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; + } + for (w = 0; w < 16; w++) { /* right line */ + T = rol32(AR + F2(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; + AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; + } + + /* Round 5 */ + round++; + for (w = 0; w < 16; w++) { /* left line */ + T = rol32(AL + F5(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; + AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; + } + for (w = 0; w < 16; w++) { /* right line */ + T = rol32(AR + F1(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; + AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; + } + + /* Final mixing stage */ + T = ctx->h[1] + CL + DR; + ctx->h[1] = ctx->h[2] + DL + ER; + ctx->h[2] = ctx->h[3] + EL + AR; + ctx->h[3] = ctx->h[4] + AL + BR; + ctx->h[4] = ctx->h[0] + BL + CR; + ctx->h[0] = T; +} + +void digestif_rmd160_update(struct rmd160_ctx *ctx, uint8_t *data, uint32_t len) +{ + uint32_t t; + + /* update length */ + t = ctx->sz[0]; + + if ((ctx->sz[0] = t + (len << 3)) < t) + ctx->sz[1]++; /* carry from low 32 bits to high 32 bits. */ + + ctx->sz[1] += (len >> 29); + + /* if data was left in buffer, pad it with fresh data and munge/eat block. */ + if (ctx->n != 0) + { + t = 64 - ctx->n; + + if (len < t) /* not enough to munge. */ + { + memcpy(ctx->buf + ctx->n, data, len); + ctx->n += len; + return; + } + + memcpy(ctx->buf + ctx->n, data, t); + rmd160_compress(ctx, (uint32_t *) ctx->buf); + data += t; + len -= t; + } + + /* munge/eat data in 64 bytes chunks. */ + while (len >= 64) + { + /* memcpy(ctx->buf, data, 64); XXX(dinosaure): from X.L. but + avoid to be fast. */ + rmd160_compress(ctx, (uint32_t *) data); + data += 64; + len -= 64; + } + + /* save remaining data. */ + memcpy(ctx->buf, data, len); + ctx->n = len; +} + +void digestif_rmd160_finalize(struct rmd160_ctx *ctx, uint8_t *out) +{ + int i = ctx->n; + + ctx->buf[i++] = 0x80; + + if (i > 56) + { + memset(ctx->buf + i, 0, 64 - i); + rmd160_compress(ctx, (uint32_t *) ctx->buf); + i = 0; + } + + memset(ctx->buf + i, 0, 56 - i); + cpu_to_le32_array((uint32_t *) (ctx->buf + 56), ctx->sz, 2); + rmd160_compress(ctx, (uint32_t *) ctx->buf); + cpu_to_le32_array((uint32_t *) out, ctx->h, 5); +} diff --git a/unikernel/duniverse/digestif/src-c/native/ripemd160.h b/unikernel/duniverse/digestif/src-c/native/ripemd160.h new file mode 100644 index 00000000..87f558a3 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/ripemd160.h @@ -0,0 +1,46 @@ +/* + * Copyright (C) 2017 Romain Calascibetta + * + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#ifndef CRYPTOHASH_RMD160_H +#define CRYPTOHASH_RMD160_H + +#include + +struct rmd160_ctx +{ + uint32_t h[5]; + uint32_t sz[2]; + int n; + uint8_t buf[64]; +}; + +#define RMD160_DIGEST_SIZE 20 +#define RMD160_CTX_SIZE (sizeof(struct rmd160_ctx)) + +void digestif_rmd160_init(struct rmd160_ctx *ctx); +void digestif_rmd160_update(struct rmd160_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_rmd160_finalize(struct rmd160_ctx *ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/sha1.c b/unikernel/duniverse/digestif/src-c/native/sha1.c new file mode 100644 index 00000000..19d3de75 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha1.c @@ -0,0 +1,209 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include +#include "sha1.h" +#include "bitfn.h" + +void digestif_sha1_init(struct sha1_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->h[0] = 0x67452301; + ctx->h[1] = 0xefcdab89; + ctx->h[2] = 0x98badcfe; + ctx->h[3] = 0x10325476; + ctx->h[4] = 0xc3d2e1f0; +} + +#define f1(x, y, z) (z ^ (x & (y ^ z))) +#define f2(x, y, z) (x ^ y ^ z) +#define f3(x, y, z) ((x & y) + (z & (x ^ y))) +#define f4(x, y, z) f2(x, y, z) + +#define K1 0x5a827999 +#define K2 0x6ed9eba1 +#define K3 0x8f1bbcdc +#define K4 0xca62c1d6 + +#define R(a, b, c, d, e, f, k, w) \ + e += rol32(a, 5) + f(b, c, d) + k + w; b = rol32(b, 30) + +#define M(i) (w[i & 0x0f] = rol32(w[i & 0x0f] ^ w[(i - 14) & 0x0f] \ + ^ w[(i - 8) & 0x0f] ^ w[(i - 3) & 0x0f], 1)) + +static inline void sha1_do_chunk(struct sha1_ctx *ctx, uint32_t *buf) +{ + uint32_t a, b, c, d, e; + uint32_t w[16]; +#define CPY(i) w[i] = be32_to_cpu(buf[i]) + CPY(0); CPY(1); CPY(2); CPY(3); CPY(4); CPY(5); CPY(6); CPY(7); + CPY(8); CPY(9); CPY(10); CPY(11); CPY(12); CPY(13); CPY(14); CPY(15); +#undef CPY + + a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; e = ctx->h[4]; + + R(a, b, c, d, e, f1, K1, w[0]); + R(e, a, b, c, d, f1, K1, w[1]); + R(d, e, a, b, c, f1, K1, w[2]); + R(c, d, e, a, b, f1, K1, w[3]); + R(b, c, d, e, a, f1, K1, w[4]); + R(a, b, c, d, e, f1, K1, w[5]); + R(e, a, b, c, d, f1, K1, w[6]); + R(d, e, a, b, c, f1, K1, w[7]); + R(c, d, e, a, b, f1, K1, w[8]); + R(b, c, d, e, a, f1, K1, w[9]); + R(a, b, c, d, e, f1, K1, w[10]); + R(e, a, b, c, d, f1, K1, w[11]); + R(d, e, a, b, c, f1, K1, w[12]); + R(c, d, e, a, b, f1, K1, w[13]); + R(b, c, d, e, a, f1, K1, w[14]); + R(a, b, c, d, e, f1, K1, w[15]); + R(e, a, b, c, d, f1, K1, M(16)); + R(d, e, a, b, c, f1, K1, M(17)); + R(c, d, e, a, b, f1, K1, M(18)); + R(b, c, d, e, a, f1, K1, M(19)); + + R(a, b, c, d, e, f2, K2, M(20)); + R(e, a, b, c, d, f2, K2, M(21)); + R(d, e, a, b, c, f2, K2, M(22)); + R(c, d, e, a, b, f2, K2, M(23)); + R(b, c, d, e, a, f2, K2, M(24)); + R(a, b, c, d, e, f2, K2, M(25)); + R(e, a, b, c, d, f2, K2, M(26)); + R(d, e, a, b, c, f2, K2, M(27)); + R(c, d, e, a, b, f2, K2, M(28)); + R(b, c, d, e, a, f2, K2, M(29)); + R(a, b, c, d, e, f2, K2, M(30)); + R(e, a, b, c, d, f2, K2, M(31)); + R(d, e, a, b, c, f2, K2, M(32)); + R(c, d, e, a, b, f2, K2, M(33)); + R(b, c, d, e, a, f2, K2, M(34)); + R(a, b, c, d, e, f2, K2, M(35)); + R(e, a, b, c, d, f2, K2, M(36)); + R(d, e, a, b, c, f2, K2, M(37)); + R(c, d, e, a, b, f2, K2, M(38)); + R(b, c, d, e, a, f2, K2, M(39)); + + R(a, b, c, d, e, f3, K3, M(40)); + R(e, a, b, c, d, f3, K3, M(41)); + R(d, e, a, b, c, f3, K3, M(42)); + R(c, d, e, a, b, f3, K3, M(43)); + R(b, c, d, e, a, f3, K3, M(44)); + R(a, b, c, d, e, f3, K3, M(45)); + R(e, a, b, c, d, f3, K3, M(46)); + R(d, e, a, b, c, f3, K3, M(47)); + R(c, d, e, a, b, f3, K3, M(48)); + R(b, c, d, e, a, f3, K3, M(49)); + R(a, b, c, d, e, f3, K3, M(50)); + R(e, a, b, c, d, f3, K3, M(51)); + R(d, e, a, b, c, f3, K3, M(52)); + R(c, d, e, a, b, f3, K3, M(53)); + R(b, c, d, e, a, f3, K3, M(54)); + R(a, b, c, d, e, f3, K3, M(55)); + R(e, a, b, c, d, f3, K3, M(56)); + R(d, e, a, b, c, f3, K3, M(57)); + R(c, d, e, a, b, f3, K3, M(58)); + R(b, c, d, e, a, f3, K3, M(59)); + + R(a, b, c, d, e, f4, K4, M(60)); + R(e, a, b, c, d, f4, K4, M(61)); + R(d, e, a, b, c, f4, K4, M(62)); + R(c, d, e, a, b, f4, K4, M(63)); + R(b, c, d, e, a, f4, K4, M(64)); + R(a, b, c, d, e, f4, K4, M(65)); + R(e, a, b, c, d, f4, K4, M(66)); + R(d, e, a, b, c, f4, K4, M(67)); + R(c, d, e, a, b, f4, K4, M(68)); + R(b, c, d, e, a, f4, K4, M(69)); + R(a, b, c, d, e, f4, K4, M(70)); + R(e, a, b, c, d, f4, K4, M(71)); + R(d, e, a, b, c, f4, K4, M(72)); + R(c, d, e, a, b, f4, K4, M(73)); + R(b, c, d, e, a, f4, K4, M(74)); + R(a, b, c, d, e, f4, K4, M(75)); + R(e, a, b, c, d, f4, K4, M(76)); + R(d, e, a, b, c, f4, K4, M(77)); + R(c, d, e, a, b, f4, K4, M(78)); + R(b, c, d, e, a, f4, K4, M(79)); + + ctx->h[0] += a; + ctx->h[1] += b; + ctx->h[2] += c; + ctx->h[3] += d; + ctx->h[4] += e; +} + +void digestif_sha1_update(struct sha1_ctx *ctx, uint8_t *data, uint32_t len) +{ + uint32_t index, to_fill; + + index = (uint32_t) (ctx->sz & 0x3f); + to_fill = 64 - index; + + ctx->sz += len; + + /* process partial buffer if there's enough data to make a block */ + if (index && len >= to_fill) { + memcpy(ctx->buf + index, data, to_fill); + sha1_do_chunk(ctx, (uint32_t *) ctx->buf); + len -= to_fill; + data += to_fill; + index = 0; + } + + /* process as much 64-block as possible */ + for (; len >= 64; len -= 64, data += 64) + sha1_do_chunk(ctx, (uint32_t *) data); + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +void digestif_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out) +{ + static uint8_t padding[64] = { 0x80, }; + uint64_t bits; + uint32_t index, padlen; + uint32_t *p = (uint32_t *) out; + + /* add padding and update data with it */ + bits = cpu_to_be64(ctx->sz << 3); + + /* pad out to 56 */ + index = (uint32_t) (ctx->sz & 0x3f); + padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); + digestif_sha1_update(ctx, padding, padlen); + + /* append length */ + digestif_sha1_update(ctx, (uint8_t *) &bits, sizeof(bits)); + + /* output hash */ + p[0] = cpu_to_be32(ctx->h[0]); + p[1] = cpu_to_be32(ctx->h[1]); + p[2] = cpu_to_be32(ctx->h[2]); + p[3] = cpu_to_be32(ctx->h[3]); + p[4] = cpu_to_be32(ctx->h[4]); +} diff --git a/unikernel/duniverse/digestif/src-c/native/sha1.h b/unikernel/duniverse/digestif/src-c/native/sha1.h new file mode 100644 index 00000000..a0cb690d --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha1.h @@ -0,0 +1,44 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#ifndef CRYPTOHASH_SHA1_H +#define CRYPTOHASH_SHA1_H + +#include + +struct sha1_ctx +{ + uint64_t sz; + uint8_t buf[64]; + uint32_t h[5]; +}; + +#define SHA1_DIGEST_SIZE 20 +#define SHA1_CTX_SIZE (sizeof(struct sha1_ctx)) + +void digestif_sha1_init(struct sha1_ctx *ctx); +void digestif_sha1_update(struct sha1_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/sha256.c b/unikernel/duniverse/digestif/src-c/native/sha256.c new file mode 100644 index 00000000..43c66d06 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha256.c @@ -0,0 +1,175 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include +#include "sha256.h" +#include "bitfn.h" + +void digestif_sha224_init(struct sha224_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->h[0] = 0xc1059ed8; + ctx->h[1] = 0x367cd507; + ctx->h[2] = 0x3070dd17; + ctx->h[3] = 0xf70e5939; + ctx->h[4] = 0xffc00b31; + ctx->h[5] = 0x68581511; + ctx->h[6] = 0x64f98fa7; + ctx->h[7] = 0xbefa4fa4; +} + +void digestif_sha256_init(struct sha256_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->h[0] = 0x6a09e667; + ctx->h[1] = 0xbb67ae85; + ctx->h[2] = 0x3c6ef372; + ctx->h[3] = 0xa54ff53a; + ctx->h[4] = 0x510e527f; + ctx->h[5] = 0x9b05688c; + ctx->h[6] = 0x1f83d9ab; + ctx->h[7] = 0x5be0cd19; +} + +/* 232 times the cube root of the first 64 primes 2..311 */ +static const uint32_t k[] = { + 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, + 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, + 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, 0xe49b69c1, 0xefbe4786, + 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, + 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, + 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, + 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, 0xa2bfe8a1, 0xa81a664b, + 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, + 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, + 0x5b9cca4f, 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, + 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 +}; + +#define e0(x) (ror32(x, 2) ^ ror32(x,13) ^ ror32(x,22)) +#define e1(x) (ror32(x, 6) ^ ror32(x,11) ^ ror32(x,25)) +#define s0(x) (ror32(x, 7) ^ ror32(x,18) ^ (x >> 3)) +#define s1(x) (ror32(x,17) ^ ror32(x,19) ^ (x >> 10)) + +static void sha256_do_chunk(struct sha256_ctx *ctx, uint32_t buf[]) +{ + uint32_t a, b, c, d, e, f, g, h, t1, t2; + int i; + uint32_t w[64]; + + cpu_to_be32_array(w, buf, 16); + for (i = 16; i < 64; i++) + w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16]; + + a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; + e = ctx->h[4]; f = ctx->h[5]; g = ctx->h[6]; h = ctx->h[7]; + +#define R(a, b, c, d, e, f, g, h, k, w) \ + t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w; \ + t2 = e0(a) + ((a & b) | (c & (a | b))); \ + d += t1; \ + h = t1 + t2; + + for (i = 0; i < 64; i += 8) { + R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]); + R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]); + R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]); + R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]); + R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]); + R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]); + R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]); + R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]); + } + +#undef R + + ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d; + ctx->h[4] += e; ctx->h[5] += f; ctx->h[6] += g; ctx->h[7] += h; +} + +void digestif_sha224_update(struct sha224_ctx *ctx, uint8_t *data, uint32_t len) +{ + digestif_sha256_update(ctx, data, len); +} + +void digestif_sha256_update(struct sha256_ctx *ctx, uint8_t *data, uint32_t len) +{ + uint32_t index, to_fill; + + /* check for partial buffer */ + index = (uint32_t) (ctx->sz & 0x3f); + to_fill = 64 - index; + + ctx->sz += len; + + /* process partial buffer if there's enough data to make a block */ + if (index && len >= to_fill) { + memcpy(ctx->buf + index, data, to_fill); + sha256_do_chunk(ctx, (uint32_t *) ctx->buf); + len -= to_fill; + data += to_fill; + index = 0; + } + + /* process as much 64-block as possible */ + for (; len >= 64; len -= 64, data += 64) + sha256_do_chunk(ctx, (uint32_t *) data); + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +void digestif_sha224_finalize(struct sha224_ctx *ctx, uint8_t *out) +{ + uint8_t intermediate[SHA256_DIGEST_SIZE]; + + digestif_sha256_finalize(ctx, intermediate); + memcpy(out, intermediate, SHA224_DIGEST_SIZE); +} + +void digestif_sha256_finalize(struct sha256_ctx *ctx, uint8_t *out) +{ + static uint8_t padding[64] = { 0x80, }; + uint64_t bits; + uint32_t i, index, padlen; + uint32_t *p = (uint32_t *) out; + + /* cpu -> big endian */ + bits = cpu_to_be64(ctx->sz << 3); + + /* pad out to 56 */ + index = (uint32_t) (ctx->sz & 0x3f); + padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); + digestif_sha256_update(ctx, padding, padlen); + + /* append length */ + digestif_sha256_update(ctx, (uint8_t *) &bits, sizeof(bits)); + + /* store to digest */ + for (i = 0; i < 8; i++) + p[i] = cpu_to_be32(ctx->h[i]); +} diff --git a/unikernel/duniverse/digestif/src-c/native/sha256.h b/unikernel/duniverse/digestif/src-c/native/sha256.h new file mode 100644 index 00000000..2c1bcfc1 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha256.h @@ -0,0 +1,53 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#ifndef CRYPTOHASH_SHA256_H +#define CRYPTOHASH_SHA256_H + +#include + +struct sha256_ctx +{ + uint64_t sz; + uint8_t buf[128]; + uint32_t h[8]; +}; + +#define sha224_ctx sha256_ctx + +#define SHA224_DIGEST_SIZE 28 +#define SHA224_CTX_SIZE sizeof(struct sha224_ctx) + +#define SHA256_DIGEST_SIZE 32 +#define SHA256_CTX_SIZE sizeof(struct sha256_ctx) + +void digestif_sha224_init(struct sha224_ctx *ctx); +void digestif_sha224_update(struct sha224_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_sha224_finalize(struct sha224_ctx *ctx, uint8_t *out); + +void digestif_sha256_init(struct sha256_ctx *ctx); +void digestif_sha256_update(struct sha256_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_sha256_finalize(struct sha256_ctx *ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/sha3.c b/unikernel/duniverse/digestif/src-c/native/sha3.c new file mode 100644 index 00000000..f4e47ef5 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha3.c @@ -0,0 +1,156 @@ +/* Copyright (c) 2015 Markku-Juhani O. Saarinen */ + +#include "sha3.h" + +#ifndef KECCAKF_ROUNDS +#define KECCAKF_ROUNDS 24 +#endif + +#ifndef ROTL64 +#define ROTL64(x, y) (((x) << (y)) | ((x) >> (64 - (y)))) +#endif + +// update the state with given number of rounds + +static void sha3_keccakf(uint64_t st[25]) +{ + // constants + const uint64_t keccakf_rndc[24] = { + 0x0000000000000001, 0x0000000000008082, 0x800000000000808a, + 0x8000000080008000, 0x000000000000808b, 0x0000000080000001, + 0x8000000080008081, 0x8000000000008009, 0x000000000000008a, + 0x0000000000000088, 0x0000000080008009, 0x000000008000000a, + 0x000000008000808b, 0x800000000000008b, 0x8000000000008089, + 0x8000000000008003, 0x8000000000008002, 0x8000000000000080, + 0x000000000000800a, 0x800000008000000a, 0x8000000080008081, + 0x8000000000008080, 0x0000000080000001, 0x8000000080008008 + }; + const int keccakf_rotc[24] = { + 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 2, 14, + 27, 41, 56, 8, 25, 43, 62, 18, 39, 61, 20, 44 + }; + const int keccakf_piln[24] = { + 10, 7, 11, 17, 18, 3, 5, 16, 8, 21, 24, 4, + 15, 23, 19, 13, 12, 2, 20, 14, 22, 9, 6, 1 + }; + + // variables + int i, j, r; + uint64_t t, bc[5]; + +#if __BYTE_ORDER__ != __ORDER_LITTLE_ENDIAN__ + uint8_t *v; + + // endianess conversion. this is redundant on little-endian targets + for (i = 0; i < 25; i++) { + v = (uint8_t *) &st[i]; + st[i] = ((uint64_t) v[0]) | (((uint64_t) v[1]) << 8) | + (((uint64_t) v[2]) << 16) | (((uint64_t) v[3]) << 24) | + (((uint64_t) v[4]) << 32) | (((uint64_t) v[5]) << 40) | + (((uint64_t) v[6]) << 48) | (((uint64_t) v[7]) << 56); + } +#endif + + // actual iteration + for (r = 0; r < KECCAKF_ROUNDS; r++) { + + // Theta + for (i = 0; i < 5; i++) + bc[i] = st[i] ^ st[i + 5] ^ st[i + 10] ^ st[i + 15] ^ st[i + 20]; + + for (i = 0; i < 5; i++) { + t = bc[(i + 4) % 5] ^ ROTL64(bc[(i + 1) % 5], 1); + for (j = 0; j < 25; j += 5) + st[j + i] ^= t; + } + + // Rho Pi + t = st[1]; + for (i = 0; i < 24; i++) { + j = keccakf_piln[i]; + bc[0] = st[j]; + st[j] = ROTL64(t, keccakf_rotc[i]); + t = bc[0]; + } + + // Chi + for (j = 0; j < 25; j += 5) { + for (i = 0; i < 5; i++) + bc[i] = st[j + i]; + for (i = 0; i < 5; i++) + st[j + i] ^= (~bc[(i + 1) % 5]) & bc[(i + 2) % 5]; + } + + // Iota + st[0] ^= keccakf_rndc[r]; + } + +#if __BYTE_ORDER__ != __ORDER_LITTLE_ENDIAN__ + // endianess conversion. this is redundant on little-endian targets + for (i = 0; i < 25; i++) { + v = (uint8_t *) &st[i]; + t = st[i]; + v[0] = t & 0xFF; + v[1] = (t >> 8) & 0xFF; + v[2] = (t >> 16) & 0xFF; + v[3] = (t >> 24) & 0xFF; + v[4] = (t >> 32) & 0xFF; + v[5] = (t >> 40) & 0xFF; + v[6] = (t >> 48) & 0xFF; + v[7] = (t >> 56) & 0xFF; + } +#endif +} + +// Initialize the context for SHA3 + +void digestif_sha3_init(struct sha3_ctx *ctx, int mdlen) +{ + int i; + for (i = 0; i < 25; i++) + ctx->st.q[i] = 0; + ctx->mdlen = mdlen/8; + ctx->rsiz = 200 - 2 * ctx->mdlen; + ctx->pt = 0; + + return; +} + +// update state with more data + +void digestif_sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len) +{ + uint32_t i; + int j; + + j = ctx->pt; + for (i = 0; i < len; i++) { + ctx->st.b[j++] ^= data[i]; + if (j >= ctx->rsiz) { + sha3_keccakf(ctx->st.q); + j = 0; + } + } + ctx->pt = j; + + return; +} + +// finalize and output a hash + +void digestif_sha3_finalize(struct sha3_ctx *ctx, uint8_t *md, uint8_t padding) +{ + int i; + + //padding + ctx->st.b[ctx->pt] ^= padding; + ctx->st.b[ctx->rsiz - 1] ^= 0x80; + + //call f on the last block + sha3_keccakf(ctx->st.q); + for (i = 0; i < ctx->mdlen; i++) { + md[i] = ctx->st.b[i]; + } + + return; +} diff --git a/unikernel/duniverse/digestif/src-c/native/sha3.h b/unikernel/duniverse/digestif/src-c/native/sha3.h new file mode 100644 index 00000000..e19f0e3a --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha3.h @@ -0,0 +1,24 @@ +/* Copyright (c) 2015 Markku-Juhani O. Saarinen */ + +#ifndef CRYPTOHASH_SHA3_H +#define CRYPTOHASH_SHA3_H + +#include + + +struct sha3_ctx +{ + union { // state: + uint8_t b[200]; // 8-bit bytes + uint64_t q[25]; // 64-bit words + } st; + int pt, rsiz, mdlen; // these don't overflow +}; + +#define SHA3_CTX_SIZE sizeof(struct sha3_ctx) + +void digestif_sha3_init(struct sha3_ctx *ctx, int mdlen); +void digestif_sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_sha3_finalize(struct sha3_ctx *ctx, uint8_t *out, uint8_t padding); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/sha512.c b/unikernel/duniverse/digestif/src-c/native/sha512.c new file mode 100644 index 00000000..7785ed3d --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha512.c @@ -0,0 +1,195 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include +#include "bitfn.h" +#include "sha512.h" + +void digestif_sha384_init(struct sha512_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->h[0] = 0xcbbb9d5dc1059ed8ULL; + ctx->h[1] = 0x629a292a367cd507ULL; + ctx->h[2] = 0x9159015a3070dd17ULL; + ctx->h[3] = 0x152fecd8f70e5939ULL; + ctx->h[4] = 0x67332667ffc00b31ULL; + ctx->h[5] = 0x8eb44a8768581511ULL; + ctx->h[6] = 0xdb0c2e0d64f98fa7ULL; + ctx->h[7] = 0x47b5481dbefa4fa4ULL; +} + +void digestif_sha512_init(struct sha512_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->h[0] = 0x6a09e667f3bcc908ULL; + ctx->h[1] = 0xbb67ae8584caa73bULL; + ctx->h[2] = 0x3c6ef372fe94f82bULL; + ctx->h[3] = 0xa54ff53a5f1d36f1ULL; + ctx->h[4] = 0x510e527fade682d1ULL; + ctx->h[5] = 0x9b05688c2b3e6c1fULL; + ctx->h[6] = 0x1f83d9abfb41bd6bULL; + ctx->h[7] = 0x5be0cd19137e2179ULL; +} + +/* 232 times the cube root of the first 64 primes 2..311 */ +static const uint64_t k[] = { + 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL, + 0xe9b5dba58189dbbcULL, 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL, + 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, 0xd807aa98a3030242ULL, + 0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL, + 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL, + 0xc19bf174cf692694ULL, 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL, + 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, 0x2de92c6f592b0275ULL, + 0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL, + 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL, + 0xbf597fc7beef0ee4ULL, 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL, + 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, 0x27b70a8546d22ffcULL, + 0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL, + 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL, + 0x92722c851482353bULL, 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL, + 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, 0xd192e819d6ef5218ULL, + 0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL, + 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL, + 0x34b0bcb5e19b48a8ULL, 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL, + 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, 0x748f82ee5defb2fcULL, + 0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL, + 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL, + 0xc67178f2e372532bULL, 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL, + 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, 0x06f067aa72176fbaULL, + 0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL, + 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL, + 0x431d67c49c100d4cULL, 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL, + 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL, +}; + +#define e0(x) (ror64(x, 28) ^ ror64(x, 34) ^ ror64(x, 39)) +#define e1(x) (ror64(x, 14) ^ ror64(x, 18) ^ ror64(x, 41)) +#define s0(x) (ror64(x, 1) ^ ror64(x, 8) ^ (x >> 7)) +#define s1(x) (ror64(x, 19) ^ ror64(x, 61) ^ (x >> 6)) + +static void sha512_do_chunk(struct sha512_ctx *ctx, uint64_t *buf) +{ + uint64_t a, b, c, d, e, f, g, h, t1, t2; + int i; + uint64_t w[80]; + + cpu_to_be64_array(w, buf, 16); + + for (i = 16; i < 80; i++) + w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16]; + + a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; + e = ctx->h[4]; f = ctx->h[5]; g = ctx->h[6]; h = ctx->h[7]; + +#define R(a, b, c, d, e, f, g, h, k, w) \ + t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w; \ + t2 = e0(a) + ((a & b) | (c & (a | b))); \ + d += t1; \ + h = t1 + t2 + + for (i = 0; i < 80; i += 8) { + R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]); + R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]); + R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]); + R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]); + R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]); + R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]); + R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]); + R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]); + } + +#undef R + + ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d; + ctx->h[4] += e; ctx->h[5] += f; ctx->h[6] += g; ctx->h[7] += h; +} + +void digestif_sha384_update(struct sha384_ctx *ctx, uint8_t *data, uint32_t len) +{ + digestif_sha512_update(ctx, data, len); +} + +void digestif_sha512_update(struct sha512_ctx *ctx, uint8_t *data, uint32_t len) +{ + unsigned int index, to_fill; + + /* check for partial buffer */ + index = (unsigned int) (ctx->sz[0] & 0x7f); + to_fill = 128 - index; + + ctx->sz[0] += len; + if (ctx->sz[0] < len) + ctx->sz[1]++; + + /* process partial buffer if there's enough data to make a block */ + if (index && len >= to_fill) { + memcpy(ctx->buf + index, data, to_fill); + sha512_do_chunk(ctx, (uint64_t *) ctx->buf); + len -= to_fill; + data += to_fill; + index = 0; + } + + /* process as much 128-block as possible */ + for (; len >= 128; len -= 128, data += 128) + sha512_do_chunk(ctx, (uint64_t *) data); + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +void digestif_sha384_finalize(struct sha384_ctx *ctx, uint8_t *out) +{ + uint8_t intermediate[SHA512_DIGEST_SIZE]; + + digestif_sha512_finalize(ctx, intermediate); + memcpy(out, intermediate, SHA384_DIGEST_SIZE); +} + +void digestif_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out) +{ + static uint8_t padding[128] = { 0x80, }; + uint32_t i, index, padlen; + uint64_t bits[2]; + uint64_t *p = (uint64_t *) out; + + /* cpu -> big endian */ + bits[0] = cpu_to_be64((ctx->sz[1] << 3 | ctx->sz[0] >> 61)); + bits[1] = cpu_to_be64((ctx->sz[0] << 3)); + + /* pad out to 56 */ + index = (unsigned int) (ctx->sz[0] & 0x7f); + padlen = (index < 112) ? (112 - index) : ((128 + 112) - index); + digestif_sha512_update(ctx, padding, padlen); + + /* append length */ + digestif_sha512_update(ctx, (uint8_t *) bits, sizeof(bits)); + + /* store to digest */ + for (i = 0; i < 8; i++) + p[i] = cpu_to_be64(ctx->h[i]); +} diff --git a/unikernel/duniverse/digestif/src-c/native/sha512.h b/unikernel/duniverse/digestif/src-c/native/sha512.h new file mode 100644 index 00000000..04461fbd --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/sha512.h @@ -0,0 +1,52 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ +#ifndef CRYPTOHASH_SHA512_H +#define CRYPTOHASH_SHA512_H + +#include + +struct sha512_ctx +{ + uint64_t sz[2]; + uint8_t buf[128]; + uint64_t h[8]; +}; + +#define sha384_ctx sha512_ctx + +#define SHA384_DIGEST_SIZE 48 +#define SHA384_CTX_SIZE sizeof(struct sha384_ctx) + +#define SHA512_DIGEST_SIZE 64 +#define SHA512_CTX_SIZE sizeof(struct sha512_ctx) + +void digestif_sha384_init(struct sha384_ctx *ctx); +void digestif_sha384_update(struct sha384_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_sha384_finalize(struct sha384_ctx *ctx, uint8_t *out); + +void digestif_sha512_init(struct sha512_ctx *ctx); +void digestif_sha512_update(struct sha512_ctx *ctx, uint8_t *data, uint32_t len); +void digestif_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-c/native/stubs.c b/unikernel/duniverse/digestif/src-c/native/stubs.c new file mode 100644 index 00000000..e9f19658 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/stubs.c @@ -0,0 +1,282 @@ +#include "digestif.h" + +#include "md5.h" +#include "sha1.h" +#include "sha256.h" +#include "sha512.h" +#include "sha3.h" +#include "whirlpool.h" +#include "blake2b.h" +#include "blake2s.h" +#include "ripemd160.h" +#include +#include + +#ifndef Bytes_val +#define Bytes_val(x) String_val(x) +#endif + +#if defined(__ocaml_freestanding__) || defined(__ocaml_solo5__) +#define __define_ba_update(name) \ + CAMLprim value \ + caml_digestif_ ## name ## _ba_update \ + (value ctx, value src, value off, value len) { \ + digestif_ ## name ## _update ( \ + (struct name ## _ctx *) String_val (ctx), \ + _ba_uint8_off (src, off), Int_val (len)); \ + return Val_unit; \ + } + +#define __define_sha3_ba_update(mdlen) \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _ba_update \ + (value ctx, value src, value off, value len) { \ + digestif_sha3_update ( \ + (struct sha3_ctx *) String_val (ctx), \ + _ba_uint8_off (src, off), Int_val (len)); \ + return Val_unit; \ + } +#else +/* XXX(dinosaure): even if they are not defined (only defined by + * [caml/threads.h]), they exists without [threads.cmxa]. For compatibility + * reason, we keep a protection when we compile for Solo5/ocaml-freestanding + * but for the rest, these functions should be available in any cases. + * + * In some cases (Solo5 or Esperanto), [caml/threads.h] is not available but + * these functions still exist! + */ + +CAMLextern void caml_enter_blocking_section (void); +CAMLextern void caml_leave_blocking_section (void); + +#define __define_ba_update(name) \ + CAMLprim value \ + caml_digestif_ ## name ## _ba_update \ + (value ctx, value src, value off, value len) { \ + CAMLparam4 (ctx, src, off, len); \ + uint8_t *off_ = ((uint8_t*) Caml_ba_data_val(src)) + Long_val (off); \ + uint32_t len_ = Long_val (len); \ + struct name ## _ctx ctx_; \ + memcpy(&ctx_, Bytes_val(ctx), sizeof(struct name ## _ctx)); \ + caml_enter_blocking_section(); \ + digestif_ ## name ## _update (&ctx_, off_, len_); \ + caml_leave_blocking_section(); \ + memcpy(Bytes_val(ctx), &ctx_, sizeof(struct name ## _ctx)); \ + CAMLreturn (Val_unit); \ + } + +#define __define_sha3_ba_update(mdlen) \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _ba_update \ + (value ctx, value src, value off, value len) { \ + CAMLparam4 (ctx, src, off, len); \ + uint8_t *off_ = ((uint8_t*) Caml_ba_data_val(src)) + Long_val (off); \ + uint32_t len_ = Long_val (len); \ + struct sha3_ctx ctx_; \ + memcpy(&ctx_, Bytes_val(ctx), sizeof(struct sha3_ctx)); \ + caml_enter_blocking_section(); \ + digestif_sha3_update (&ctx_, off_, len_); \ + caml_leave_blocking_section(); \ + memcpy(Bytes_val(ctx), &ctx_, sizeof(struct sha3_ctx)); \ + CAMLreturn (Val_unit); \ + } +#endif + +#define __define_hash(name, upper) \ + \ + CAMLprim value \ + caml_digestif_ ## name ## _ba_init (value ctx) { \ + digestif_ ## name ## _init ((struct name ## _ctx *) String_val (ctx)); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_ ## name ## _st_init (value ctx) { \ + digestif_ ## name ## _init ((struct name ## _ctx *) String_val (ctx)); \ + return Val_unit; \ + } \ + \ + __define_ba_update(name) \ + \ + CAMLprim value \ + caml_digestif_ ## name ## _st_update \ + (value ctx, value src, value off, value len) { \ + digestif_ ## name ## _update ( \ + (struct name ## _ctx *) String_val (ctx), \ + _st_uint8_off (src, off), Int_val (len)); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_ ## name ## _ba_finalize (value ctx, value dst, value off) { \ + digestif_ ## name ## _finalize ( \ + (struct name ## _ctx *) String_val (ctx), \ + _ba_uint8_off (dst, off)); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_ ## name ## _st_finalize (value ctx, value dst, value off) { \ + digestif_ ## name ## _finalize( \ + (struct name ## _ctx *) String_val (ctx), \ + _st_uint8_off (dst, off)); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_ ## name ## _ctx_size (__unit ()) { \ + return Val_int (upper ## _CTX_SIZE); \ + } + +__define_hash (md5, MD5) +__define_hash (sha1, SHA1) +__define_hash (sha224, SHA224) +__define_hash (sha256, SHA256) +__define_hash (sha384, SHA384) +__define_hash (sha512, SHA512) +__define_hash (whirlpool, WHIRLPOOL) +__define_hash (blake2b, BLAKE2B) +__define_hash (blake2s, BLAKE2S) +__define_hash (rmd160, RMD160) + +CAMLprim value +caml_digestif_blake2b_ba_init_with_outlen_and_key(value ctx, value outlen, value key, value off, value len) +{ + digestif_blake2b_init_with_outlen_and_key( + (struct blake2b_ctx *) String_val (ctx), Int_val (outlen), + _ba_uint8_off(key, off), Int_val (len)); + + return Val_unit; +} + +CAMLprim value +caml_digestif_blake2b_st_init_with_outlen_and_key(value ctx, value outlen, value key, value off, value len) +{ + digestif_blake2b_init_with_outlen_and_key( + (struct blake2b_ctx *) String_val (ctx), Int_val (outlen), + _st_uint8_off(key, off), Int_val (len)); + + return Val_unit; +} + +CAMLprim value +caml_digestif_blake2b_key_size(__unit ()) { + return Val_int (BLAKE2B_KEYBYTES); +} + +CAMLprim value +caml_digestif_blake2b_max_outlen(__unit ()) { + return Val_int (BLAKE2B_OUTBYTES); +} + +CAMLprim value +caml_digestif_blake2b_digest_size(value ctx) { + return Val_int(((struct blake2b_ctx *) String_val (ctx))->outlen); +} + +CAMLprim value +caml_digestif_blake2s_ba_init_with_outlen_and_key(value ctx, value outlen, value key, value off, value len) +{ + digestif_blake2s_init_with_outlen_and_key( + (struct blake2s_ctx *) String_val (ctx), Int_val (outlen), + _ba_uint8_off(key, off), Int_val (len)); + + return Val_unit; +} + +CAMLprim value +caml_digestif_blake2s_st_init_with_outlen_and_key(value ctx, value outlen, value key, value off, value len) +{ + digestif_blake2s_init_with_outlen_and_key( + (struct blake2s_ctx *) String_val (ctx), Int_val (outlen), + _st_uint8_off(key, off), Int_val (len)); + + return Val_unit; +} + +CAMLprim value +caml_digestif_blake2s_key_size(__unit ()) { + return Val_int (BLAKE2S_KEYBYTES); +} + +CAMLprim value +caml_digestif_blake2s_max_outlen(__unit ()) { + return Val_int (BLAKE2S_OUTBYTES); +} + +CAMLprim value +caml_digestif_blake2s_digest_size(value ctx) { + return Val_int(((struct blake2s_ctx *) String_val (ctx))->outlen); +} + +CAMLprim value +caml_digestif_keccak_256_ba_finalize +(value ctx, value dst, value off) { + digestif_sha3_finalize ( + (struct sha3_ctx *) String_val (ctx), + _ba_uint8_off (dst, off), 0x01); + return Val_unit; +} + +CAMLprim value +caml_digestif_keccak_256_st_finalize +(value ctx, value dst, value off) { + digestif_sha3_finalize( + (struct sha3_ctx *) String_val (ctx), + _st_uint8_off (dst, off), 0x01); + return Val_unit; +} + + +#define __define_hash_sha3(mdlen) \ + \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _ba_init (value ctx) { \ + digestif_sha3_init ((struct sha3_ctx *) String_val (ctx), mdlen); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _st_init (value ctx) { \ + digestif_sha3_init ((struct sha3_ctx *) String_val (ctx), mdlen); \ + return Val_unit; \ + } \ + \ + __define_sha3_ba_update(mdlen) \ + \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _st_update \ + (value ctx, value src, value off, value len) { \ + digestif_sha3_update ( \ + (struct sha3_ctx *) String_val (ctx), \ + _st_uint8_off (src, off), Int_val (len)); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _ba_finalize \ + (value ctx, value dst, value off) { \ + digestif_sha3_finalize ( \ + (struct sha3_ctx *) String_val (ctx), \ + _ba_uint8_off (dst, off), 0x06); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _st_finalize \ + (value ctx, value dst, value off) { \ + digestif_sha3_finalize( \ + (struct sha3_ctx *) String_val (ctx), \ + _st_uint8_off (dst, off), 0x06); \ + return Val_unit; \ + } \ + \ + CAMLprim value \ + caml_digestif_sha3_ ## mdlen ## _ctx_size (__unit ()) { \ + return Val_int (SHA3_CTX_SIZE); \ + } + +__define_hash_sha3 (224) +__define_hash_sha3 (256) +__define_hash_sha3 (384) +__define_hash_sha3 (512) diff --git a/unikernel/duniverse/digestif/src-c/native/whirlpool.c b/unikernel/duniverse/digestif/src-c/native/whirlpool.c new file mode 100644 index 00000000..fce84f92 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/whirlpool.c @@ -0,0 +1,729 @@ +/* whirlpool.c - an implementation of the Whirlpool Hash Function. + * + * Copyright: 2009-2012 Aleksey Kravchenko + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. Use this program at your own risk! + * + * Documentation: + * P. S. L. M. Barreto, V. Rijmen, ``The Whirlpool hashing function,'' + * NESSIE submission, 2000 (tweaked version, 2001) + * + * The algorithm is named after the Whirlpool Galaxy in Canes Venatici. + */ + +#include +#include "bitfn.h" +#include "whirlpool.h" + +uint64_t digestif_whirlpool_sbox[8][256] = { + { + /* C0 vectors */ + 0x18186018c07830d8ULL, 0x23238c2305af4626ULL, 0xc6c63fc67ef991b8ULL, 0xe8e887e8136fcdfbULL, + 0x878726874ca113cbULL, 0xb8b8dab8a9626d11ULL, 0x0101040108050209ULL, 0x4f4f214f426e9e0dULL, + 0x3636d836adee6c9bULL, 0xa6a6a2a6590451ffULL, 0xd2d26fd2debdb90cULL, 0xf5f5f3f5fb06f70eULL, + 0x7979f979ef80f296ULL, 0x6f6fa16f5fcede30ULL, 0x91917e91fcef3f6dULL, 0x52525552aa07a4f8ULL, + 0x60609d6027fdc047ULL, 0xbcbccabc89766535ULL, 0x9b9b569baccd2b37ULL, 0x8e8e028e048c018aULL, + 0xa3a3b6a371155bd2ULL, 0x0c0c300c603c186cULL, 0x7b7bf17bff8af684ULL, 0x3535d435b5e16a80ULL, + 0x1d1d741de8693af5ULL, 0xe0e0a7e05347ddb3ULL, 0xd7d77bd7f6acb321ULL, 0xc2c22fc25eed999cULL, + 0x2e2eb82e6d965c43ULL, 0x4b4b314b627a9629ULL, 0xfefedffea321e15dULL, 0x575741578216aed5ULL, + 0x15155415a8412abdULL, 0x7777c1779fb6eee8ULL, 0x3737dc37a5eb6e92ULL, 0xe5e5b3e57b56d79eULL, + 0x9f9f469f8cd92313ULL, 0xf0f0e7f0d317fd23ULL, 0x4a4a354a6a7f9420ULL, 0xdada4fda9e95a944ULL, + 0x58587d58fa25b0a2ULL, 0xc9c903c906ca8fcfULL, 0x2929a429558d527cULL, 0x0a0a280a5022145aULL, + 0xb1b1feb1e14f7f50ULL, 0xa0a0baa0691a5dc9ULL, 0x6b6bb16b7fdad614ULL, 0x85852e855cab17d9ULL, + 0xbdbdcebd8173673cULL, 0x5d5d695dd234ba8fULL, 0x1010401080502090ULL, 0xf4f4f7f4f303f507ULL, + 0xcbcb0bcb16c08bddULL, 0x3e3ef83eedc67cd3ULL, 0x0505140528110a2dULL, 0x676781671fe6ce78ULL, + 0xe4e4b7e47353d597ULL, 0x27279c2725bb4e02ULL, 0x4141194132588273ULL, 0x8b8b168b2c9d0ba7ULL, + 0xa7a7a6a7510153f6ULL, 0x7d7de97dcf94fab2ULL, 0x95956e95dcfb3749ULL, 0xd8d847d88e9fad56ULL, + 0xfbfbcbfb8b30eb70ULL, 0xeeee9fee2371c1cdULL, 0x7c7ced7cc791f8bbULL, 0x6666856617e3cc71ULL, + 0xdddd53dda68ea77bULL, 0x17175c17b84b2eafULL, 0x4747014702468e45ULL, 0x9e9e429e84dc211aULL, + 0xcaca0fca1ec589d4ULL, 0x2d2db42d75995a58ULL, 0xbfbfc6bf9179632eULL, 0x07071c07381b0e3fULL, + 0xadad8ead012347acULL, 0x5a5a755aea2fb4b0ULL, 0x838336836cb51befULL, 0x3333cc3385ff66b6ULL, + 0x636391633ff2c65cULL, 0x02020802100a0412ULL, 0xaaaa92aa39384993ULL, 0x7171d971afa8e2deULL, + 0xc8c807c80ecf8dc6ULL, 0x19196419c87d32d1ULL, 0x494939497270923bULL, 0xd9d943d9869aaf5fULL, + 0xf2f2eff2c31df931ULL, 0xe3e3abe34b48dba8ULL, 0x5b5b715be22ab6b9ULL, 0x88881a8834920dbcULL, + 0x9a9a529aa4c8293eULL, 0x262698262dbe4c0bULL, 0x3232c8328dfa64bfULL, 0xb0b0fab0e94a7d59ULL, + 0xe9e983e91b6acff2ULL, 0x0f0f3c0f78331e77ULL, 0xd5d573d5e6a6b733ULL, 0x80803a8074ba1df4ULL, + 0xbebec2be997c6127ULL, 0xcdcd13cd26de87ebULL, 0x3434d034bde46889ULL, 0x48483d487a759032ULL, + 0xffffdbffab24e354ULL, 0x7a7af57af78ff48dULL, 0x90907a90f4ea3d64ULL, 0x5f5f615fc23ebe9dULL, + 0x202080201da0403dULL, 0x6868bd6867d5d00fULL, 0x1a1a681ad07234caULL, 0xaeae82ae192c41b7ULL, + 0xb4b4eab4c95e757dULL, 0x54544d549a19a8ceULL, 0x93937693ece53b7fULL, 0x222288220daa442fULL, + 0x64648d6407e9c863ULL, 0xf1f1e3f1db12ff2aULL, 0x7373d173bfa2e6ccULL, 0x12124812905a2482ULL, + 0x40401d403a5d807aULL, 0x0808200840281048ULL, 0xc3c32bc356e89b95ULL, 0xecec97ec337bc5dfULL, + 0xdbdb4bdb9690ab4dULL, 0xa1a1bea1611f5fc0ULL, 0x8d8d0e8d1c830791ULL, 0x3d3df43df5c97ac8ULL, + 0x97976697ccf1335bULL, 0x0000000000000000ULL, 0xcfcf1bcf36d483f9ULL, 0x2b2bac2b4587566eULL, + 0x7676c57697b3ece1ULL, 0x8282328264b019e6ULL, 0xd6d67fd6fea9b128ULL, 0x1b1b6c1bd87736c3ULL, + 0xb5b5eeb5c15b7774ULL, 0xafaf86af112943beULL, 0x6a6ab56a77dfd41dULL, 0x50505d50ba0da0eaULL, + 0x45450945124c8a57ULL, 0xf3f3ebf3cb18fb38ULL, 0x3030c0309df060adULL, 0xefef9bef2b74c3c4ULL, + 0x3f3ffc3fe5c37edaULL, 0x55554955921caac7ULL, 0xa2a2b2a2791059dbULL, 0xeaea8fea0365c9e9ULL, + 0x656589650fecca6aULL, 0xbabad2bab9686903ULL, 0x2f2fbc2f65935e4aULL, 0xc0c027c04ee79d8eULL, + 0xdede5fdebe81a160ULL, 0x1c1c701ce06c38fcULL, 0xfdfdd3fdbb2ee746ULL, 0x4d4d294d52649a1fULL, + 0x92927292e4e03976ULL, 0x7575c9758fbceafaULL, 0x06061806301e0c36ULL, 0x8a8a128a249809aeULL, + 0xb2b2f2b2f940794bULL, 0xe6e6bfe66359d185ULL, 0x0e0e380e70361c7eULL, 0x1f1f7c1ff8633ee7ULL, + 0x6262956237f7c455ULL, 0xd4d477d4eea3b53aULL, 0xa8a89aa829324d81ULL, 0x96966296c4f43152ULL, + 0xf9f9c3f99b3aef62ULL, 0xc5c533c566f697a3ULL, 0x2525942535b14a10ULL, 0x59597959f220b2abULL, + 0x84842a8454ae15d0ULL, 0x7272d572b7a7e4c5ULL, 0x3939e439d5dd72ecULL, 0x4c4c2d4c5a619816ULL, + 0x5e5e655eca3bbc94ULL, 0x7878fd78e785f09fULL, 0x3838e038ddd870e5ULL, 0x8c8c0a8c14860598ULL, + 0xd1d163d1c6b2bf17ULL, 0xa5a5aea5410b57e4ULL, 0xe2e2afe2434dd9a1ULL, 0x616199612ff8c24eULL, + 0xb3b3f6b3f1457b42ULL, 0x2121842115a54234ULL, 0x9c9c4a9c94d62508ULL, 0x1e1e781ef0663ceeULL, + 0x4343114322528661ULL, 0xc7c73bc776fc93b1ULL, 0xfcfcd7fcb32be54fULL, 0x0404100420140824ULL, + 0x51515951b208a2e3ULL, 0x99995e99bcc72f25ULL, 0x6d6da96d4fc4da22ULL, 0x0d0d340d68391a65ULL, + 0xfafacffa8335e979ULL, 0xdfdf5bdfb684a369ULL, 0x7e7ee57ed79bfca9ULL, 0x242490243db44819ULL, + 0x3b3bec3bc5d776feULL, 0xabab96ab313d4b9aULL, 0xcece1fce3ed181f0ULL, 0x1111441188552299ULL, + 0x8f8f068f0c890383ULL, 0x4e4e254e4a6b9c04ULL, 0xb7b7e6b7d1517366ULL, 0xebeb8beb0b60cbe0ULL, + 0x3c3cf03cfdcc78c1ULL, 0x81813e817cbf1ffdULL, 0x94946a94d4fe3540ULL, 0xf7f7fbf7eb0cf31cULL, + 0xb9b9deb9a1676f18ULL, 0x13134c13985f268bULL, 0x2c2cb02c7d9c5851ULL, 0xd3d36bd3d6b8bb05ULL, + 0xe7e7bbe76b5cd38cULL, 0x6e6ea56e57cbdc39ULL, 0xc4c437c46ef395aaULL, 0x03030c03180f061bULL, + 0x565645568a13acdcULL, 0x44440d441a49885eULL, 0x7f7fe17fdf9efea0ULL, 0xa9a99ea921374f88ULL, + 0x2a2aa82a4d825467ULL, 0xbbbbd6bbb16d6b0aULL, 0xc1c123c146e29f87ULL, 0x53535153a202a6f1ULL, + 0xdcdc57dcae8ba572ULL, 0x0b0b2c0b58271653ULL, 0x9d9d4e9d9cd32701ULL, 0x6c6cad6c47c1d82bULL, + 0x3131c43195f562a4ULL, 0x7474cd7487b9e8f3ULL, 0xf6f6fff6e309f115ULL, 0x464605460a438c4cULL, + 0xacac8aac092645a5ULL, 0x89891e893c970fb5ULL, 0x14145014a04428b4ULL, 0xe1e1a3e15b42dfbaULL, + 0x16165816b04e2ca6ULL, 0x3a3ae83acdd274f7ULL, 0x6969b9696fd0d206ULL, 0x09092409482d1241ULL, + 0x7070dd70a7ade0d7ULL, 0xb6b6e2b6d954716fULL, 0xd0d067d0ceb7bd1eULL, 0xeded93ed3b7ec7d6ULL, + 0xcccc17cc2edb85e2ULL, 0x424215422a578468ULL, 0x98985a98b4c22d2cULL, 0xa4a4aaa4490e55edULL, + 0x2828a0285d885075ULL, 0x5c5c6d5cda31b886ULL, 0xf8f8c7f8933fed6bULL, 0x8686228644a411c2ULL, + }, { + /* C1 vectors */ + 0xd818186018c07830ULL, 0x2623238c2305af46ULL, 0xb8c6c63fc67ef991ULL, 0xfbe8e887e8136fcdULL, + 0xcb878726874ca113ULL, 0x11b8b8dab8a9626dULL, 0x0901010401080502ULL, 0x0d4f4f214f426e9eULL, + 0x9b3636d836adee6cULL, 0xffa6a6a2a6590451ULL, 0x0cd2d26fd2debdb9ULL, 0x0ef5f5f3f5fb06f7ULL, + 0x967979f979ef80f2ULL, 0x306f6fa16f5fcedeULL, 0x6d91917e91fcef3fULL, 0xf852525552aa07a4ULL, + 0x4760609d6027fdc0ULL, 0x35bcbccabc897665ULL, 0x379b9b569baccd2bULL, 0x8a8e8e028e048c01ULL, + 0xd2a3a3b6a371155bULL, 0x6c0c0c300c603c18ULL, 0x847b7bf17bff8af6ULL, 0x803535d435b5e16aULL, + 0xf51d1d741de8693aULL, 0xb3e0e0a7e05347ddULL, 0x21d7d77bd7f6acb3ULL, 0x9cc2c22fc25eed99ULL, + 0x432e2eb82e6d965cULL, 0x294b4b314b627a96ULL, 0x5dfefedffea321e1ULL, 0xd5575741578216aeULL, + 0xbd15155415a8412aULL, 0xe87777c1779fb6eeULL, 0x923737dc37a5eb6eULL, 0x9ee5e5b3e57b56d7ULL, + 0x139f9f469f8cd923ULL, 0x23f0f0e7f0d317fdULL, 0x204a4a354a6a7f94ULL, 0x44dada4fda9e95a9ULL, + 0xa258587d58fa25b0ULL, 0xcfc9c903c906ca8fULL, 0x7c2929a429558d52ULL, 0x5a0a0a280a502214ULL, + 0x50b1b1feb1e14f7fULL, 0xc9a0a0baa0691a5dULL, 0x146b6bb16b7fdad6ULL, 0xd985852e855cab17ULL, + 0x3cbdbdcebd817367ULL, 0x8f5d5d695dd234baULL, 0x9010104010805020ULL, 0x07f4f4f7f4f303f5ULL, + 0xddcbcb0bcb16c08bULL, 0xd33e3ef83eedc67cULL, 0x2d0505140528110aULL, 0x78676781671fe6ceULL, + 0x97e4e4b7e47353d5ULL, 0x0227279c2725bb4eULL, 0x7341411941325882ULL, 0xa78b8b168b2c9d0bULL, + 0xf6a7a7a6a7510153ULL, 0xb27d7de97dcf94faULL, 0x4995956e95dcfb37ULL, 0x56d8d847d88e9fadULL, + 0x70fbfbcbfb8b30ebULL, 0xcdeeee9fee2371c1ULL, 0xbb7c7ced7cc791f8ULL, 0x716666856617e3ccULL, + 0x7bdddd53dda68ea7ULL, 0xaf17175c17b84b2eULL, 0x454747014702468eULL, 0x1a9e9e429e84dc21ULL, + 0xd4caca0fca1ec589ULL, 0x582d2db42d75995aULL, 0x2ebfbfc6bf917963ULL, 0x3f07071c07381b0eULL, + 0xacadad8ead012347ULL, 0xb05a5a755aea2fb4ULL, 0xef838336836cb51bULL, 0xb63333cc3385ff66ULL, + 0x5c636391633ff2c6ULL, 0x1202020802100a04ULL, 0x93aaaa92aa393849ULL, 0xde7171d971afa8e2ULL, + 0xc6c8c807c80ecf8dULL, 0xd119196419c87d32ULL, 0x3b49493949727092ULL, 0x5fd9d943d9869aafULL, + 0x31f2f2eff2c31df9ULL, 0xa8e3e3abe34b48dbULL, 0xb95b5b715be22ab6ULL, 0xbc88881a8834920dULL, + 0x3e9a9a529aa4c829ULL, 0x0b262698262dbe4cULL, 0xbf3232c8328dfa64ULL, 0x59b0b0fab0e94a7dULL, + 0xf2e9e983e91b6acfULL, 0x770f0f3c0f78331eULL, 0x33d5d573d5e6a6b7ULL, 0xf480803a8074ba1dULL, + 0x27bebec2be997c61ULL, 0xebcdcd13cd26de87ULL, 0x893434d034bde468ULL, 0x3248483d487a7590ULL, + 0x54ffffdbffab24e3ULL, 0x8d7a7af57af78ff4ULL, 0x6490907a90f4ea3dULL, 0x9d5f5f615fc23ebeULL, + 0x3d202080201da040ULL, 0x0f6868bd6867d5d0ULL, 0xca1a1a681ad07234ULL, 0xb7aeae82ae192c41ULL, + 0x7db4b4eab4c95e75ULL, 0xce54544d549a19a8ULL, 0x7f93937693ece53bULL, 0x2f222288220daa44ULL, + 0x6364648d6407e9c8ULL, 0x2af1f1e3f1db12ffULL, 0xcc7373d173bfa2e6ULL, 0x8212124812905a24ULL, + 0x7a40401d403a5d80ULL, 0x4808082008402810ULL, 0x95c3c32bc356e89bULL, 0xdfecec97ec337bc5ULL, + 0x4ddbdb4bdb9690abULL, 0xc0a1a1bea1611f5fULL, 0x918d8d0e8d1c8307ULL, 0xc83d3df43df5c97aULL, + 0x5b97976697ccf133ULL, 0x0000000000000000ULL, 0xf9cfcf1bcf36d483ULL, 0x6e2b2bac2b458756ULL, + 0xe17676c57697b3ecULL, 0xe68282328264b019ULL, 0x28d6d67fd6fea9b1ULL, 0xc31b1b6c1bd87736ULL, + 0x74b5b5eeb5c15b77ULL, 0xbeafaf86af112943ULL, 0x1d6a6ab56a77dfd4ULL, 0xea50505d50ba0da0ULL, + 0x5745450945124c8aULL, 0x38f3f3ebf3cb18fbULL, 0xad3030c0309df060ULL, 0xc4efef9bef2b74c3ULL, + 0xda3f3ffc3fe5c37eULL, 0xc755554955921caaULL, 0xdba2a2b2a2791059ULL, 0xe9eaea8fea0365c9ULL, + 0x6a656589650feccaULL, 0x03babad2bab96869ULL, 0x4a2f2fbc2f65935eULL, 0x8ec0c027c04ee79dULL, + 0x60dede5fdebe81a1ULL, 0xfc1c1c701ce06c38ULL, 0x46fdfdd3fdbb2ee7ULL, 0x1f4d4d294d52649aULL, + 0x7692927292e4e039ULL, 0xfa7575c9758fbceaULL, 0x3606061806301e0cULL, 0xae8a8a128a249809ULL, + 0x4bb2b2f2b2f94079ULL, 0x85e6e6bfe66359d1ULL, 0x7e0e0e380e70361cULL, 0xe71f1f7c1ff8633eULL, + 0x556262956237f7c4ULL, 0x3ad4d477d4eea3b5ULL, 0x81a8a89aa829324dULL, 0x5296966296c4f431ULL, + 0x62f9f9c3f99b3aefULL, 0xa3c5c533c566f697ULL, 0x102525942535b14aULL, 0xab59597959f220b2ULL, + 0xd084842a8454ae15ULL, 0xc57272d572b7a7e4ULL, 0xec3939e439d5dd72ULL, 0x164c4c2d4c5a6198ULL, + 0x945e5e655eca3bbcULL, 0x9f7878fd78e785f0ULL, 0xe53838e038ddd870ULL, 0x988c8c0a8c148605ULL, + 0x17d1d163d1c6b2bfULL, 0xe4a5a5aea5410b57ULL, 0xa1e2e2afe2434dd9ULL, 0x4e616199612ff8c2ULL, + 0x42b3b3f6b3f1457bULL, 0x342121842115a542ULL, 0x089c9c4a9c94d625ULL, 0xee1e1e781ef0663cULL, + 0x6143431143225286ULL, 0xb1c7c73bc776fc93ULL, 0x4ffcfcd7fcb32be5ULL, 0x2404041004201408ULL, + 0xe351515951b208a2ULL, 0x2599995e99bcc72fULL, 0x226d6da96d4fc4daULL, 0x650d0d340d68391aULL, + 0x79fafacffa8335e9ULL, 0x69dfdf5bdfb684a3ULL, 0xa97e7ee57ed79bfcULL, 0x19242490243db448ULL, + 0xfe3b3bec3bc5d776ULL, 0x9aabab96ab313d4bULL, 0xf0cece1fce3ed181ULL, 0x9911114411885522ULL, + 0x838f8f068f0c8903ULL, 0x044e4e254e4a6b9cULL, 0x66b7b7e6b7d15173ULL, 0xe0ebeb8beb0b60cbULL, + 0xc13c3cf03cfdcc78ULL, 0xfd81813e817cbf1fULL, 0x4094946a94d4fe35ULL, 0x1cf7f7fbf7eb0cf3ULL, + 0x18b9b9deb9a1676fULL, 0x8b13134c13985f26ULL, 0x512c2cb02c7d9c58ULL, 0x05d3d36bd3d6b8bbULL, + 0x8ce7e7bbe76b5cd3ULL, 0x396e6ea56e57cbdcULL, 0xaac4c437c46ef395ULL, 0x1b03030c03180f06ULL, + 0xdc565645568a13acULL, 0x5e44440d441a4988ULL, 0xa07f7fe17fdf9efeULL, 0x88a9a99ea921374fULL, + 0x672a2aa82a4d8254ULL, 0x0abbbbd6bbb16d6bULL, 0x87c1c123c146e29fULL, 0xf153535153a202a6ULL, + 0x72dcdc57dcae8ba5ULL, 0x530b0b2c0b582716ULL, 0x019d9d4e9d9cd327ULL, 0x2b6c6cad6c47c1d8ULL, + 0xa43131c43195f562ULL, 0xf37474cd7487b9e8ULL, 0x15f6f6fff6e309f1ULL, 0x4c464605460a438cULL, + 0xa5acac8aac092645ULL, 0xb589891e893c970fULL, 0xb414145014a04428ULL, 0xbae1e1a3e15b42dfULL, + 0xa616165816b04e2cULL, 0xf73a3ae83acdd274ULL, 0x066969b9696fd0d2ULL, 0x4109092409482d12ULL, + 0xd77070dd70a7ade0ULL, 0x6fb6b6e2b6d95471ULL, 0x1ed0d067d0ceb7bdULL, 0xd6eded93ed3b7ec7ULL, + 0xe2cccc17cc2edb85ULL, 0x68424215422a5784ULL, 0x2c98985a98b4c22dULL, 0xeda4a4aaa4490e55ULL, + 0x752828a0285d8850ULL, 0x865c5c6d5cda31b8ULL, 0x6bf8f8c7f8933fedULL, 0xc28686228644a411ULL, + }, { + /* C2 vectors */ + 0x30d818186018c078ULL, 0x462623238c2305afULL, 0x91b8c6c63fc67ef9ULL, 0xcdfbe8e887e8136fULL, + 0x13cb878726874ca1ULL, 0x6d11b8b8dab8a962ULL, 0x0209010104010805ULL, 0x9e0d4f4f214f426eULL, + 0x6c9b3636d836adeeULL, 0x51ffa6a6a2a65904ULL, 0xb90cd2d26fd2debdULL, 0xf70ef5f5f3f5fb06ULL, + 0xf2967979f979ef80ULL, 0xde306f6fa16f5fceULL, 0x3f6d91917e91fcefULL, 0xa4f852525552aa07ULL, + 0xc04760609d6027fdULL, 0x6535bcbccabc8976ULL, 0x2b379b9b569baccdULL, 0x018a8e8e028e048cULL, + 0x5bd2a3a3b6a37115ULL, 0x186c0c0c300c603cULL, 0xf6847b7bf17bff8aULL, 0x6a803535d435b5e1ULL, + 0x3af51d1d741de869ULL, 0xddb3e0e0a7e05347ULL, 0xb321d7d77bd7f6acULL, 0x999cc2c22fc25eedULL, + 0x5c432e2eb82e6d96ULL, 0x96294b4b314b627aULL, 0xe15dfefedffea321ULL, 0xaed5575741578216ULL, + 0x2abd15155415a841ULL, 0xeee87777c1779fb6ULL, 0x6e923737dc37a5ebULL, 0xd79ee5e5b3e57b56ULL, + 0x23139f9f469f8cd9ULL, 0xfd23f0f0e7f0d317ULL, 0x94204a4a354a6a7fULL, 0xa944dada4fda9e95ULL, + 0xb0a258587d58fa25ULL, 0x8fcfc9c903c906caULL, 0x527c2929a429558dULL, 0x145a0a0a280a5022ULL, + 0x7f50b1b1feb1e14fULL, 0x5dc9a0a0baa0691aULL, 0xd6146b6bb16b7fdaULL, 0x17d985852e855cabULL, + 0x673cbdbdcebd8173ULL, 0xba8f5d5d695dd234ULL, 0x2090101040108050ULL, 0xf507f4f4f7f4f303ULL, + 0x8bddcbcb0bcb16c0ULL, 0x7cd33e3ef83eedc6ULL, 0x0a2d050514052811ULL, 0xce78676781671fe6ULL, + 0xd597e4e4b7e47353ULL, 0x4e0227279c2725bbULL, 0x8273414119413258ULL, 0x0ba78b8b168b2c9dULL, + 0x53f6a7a7a6a75101ULL, 0xfab27d7de97dcf94ULL, 0x374995956e95dcfbULL, 0xad56d8d847d88e9fULL, + 0xeb70fbfbcbfb8b30ULL, 0xc1cdeeee9fee2371ULL, 0xf8bb7c7ced7cc791ULL, 0xcc716666856617e3ULL, + 0xa77bdddd53dda68eULL, 0x2eaf17175c17b84bULL, 0x8e45474701470246ULL, 0x211a9e9e429e84dcULL, + 0x89d4caca0fca1ec5ULL, 0x5a582d2db42d7599ULL, 0x632ebfbfc6bf9179ULL, 0x0e3f07071c07381bULL, + 0x47acadad8ead0123ULL, 0xb4b05a5a755aea2fULL, 0x1bef838336836cb5ULL, 0x66b63333cc3385ffULL, + 0xc65c636391633ff2ULL, 0x041202020802100aULL, 0x4993aaaa92aa3938ULL, 0xe2de7171d971afa8ULL, + 0x8dc6c8c807c80ecfULL, 0x32d119196419c87dULL, 0x923b494939497270ULL, 0xaf5fd9d943d9869aULL, + 0xf931f2f2eff2c31dULL, 0xdba8e3e3abe34b48ULL, 0xb6b95b5b715be22aULL, 0x0dbc88881a883492ULL, + 0x293e9a9a529aa4c8ULL, 0x4c0b262698262dbeULL, 0x64bf3232c8328dfaULL, 0x7d59b0b0fab0e94aULL, + 0xcff2e9e983e91b6aULL, 0x1e770f0f3c0f7833ULL, 0xb733d5d573d5e6a6ULL, 0x1df480803a8074baULL, + 0x6127bebec2be997cULL, 0x87ebcdcd13cd26deULL, 0x68893434d034bde4ULL, 0x903248483d487a75ULL, + 0xe354ffffdbffab24ULL, 0xf48d7a7af57af78fULL, 0x3d6490907a90f4eaULL, 0xbe9d5f5f615fc23eULL, + 0x403d202080201da0ULL, 0xd00f6868bd6867d5ULL, 0x34ca1a1a681ad072ULL, 0x41b7aeae82ae192cULL, + 0x757db4b4eab4c95eULL, 0xa8ce54544d549a19ULL, 0x3b7f93937693ece5ULL, 0x442f222288220daaULL, + 0xc86364648d6407e9ULL, 0xff2af1f1e3f1db12ULL, 0xe6cc7373d173bfa2ULL, 0x248212124812905aULL, + 0x807a40401d403a5dULL, 0x1048080820084028ULL, 0x9b95c3c32bc356e8ULL, 0xc5dfecec97ec337bULL, + 0xab4ddbdb4bdb9690ULL, 0x5fc0a1a1bea1611fULL, 0x07918d8d0e8d1c83ULL, 0x7ac83d3df43df5c9ULL, + 0x335b97976697ccf1ULL, 0x0000000000000000ULL, 0x83f9cfcf1bcf36d4ULL, 0x566e2b2bac2b4587ULL, + 0xece17676c57697b3ULL, 0x19e68282328264b0ULL, 0xb128d6d67fd6fea9ULL, 0x36c31b1b6c1bd877ULL, + 0x7774b5b5eeb5c15bULL, 0x43beafaf86af1129ULL, 0xd41d6a6ab56a77dfULL, 0xa0ea50505d50ba0dULL, + 0x8a5745450945124cULL, 0xfb38f3f3ebf3cb18ULL, 0x60ad3030c0309df0ULL, 0xc3c4efef9bef2b74ULL, + 0x7eda3f3ffc3fe5c3ULL, 0xaac755554955921cULL, 0x59dba2a2b2a27910ULL, 0xc9e9eaea8fea0365ULL, + 0xca6a656589650fecULL, 0x6903babad2bab968ULL, 0x5e4a2f2fbc2f6593ULL, 0x9d8ec0c027c04ee7ULL, + 0xa160dede5fdebe81ULL, 0x38fc1c1c701ce06cULL, 0xe746fdfdd3fdbb2eULL, 0x9a1f4d4d294d5264ULL, + 0x397692927292e4e0ULL, 0xeafa7575c9758fbcULL, 0x0c3606061806301eULL, 0x09ae8a8a128a2498ULL, + 0x794bb2b2f2b2f940ULL, 0xd185e6e6bfe66359ULL, 0x1c7e0e0e380e7036ULL, 0x3ee71f1f7c1ff863ULL, + 0xc4556262956237f7ULL, 0xb53ad4d477d4eea3ULL, 0x4d81a8a89aa82932ULL, 0x315296966296c4f4ULL, + 0xef62f9f9c3f99b3aULL, 0x97a3c5c533c566f6ULL, 0x4a102525942535b1ULL, 0xb2ab59597959f220ULL, + 0x15d084842a8454aeULL, 0xe4c57272d572b7a7ULL, 0x72ec3939e439d5ddULL, 0x98164c4c2d4c5a61ULL, + 0xbc945e5e655eca3bULL, 0xf09f7878fd78e785ULL, 0x70e53838e038ddd8ULL, 0x05988c8c0a8c1486ULL, + 0xbf17d1d163d1c6b2ULL, 0x57e4a5a5aea5410bULL, 0xd9a1e2e2afe2434dULL, 0xc24e616199612ff8ULL, + 0x7b42b3b3f6b3f145ULL, 0x42342121842115a5ULL, 0x25089c9c4a9c94d6ULL, 0x3cee1e1e781ef066ULL, + 0x8661434311432252ULL, 0x93b1c7c73bc776fcULL, 0xe54ffcfcd7fcb32bULL, 0x0824040410042014ULL, + 0xa2e351515951b208ULL, 0x2f2599995e99bcc7ULL, 0xda226d6da96d4fc4ULL, 0x1a650d0d340d6839ULL, + 0xe979fafacffa8335ULL, 0xa369dfdf5bdfb684ULL, 0xfca97e7ee57ed79bULL, 0x4819242490243db4ULL, + 0x76fe3b3bec3bc5d7ULL, 0x4b9aabab96ab313dULL, 0x81f0cece1fce3ed1ULL, 0x2299111144118855ULL, + 0x03838f8f068f0c89ULL, 0x9c044e4e254e4a6bULL, 0x7366b7b7e6b7d151ULL, 0xcbe0ebeb8beb0b60ULL, + 0x78c13c3cf03cfdccULL, 0x1ffd81813e817cbfULL, 0x354094946a94d4feULL, 0xf31cf7f7fbf7eb0cULL, + 0x6f18b9b9deb9a167ULL, 0x268b13134c13985fULL, 0x58512c2cb02c7d9cULL, 0xbb05d3d36bd3d6b8ULL, + 0xd38ce7e7bbe76b5cULL, 0xdc396e6ea56e57cbULL, 0x95aac4c437c46ef3ULL, 0x061b03030c03180fULL, + 0xacdc565645568a13ULL, 0x885e44440d441a49ULL, 0xfea07f7fe17fdf9eULL, 0x4f88a9a99ea92137ULL, + 0x54672a2aa82a4d82ULL, 0x6b0abbbbd6bbb16dULL, 0x9f87c1c123c146e2ULL, 0xa6f153535153a202ULL, + 0xa572dcdc57dcae8bULL, 0x16530b0b2c0b5827ULL, 0x27019d9d4e9d9cd3ULL, 0xd82b6c6cad6c47c1ULL, + 0x62a43131c43195f5ULL, 0xe8f37474cd7487b9ULL, 0xf115f6f6fff6e309ULL, 0x8c4c464605460a43ULL, + 0x45a5acac8aac0926ULL, 0x0fb589891e893c97ULL, 0x28b414145014a044ULL, 0xdfbae1e1a3e15b42ULL, + 0x2ca616165816b04eULL, 0x74f73a3ae83acdd2ULL, 0xd2066969b9696fd0ULL, 0x124109092409482dULL, + 0xe0d77070dd70a7adULL, 0x716fb6b6e2b6d954ULL, 0xbd1ed0d067d0ceb7ULL, 0xc7d6eded93ed3b7eULL, + 0x85e2cccc17cc2edbULL, 0x8468424215422a57ULL, 0x2d2c98985a98b4c2ULL, 0x55eda4a4aaa4490eULL, + 0x50752828a0285d88ULL, 0xb8865c5c6d5cda31ULL, 0xed6bf8f8c7f8933fULL, 0x11c28686228644a4ULL, + }, { + /* C3 vectors */ + 0x7830d818186018c0ULL, 0xaf462623238c2305ULL, 0xf991b8c6c63fc67eULL, 0x6fcdfbe8e887e813ULL, + 0xa113cb878726874cULL, 0x626d11b8b8dab8a9ULL, 0x0502090101040108ULL, 0x6e9e0d4f4f214f42ULL, + 0xee6c9b3636d836adULL, 0x0451ffa6a6a2a659ULL, 0xbdb90cd2d26fd2deULL, 0x06f70ef5f5f3f5fbULL, + 0x80f2967979f979efULL, 0xcede306f6fa16f5fULL, 0xef3f6d91917e91fcULL, 0x07a4f852525552aaULL, + 0xfdc04760609d6027ULL, 0x766535bcbccabc89ULL, 0xcd2b379b9b569bacULL, 0x8c018a8e8e028e04ULL, + 0x155bd2a3a3b6a371ULL, 0x3c186c0c0c300c60ULL, 0x8af6847b7bf17bffULL, 0xe16a803535d435b5ULL, + 0x693af51d1d741de8ULL, 0x47ddb3e0e0a7e053ULL, 0xacb321d7d77bd7f6ULL, 0xed999cc2c22fc25eULL, + 0x965c432e2eb82e6dULL, 0x7a96294b4b314b62ULL, 0x21e15dfefedffea3ULL, 0x16aed55757415782ULL, + 0x412abd15155415a8ULL, 0xb6eee87777c1779fULL, 0xeb6e923737dc37a5ULL, 0x56d79ee5e5b3e57bULL, + 0xd923139f9f469f8cULL, 0x17fd23f0f0e7f0d3ULL, 0x7f94204a4a354a6aULL, 0x95a944dada4fda9eULL, + 0x25b0a258587d58faULL, 0xca8fcfc9c903c906ULL, 0x8d527c2929a42955ULL, 0x22145a0a0a280a50ULL, + 0x4f7f50b1b1feb1e1ULL, 0x1a5dc9a0a0baa069ULL, 0xdad6146b6bb16b7fULL, 0xab17d985852e855cULL, + 0x73673cbdbdcebd81ULL, 0x34ba8f5d5d695dd2ULL, 0x5020901010401080ULL, 0x03f507f4f4f7f4f3ULL, + 0xc08bddcbcb0bcb16ULL, 0xc67cd33e3ef83eedULL, 0x110a2d0505140528ULL, 0xe6ce78676781671fULL, + 0x53d597e4e4b7e473ULL, 0xbb4e0227279c2725ULL, 0x5882734141194132ULL, 0x9d0ba78b8b168b2cULL, + 0x0153f6a7a7a6a751ULL, 0x94fab27d7de97dcfULL, 0xfb374995956e95dcULL, 0x9fad56d8d847d88eULL, + 0x30eb70fbfbcbfb8bULL, 0x71c1cdeeee9fee23ULL, 0x91f8bb7c7ced7cc7ULL, 0xe3cc716666856617ULL, + 0x8ea77bdddd53dda6ULL, 0x4b2eaf17175c17b8ULL, 0x468e454747014702ULL, 0xdc211a9e9e429e84ULL, + 0xc589d4caca0fca1eULL, 0x995a582d2db42d75ULL, 0x79632ebfbfc6bf91ULL, 0x1b0e3f07071c0738ULL, + 0x2347acadad8ead01ULL, 0x2fb4b05a5a755aeaULL, 0xb51bef838336836cULL, 0xff66b63333cc3385ULL, + 0xf2c65c636391633fULL, 0x0a04120202080210ULL, 0x384993aaaa92aa39ULL, 0xa8e2de7171d971afULL, + 0xcf8dc6c8c807c80eULL, 0x7d32d119196419c8ULL, 0x70923b4949394972ULL, 0x9aaf5fd9d943d986ULL, + 0x1df931f2f2eff2c3ULL, 0x48dba8e3e3abe34bULL, 0x2ab6b95b5b715be2ULL, 0x920dbc88881a8834ULL, + 0xc8293e9a9a529aa4ULL, 0xbe4c0b262698262dULL, 0xfa64bf3232c8328dULL, 0x4a7d59b0b0fab0e9ULL, + 0x6acff2e9e983e91bULL, 0x331e770f0f3c0f78ULL, 0xa6b733d5d573d5e6ULL, 0xba1df480803a8074ULL, + 0x7c6127bebec2be99ULL, 0xde87ebcdcd13cd26ULL, 0xe468893434d034bdULL, 0x75903248483d487aULL, + 0x24e354ffffdbffabULL, 0x8ff48d7a7af57af7ULL, 0xea3d6490907a90f4ULL, 0x3ebe9d5f5f615fc2ULL, + 0xa0403d202080201dULL, 0xd5d00f6868bd6867ULL, 0x7234ca1a1a681ad0ULL, 0x2c41b7aeae82ae19ULL, + 0x5e757db4b4eab4c9ULL, 0x19a8ce54544d549aULL, 0xe53b7f93937693ecULL, 0xaa442f222288220dULL, + 0xe9c86364648d6407ULL, 0x12ff2af1f1e3f1dbULL, 0xa2e6cc7373d173bfULL, 0x5a24821212481290ULL, + 0x5d807a40401d403aULL, 0x2810480808200840ULL, 0xe89b95c3c32bc356ULL, 0x7bc5dfecec97ec33ULL, + 0x90ab4ddbdb4bdb96ULL, 0x1f5fc0a1a1bea161ULL, 0x8307918d8d0e8d1cULL, 0xc97ac83d3df43df5ULL, + 0xf1335b97976697ccULL, 0x0000000000000000ULL, 0xd483f9cfcf1bcf36ULL, 0x87566e2b2bac2b45ULL, + 0xb3ece17676c57697ULL, 0xb019e68282328264ULL, 0xa9b128d6d67fd6feULL, 0x7736c31b1b6c1bd8ULL, + 0x5b7774b5b5eeb5c1ULL, 0x2943beafaf86af11ULL, 0xdfd41d6a6ab56a77ULL, 0x0da0ea50505d50baULL, + 0x4c8a574545094512ULL, 0x18fb38f3f3ebf3cbULL, 0xf060ad3030c0309dULL, 0x74c3c4efef9bef2bULL, + 0xc37eda3f3ffc3fe5ULL, 0x1caac75555495592ULL, 0x1059dba2a2b2a279ULL, 0x65c9e9eaea8fea03ULL, + 0xecca6a656589650fULL, 0x686903babad2bab9ULL, 0x935e4a2f2fbc2f65ULL, 0xe79d8ec0c027c04eULL, + 0x81a160dede5fdebeULL, 0x6c38fc1c1c701ce0ULL, 0x2ee746fdfdd3fdbbULL, 0x649a1f4d4d294d52ULL, + 0xe0397692927292e4ULL, 0xbceafa7575c9758fULL, 0x1e0c360606180630ULL, 0x9809ae8a8a128a24ULL, + 0x40794bb2b2f2b2f9ULL, 0x59d185e6e6bfe663ULL, 0x361c7e0e0e380e70ULL, 0x633ee71f1f7c1ff8ULL, + 0xf7c4556262956237ULL, 0xa3b53ad4d477d4eeULL, 0x324d81a8a89aa829ULL, 0xf4315296966296c4ULL, + 0x3aef62f9f9c3f99bULL, 0xf697a3c5c533c566ULL, 0xb14a102525942535ULL, 0x20b2ab59597959f2ULL, + 0xae15d084842a8454ULL, 0xa7e4c57272d572b7ULL, 0xdd72ec3939e439d5ULL, 0x6198164c4c2d4c5aULL, + 0x3bbc945e5e655ecaULL, 0x85f09f7878fd78e7ULL, 0xd870e53838e038ddULL, 0x8605988c8c0a8c14ULL, + 0xb2bf17d1d163d1c6ULL, 0x0b57e4a5a5aea541ULL, 0x4dd9a1e2e2afe243ULL, 0xf8c24e616199612fULL, + 0x457b42b3b3f6b3f1ULL, 0xa542342121842115ULL, 0xd625089c9c4a9c94ULL, 0x663cee1e1e781ef0ULL, + 0x5286614343114322ULL, 0xfc93b1c7c73bc776ULL, 0x2be54ffcfcd7fcb3ULL, 0x1408240404100420ULL, + 0x08a2e351515951b2ULL, 0xc72f2599995e99bcULL, 0xc4da226d6da96d4fULL, 0x391a650d0d340d68ULL, + 0x35e979fafacffa83ULL, 0x84a369dfdf5bdfb6ULL, 0x9bfca97e7ee57ed7ULL, 0xb44819242490243dULL, + 0xd776fe3b3bec3bc5ULL, 0x3d4b9aabab96ab31ULL, 0xd181f0cece1fce3eULL, 0x5522991111441188ULL, + 0x8903838f8f068f0cULL, 0x6b9c044e4e254e4aULL, 0x517366b7b7e6b7d1ULL, 0x60cbe0ebeb8beb0bULL, + 0xcc78c13c3cf03cfdULL, 0xbf1ffd81813e817cULL, 0xfe354094946a94d4ULL, 0x0cf31cf7f7fbf7ebULL, + 0x676f18b9b9deb9a1ULL, 0x5f268b13134c1398ULL, 0x9c58512c2cb02c7dULL, 0xb8bb05d3d36bd3d6ULL, + 0x5cd38ce7e7bbe76bULL, 0xcbdc396e6ea56e57ULL, 0xf395aac4c437c46eULL, 0x0f061b03030c0318ULL, + 0x13acdc565645568aULL, 0x49885e44440d441aULL, 0x9efea07f7fe17fdfULL, 0x374f88a9a99ea921ULL, + 0x8254672a2aa82a4dULL, 0x6d6b0abbbbd6bbb1ULL, 0xe29f87c1c123c146ULL, 0x02a6f153535153a2ULL, + 0x8ba572dcdc57dcaeULL, 0x2716530b0b2c0b58ULL, 0xd327019d9d4e9d9cULL, 0xc1d82b6c6cad6c47ULL, + 0xf562a43131c43195ULL, 0xb9e8f37474cd7487ULL, 0x09f115f6f6fff6e3ULL, 0x438c4c464605460aULL, + 0x2645a5acac8aac09ULL, 0x970fb589891e893cULL, 0x4428b414145014a0ULL, 0x42dfbae1e1a3e15bULL, + 0x4e2ca616165816b0ULL, 0xd274f73a3ae83acdULL, 0xd0d2066969b9696fULL, 0x2d12410909240948ULL, + 0xade0d77070dd70a7ULL, 0x54716fb6b6e2b6d9ULL, 0xb7bd1ed0d067d0ceULL, 0x7ec7d6eded93ed3bULL, + 0xdb85e2cccc17cc2eULL, 0x578468424215422aULL, 0xc22d2c98985a98b4ULL, 0x0e55eda4a4aaa449ULL, + 0x8850752828a0285dULL, 0x31b8865c5c6d5cdaULL, 0x3fed6bf8f8c7f893ULL, 0xa411c28686228644ULL, + }, { + /* C4 vectors */ + 0xc07830d818186018ULL, 0x05af462623238c23ULL, 0x7ef991b8c6c63fc6ULL, 0x136fcdfbe8e887e8ULL, + 0x4ca113cb87872687ULL, 0xa9626d11b8b8dab8ULL, 0x0805020901010401ULL, 0x426e9e0d4f4f214fULL, + 0xadee6c9b3636d836ULL, 0x590451ffa6a6a2a6ULL, 0xdebdb90cd2d26fd2ULL, 0xfb06f70ef5f5f3f5ULL, + 0xef80f2967979f979ULL, 0x5fcede306f6fa16fULL, 0xfcef3f6d91917e91ULL, 0xaa07a4f852525552ULL, + 0x27fdc04760609d60ULL, 0x89766535bcbccabcULL, 0xaccd2b379b9b569bULL, 0x048c018a8e8e028eULL, + 0x71155bd2a3a3b6a3ULL, 0x603c186c0c0c300cULL, 0xff8af6847b7bf17bULL, 0xb5e16a803535d435ULL, + 0xe8693af51d1d741dULL, 0x5347ddb3e0e0a7e0ULL, 0xf6acb321d7d77bd7ULL, 0x5eed999cc2c22fc2ULL, + 0x6d965c432e2eb82eULL, 0x627a96294b4b314bULL, 0xa321e15dfefedffeULL, 0x8216aed557574157ULL, + 0xa8412abd15155415ULL, 0x9fb6eee87777c177ULL, 0xa5eb6e923737dc37ULL, 0x7b56d79ee5e5b3e5ULL, + 0x8cd923139f9f469fULL, 0xd317fd23f0f0e7f0ULL, 0x6a7f94204a4a354aULL, 0x9e95a944dada4fdaULL, + 0xfa25b0a258587d58ULL, 0x06ca8fcfc9c903c9ULL, 0x558d527c2929a429ULL, 0x5022145a0a0a280aULL, + 0xe14f7f50b1b1feb1ULL, 0x691a5dc9a0a0baa0ULL, 0x7fdad6146b6bb16bULL, 0x5cab17d985852e85ULL, + 0x8173673cbdbdcebdULL, 0xd234ba8f5d5d695dULL, 0x8050209010104010ULL, 0xf303f507f4f4f7f4ULL, + 0x16c08bddcbcb0bcbULL, 0xedc67cd33e3ef83eULL, 0x28110a2d05051405ULL, 0x1fe6ce7867678167ULL, + 0x7353d597e4e4b7e4ULL, 0x25bb4e0227279c27ULL, 0x3258827341411941ULL, 0x2c9d0ba78b8b168bULL, + 0x510153f6a7a7a6a7ULL, 0xcf94fab27d7de97dULL, 0xdcfb374995956e95ULL, 0x8e9fad56d8d847d8ULL, + 0x8b30eb70fbfbcbfbULL, 0x2371c1cdeeee9feeULL, 0xc791f8bb7c7ced7cULL, 0x17e3cc7166668566ULL, + 0xa68ea77bdddd53ddULL, 0xb84b2eaf17175c17ULL, 0x02468e4547470147ULL, 0x84dc211a9e9e429eULL, + 0x1ec589d4caca0fcaULL, 0x75995a582d2db42dULL, 0x9179632ebfbfc6bfULL, 0x381b0e3f07071c07ULL, + 0x012347acadad8eadULL, 0xea2fb4b05a5a755aULL, 0x6cb51bef83833683ULL, 0x85ff66b63333cc33ULL, + 0x3ff2c65c63639163ULL, 0x100a041202020802ULL, 0x39384993aaaa92aaULL, 0xafa8e2de7171d971ULL, + 0x0ecf8dc6c8c807c8ULL, 0xc87d32d119196419ULL, 0x7270923b49493949ULL, 0x869aaf5fd9d943d9ULL, + 0xc31df931f2f2eff2ULL, 0x4b48dba8e3e3abe3ULL, 0xe22ab6b95b5b715bULL, 0x34920dbc88881a88ULL, + 0xa4c8293e9a9a529aULL, 0x2dbe4c0b26269826ULL, 0x8dfa64bf3232c832ULL, 0xe94a7d59b0b0fab0ULL, + 0x1b6acff2e9e983e9ULL, 0x78331e770f0f3c0fULL, 0xe6a6b733d5d573d5ULL, 0x74ba1df480803a80ULL, + 0x997c6127bebec2beULL, 0x26de87ebcdcd13cdULL, 0xbde468893434d034ULL, 0x7a75903248483d48ULL, + 0xab24e354ffffdbffULL, 0xf78ff48d7a7af57aULL, 0xf4ea3d6490907a90ULL, 0xc23ebe9d5f5f615fULL, + 0x1da0403d20208020ULL, 0x67d5d00f6868bd68ULL, 0xd07234ca1a1a681aULL, 0x192c41b7aeae82aeULL, + 0xc95e757db4b4eab4ULL, 0x9a19a8ce54544d54ULL, 0xece53b7f93937693ULL, 0x0daa442f22228822ULL, + 0x07e9c86364648d64ULL, 0xdb12ff2af1f1e3f1ULL, 0xbfa2e6cc7373d173ULL, 0x905a248212124812ULL, + 0x3a5d807a40401d40ULL, 0x4028104808082008ULL, 0x56e89b95c3c32bc3ULL, 0x337bc5dfecec97ecULL, + 0x9690ab4ddbdb4bdbULL, 0x611f5fc0a1a1bea1ULL, 0x1c8307918d8d0e8dULL, 0xf5c97ac83d3df43dULL, + 0xccf1335b97976697ULL, 0x0000000000000000ULL, 0x36d483f9cfcf1bcfULL, 0x4587566e2b2bac2bULL, + 0x97b3ece17676c576ULL, 0x64b019e682823282ULL, 0xfea9b128d6d67fd6ULL, 0xd87736c31b1b6c1bULL, + 0xc15b7774b5b5eeb5ULL, 0x112943beafaf86afULL, 0x77dfd41d6a6ab56aULL, 0xba0da0ea50505d50ULL, + 0x124c8a5745450945ULL, 0xcb18fb38f3f3ebf3ULL, 0x9df060ad3030c030ULL, 0x2b74c3c4efef9befULL, + 0xe5c37eda3f3ffc3fULL, 0x921caac755554955ULL, 0x791059dba2a2b2a2ULL, 0x0365c9e9eaea8feaULL, + 0x0fecca6a65658965ULL, 0xb9686903babad2baULL, 0x65935e4a2f2fbc2fULL, 0x4ee79d8ec0c027c0ULL, + 0xbe81a160dede5fdeULL, 0xe06c38fc1c1c701cULL, 0xbb2ee746fdfdd3fdULL, 0x52649a1f4d4d294dULL, + 0xe4e0397692927292ULL, 0x8fbceafa7575c975ULL, 0x301e0c3606061806ULL, 0x249809ae8a8a128aULL, + 0xf940794bb2b2f2b2ULL, 0x6359d185e6e6bfe6ULL, 0x70361c7e0e0e380eULL, 0xf8633ee71f1f7c1fULL, + 0x37f7c45562629562ULL, 0xeea3b53ad4d477d4ULL, 0x29324d81a8a89aa8ULL, 0xc4f4315296966296ULL, + 0x9b3aef62f9f9c3f9ULL, 0x66f697a3c5c533c5ULL, 0x35b14a1025259425ULL, 0xf220b2ab59597959ULL, + 0x54ae15d084842a84ULL, 0xb7a7e4c57272d572ULL, 0xd5dd72ec3939e439ULL, 0x5a6198164c4c2d4cULL, + 0xca3bbc945e5e655eULL, 0xe785f09f7878fd78ULL, 0xddd870e53838e038ULL, 0x148605988c8c0a8cULL, + 0xc6b2bf17d1d163d1ULL, 0x410b57e4a5a5aea5ULL, 0x434dd9a1e2e2afe2ULL, 0x2ff8c24e61619961ULL, + 0xf1457b42b3b3f6b3ULL, 0x15a5423421218421ULL, 0x94d625089c9c4a9cULL, 0xf0663cee1e1e781eULL, + 0x2252866143431143ULL, 0x76fc93b1c7c73bc7ULL, 0xb32be54ffcfcd7fcULL, 0x2014082404041004ULL, + 0xb208a2e351515951ULL, 0xbcc72f2599995e99ULL, 0x4fc4da226d6da96dULL, 0x68391a650d0d340dULL, + 0x8335e979fafacffaULL, 0xb684a369dfdf5bdfULL, 0xd79bfca97e7ee57eULL, 0x3db4481924249024ULL, + 0xc5d776fe3b3bec3bULL, 0x313d4b9aabab96abULL, 0x3ed181f0cece1fceULL, 0x8855229911114411ULL, + 0x0c8903838f8f068fULL, 0x4a6b9c044e4e254eULL, 0xd1517366b7b7e6b7ULL, 0x0b60cbe0ebeb8bebULL, + 0xfdcc78c13c3cf03cULL, 0x7cbf1ffd81813e81ULL, 0xd4fe354094946a94ULL, 0xeb0cf31cf7f7fbf7ULL, + 0xa1676f18b9b9deb9ULL, 0x985f268b13134c13ULL, 0x7d9c58512c2cb02cULL, 0xd6b8bb05d3d36bd3ULL, + 0x6b5cd38ce7e7bbe7ULL, 0x57cbdc396e6ea56eULL, 0x6ef395aac4c437c4ULL, 0x180f061b03030c03ULL, + 0x8a13acdc56564556ULL, 0x1a49885e44440d44ULL, 0xdf9efea07f7fe17fULL, 0x21374f88a9a99ea9ULL, + 0x4d8254672a2aa82aULL, 0xb16d6b0abbbbd6bbULL, 0x46e29f87c1c123c1ULL, 0xa202a6f153535153ULL, + 0xae8ba572dcdc57dcULL, 0x582716530b0b2c0bULL, 0x9cd327019d9d4e9dULL, 0x47c1d82b6c6cad6cULL, + 0x95f562a43131c431ULL, 0x87b9e8f37474cd74ULL, 0xe309f115f6f6fff6ULL, 0x0a438c4c46460546ULL, + 0x092645a5acac8aacULL, 0x3c970fb589891e89ULL, 0xa04428b414145014ULL, 0x5b42dfbae1e1a3e1ULL, + 0xb04e2ca616165816ULL, 0xcdd274f73a3ae83aULL, 0x6fd0d2066969b969ULL, 0x482d124109092409ULL, + 0xa7ade0d77070dd70ULL, 0xd954716fb6b6e2b6ULL, 0xceb7bd1ed0d067d0ULL, 0x3b7ec7d6eded93edULL, + 0x2edb85e2cccc17ccULL, 0x2a57846842421542ULL, 0xb4c22d2c98985a98ULL, 0x490e55eda4a4aaa4ULL, + 0x5d8850752828a028ULL, 0xda31b8865c5c6d5cULL, 0x933fed6bf8f8c7f8ULL, 0x44a411c286862286ULL, + }, { + /* C5 vectors */ + 0x18c07830d8181860ULL, 0x2305af462623238cULL, 0xc67ef991b8c6c63fULL, 0xe8136fcdfbe8e887ULL, + 0x874ca113cb878726ULL, 0xb8a9626d11b8b8daULL, 0x0108050209010104ULL, 0x4f426e9e0d4f4f21ULL, + 0x36adee6c9b3636d8ULL, 0xa6590451ffa6a6a2ULL, 0xd2debdb90cd2d26fULL, 0xf5fb06f70ef5f5f3ULL, + 0x79ef80f2967979f9ULL, 0x6f5fcede306f6fa1ULL, 0x91fcef3f6d91917eULL, 0x52aa07a4f8525255ULL, + 0x6027fdc04760609dULL, 0xbc89766535bcbccaULL, 0x9baccd2b379b9b56ULL, 0x8e048c018a8e8e02ULL, + 0xa371155bd2a3a3b6ULL, 0x0c603c186c0c0c30ULL, 0x7bff8af6847b7bf1ULL, 0x35b5e16a803535d4ULL, + 0x1de8693af51d1d74ULL, 0xe05347ddb3e0e0a7ULL, 0xd7f6acb321d7d77bULL, 0xc25eed999cc2c22fULL, + 0x2e6d965c432e2eb8ULL, 0x4b627a96294b4b31ULL, 0xfea321e15dfefedfULL, 0x578216aed5575741ULL, + 0x15a8412abd151554ULL, 0x779fb6eee87777c1ULL, 0x37a5eb6e923737dcULL, 0xe57b56d79ee5e5b3ULL, + 0x9f8cd923139f9f46ULL, 0xf0d317fd23f0f0e7ULL, 0x4a6a7f94204a4a35ULL, 0xda9e95a944dada4fULL, + 0x58fa25b0a258587dULL, 0xc906ca8fcfc9c903ULL, 0x29558d527c2929a4ULL, 0x0a5022145a0a0a28ULL, + 0xb1e14f7f50b1b1feULL, 0xa0691a5dc9a0a0baULL, 0x6b7fdad6146b6bb1ULL, 0x855cab17d985852eULL, + 0xbd8173673cbdbdceULL, 0x5dd234ba8f5d5d69ULL, 0x1080502090101040ULL, 0xf4f303f507f4f4f7ULL, + 0xcb16c08bddcbcb0bULL, 0x3eedc67cd33e3ef8ULL, 0x0528110a2d050514ULL, 0x671fe6ce78676781ULL, + 0xe47353d597e4e4b7ULL, 0x2725bb4e0227279cULL, 0x4132588273414119ULL, 0x8b2c9d0ba78b8b16ULL, + 0xa7510153f6a7a7a6ULL, 0x7dcf94fab27d7de9ULL, 0x95dcfb374995956eULL, 0xd88e9fad56d8d847ULL, + 0xfb8b30eb70fbfbcbULL, 0xee2371c1cdeeee9fULL, 0x7cc791f8bb7c7cedULL, 0x6617e3cc71666685ULL, + 0xdda68ea77bdddd53ULL, 0x17b84b2eaf17175cULL, 0x4702468e45474701ULL, 0x9e84dc211a9e9e42ULL, + 0xca1ec589d4caca0fULL, 0x2d75995a582d2db4ULL, 0xbf9179632ebfbfc6ULL, 0x07381b0e3f07071cULL, + 0xad012347acadad8eULL, 0x5aea2fb4b05a5a75ULL, 0x836cb51bef838336ULL, 0x3385ff66b63333ccULL, + 0x633ff2c65c636391ULL, 0x02100a0412020208ULL, 0xaa39384993aaaa92ULL, 0x71afa8e2de7171d9ULL, + 0xc80ecf8dc6c8c807ULL, 0x19c87d32d1191964ULL, 0x497270923b494939ULL, 0xd9869aaf5fd9d943ULL, + 0xf2c31df931f2f2efULL, 0xe34b48dba8e3e3abULL, 0x5be22ab6b95b5b71ULL, 0x8834920dbc88881aULL, + 0x9aa4c8293e9a9a52ULL, 0x262dbe4c0b262698ULL, 0x328dfa64bf3232c8ULL, 0xb0e94a7d59b0b0faULL, + 0xe91b6acff2e9e983ULL, 0x0f78331e770f0f3cULL, 0xd5e6a6b733d5d573ULL, 0x8074ba1df480803aULL, + 0xbe997c6127bebec2ULL, 0xcd26de87ebcdcd13ULL, 0x34bde468893434d0ULL, 0x487a75903248483dULL, + 0xffab24e354ffffdbULL, 0x7af78ff48d7a7af5ULL, 0x90f4ea3d6490907aULL, 0x5fc23ebe9d5f5f61ULL, + 0x201da0403d202080ULL, 0x6867d5d00f6868bdULL, 0x1ad07234ca1a1a68ULL, 0xae192c41b7aeae82ULL, + 0xb4c95e757db4b4eaULL, 0x549a19a8ce54544dULL, 0x93ece53b7f939376ULL, 0x220daa442f222288ULL, + 0x6407e9c86364648dULL, 0xf1db12ff2af1f1e3ULL, 0x73bfa2e6cc7373d1ULL, 0x12905a2482121248ULL, + 0x403a5d807a40401dULL, 0x0840281048080820ULL, 0xc356e89b95c3c32bULL, 0xec337bc5dfecec97ULL, + 0xdb9690ab4ddbdb4bULL, 0xa1611f5fc0a1a1beULL, 0x8d1c8307918d8d0eULL, 0x3df5c97ac83d3df4ULL, + 0x97ccf1335b979766ULL, 0x0000000000000000ULL, 0xcf36d483f9cfcf1bULL, 0x2b4587566e2b2bacULL, + 0x7697b3ece17676c5ULL, 0x8264b019e6828232ULL, 0xd6fea9b128d6d67fULL, 0x1bd87736c31b1b6cULL, + 0xb5c15b7774b5b5eeULL, 0xaf112943beafaf86ULL, 0x6a77dfd41d6a6ab5ULL, 0x50ba0da0ea50505dULL, + 0x45124c8a57454509ULL, 0xf3cb18fb38f3f3ebULL, 0x309df060ad3030c0ULL, 0xef2b74c3c4efef9bULL, + 0x3fe5c37eda3f3ffcULL, 0x55921caac7555549ULL, 0xa2791059dba2a2b2ULL, 0xea0365c9e9eaea8fULL, + 0x650fecca6a656589ULL, 0xbab9686903babad2ULL, 0x2f65935e4a2f2fbcULL, 0xc04ee79d8ec0c027ULL, + 0xdebe81a160dede5fULL, 0x1ce06c38fc1c1c70ULL, 0xfdbb2ee746fdfdd3ULL, 0x4d52649a1f4d4d29ULL, + 0x92e4e03976929272ULL, 0x758fbceafa7575c9ULL, 0x06301e0c36060618ULL, 0x8a249809ae8a8a12ULL, + 0xb2f940794bb2b2f2ULL, 0xe66359d185e6e6bfULL, 0x0e70361c7e0e0e38ULL, 0x1ff8633ee71f1f7cULL, + 0x6237f7c455626295ULL, 0xd4eea3b53ad4d477ULL, 0xa829324d81a8a89aULL, 0x96c4f43152969662ULL, + 0xf99b3aef62f9f9c3ULL, 0xc566f697a3c5c533ULL, 0x2535b14a10252594ULL, 0x59f220b2ab595979ULL, + 0x8454ae15d084842aULL, 0x72b7a7e4c57272d5ULL, 0x39d5dd72ec3939e4ULL, 0x4c5a6198164c4c2dULL, + 0x5eca3bbc945e5e65ULL, 0x78e785f09f7878fdULL, 0x38ddd870e53838e0ULL, 0x8c148605988c8c0aULL, + 0xd1c6b2bf17d1d163ULL, 0xa5410b57e4a5a5aeULL, 0xe2434dd9a1e2e2afULL, 0x612ff8c24e616199ULL, + 0xb3f1457b42b3b3f6ULL, 0x2115a54234212184ULL, 0x9c94d625089c9c4aULL, 0x1ef0663cee1e1e78ULL, + 0x4322528661434311ULL, 0xc776fc93b1c7c73bULL, 0xfcb32be54ffcfcd7ULL, 0x0420140824040410ULL, + 0x51b208a2e3515159ULL, 0x99bcc72f2599995eULL, 0x6d4fc4da226d6da9ULL, 0x0d68391a650d0d34ULL, + 0xfa8335e979fafacfULL, 0xdfb684a369dfdf5bULL, 0x7ed79bfca97e7ee5ULL, 0x243db44819242490ULL, + 0x3bc5d776fe3b3becULL, 0xab313d4b9aabab96ULL, 0xce3ed181f0cece1fULL, 0x1188552299111144ULL, + 0x8f0c8903838f8f06ULL, 0x4e4a6b9c044e4e25ULL, 0xb7d1517366b7b7e6ULL, 0xeb0b60cbe0ebeb8bULL, + 0x3cfdcc78c13c3cf0ULL, 0x817cbf1ffd81813eULL, 0x94d4fe354094946aULL, 0xf7eb0cf31cf7f7fbULL, + 0xb9a1676f18b9b9deULL, 0x13985f268b13134cULL, 0x2c7d9c58512c2cb0ULL, 0xd3d6b8bb05d3d36bULL, + 0xe76b5cd38ce7e7bbULL, 0x6e57cbdc396e6ea5ULL, 0xc46ef395aac4c437ULL, 0x03180f061b03030cULL, + 0x568a13acdc565645ULL, 0x441a49885e44440dULL, 0x7fdf9efea07f7fe1ULL, 0xa921374f88a9a99eULL, + 0x2a4d8254672a2aa8ULL, 0xbbb16d6b0abbbbd6ULL, 0xc146e29f87c1c123ULL, 0x53a202a6f1535351ULL, + 0xdcae8ba572dcdc57ULL, 0x0b582716530b0b2cULL, 0x9d9cd327019d9d4eULL, 0x6c47c1d82b6c6cadULL, + 0x3195f562a43131c4ULL, 0x7487b9e8f37474cdULL, 0xf6e309f115f6f6ffULL, 0x460a438c4c464605ULL, + 0xac092645a5acac8aULL, 0x893c970fb589891eULL, 0x14a04428b4141450ULL, 0xe15b42dfbae1e1a3ULL, + 0x16b04e2ca6161658ULL, 0x3acdd274f73a3ae8ULL, 0x696fd0d2066969b9ULL, 0x09482d1241090924ULL, + 0x70a7ade0d77070ddULL, 0xb6d954716fb6b6e2ULL, 0xd0ceb7bd1ed0d067ULL, 0xed3b7ec7d6eded93ULL, + 0xcc2edb85e2cccc17ULL, 0x422a578468424215ULL, 0x98b4c22d2c98985aULL, 0xa4490e55eda4a4aaULL, + 0x285d8850752828a0ULL, 0x5cda31b8865c5c6dULL, 0xf8933fed6bf8f8c7ULL, 0x8644a411c2868622ULL, + }, { + /* C6 vectors */ + 0x6018c07830d81818ULL, 0x8c2305af46262323ULL, 0x3fc67ef991b8c6c6ULL, 0x87e8136fcdfbe8e8ULL, + 0x26874ca113cb8787ULL, 0xdab8a9626d11b8b8ULL, 0x0401080502090101ULL, 0x214f426e9e0d4f4fULL, + 0xd836adee6c9b3636ULL, 0xa2a6590451ffa6a6ULL, 0x6fd2debdb90cd2d2ULL, 0xf3f5fb06f70ef5f5ULL, + 0xf979ef80f2967979ULL, 0xa16f5fcede306f6fULL, 0x7e91fcef3f6d9191ULL, 0x5552aa07a4f85252ULL, + 0x9d6027fdc0476060ULL, 0xcabc89766535bcbcULL, 0x569baccd2b379b9bULL, 0x028e048c018a8e8eULL, + 0xb6a371155bd2a3a3ULL, 0x300c603c186c0c0cULL, 0xf17bff8af6847b7bULL, 0xd435b5e16a803535ULL, + 0x741de8693af51d1dULL, 0xa7e05347ddb3e0e0ULL, 0x7bd7f6acb321d7d7ULL, 0x2fc25eed999cc2c2ULL, + 0xb82e6d965c432e2eULL, 0x314b627a96294b4bULL, 0xdffea321e15dfefeULL, 0x41578216aed55757ULL, + 0x5415a8412abd1515ULL, 0xc1779fb6eee87777ULL, 0xdc37a5eb6e923737ULL, 0xb3e57b56d79ee5e5ULL, + 0x469f8cd923139f9fULL, 0xe7f0d317fd23f0f0ULL, 0x354a6a7f94204a4aULL, 0x4fda9e95a944dadaULL, + 0x7d58fa25b0a25858ULL, 0x03c906ca8fcfc9c9ULL, 0xa429558d527c2929ULL, 0x280a5022145a0a0aULL, + 0xfeb1e14f7f50b1b1ULL, 0xbaa0691a5dc9a0a0ULL, 0xb16b7fdad6146b6bULL, 0x2e855cab17d98585ULL, + 0xcebd8173673cbdbdULL, 0x695dd234ba8f5d5dULL, 0x4010805020901010ULL, 0xf7f4f303f507f4f4ULL, + 0x0bcb16c08bddcbcbULL, 0xf83eedc67cd33e3eULL, 0x140528110a2d0505ULL, 0x81671fe6ce786767ULL, + 0xb7e47353d597e4e4ULL, 0x9c2725bb4e022727ULL, 0x1941325882734141ULL, 0x168b2c9d0ba78b8bULL, + 0xa6a7510153f6a7a7ULL, 0xe97dcf94fab27d7dULL, 0x6e95dcfb37499595ULL, 0x47d88e9fad56d8d8ULL, + 0xcbfb8b30eb70fbfbULL, 0x9fee2371c1cdeeeeULL, 0xed7cc791f8bb7c7cULL, 0x856617e3cc716666ULL, + 0x53dda68ea77bddddULL, 0x5c17b84b2eaf1717ULL, 0x014702468e454747ULL, 0x429e84dc211a9e9eULL, + 0x0fca1ec589d4cacaULL, 0xb42d75995a582d2dULL, 0xc6bf9179632ebfbfULL, 0x1c07381b0e3f0707ULL, + 0x8ead012347acadadULL, 0x755aea2fb4b05a5aULL, 0x36836cb51bef8383ULL, 0xcc3385ff66b63333ULL, + 0x91633ff2c65c6363ULL, 0x0802100a04120202ULL, 0x92aa39384993aaaaULL, 0xd971afa8e2de7171ULL, + 0x07c80ecf8dc6c8c8ULL, 0x6419c87d32d11919ULL, 0x39497270923b4949ULL, 0x43d9869aaf5fd9d9ULL, + 0xeff2c31df931f2f2ULL, 0xabe34b48dba8e3e3ULL, 0x715be22ab6b95b5bULL, 0x1a8834920dbc8888ULL, + 0x529aa4c8293e9a9aULL, 0x98262dbe4c0b2626ULL, 0xc8328dfa64bf3232ULL, 0xfab0e94a7d59b0b0ULL, + 0x83e91b6acff2e9e9ULL, 0x3c0f78331e770f0fULL, 0x73d5e6a6b733d5d5ULL, 0x3a8074ba1df48080ULL, + 0xc2be997c6127bebeULL, 0x13cd26de87ebcdcdULL, 0xd034bde468893434ULL, 0x3d487a7590324848ULL, + 0xdbffab24e354ffffULL, 0xf57af78ff48d7a7aULL, 0x7a90f4ea3d649090ULL, 0x615fc23ebe9d5f5fULL, + 0x80201da0403d2020ULL, 0xbd6867d5d00f6868ULL, 0x681ad07234ca1a1aULL, 0x82ae192c41b7aeaeULL, + 0xeab4c95e757db4b4ULL, 0x4d549a19a8ce5454ULL, 0x7693ece53b7f9393ULL, 0x88220daa442f2222ULL, + 0x8d6407e9c8636464ULL, 0xe3f1db12ff2af1f1ULL, 0xd173bfa2e6cc7373ULL, 0x4812905a24821212ULL, + 0x1d403a5d807a4040ULL, 0x2008402810480808ULL, 0x2bc356e89b95c3c3ULL, 0x97ec337bc5dfececULL, + 0x4bdb9690ab4ddbdbULL, 0xbea1611f5fc0a1a1ULL, 0x0e8d1c8307918d8dULL, 0xf43df5c97ac83d3dULL, + 0x6697ccf1335b9797ULL, 0x0000000000000000ULL, 0x1bcf36d483f9cfcfULL, 0xac2b4587566e2b2bULL, + 0xc57697b3ece17676ULL, 0x328264b019e68282ULL, 0x7fd6fea9b128d6d6ULL, 0x6c1bd87736c31b1bULL, + 0xeeb5c15b7774b5b5ULL, 0x86af112943beafafULL, 0xb56a77dfd41d6a6aULL, 0x5d50ba0da0ea5050ULL, + 0x0945124c8a574545ULL, 0xebf3cb18fb38f3f3ULL, 0xc0309df060ad3030ULL, 0x9bef2b74c3c4efefULL, + 0xfc3fe5c37eda3f3fULL, 0x4955921caac75555ULL, 0xb2a2791059dba2a2ULL, 0x8fea0365c9e9eaeaULL, + 0x89650fecca6a6565ULL, 0xd2bab9686903babaULL, 0xbc2f65935e4a2f2fULL, 0x27c04ee79d8ec0c0ULL, + 0x5fdebe81a160dedeULL, 0x701ce06c38fc1c1cULL, 0xd3fdbb2ee746fdfdULL, 0x294d52649a1f4d4dULL, + 0x7292e4e039769292ULL, 0xc9758fbceafa7575ULL, 0x1806301e0c360606ULL, 0x128a249809ae8a8aULL, + 0xf2b2f940794bb2b2ULL, 0xbfe66359d185e6e6ULL, 0x380e70361c7e0e0eULL, 0x7c1ff8633ee71f1fULL, + 0x956237f7c4556262ULL, 0x77d4eea3b53ad4d4ULL, 0x9aa829324d81a8a8ULL, 0x6296c4f431529696ULL, + 0xc3f99b3aef62f9f9ULL, 0x33c566f697a3c5c5ULL, 0x942535b14a102525ULL, 0x7959f220b2ab5959ULL, + 0x2a8454ae15d08484ULL, 0xd572b7a7e4c57272ULL, 0xe439d5dd72ec3939ULL, 0x2d4c5a6198164c4cULL, + 0x655eca3bbc945e5eULL, 0xfd78e785f09f7878ULL, 0xe038ddd870e53838ULL, 0x0a8c148605988c8cULL, + 0x63d1c6b2bf17d1d1ULL, 0xaea5410b57e4a5a5ULL, 0xafe2434dd9a1e2e2ULL, 0x99612ff8c24e6161ULL, + 0xf6b3f1457b42b3b3ULL, 0x842115a542342121ULL, 0x4a9c94d625089c9cULL, 0x781ef0663cee1e1eULL, + 0x1143225286614343ULL, 0x3bc776fc93b1c7c7ULL, 0xd7fcb32be54ffcfcULL, 0x1004201408240404ULL, + 0x5951b208a2e35151ULL, 0x5e99bcc72f259999ULL, 0xa96d4fc4da226d6dULL, 0x340d68391a650d0dULL, + 0xcffa8335e979fafaULL, 0x5bdfb684a369dfdfULL, 0xe57ed79bfca97e7eULL, 0x90243db448192424ULL, + 0xec3bc5d776fe3b3bULL, 0x96ab313d4b9aababULL, 0x1fce3ed181f0ceceULL, 0x4411885522991111ULL, + 0x068f0c8903838f8fULL, 0x254e4a6b9c044e4eULL, 0xe6b7d1517366b7b7ULL, 0x8beb0b60cbe0ebebULL, + 0xf03cfdcc78c13c3cULL, 0x3e817cbf1ffd8181ULL, 0x6a94d4fe35409494ULL, 0xfbf7eb0cf31cf7f7ULL, + 0xdeb9a1676f18b9b9ULL, 0x4c13985f268b1313ULL, 0xb02c7d9c58512c2cULL, 0x6bd3d6b8bb05d3d3ULL, + 0xbbe76b5cd38ce7e7ULL, 0xa56e57cbdc396e6eULL, 0x37c46ef395aac4c4ULL, 0x0c03180f061b0303ULL, + 0x45568a13acdc5656ULL, 0x0d441a49885e4444ULL, 0xe17fdf9efea07f7fULL, 0x9ea921374f88a9a9ULL, + 0xa82a4d8254672a2aULL, 0xd6bbb16d6b0abbbbULL, 0x23c146e29f87c1c1ULL, 0x5153a202a6f15353ULL, + 0x57dcae8ba572dcdcULL, 0x2c0b582716530b0bULL, 0x4e9d9cd327019d9dULL, 0xad6c47c1d82b6c6cULL, + 0xc43195f562a43131ULL, 0xcd7487b9e8f37474ULL, 0xfff6e309f115f6f6ULL, 0x05460a438c4c4646ULL, + 0x8aac092645a5acacULL, 0x1e893c970fb58989ULL, 0x5014a04428b41414ULL, 0xa3e15b42dfbae1e1ULL, + 0x5816b04e2ca61616ULL, 0xe83acdd274f73a3aULL, 0xb9696fd0d2066969ULL, 0x2409482d12410909ULL, + 0xdd70a7ade0d77070ULL, 0xe2b6d954716fb6b6ULL, 0x67d0ceb7bd1ed0d0ULL, 0x93ed3b7ec7d6ededULL, + 0x17cc2edb85e2ccccULL, 0x15422a5784684242ULL, 0x5a98b4c22d2c9898ULL, 0xaaa4490e55eda4a4ULL, + 0xa0285d8850752828ULL, 0x6d5cda31b8865c5cULL, 0xc7f8933fed6bf8f8ULL, 0x228644a411c28686ULL, + }, { + /* C7 vectors */ + 0x186018c07830d818ULL, 0x238c2305af462623ULL, 0xc63fc67ef991b8c6ULL, 0xe887e8136fcdfbe8ULL, + 0x8726874ca113cb87ULL, 0xb8dab8a9626d11b8ULL, 0x0104010805020901ULL, 0x4f214f426e9e0d4fULL, + 0x36d836adee6c9b36ULL, 0xa6a2a6590451ffa6ULL, 0xd26fd2debdb90cd2ULL, 0xf5f3f5fb06f70ef5ULL, + 0x79f979ef80f29679ULL, 0x6fa16f5fcede306fULL, 0x917e91fcef3f6d91ULL, 0x525552aa07a4f852ULL, + 0x609d6027fdc04760ULL, 0xbccabc89766535bcULL, 0x9b569baccd2b379bULL, 0x8e028e048c018a8eULL, + 0xa3b6a371155bd2a3ULL, 0x0c300c603c186c0cULL, 0x7bf17bff8af6847bULL, 0x35d435b5e16a8035ULL, + 0x1d741de8693af51dULL, 0xe0a7e05347ddb3e0ULL, 0xd77bd7f6acb321d7ULL, 0xc22fc25eed999cc2ULL, + 0x2eb82e6d965c432eULL, 0x4b314b627a96294bULL, 0xfedffea321e15dfeULL, 0x5741578216aed557ULL, + 0x155415a8412abd15ULL, 0x77c1779fb6eee877ULL, 0x37dc37a5eb6e9237ULL, 0xe5b3e57b56d79ee5ULL, + 0x9f469f8cd923139fULL, 0xf0e7f0d317fd23f0ULL, 0x4a354a6a7f94204aULL, 0xda4fda9e95a944daULL, + 0x587d58fa25b0a258ULL, 0xc903c906ca8fcfc9ULL, 0x29a429558d527c29ULL, 0x0a280a5022145a0aULL, + 0xb1feb1e14f7f50b1ULL, 0xa0baa0691a5dc9a0ULL, 0x6bb16b7fdad6146bULL, 0x852e855cab17d985ULL, + 0xbdcebd8173673cbdULL, 0x5d695dd234ba8f5dULL, 0x1040108050209010ULL, 0xf4f7f4f303f507f4ULL, + 0xcb0bcb16c08bddcbULL, 0x3ef83eedc67cd33eULL, 0x05140528110a2d05ULL, 0x6781671fe6ce7867ULL, + 0xe4b7e47353d597e4ULL, 0x279c2725bb4e0227ULL, 0x4119413258827341ULL, 0x8b168b2c9d0ba78bULL, + 0xa7a6a7510153f6a7ULL, 0x7de97dcf94fab27dULL, 0x956e95dcfb374995ULL, 0xd847d88e9fad56d8ULL, + 0xfbcbfb8b30eb70fbULL, 0xee9fee2371c1cdeeULL, 0x7ced7cc791f8bb7cULL, 0x66856617e3cc7166ULL, + 0xdd53dda68ea77bddULL, 0x175c17b84b2eaf17ULL, 0x47014702468e4547ULL, 0x9e429e84dc211a9eULL, + 0xca0fca1ec589d4caULL, 0x2db42d75995a582dULL, 0xbfc6bf9179632ebfULL, 0x071c07381b0e3f07ULL, + 0xad8ead012347acadULL, 0x5a755aea2fb4b05aULL, 0x8336836cb51bef83ULL, 0x33cc3385ff66b633ULL, + 0x6391633ff2c65c63ULL, 0x020802100a041202ULL, 0xaa92aa39384993aaULL, 0x71d971afa8e2de71ULL, + 0xc807c80ecf8dc6c8ULL, 0x196419c87d32d119ULL, 0x4939497270923b49ULL, 0xd943d9869aaf5fd9ULL, + 0xf2eff2c31df931f2ULL, 0xe3abe34b48dba8e3ULL, 0x5b715be22ab6b95bULL, 0x881a8834920dbc88ULL, + 0x9a529aa4c8293e9aULL, 0x2698262dbe4c0b26ULL, 0x32c8328dfa64bf32ULL, 0xb0fab0e94a7d59b0ULL, + 0xe983e91b6acff2e9ULL, 0x0f3c0f78331e770fULL, 0xd573d5e6a6b733d5ULL, 0x803a8074ba1df480ULL, + 0xbec2be997c6127beULL, 0xcd13cd26de87ebcdULL, 0x34d034bde4688934ULL, 0x483d487a75903248ULL, + 0xffdbffab24e354ffULL, 0x7af57af78ff48d7aULL, 0x907a90f4ea3d6490ULL, 0x5f615fc23ebe9d5fULL, + 0x2080201da0403d20ULL, 0x68bd6867d5d00f68ULL, 0x1a681ad07234ca1aULL, 0xae82ae192c41b7aeULL, + 0xb4eab4c95e757db4ULL, 0x544d549a19a8ce54ULL, 0x937693ece53b7f93ULL, 0x2288220daa442f22ULL, + 0x648d6407e9c86364ULL, 0xf1e3f1db12ff2af1ULL, 0x73d173bfa2e6cc73ULL, 0x124812905a248212ULL, + 0x401d403a5d807a40ULL, 0x0820084028104808ULL, 0xc32bc356e89b95c3ULL, 0xec97ec337bc5dfecULL, + 0xdb4bdb9690ab4ddbULL, 0xa1bea1611f5fc0a1ULL, 0x8d0e8d1c8307918dULL, 0x3df43df5c97ac83dULL, + 0x976697ccf1335b97ULL, 0x0000000000000000ULL, 0xcf1bcf36d483f9cfULL, 0x2bac2b4587566e2bULL, + 0x76c57697b3ece176ULL, 0x82328264b019e682ULL, 0xd67fd6fea9b128d6ULL, 0x1b6c1bd87736c31bULL, + 0xb5eeb5c15b7774b5ULL, 0xaf86af112943beafULL, 0x6ab56a77dfd41d6aULL, 0x505d50ba0da0ea50ULL, + 0x450945124c8a5745ULL, 0xf3ebf3cb18fb38f3ULL, 0x30c0309df060ad30ULL, 0xef9bef2b74c3c4efULL, + 0x3ffc3fe5c37eda3fULL, 0x554955921caac755ULL, 0xa2b2a2791059dba2ULL, 0xea8fea0365c9e9eaULL, + 0x6589650fecca6a65ULL, 0xbad2bab9686903baULL, 0x2fbc2f65935e4a2fULL, 0xc027c04ee79d8ec0ULL, + 0xde5fdebe81a160deULL, 0x1c701ce06c38fc1cULL, 0xfdd3fdbb2ee746fdULL, 0x4d294d52649a1f4dULL, + 0x927292e4e0397692ULL, 0x75c9758fbceafa75ULL, 0x061806301e0c3606ULL, 0x8a128a249809ae8aULL, + 0xb2f2b2f940794bb2ULL, 0xe6bfe66359d185e6ULL, 0x0e380e70361c7e0eULL, 0x1f7c1ff8633ee71fULL, + 0x62956237f7c45562ULL, 0xd477d4eea3b53ad4ULL, 0xa89aa829324d81a8ULL, 0x966296c4f4315296ULL, + 0xf9c3f99b3aef62f9ULL, 0xc533c566f697a3c5ULL, 0x25942535b14a1025ULL, 0x597959f220b2ab59ULL, + 0x842a8454ae15d084ULL, 0x72d572b7a7e4c572ULL, 0x39e439d5dd72ec39ULL, 0x4c2d4c5a6198164cULL, + 0x5e655eca3bbc945eULL, 0x78fd78e785f09f78ULL, 0x38e038ddd870e538ULL, 0x8c0a8c148605988cULL, + 0xd163d1c6b2bf17d1ULL, 0xa5aea5410b57e4a5ULL, 0xe2afe2434dd9a1e2ULL, 0x6199612ff8c24e61ULL, + 0xb3f6b3f1457b42b3ULL, 0x21842115a5423421ULL, 0x9c4a9c94d625089cULL, 0x1e781ef0663cee1eULL, + 0x4311432252866143ULL, 0xc73bc776fc93b1c7ULL, 0xfcd7fcb32be54ffcULL, 0x0410042014082404ULL, + 0x515951b208a2e351ULL, 0x995e99bcc72f2599ULL, 0x6da96d4fc4da226dULL, 0x0d340d68391a650dULL, + 0xfacffa8335e979faULL, 0xdf5bdfb684a369dfULL, 0x7ee57ed79bfca97eULL, 0x2490243db4481924ULL, + 0x3bec3bc5d776fe3bULL, 0xab96ab313d4b9aabULL, 0xce1fce3ed181f0ceULL, 0x1144118855229911ULL, + 0x8f068f0c8903838fULL, 0x4e254e4a6b9c044eULL, 0xb7e6b7d1517366b7ULL, 0xeb8beb0b60cbe0ebULL, + 0x3cf03cfdcc78c13cULL, 0x813e817cbf1ffd81ULL, 0x946a94d4fe354094ULL, 0xf7fbf7eb0cf31cf7ULL, + 0xb9deb9a1676f18b9ULL, 0x134c13985f268b13ULL, 0x2cb02c7d9c58512cULL, 0xd36bd3d6b8bb05d3ULL, + 0xe7bbe76b5cd38ce7ULL, 0x6ea56e57cbdc396eULL, 0xc437c46ef395aac4ULL, 0x030c03180f061b03ULL, + 0x5645568a13acdc56ULL, 0x440d441a49885e44ULL, 0x7fe17fdf9efea07fULL, 0xa99ea921374f88a9ULL, + 0x2aa82a4d8254672aULL, 0xbbd6bbb16d6b0abbULL, 0xc123c146e29f87c1ULL, 0x535153a202a6f153ULL, + 0xdc57dcae8ba572dcULL, 0x0b2c0b582716530bULL, 0x9d4e9d9cd327019dULL, 0x6cad6c47c1d82b6cULL, + 0x31c43195f562a431ULL, 0x74cd7487b9e8f374ULL, 0xf6fff6e309f115f6ULL, 0x4605460a438c4c46ULL, + 0xac8aac092645a5acULL, 0x891e893c970fb589ULL, 0x145014a04428b414ULL, 0xe1a3e15b42dfbae1ULL, + 0x165816b04e2ca616ULL, 0x3ae83acdd274f73aULL, 0x69b9696fd0d20669ULL, 0x092409482d124109ULL, + 0x70dd70a7ade0d770ULL, 0xb6e2b6d954716fb6ULL, 0xd067d0ceb7bd1ed0ULL, 0xed93ed3b7ec7d6edULL, + 0xcc17cc2edb85e2ccULL, 0x4215422a57846842ULL, 0x985a98b4c22d2c98ULL, 0xa4aaa4490e55eda4ULL, + 0x28a0285d88507528ULL, 0x5c6d5cda31b8865cULL, 0xf8c7f8933fed6bf8ULL, 0x86228644a411c286ULL, + } +}; + +/** + * Initialize context before calculating hash. + * + * @param ctx context to initialize + */ +void digestif_whirlpool_init(struct whirlpool_ctx* ctx) +{ + memset(ctx, 0, sizeof(*ctx)); +} + +/* Algorithm S-Box */ +#define WHIRLPOOL_OP(src, shift) ( \ + digestif_whirlpool_sbox[0][(int)(src[ shift & 7] >> 56) ] ^ \ + digestif_whirlpool_sbox[1][(int)(src[(shift + 7) & 7] >> 48) & 0xff] ^ \ + digestif_whirlpool_sbox[2][(int)(src[(shift + 6) & 7] >> 40) & 0xff] ^ \ + digestif_whirlpool_sbox[3][(int)(src[(shift + 5) & 7] >> 32) & 0xff] ^ \ + digestif_whirlpool_sbox[4][(int)(src[(shift + 4) & 7] >> 24) & 0xff] ^ \ + digestif_whirlpool_sbox[5][(int)(src[(shift + 3) & 7] >> 16) & 0xff] ^ \ + digestif_whirlpool_sbox[6][(int)(src[(shift + 2) & 7] >> 8) & 0xff] ^ \ + digestif_whirlpool_sbox[7][(int)(src[(shift + 1) & 7] ) & 0xff]) + +/** + * The core transformation. Process a 512-bit block. + * + * @param hash algorithm state + * @param block the message block to process + */ +static void whirlpool_do_chunk(uint64_t *hash, uint64_t* p_block) +{ + int i; /* loop counter */ + uint64_t K[2][8]; /* key */ + uint64_t state[2][8]; /* state */ + + /* alternating binary flags */ + unsigned int m = 0; + + /* the number of rounds of the internal dedicated block cipher */ + const int number_of_rounds = 10; + + /* array used in the rounds */ + static const uint64_t rc[10] = { + 0x1823c6e887b8014fULL, + 0x36a6d2f5796f9152ULL, + 0x60bc9b8ea30c7b35ULL, + 0x1de0d7c22e4bfe57ULL, + 0x157737e59ff04adaULL, + 0x58c9290ab1a06b85ULL, + 0xbd5d10f4cb3e0567ULL, + 0xe427418ba77d95d8ULL, + 0xfbee7c66dd17479eULL, + 0xca2dbf07ad5a8333ULL + }; + + /* map the message buffer to a block */ + for (i = 0; i < 8; i++) { + /* store K^0 and xor it with the intermediate hash state */ + K[0][i] = hash[i]; + state[0][i] = be64_to_cpu(p_block[i]) ^ hash[i]; + hash[i] = state[0][i]; + } + + /* iterate over algorithm rounds */ + for (i = 0; i < number_of_rounds; i++) + { + /* compute K^i from K^{i-1} */ + K[m ^ 1][0] = WHIRLPOOL_OP(K[m], 0) ^ rc[i]; + K[m ^ 1][1] = WHIRLPOOL_OP(K[m], 1); + K[m ^ 1][2] = WHIRLPOOL_OP(K[m], 2); + K[m ^ 1][3] = WHIRLPOOL_OP(K[m], 3); + K[m ^ 1][4] = WHIRLPOOL_OP(K[m], 4); + K[m ^ 1][5] = WHIRLPOOL_OP(K[m], 5); + K[m ^ 1][6] = WHIRLPOOL_OP(K[m], 6); + K[m ^ 1][7] = WHIRLPOOL_OP(K[m], 7); + + /* apply the i-th round transformation */ + state[m ^ 1][0] = WHIRLPOOL_OP(state[m], 0) ^ K[m ^ 1][0]; + state[m ^ 1][1] = WHIRLPOOL_OP(state[m], 1) ^ K[m ^ 1][1]; + state[m ^ 1][2] = WHIRLPOOL_OP(state[m], 2) ^ K[m ^ 1][2]; + state[m ^ 1][3] = WHIRLPOOL_OP(state[m], 3) ^ K[m ^ 1][3]; + state[m ^ 1][4] = WHIRLPOOL_OP(state[m], 4) ^ K[m ^ 1][4]; + state[m ^ 1][5] = WHIRLPOOL_OP(state[m], 5) ^ K[m ^ 1][5]; + state[m ^ 1][6] = WHIRLPOOL_OP(state[m], 6) ^ K[m ^ 1][6]; + state[m ^ 1][7] = WHIRLPOOL_OP(state[m], 7) ^ K[m ^ 1][7]; + + m = m ^ 1; + } + + /* apply the Miyaguchi-Preneel compression function */ + hash[0] ^= state[0][0]; + hash[1] ^= state[0][1]; + hash[2] ^= state[0][2]; + hash[3] ^= state[0][3]; + hash[4] ^= state[0][4]; + hash[5] ^= state[0][5]; + hash[6] ^= state[0][6]; + hash[7] ^= state[0][7]; +} + +/** + * Calculate message hash. + * Can be called repeatedly with chunks of the message to be hashed. + * + * @param ctx the algorithm context containing current hashing state + * @param msg message chunk + * @param size length of the message chunk + */ +void digestif_whirlpool_update(struct whirlpool_ctx* ctx, uint8_t *data, uint32_t len) +{ + unsigned int index, to_fill; + + /* check for partial buffer */ + index = (unsigned int) (ctx->sz & 0x3f); + to_fill = 64 - index; // sizeof(ctx->buf) - index + + ctx->sz += len; + + /* process partial buffer if there's enough data to make a block */ + if (index && len >= to_fill) { + memcpy(ctx->buf + index, data, to_fill); + whirlpool_do_chunk(ctx->h, (uint64_t*)ctx->buf); + len -= to_fill; + data += to_fill; + index = 0; + } + + /* process as much 128-block as possible */ + for (; len >= 64; len -= 64, data += 64) + whirlpool_do_chunk(ctx->h, (uint64_t*)data); + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +/** + * Store calculated hash into the given array. + * + * @param ctx the algorithm context containing current hashing state + * @param result calculated hash in binary form + */ +void digestif_whirlpool_finalize(struct whirlpool_ctx* ctx, uint8_t *out) +{ + uint32_t i, index; + uint64_t* msg64 = (uint64_t*)ctx->buf; + index = (uint32_t) (ctx->sz & 0x3f); + uint64_t *p = (uint64_t *) out; + + /* pad message and run for last block */ + ctx->buf[index++] = 0x80; + + /* if no room left in the message to store 256-bit message length */ + if (index > 32) { + /* then pad the rest with zeros and process it */ + while (index < 64) { + ctx->buf[index++] = 0; + } + whirlpool_do_chunk(ctx->h, msg64); + index = 0; + } + + /* due to optimization actually only 64-bit of message length are stored */ + while (index < 56) { + ctx->buf[index++] = 0; + } + msg64[7] = be64_to_cpu(ctx->sz << 3); + whirlpool_do_chunk(ctx->h, msg64); + + /* save result hash */ + for (i = 0; i < 8; i++) + p[i] = cpu_to_be64(ctx->h[i]); +} diff --git a/unikernel/duniverse/digestif/src-c/native/whirlpool.h b/unikernel/duniverse/digestif/src-c/native/whirlpool.h new file mode 100644 index 00000000..6c68c7b9 --- /dev/null +++ b/unikernel/duniverse/digestif/src-c/native/whirlpool.h @@ -0,0 +1,41 @@ +/* whirlpool.c - an implementation of the Whirlpool Hash Function. + * + * Copyright: 2009-2012 Aleksey Kravchenko + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. Use this program at your own risk! + * + * Documentation: + * P. S. L. M. Barreto, V. Rijmen, ``The Whirlpool hashing function,'' + * NESSIE submission, 2000 (tweaked version, 2001) + * + * The algorithm is named after the Whirlpool Galaxy in Canes Venatici. + */ +#ifndef CRYPTOHASH_WHIRLPOOL_H +#define CRYPTOHASH_WHIRLPOOL_H + +#include + +struct whirlpool_ctx +{ + uint64_t sz; + uint8_t buf[64]; + uint64_t h[8]; +}; + +#define WHIRLPOOL_DIGEST_SIZE 64 +#define WHIRLPOOL_CTX_SIZE sizeof(struct whirlpool_ctx) + +void digestif_whirlpool_init(struct whirlpool_ctx* ctx); +void digestif_whirlpool_update(struct whirlpool_ctx* ctx, uint8_t *data, uint32_t len); +void digestif_whirlpool_finalize(struct whirlpool_ctx* ctx, uint8_t *out); + +#endif diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_blake2b.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_blake2b.ml new file mode 100644 index 00000000..efc60f9a --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_blake2b.ml @@ -0,0 +1,353 @@ +module By = Digestif_by +module Bi = Digestif_bi + +let failwith fmt = Format.kasprintf failwith fmt + +module Int32 = struct + include Int32 + + let ( lsl ) = Int32.shift_left + let ( lsr ) = Int32.shift_right_logical + let ( asr ) = Int32.shift_right + let ( lor ) = Int32.logor + let ( lxor ) = Int32.logxor + let ( land ) = Int32.logand + let lnot = Int32.lognot + let ( + ) = Int32.add + let rol32 a n = (a lsl n) lor (a lsr (32 - n)) + let ror32 a n = (a lsr n) lor (a lsl (32 - n)) +end + +module Int64 = struct + include Int64 + + let ( land ) = Int64.logand + let ( lsl ) = Int64.shift_left + let ( lsr ) = Int64.shift_right_logical + let ( lor ) = Int64.logor + let ( asr ) = Int64.shift_right + let ( lxor ) = Int64.logxor + let ( + ) = Int64.add + let rol64 a n = (a lsl n) lor (a lsr (64 - n)) + let ror64 a n = (a lsr n) lor (a lsl (64 - n)) +end + +module type S = sig + type ctx + type kind = [ `BLAKE2B ] + + val init : unit -> ctx + val with_outlen_and_bytes_key : int -> By.t -> int -> int -> ctx + val with_outlen_and_bigstring_key : int -> Bi.t -> int -> int -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx + val max_outlen : int +end + +module Unsafe : S = struct + type kind = [ `BLAKE2B ] + + type param = { + digest_length : int; + key_length : int; + fanout : int; + depth : int; + leaf_length : int32; + node_offset : int32; + xof_length : int32; + node_depth : int; + inner_length : int; + reserved : int array; + salt : int array; + personal : int array; + } + + type ctx = { + mutable buflen : int; + outlen : int; + mutable last_node : int; + buf : Bytes.t; + h : int64 array; + t : int64 array; + f : int64 array; + } + + let dup ctx = + { + buflen = ctx.buflen; + outlen = ctx.outlen; + last_node = ctx.last_node; + buf = By.copy ctx.buf; + h = Array.copy ctx.h; + t = Array.copy ctx.t; + f = Array.copy ctx.f; + } + + let param_to_bytes param = + let arr = + [| + param.digest_length land 0xFF; param.key_length land 0xFF; + param.fanout land 0xFF; + param.depth land 0xFF (* store to little-endian *); + Int32.(to_int ((param.leaf_length lsr 0) land 0xFFl)); + Int32.(to_int ((param.leaf_length lsr 8) land 0xFFl)); + Int32.(to_int ((param.leaf_length lsr 16) land 0xFFl)); + Int32.(to_int ((param.leaf_length lsr 24) land 0xFFl)) + (* store to little-endian *); + Int32.(to_int ((param.node_offset lsr 0) land 0xFFl)); + Int32.(to_int ((param.node_offset lsr 8) land 0xFFl)); + Int32.(to_int ((param.node_offset lsr 16) land 0xFFl)); + Int32.(to_int ((param.node_offset lsr 24) land 0xFFl)) + (* store to little-endian *); + Int32.(to_int ((param.xof_length lsr 0) land 0xFFl)); + Int32.(to_int ((param.xof_length lsr 8) land 0xFFl)); + Int32.(to_int ((param.xof_length lsr 16) land 0xFFl)); + Int32.(to_int ((param.xof_length lsr 24) land 0xFFl)); + param.node_depth land 0xFF; param.inner_length land 0xFF; + param.reserved.(0) land 0xFF; param.reserved.(1) land 0xFF; + param.reserved.(2) land 0xFF; param.reserved.(3) land 0xFF; + param.reserved.(4) land 0xFF; param.reserved.(5) land 0xFF; + param.reserved.(6) land 0xFF; param.reserved.(7) land 0xFF; + param.reserved.(8) land 0xFF; param.reserved.(9) land 0xFF; + param.reserved.(10) land 0xFF; param.reserved.(11) land 0xFF; + param.reserved.(12) land 0xFF; param.reserved.(13) land 0xFF; + param.salt.(0) land 0xFF; param.salt.(1) land 0xFF; + param.salt.(2) land 0xFF; param.salt.(3) land 0xFF; + param.salt.(4) land 0xFF; param.salt.(5) land 0xFF; + param.salt.(6) land 0xFF; param.salt.(7) land 0xFF; + param.salt.(8) land 0xFF; param.salt.(9) land 0xFF; + param.salt.(10) land 0xFF; param.salt.(11) land 0xFF; + param.salt.(12) land 0xFF; param.salt.(13) land 0xFF; + param.salt.(14) land 0xFF; param.salt.(15) land 0xFF; + param.personal.(0) land 0xFF; param.personal.(1) land 0xFF; + param.personal.(2) land 0xFF; param.personal.(3) land 0xFF; + param.personal.(4) land 0xFF; param.personal.(5) land 0xFF; + param.personal.(6) land 0xFF; param.personal.(7) land 0xFF; + param.personal.(8) land 0xFF; param.personal.(9) land 0xFF; + param.personal.(10) land 0xFF; param.personal.(11) land 0xFF; + param.personal.(12) land 0xFF; param.personal.(13) land 0xFF; + param.personal.(14) land 0xFF; param.personal.(15) land 0xFF; + |] in + By.init 64 (fun i -> Char.unsafe_chr arr.(i)) + + let max_outlen = 64 + + let default_param = + { + digest_length = max_outlen; + key_length = 0; + fanout = 1; + depth = 1; + leaf_length = 0l; + node_offset = 0l; + xof_length = 0l; + node_depth = 0; + inner_length = 0; + reserved = [| 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]; + salt = [| 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]; + personal = [| 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]; + } + + let iv = + [| + 0x6a09e667f3bcc908L; 0xbb67ae8584caa73bL; 0x3c6ef372fe94f82bL; + 0xa54ff53a5f1d36f1L; 0x510e527fade682d1L; 0x9b05688c2b3e6c1fL; + 0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L; + |] + + let increment_counter ctx inc = + let open Int64 in + ctx.t.(0) <- ctx.t.(0) + inc ; + ctx.t.(1) <- (ctx.t.(1) + if ctx.t.(0) < inc then 1L else 0L) + + let set_lastnode ctx = ctx.f.(1) <- Int64.minus_one + + let set_lastblock ctx = + if ctx.last_node <> 0 then set_lastnode ctx ; + ctx.f.(0) <- Int64.minus_one + + let init () = + let buf = By.make 128 '\x00' in + By.fill buf 0 128 '\x00' ; + let ctx = + { + buflen = 0; + outlen = default_param.digest_length; + last_node = 0; + buf; + h = Array.make 8 0L; + t = Array.make 2 0L; + f = Array.make 2 0L; + } in + let param_bytes = param_to_bytes default_param in + for i = 0 to 7 do + ctx.h.(i) <- Int64.(iv.(i) lxor By.le64_to_cpu param_bytes (i * 8)) + done ; + ctx + + let sigma = + [| + [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 |]; + [| 14; 10; 4; 8; 9; 15; 13; 6; 1; 12; 0; 2; 11; 7; 5; 3 |]; + [| 11; 8; 12; 0; 5; 2; 15; 13; 10; 14; 3; 6; 7; 1; 9; 4 |]; + [| 7; 9; 3; 1; 13; 12; 11; 14; 2; 6; 5; 10; 4; 0; 15; 8 |]; + [| 9; 0; 5; 7; 2; 4; 10; 15; 14; 1; 11; 12; 6; 8; 3; 13 |]; + [| 2; 12; 6; 10; 0; 11; 8; 3; 4; 13; 7; 5; 15; 14; 1; 9 |]; + [| 12; 5; 1; 15; 14; 13; 4; 10; 0; 7; 6; 3; 9; 2; 8; 11 |]; + [| 13; 11; 7; 14; 12; 1; 3; 9; 5; 0; 15; 4; 8; 6; 2; 10 |]; + [| 6; 15; 14; 9; 11; 3; 0; 8; 12; 2; 13; 7; 1; 4; 10; 5 |]; + [| 10; 2; 8; 4; 7; 6; 1; 5; 15; 11; 9; 14; 3; 12; 13; 0 |]; + [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 |]; + [| 14; 10; 4; 8; 9; 15; 13; 6; 1; 12; 0; 2; 11; 7; 5; 3 |]; + |] + + let compress : + type a. le64_to_cpu:(a -> int -> int64) -> ctx -> a -> int -> unit = + fun ~le64_to_cpu ctx block off -> + let v = Array.make 16 0L in + let m = Array.make 16 0L in + let g r i a_idx b_idx c_idx d_idx = + let ( ++ ) = ( + ) in + let open Int64 in + v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 0)) ; + v.(d_idx) <- ror64 (v.(d_idx) lxor v.(a_idx)) 32 ; + v.(c_idx) <- v.(c_idx) + v.(d_idx) ; + v.(b_idx) <- ror64 (v.(b_idx) lxor v.(c_idx)) 24 ; + v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 1)) ; + v.(d_idx) <- ror64 (v.(d_idx) lxor v.(a_idx)) 16 ; + v.(c_idx) <- v.(c_idx) + v.(d_idx) ; + v.(b_idx) <- ror64 (v.(b_idx) lxor v.(c_idx)) 63 in + let r r = + g r 0 0 4 8 12 ; + g r 1 1 5 9 13 ; + g r 2 2 6 10 14 ; + g r 3 3 7 11 15 ; + g r 4 0 5 10 15 ; + g r 5 1 6 11 12 ; + g r 6 2 7 8 13 ; + g r 7 3 4 9 14 in + for i = 0 to 15 do + m.(i) <- le64_to_cpu block (off + (i * 8)) + done ; + for i = 0 to 7 do + v.(i) <- ctx.h.(i) + done ; + v.(8) <- iv.(0) ; + v.(9) <- iv.(1) ; + v.(10) <- iv.(2) ; + v.(11) <- iv.(3) ; + v.(12) <- Int64.(iv.(4) lxor ctx.t.(0)) ; + v.(13) <- Int64.(iv.(5) lxor ctx.t.(1)) ; + v.(14) <- Int64.(iv.(6) lxor ctx.f.(0)) ; + v.(15) <- Int64.(iv.(7) lxor ctx.f.(1)) ; + r 0 ; + r 1 ; + r 2 ; + r 3 ; + r 4 ; + r 5 ; + r 6 ; + r 7 ; + r 8 ; + r 9 ; + r 10 ; + r 11 ; + let ( ++ ) = ( + ) in + for i = 0 to 7 do + ctx.h.(i) <- Int64.(ctx.h.(i) lxor v.(i) lxor v.(i ++ 8)) + done ; + () + + let feed : + type a. + blit:(a -> int -> By.t -> int -> int -> unit) -> + le64_to_cpu:(a -> int -> int64) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~blit ~le64_to_cpu ctx buf off len -> + let in_off = ref off in + let in_len = ref len in + if !in_len > 0 + then ( + let left = ctx.buflen in + let fill = 128 - left in + if !in_len > fill + then ( + ctx.buflen <- 0 ; + blit buf !in_off ctx.buf left fill ; + increment_counter ctx 128L ; + compress ~le64_to_cpu:By.le64_to_cpu ctx ctx.buf 0 ; + in_off := !in_off + fill ; + in_len := !in_len - fill ; + while !in_len > 128 do + increment_counter ctx 128L ; + compress ~le64_to_cpu ctx buf !in_off ; + in_off := !in_off + 128 ; + in_len := !in_len - 128 + done) ; + blit buf !in_off ctx.buf ctx.buflen !in_len ; + ctx.buflen <- ctx.buflen + !in_len) ; + () + + let unsafe_feed_bytes = feed ~blit:By.blit ~le64_to_cpu:By.le64_to_cpu + + let unsafe_feed_bigstring = + feed ~blit:By.blit_from_bigstring ~le64_to_cpu:Bi.le64_to_cpu + + let with_outlen_and_key ~blit outlen key off len = + if outlen > max_outlen + then + failwith "out length can not be upper than %d (out length: %d)" max_outlen + outlen ; + let buf = By.make 128 '\x00' in + let ctx = + { + buflen = 0; + outlen; + last_node = 0; + buf; + h = Array.make 8 0L; + t = Array.make 2 0L; + f = Array.make 2 0L; + } in + let param_bytes = + param_to_bytes + { default_param with digest_length = outlen; key_length = len } in + for i = 0 to 7 do + ctx.h.(i) <- Int64.(iv.(i) lxor By.le64_to_cpu param_bytes (i * 8)) + done ; + if len > 0 + then ( + let block = By.make 128 '\x00' in + blit key off block 0 len ; + unsafe_feed_bytes ctx block 0 128) ; + ctx + + let with_outlen_and_bytes_key outlen key off len = + with_outlen_and_key ~blit:By.blit outlen key off len + + let with_outlen_and_bigstring_key outlen key off len = + with_outlen_and_key ~blit:By.blit_from_bigstring outlen key off len + + let unsafe_get ctx = + let res = By.make default_param.digest_length '\x00' in + increment_counter ctx (Int64.of_int ctx.buflen) ; + set_lastblock ctx ; + By.fill ctx.buf ctx.buflen (128 - ctx.buflen) '\x00' ; + compress ~le64_to_cpu:By.le64_to_cpu ctx ctx.buf 0 ; + for i = 0 to 7 do + By.cpu_to_le64 res (i * 8) ctx.h.(i) + done ; + if ctx.outlen < default_param.digest_length + then By.sub res 0 ctx.outlen + else if ctx.outlen > default_param.digest_length + then + assert false + (* XXX(dinosaure): [ctx] can not be initialized with [outlen > digest_length = max_outlen]. *) + else res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_blake2s.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_blake2s.ml new file mode 100644 index 00000000..d9be997c --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_blake2s.ml @@ -0,0 +1,327 @@ +module By = Digestif_by +module Bi = Digestif_bi + +let failwith fmt = Format.kasprintf failwith fmt + +module Int32 = struct + include Int32 + + let ( lsl ) = Int32.shift_left + let ( lsr ) = Int32.shift_right_logical + let ( asr ) = Int32.shift_right + let ( lor ) = Int32.logor + let ( lxor ) = Int32.logxor + let ( land ) = Int32.logand + let lnot = Int32.lognot + let ( + ) = Int32.add + let rol32 a n = (a lsl n) lor (a lsr (32 - n)) + let ror32 a n = (a lsr n) lor (a lsl (32 - n)) +end + +module Int64 = struct + include Int64 + + let ( land ) = Int64.logand + let ( lsl ) = Int64.shift_left + let ( lsr ) = Int64.shift_right_logical + let ( lor ) = Int64.logor + let ( asr ) = Int64.shift_right + let ( lxor ) = Int64.logxor + let ( + ) = Int64.add + let rol64 a n = (a lsl n) lor (a lsr (64 - n)) + let ror64 a n = (a lsr n) lor (a lsl (64 - n)) +end + +module type S = sig + type ctx + type kind = [ `BLAKE2S ] + + val init : unit -> ctx + val with_outlen_and_bytes_key : int -> By.t -> int -> int -> ctx + val with_outlen_and_bigstring_key : int -> Bi.t -> int -> int -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx + val max_outlen : int +end + +module Unsafe : S = struct + type kind = [ `BLAKE2S ] + + type param = { + digest_length : int; + key_length : int; + fanout : int; + depth : int; + leaf_length : int32; + node_offset : int32; + xof_length : int; + node_depth : int; + inner_length : int; + salt : int array; + personal : int array; + } + + type ctx = { + mutable buflen : int; + outlen : int; + mutable last_node : int; + buf : Bytes.t; + h : int32 array; + t : int32 array; + f : int32 array; + } + + let dup ctx = + { + buflen = ctx.buflen; + outlen = ctx.outlen; + last_node = ctx.last_node; + buf = By.copy ctx.buf; + h = Array.copy ctx.h; + t = Array.copy ctx.t; + f = Array.copy ctx.f; + } + + let param_to_bytes param = + let arr = + [| + param.digest_length land 0xFF; param.key_length land 0xFF; + param.fanout land 0xFF; + param.depth land 0xFF (* store to little-endian *); + Int32.(to_int ((param.leaf_length lsr 0) land 0xFFl)); + Int32.(to_int ((param.leaf_length lsr 8) land 0xFFl)); + Int32.(to_int ((param.leaf_length lsr 16) land 0xFFl)); + Int32.(to_int ((param.leaf_length lsr 24) land 0xFFl)) + (* store to little-endian *); + Int32.(to_int ((param.node_offset lsr 0) land 0xFFl)); + Int32.(to_int ((param.node_offset lsr 8) land 0xFFl)); + Int32.(to_int ((param.node_offset lsr 16) land 0xFFl)); + Int32.(to_int ((param.node_offset lsr 24) land 0xFFl)) + (* store to little-endian *); (param.xof_length lsr 0) land 0xFF; + (param.xof_length lsr 8) land 0xFF; param.node_depth land 0xFF; + param.inner_length land 0xFF; param.salt.(0) land 0xFF; + param.salt.(1) land 0xFF; param.salt.(2) land 0xFF; + param.salt.(3) land 0xFF; param.salt.(4) land 0xFF; + param.salt.(5) land 0xFF; param.salt.(6) land 0xFF; + param.salt.(7) land 0xFF; param.personal.(0) land 0xFF; + param.personal.(1) land 0xFF; param.personal.(2) land 0xFF; + param.personal.(3) land 0xFF; param.personal.(4) land 0xFF; + param.personal.(5) land 0xFF; param.personal.(6) land 0xFF; + param.personal.(7) land 0xFF; + |] in + By.init 32 (fun i -> Char.unsafe_chr arr.(i)) + + let max_outlen = 32 + + let default_param = + { + digest_length = max_outlen; + key_length = 0; + fanout = 1; + depth = 1; + leaf_length = 0l; + node_offset = 0l; + xof_length = 0; + node_depth = 0; + inner_length = 0; + salt = [| 0; 0; 0; 0; 0; 0; 0; 0 |]; + personal = [| 0; 0; 0; 0; 0; 0; 0; 0 |]; + } + + let iv = + [| + 0x6A09E667l; 0xBB67AE85l; 0x3C6EF372l; 0xA54FF53Al; 0x510E527Fl; + 0x9B05688Cl; 0x1F83D9ABl; 0x5BE0CD19l; + |] + + let increment_counter ctx inc = + let open Int32 in + ctx.t.(0) <- ctx.t.(0) + inc ; + ctx.t.(1) <- (ctx.t.(1) + if ctx.t.(0) < inc then 1l else 0l) + + let set_lastnode ctx = ctx.f.(1) <- Int32.minus_one + + let set_lastblock ctx = + if ctx.last_node <> 0 then set_lastnode ctx ; + ctx.f.(0) <- Int32.minus_one + + let init () = + let buf = By.make 64 '\x00' in + let ctx = + { + buflen = 0; + outlen = default_param.digest_length; + last_node = 0; + buf; + h = Array.make 8 0l; + t = Array.make 2 0l; + f = Array.make 2 0l; + } in + let param_bytes = param_to_bytes default_param in + for i = 0 to 7 do + ctx.h.(i) <- Int32.(iv.(i) lxor By.le32_to_cpu param_bytes (i * 4)) + done ; + ctx + + let sigma = + [| + [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 |]; + [| 14; 10; 4; 8; 9; 15; 13; 6; 1; 12; 0; 2; 11; 7; 5; 3 |]; + [| 11; 8; 12; 0; 5; 2; 15; 13; 10; 14; 3; 6; 7; 1; 9; 4 |]; + [| 7; 9; 3; 1; 13; 12; 11; 14; 2; 6; 5; 10; 4; 0; 15; 8 |]; + [| 9; 0; 5; 7; 2; 4; 10; 15; 14; 1; 11; 12; 6; 8; 3; 13 |]; + [| 2; 12; 6; 10; 0; 11; 8; 3; 4; 13; 7; 5; 15; 14; 1; 9 |]; + [| 12; 5; 1; 15; 14; 13; 4; 10; 0; 7; 6; 3; 9; 2; 8; 11 |]; + [| 13; 11; 7; 14; 12; 1; 3; 9; 5; 0; 15; 4; 8; 6; 2; 10 |]; + [| 6; 15; 14; 9; 11; 3; 0; 8; 12; 2; 13; 7; 1; 4; 10; 5 |]; + [| 10; 2; 8; 4; 7; 6; 1; 5; 15; 11; 9; 14; 3; 12; 13; 0 |]; + |] + + let compress : + type a. le32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = + fun ~le32_to_cpu ctx block off -> + let v = Array.make 16 0l in + let m = Array.make 16 0l in + let g r i a_idx b_idx c_idx d_idx = + let ( ++ ) = ( + ) in + let open Int32 in + v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 0)) ; + v.(d_idx) <- ror32 (v.(d_idx) lxor v.(a_idx)) 16 ; + v.(c_idx) <- v.(c_idx) + v.(d_idx) ; + v.(b_idx) <- ror32 (v.(b_idx) lxor v.(c_idx)) 12 ; + v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 1)) ; + v.(d_idx) <- ror32 (v.(d_idx) lxor v.(a_idx)) 8 ; + v.(c_idx) <- v.(c_idx) + v.(d_idx) ; + v.(b_idx) <- ror32 (v.(b_idx) lxor v.(c_idx)) 7 in + let r r = + g r 0 0 4 8 12 ; + g r 1 1 5 9 13 ; + g r 2 2 6 10 14 ; + g r 3 3 7 11 15 ; + g r 4 0 5 10 15 ; + g r 5 1 6 11 12 ; + g r 6 2 7 8 13 ; + g r 7 3 4 9 14 in + for i = 0 to 15 do + m.(i) <- le32_to_cpu block (off + (i * 4)) + done ; + for i = 0 to 7 do + v.(i) <- ctx.h.(i) + done ; + v.(8) <- iv.(0) ; + v.(9) <- iv.(1) ; + v.(10) <- iv.(2) ; + v.(11) <- iv.(3) ; + v.(12) <- Int32.(iv.(4) lxor ctx.t.(0)) ; + v.(13) <- Int32.(iv.(5) lxor ctx.t.(1)) ; + v.(14) <- Int32.(iv.(6) lxor ctx.f.(0)) ; + v.(15) <- Int32.(iv.(7) lxor ctx.f.(1)) ; + r 0 ; + r 1 ; + r 2 ; + r 3 ; + r 4 ; + r 5 ; + r 6 ; + r 7 ; + r 8 ; + r 9 ; + let ( ++ ) = ( + ) in + for i = 0 to 7 do + ctx.h.(i) <- Int32.(ctx.h.(i) lxor v.(i) lxor v.(i ++ 8)) + done ; + () + + let feed : + type a. + blit:(a -> int -> By.t -> int -> int -> unit) -> + le32_to_cpu:(a -> int -> int32) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~blit ~le32_to_cpu ctx buf off len -> + let in_off = ref off in + let in_len = ref len in + if !in_len > 0 + then ( + let left = ctx.buflen in + let fill = 64 - left in + if !in_len > fill + then ( + ctx.buflen <- 0 ; + blit buf !in_off ctx.buf left fill ; + increment_counter ctx 64l ; + compress ~le32_to_cpu:By.le32_to_cpu ctx ctx.buf 0 ; + in_off := !in_off + fill ; + in_len := !in_len - fill ; + while !in_len > 64 do + increment_counter ctx 64l ; + compress ~le32_to_cpu ctx buf !in_off ; + in_off := !in_off + 64 ; + in_len := !in_len - 64 + done) ; + blit buf !in_off ctx.buf ctx.buflen !in_len ; + ctx.buflen <- ctx.buflen + !in_len) ; + () + + let unsafe_feed_bytes = feed ~blit:By.blit ~le32_to_cpu:By.le32_to_cpu + + let unsafe_feed_bigstring = + feed ~blit:By.blit_from_bigstring ~le32_to_cpu:Bi.le32_to_cpu + + let with_outlen_and_key ~blit outlen key off len = + if outlen > max_outlen + then + failwith "out length can not be upper than %d (out length: %d)" max_outlen + outlen ; + let buf = By.make 64 '\x00' in + let ctx = + { + buflen = 0; + outlen; + last_node = 0; + buf; + h = Array.make 8 0l; + t = Array.make 2 0l; + f = Array.make 2 0l; + } in + let param_bytes = + param_to_bytes + { default_param with key_length = len; digest_length = outlen } in + for i = 0 to 7 do + ctx.h.(i) <- Int32.(iv.(i) lxor By.le32_to_cpu param_bytes (i * 4)) + done ; + if len > 0 + then ( + let block = By.make 64 '\x00' in + blit key off block 0 len ; + unsafe_feed_bytes ctx block 0 64) ; + ctx + + let with_outlen_and_bytes_key outlen key off len = + with_outlen_and_key ~blit:By.blit outlen key off len + + let with_outlen_and_bigstring_key outlen key off len = + with_outlen_and_key ~blit:By.blit_from_bigstring outlen key off len + + let unsafe_get ctx = + let res = By.make default_param.digest_length '\x00' in + increment_counter ctx (Int32.of_int ctx.buflen) ; + set_lastblock ctx ; + By.fill ctx.buf ctx.buflen (64 - ctx.buflen) '\x00' ; + compress ~le32_to_cpu:By.le32_to_cpu ctx ctx.buf 0 ; + for i = 0 to 7 do + By.cpu_to_le32 res (i * 4) ctx.h.(i) + done ; + if ctx.outlen < default_param.digest_length + then By.sub res 0 ctx.outlen + else if ctx.outlen > default_param.digest_length + then + assert false + (* XXX(dinosaure): [ctx] can not be initialized with [outlen > digest_length = max_outlen]. *) + else res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_keccak_256.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_keccak_256.ml new file mode 100644 index 00000000..1a0bce49 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_keccak_256.ml @@ -0,0 +1,31 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `SHA3_256 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA3_256 ] + + module U = Baijiu_sha3.Unsafe (struct + let padding = Baijiu_sha3.keccak_padding + end) + + open U + + type nonrec ctx = ctx + + let init () = U.init 32 + let unsafe_get = unsafe_get + let dup = dup + let unsafe_feed_bytes = unsafe_feed_bytes + let unsafe_feed_bigstring = unsafe_feed_bigstring +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_md5.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_md5.ml new file mode 100644 index 00000000..e16290d6 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_md5.ml @@ -0,0 +1,189 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module Int32 = struct + include Int32 + + let ( lsl ) = Int32.shift_left + let ( lsr ) = Int32.shift_right_logical + let ( asr ) = Int32.shift_right + let ( lor ) = Int32.logor + let ( lxor ) = Int32.logxor + let ( land ) = Int32.logand + let lnot = Int32.lognot + let ( + ) = Int32.add + let rol32 a n = (a lsl n) lor (a lsr (32 - n)) + let ror32 a n = (a lsr n) lor (a lsl (32 - n)) +end + +module Int64 = struct + include Int64 + + let ( land ) = Int64.logand + let ( lsl ) = Int64.shift_left +end + +module type S = sig + type kind = [ `MD5 ] + type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `MD5 ] + type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } + + let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } + + let init () = + let b = By.make 64 '\x00' in + { + size = 0L; + b; + h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l |]; + } + + let f1 x y z = Int32.(z lxor (x land (y lxor z))) + let f2 x y z = f1 z x y + let f3 x y z = Int32.(x lxor y lxor z) + let f4 x y z = Int32.(y lxor (x lor lnot z)) + + let md5_do_chunk : + type a. le32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = + fun ~le32_to_cpu ctx buf off -> + let a, b, c, d = + (ref ctx.h.(0), ref ctx.h.(1), ref ctx.h.(2), ref ctx.h.(3)) in + let w = Array.make 16 0l in + for i = 0 to 15 do + w.(i) <- le32_to_cpu buf (off + (i * 4)) + done ; + let round f a b c d i k s = + let open Int32 in + a := !a + f !b !c !d + w.(i) + k ; + a := rol32 !a s ; + a := !a + !b in + round f1 a b c d 0 0xd76aa478l 7 ; + round f1 d a b c 1 0xe8c7b756l 12 ; + round f1 c d a b 2 0x242070dbl 17 ; + round f1 b c d a 3 0xc1bdceeel 22 ; + round f1 a b c d 4 0xf57c0fafl 7 ; + round f1 d a b c 5 0x4787c62al 12 ; + round f1 c d a b 6 0xa8304613l 17 ; + round f1 b c d a 7 0xfd469501l 22 ; + round f1 a b c d 8 0x698098d8l 7 ; + round f1 d a b c 9 0x8b44f7afl 12 ; + round f1 c d a b 10 0xffff5bb1l 17 ; + round f1 b c d a 11 0x895cd7bel 22 ; + round f1 a b c d 12 0x6b901122l 7 ; + round f1 d a b c 13 0xfd987193l 12 ; + round f1 c d a b 14 0xa679438el 17 ; + round f1 b c d a 15 0x49b40821l 22 ; + round f2 a b c d 1 0xf61e2562l 5 ; + round f2 d a b c 6 0xc040b340l 9 ; + round f2 c d a b 11 0x265e5a51l 14 ; + round f2 b c d a 0 0xe9b6c7aal 20 ; + round f2 a b c d 5 0xd62f105dl 5 ; + round f2 d a b c 10 0x02441453l 9 ; + round f2 c d a b 15 0xd8a1e681l 14 ; + round f2 b c d a 4 0xe7d3fbc8l 20 ; + round f2 a b c d 9 0x21e1cde6l 5 ; + round f2 d a b c 14 0xc33707d6l 9 ; + round f2 c d a b 3 0xf4d50d87l 14 ; + round f2 b c d a 8 0x455a14edl 20 ; + round f2 a b c d 13 0xa9e3e905l 5 ; + round f2 d a b c 2 0xfcefa3f8l 9 ; + round f2 c d a b 7 0x676f02d9l 14 ; + round f2 b c d a 12 0x8d2a4c8al 20 ; + round f3 a b c d 5 0xfffa3942l 4 ; + round f3 d a b c 8 0x8771f681l 11 ; + round f3 c d a b 11 0x6d9d6122l 16 ; + round f3 b c d a 14 0xfde5380cl 23 ; + round f3 a b c d 1 0xa4beea44l 4 ; + round f3 d a b c 4 0x4bdecfa9l 11 ; + round f3 c d a b 7 0xf6bb4b60l 16 ; + round f3 b c d a 10 0xbebfbc70l 23 ; + round f3 a b c d 13 0x289b7ec6l 4 ; + round f3 d a b c 0 0xeaa127fal 11 ; + round f3 c d a b 3 0xd4ef3085l 16 ; + round f3 b c d a 6 0x04881d05l 23 ; + round f3 a b c d 9 0xd9d4d039l 4 ; + round f3 d a b c 12 0xe6db99e5l 11 ; + round f3 c d a b 15 0x1fa27cf8l 16 ; + round f3 b c d a 2 0xc4ac5665l 23 ; + round f4 a b c d 0 0xf4292244l 6 ; + round f4 d a b c 7 0x432aff97l 10 ; + round f4 c d a b 14 0xab9423a7l 15 ; + round f4 b c d a 5 0xfc93a039l 21 ; + round f4 a b c d 12 0x655b59c3l 6 ; + round f4 d a b c 3 0x8f0ccc92l 10 ; + round f4 c d a b 10 0xffeff47dl 15 ; + round f4 b c d a 1 0x85845dd1l 21 ; + round f4 a b c d 8 0x6fa87e4fl 6 ; + round f4 d a b c 15 0xfe2ce6e0l 10 ; + round f4 c d a b 6 0xa3014314l 15 ; + round f4 b c d a 13 0x4e0811a1l 21 ; + round f4 a b c d 4 0xf7537e82l 6 ; + round f4 d a b c 11 0xbd3af235l 10 ; + round f4 c d a b 2 0x2ad7d2bbl 15 ; + round f4 b c d a 9 0xeb86d391l 21 ; + let open Int32 in + ctx.h.(0) <- ctx.h.(0) + !a ; + ctx.h.(1) <- ctx.h.(1) + !b ; + ctx.h.(2) <- ctx.h.(2) + !c ; + ctx.h.(3) <- ctx.h.(3) + !d ; + () + + let feed : + type a. + blit:(a -> int -> By.t -> int -> int -> unit) -> + le32_to_cpu:(a -> int -> int32) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~blit ~le32_to_cpu ctx buf off len -> + let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in + let len = ref len in + let off = ref off in + let to_fill = 64 - !idx in + ctx.size <- Int64.add ctx.size (Int64.of_int !len) ; + if !idx <> 0 && !len >= to_fill + then ( + blit buf !off ctx.b !idx to_fill ; + md5_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; + len := !len - to_fill ; + off := !off + to_fill ; + idx := 0) ; + while !len >= 64 do + md5_do_chunk ~le32_to_cpu ctx buf !off ; + len := !len - 64 ; + off := !off + 64 + done ; + if !len <> 0 then blit buf !off ctx.b !idx !len ; + () + + let unsafe_feed_bytes = feed ~blit:By.blit ~le32_to_cpu:By.le32_to_cpu + + let unsafe_feed_bigstring = + feed ~blit:By.blit_from_bigstring ~le32_to_cpu:Bi.le32_to_cpu + + let unsafe_get ctx = + let index = Int64.(to_int (ctx.size land 0x3FL)) in + let padlen = if index < 56 then 56 - index else 64 + 56 - index in + let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in + let bits = By.create 8 in + By.cpu_to_le64 bits 0 Int64.(ctx.size lsl 3) ; + unsafe_feed_bytes ctx padding 0 padlen ; + unsafe_feed_bytes ctx bits 0 8 ; + let res = By.create (4 * 4) in + for i = 0 to 3 do + By.cpu_to_le32 res (i * 4) ctx.h.(i) + done ; + res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_rmd160.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_rmd160.ml new file mode 100644 index 00000000..88a86b9b --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_rmd160.ml @@ -0,0 +1,371 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `RMD160 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Int32 = struct + include Int32 + + let ( lsl ) = Int32.shift_left + let ( lsr ) = Int32.shift_right_logical + let ( asr ) = Int32.shift_right + let ( lor ) = Int32.logor + let ( lxor ) = Int32.logxor + let ( land ) = Int32.logand + let lnot = Int32.lognot + let ( + ) = Int32.add + let rol32 a n = (a lsl n) lor (a lsr (32 - n)) + let ror32 a n = (a lsr n) lor (a lsl (32 - n)) +end + +module Int64 = struct + include Int64 + + let ( land ) = Int64.logand + let ( lsl ) = Int64.shift_left +end + +module Unsafe : S = struct + type kind = [ `RMD160 ] + type ctx = { s : int32 array; mutable n : int; h : int32 array; b : Bytes.t } + + let dup ctx = + { s = Array.copy ctx.s; n = ctx.n; h = Array.copy ctx.h; b = By.copy ctx.b } + + let init () = + let b = By.make 64 '\x00' in + { + s = [| 0l; 0l |]; + n = 0; + b; + h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l; 0xc3d2e1f0l |]; + } + + let f x y z = Int32.(x lxor y lxor z) + let g x y z = Int32.(x land y lor (lnot x land z)) + let h x y z = Int32.(x lor lnot y lxor z) + let i x y z = Int32.(x land z lor (y land lnot z)) + let j x y z = Int32.(x lxor (y lor lnot z)) + + let ff a b c d e x s = + let open Int32 in + a := !a + f !b !c !d + x ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let gg a b c d e x s = + let open Int32 in + a := !a + g !b !c !d + x + 0x5a827999l ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let hh a b c d e x s = + let open Int32 in + a := !a + h !b !c !d + x + 0x6ed9eba1l ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let ii a b c d e x s = + let open Int32 in + a := !a + i !b !c !d + x + 0x8f1bbcdcl ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let jj a b c d e x s = + let open Int32 in + a := !a + j !b !c !d + x + 0xa953fd4el ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let fff a b c d e x s = + let open Int32 in + a := !a + f !b !c !d + x ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let ggg a b c d e x s = + let open Int32 in + a := !a + g !b !c !d + x + 0x7a6d76e9l ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let hhh a b c d e x s = + let open Int32 in + a := !a + h !b !c !d + x + 0x6d703ef3l ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let iii a b c d e x s = + let open Int32 in + a := !a + i !b !c !d + x + 0x5c4dd124l ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let jjj a b c d e x s = + let open Int32 in + a := !a + j !b !c !d + x + 0x50a28be6l ; + a := rol32 !a s + !e ; + c := rol32 !c 10 + + let rmd160_do_chunk : + type a. le32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = + fun ~le32_to_cpu ctx buff off -> + let aa, bb, cc, dd, ee, aaa, bbb, ccc, ddd, eee = + ( ref ctx.h.(0), + ref ctx.h.(1), + ref ctx.h.(2), + ref ctx.h.(3), + ref ctx.h.(4), + ref ctx.h.(0), + ref ctx.h.(1), + ref ctx.h.(2), + ref ctx.h.(3), + ref ctx.h.(4) ) in + let w = Array.make 16 0l in + for i = 0 to 15 do + w.(i) <- le32_to_cpu buff (off + (i * 4)) + done ; + ff aa bb cc dd ee w.(0) 11 ; + ff ee aa bb cc dd w.(1) 14 ; + ff dd ee aa bb cc w.(2) 15 ; + ff cc dd ee aa bb w.(3) 12 ; + ff bb cc dd ee aa w.(4) 5 ; + ff aa bb cc dd ee w.(5) 8 ; + ff ee aa bb cc dd w.(6) 7 ; + ff dd ee aa bb cc w.(7) 9 ; + ff cc dd ee aa bb w.(8) 11 ; + ff bb cc dd ee aa w.(9) 13 ; + ff aa bb cc dd ee w.(10) 14 ; + ff ee aa bb cc dd w.(11) 15 ; + ff dd ee aa bb cc w.(12) 6 ; + ff cc dd ee aa bb w.(13) 7 ; + ff bb cc dd ee aa w.(14) 9 ; + ff aa bb cc dd ee w.(15) 8 ; + gg ee aa bb cc dd w.(7) 7 ; + gg dd ee aa bb cc w.(4) 6 ; + gg cc dd ee aa bb w.(13) 8 ; + gg bb cc dd ee aa w.(1) 13 ; + gg aa bb cc dd ee w.(10) 11 ; + gg ee aa bb cc dd w.(6) 9 ; + gg dd ee aa bb cc w.(15) 7 ; + gg cc dd ee aa bb w.(3) 15 ; + gg bb cc dd ee aa w.(12) 7 ; + gg aa bb cc dd ee w.(0) 12 ; + gg ee aa bb cc dd w.(9) 15 ; + gg dd ee aa bb cc w.(5) 9 ; + gg cc dd ee aa bb w.(2) 11 ; + gg bb cc dd ee aa w.(14) 7 ; + gg aa bb cc dd ee w.(11) 13 ; + gg ee aa bb cc dd w.(8) 12 ; + hh dd ee aa bb cc w.(3) 11 ; + hh cc dd ee aa bb w.(10) 13 ; + hh bb cc dd ee aa w.(14) 6 ; + hh aa bb cc dd ee w.(4) 7 ; + hh ee aa bb cc dd w.(9) 14 ; + hh dd ee aa bb cc w.(15) 9 ; + hh cc dd ee aa bb w.(8) 13 ; + hh bb cc dd ee aa w.(1) 15 ; + hh aa bb cc dd ee w.(2) 14 ; + hh ee aa bb cc dd w.(7) 8 ; + hh dd ee aa bb cc w.(0) 13 ; + hh cc dd ee aa bb w.(6) 6 ; + hh bb cc dd ee aa w.(13) 5 ; + hh aa bb cc dd ee w.(11) 12 ; + hh ee aa bb cc dd w.(5) 7 ; + hh dd ee aa bb cc w.(12) 5 ; + ii cc dd ee aa bb w.(1) 11 ; + ii bb cc dd ee aa w.(9) 12 ; + ii aa bb cc dd ee w.(11) 14 ; + ii ee aa bb cc dd w.(10) 15 ; + ii dd ee aa bb cc w.(0) 14 ; + ii cc dd ee aa bb w.(8) 15 ; + ii bb cc dd ee aa w.(12) 9 ; + ii aa bb cc dd ee w.(4) 8 ; + ii ee aa bb cc dd w.(13) 9 ; + ii dd ee aa bb cc w.(3) 14 ; + ii cc dd ee aa bb w.(7) 5 ; + ii bb cc dd ee aa w.(15) 6 ; + ii aa bb cc dd ee w.(14) 8 ; + ii ee aa bb cc dd w.(5) 6 ; + ii dd ee aa bb cc w.(6) 5 ; + ii cc dd ee aa bb w.(2) 12 ; + jj bb cc dd ee aa w.(4) 9 ; + jj aa bb cc dd ee w.(0) 15 ; + jj ee aa bb cc dd w.(5) 5 ; + jj dd ee aa bb cc w.(9) 11 ; + jj cc dd ee aa bb w.(7) 6 ; + jj bb cc dd ee aa w.(12) 8 ; + jj aa bb cc dd ee w.(2) 13 ; + jj ee aa bb cc dd w.(10) 12 ; + jj dd ee aa bb cc w.(14) 5 ; + jj cc dd ee aa bb w.(1) 12 ; + jj bb cc dd ee aa w.(3) 13 ; + jj aa bb cc dd ee w.(8) 14 ; + jj ee aa bb cc dd w.(11) 11 ; + jj dd ee aa bb cc w.(6) 8 ; + jj cc dd ee aa bb w.(15) 5 ; + jj bb cc dd ee aa w.(13) 6 ; + jjj aaa bbb ccc ddd eee w.(5) 8 ; + jjj eee aaa bbb ccc ddd w.(14) 9 ; + jjj ddd eee aaa bbb ccc w.(7) 9 ; + jjj ccc ddd eee aaa bbb w.(0) 11 ; + jjj bbb ccc ddd eee aaa w.(9) 13 ; + jjj aaa bbb ccc ddd eee w.(2) 15 ; + jjj eee aaa bbb ccc ddd w.(11) 15 ; + jjj ddd eee aaa bbb ccc w.(4) 5 ; + jjj ccc ddd eee aaa bbb w.(13) 7 ; + jjj bbb ccc ddd eee aaa w.(6) 7 ; + jjj aaa bbb ccc ddd eee w.(15) 8 ; + jjj eee aaa bbb ccc ddd w.(8) 11 ; + jjj ddd eee aaa bbb ccc w.(1) 14 ; + jjj ccc ddd eee aaa bbb w.(10) 14 ; + jjj bbb ccc ddd eee aaa w.(3) 12 ; + jjj aaa bbb ccc ddd eee w.(12) 6 ; + iii eee aaa bbb ccc ddd w.(6) 9 ; + iii ddd eee aaa bbb ccc w.(11) 13 ; + iii ccc ddd eee aaa bbb w.(3) 15 ; + iii bbb ccc ddd eee aaa w.(7) 7 ; + iii aaa bbb ccc ddd eee w.(0) 12 ; + iii eee aaa bbb ccc ddd w.(13) 8 ; + iii ddd eee aaa bbb ccc w.(5) 9 ; + iii ccc ddd eee aaa bbb w.(10) 11 ; + iii bbb ccc ddd eee aaa w.(14) 7 ; + iii aaa bbb ccc ddd eee w.(15) 7 ; + iii eee aaa bbb ccc ddd w.(8) 12 ; + iii ddd eee aaa bbb ccc w.(12) 7 ; + iii ccc ddd eee aaa bbb w.(4) 6 ; + iii bbb ccc ddd eee aaa w.(9) 15 ; + iii aaa bbb ccc ddd eee w.(1) 13 ; + iii eee aaa bbb ccc ddd w.(2) 11 ; + hhh ddd eee aaa bbb ccc w.(15) 9 ; + hhh ccc ddd eee aaa bbb w.(5) 7 ; + hhh bbb ccc ddd eee aaa w.(1) 15 ; + hhh aaa bbb ccc ddd eee w.(3) 11 ; + hhh eee aaa bbb ccc ddd w.(7) 8 ; + hhh ddd eee aaa bbb ccc w.(14) 6 ; + hhh ccc ddd eee aaa bbb w.(6) 6 ; + hhh bbb ccc ddd eee aaa w.(9) 14 ; + hhh aaa bbb ccc ddd eee w.(11) 12 ; + hhh eee aaa bbb ccc ddd w.(8) 13 ; + hhh ddd eee aaa bbb ccc w.(12) 5 ; + hhh ccc ddd eee aaa bbb w.(2) 14 ; + hhh bbb ccc ddd eee aaa w.(10) 13 ; + hhh aaa bbb ccc ddd eee w.(0) 13 ; + hhh eee aaa bbb ccc ddd w.(4) 7 ; + hhh ddd eee aaa bbb ccc w.(13) 5 ; + ggg ccc ddd eee aaa bbb w.(8) 15 ; + ggg bbb ccc ddd eee aaa w.(6) 5 ; + ggg aaa bbb ccc ddd eee w.(4) 8 ; + ggg eee aaa bbb ccc ddd w.(1) 11 ; + ggg ddd eee aaa bbb ccc w.(3) 14 ; + ggg ccc ddd eee aaa bbb w.(11) 14 ; + ggg bbb ccc ddd eee aaa w.(15) 6 ; + ggg aaa bbb ccc ddd eee w.(0) 14 ; + ggg eee aaa bbb ccc ddd w.(5) 6 ; + ggg ddd eee aaa bbb ccc w.(12) 9 ; + ggg ccc ddd eee aaa bbb w.(2) 12 ; + ggg bbb ccc ddd eee aaa w.(13) 9 ; + ggg aaa bbb ccc ddd eee w.(9) 12 ; + ggg eee aaa bbb ccc ddd w.(7) 5 ; + ggg ddd eee aaa bbb ccc w.(10) 15 ; + ggg ccc ddd eee aaa bbb w.(14) 8 ; + fff bbb ccc ddd eee aaa w.(12) 8 ; + fff aaa bbb ccc ddd eee w.(15) 5 ; + fff eee aaa bbb ccc ddd w.(10) 12 ; + fff ddd eee aaa bbb ccc w.(4) 9 ; + fff ccc ddd eee aaa bbb w.(1) 12 ; + fff bbb ccc ddd eee aaa w.(5) 5 ; + fff aaa bbb ccc ddd eee w.(8) 14 ; + fff eee aaa bbb ccc ddd w.(7) 6 ; + fff ddd eee aaa bbb ccc w.(6) 8 ; + fff ccc ddd eee aaa bbb w.(2) 13 ; + fff bbb ccc ddd eee aaa w.(13) 6 ; + fff aaa bbb ccc ddd eee w.(14) 5 ; + fff eee aaa bbb ccc ddd w.(0) 15 ; + fff ddd eee aaa bbb ccc w.(3) 13 ; + fff ccc ddd eee aaa bbb w.(9) 11 ; + fff bbb ccc ddd eee aaa w.(11) 11 ; + let open Int32 in + ddd := !ddd + !cc + ctx.h.(1) ; + (* final result for h[0]. *) + ctx.h.(1) <- ctx.h.(2) + !dd + !eee ; + ctx.h.(2) <- ctx.h.(3) + !ee + !aaa ; + ctx.h.(3) <- ctx.h.(4) + !aa + !bbb ; + ctx.h.(4) <- ctx.h.(0) + !bb + !ccc ; + ctx.h.(0) <- !ddd ; + () + + exception Leave + + let feed : + type a. + le32_to_cpu:(a -> int -> int32) -> + blit:(a -> int -> By.t -> int -> int -> unit) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~le32_to_cpu ~blit ctx buf off len -> + let t = ref ctx.s.(0) in + let off = ref off in + let len = ref len in + ctx.s.(0) <- Int32.add !t (Int32.of_int (!len lsl 3)) ; + if ctx.s.(0) < !t then ctx.s.(1) <- Int32.(ctx.s.(1) + 1l) ; + ctx.s.(1) <- Int32.add ctx.s.(1) (Int32.of_int (!len lsr 29)) ; + try + if ctx.n <> 0 + then ( + let t = 64 - ctx.n in + if !len < t + then ( + blit buf !off ctx.b ctx.n !len ; + ctx.n <- ctx.n + !len ; + raise Leave) ; + blit buf !off ctx.b ctx.n t ; + rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; + off := !off + t ; + len := !len - t) ; + while !len >= 64 do + rmd160_do_chunk ~le32_to_cpu ctx buf !off ; + off := !off + 64 ; + len := !len - 64 + done ; + blit buf !off ctx.b 0 !len ; + ctx.n <- !len + with Leave -> () + + let unsafe_feed_bytes ctx buf off len = + feed ~blit:By.blit ~le32_to_cpu:By.le32_to_cpu ctx buf off len + + let unsafe_feed_bigstring ctx buf off len = + feed ~blit:By.blit_from_bigstring ~le32_to_cpu:Bi.le32_to_cpu ctx buf off + len + + let unsafe_get ctx = + let i = ref (ctx.n + 1) in + let res = By.create (5 * 4) in + By.set ctx.b ctx.n '\x80' ; + if !i > 56 + then ( + By.fill ctx.b !i (64 - !i) '\x00' ; + rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; + i := 0) ; + By.fill ctx.b !i (56 - !i) '\x00' ; + By.cpu_to_le32 ctx.b 56 ctx.s.(0) ; + By.cpu_to_le32 ctx.b 60 ctx.s.(1) ; + rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; + for i = 0 to 4 do + By.cpu_to_le32 res (i * 4) ctx.h.(i) + done ; + res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha1.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha1.ml new file mode 100644 index 00000000..8c12bfa1 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha1.ml @@ -0,0 +1,221 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module Int32 = struct + include Int32 + + let ( lsl ) = Int32.shift_left + let ( lsr ) = Int32.shift_right_logical + let ( asr ) = Int32.shift_right + let ( lor ) = Int32.logor + let ( lxor ) = Int32.logxor + let ( land ) = Int32.logand + let ( + ) = Int32.add + let rol32 a n = (a lsl n) lor (a lsr (32 - n)) +end + +module Int64 = struct + include Int64 + + let ( land ) = Int64.logand + let ( lsl ) = Int64.shift_left +end + +module type S = sig + type ctx + type kind = [ `SHA1 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA1 ] + type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } + + let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } + + let init () = + let b = By.make 64 '\x00' in + { + size = 0L; + b; + h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l; 0xc3d2e1f0l |]; + } + + let f1 x y z = Int32.(z lxor (x land (y lxor z))) + let f2 x y z = Int32.(x lxor y lxor z) + let f3 x y z = Int32.((x land y) + (z land (x lxor y))) + let f4 = f2 + let k1 = 0x5a827999l + let k2 = 0x6ed9eba1l + let k3 = 0x8f1bbcdcl + let k4 = 0xca62c1d6l + + let sha1_do_chunk : + type a. be32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = + fun ~be32_to_cpu ctx buf off -> + let a = ref ctx.h.(0) in + let b = ref ctx.h.(1) in + let c = ref ctx.h.(2) in + let d = ref ctx.h.(3) in + let e = ref ctx.h.(4) in + let w = Array.make 16 0l in + let m i = + let ( && ) a b = a land b in + let ( -- ) a b = a - b in + let v = + Int32.( + rol32 + (w.(i && 0x0F) + lxor w.((i -- 14) && 0x0F) + lxor w.((i -- 8) && 0x0F) + lxor w.((i -- 3) && 0x0F)) + 1) in + w.(i land 0x0F) <- v ; + w.(i land 0x0F) in + let round a b c d e f k w = + (e := Int32.(!e + rol32 !a 5 + f !b !c !d + k + w)) ; + b := Int32.(rol32 !b 30) in + for i = 0 to 15 do + w.(i) <- be32_to_cpu buf (off + (i * 4)) + done ; + round a b c d e f1 k1 w.(0) ; + round e a b c d f1 k1 w.(1) ; + round d e a b c f1 k1 w.(2) ; + round c d e a b f1 k1 w.(3) ; + round b c d e a f1 k1 w.(4) ; + round a b c d e f1 k1 w.(5) ; + round e a b c d f1 k1 w.(6) ; + round d e a b c f1 k1 w.(7) ; + round c d e a b f1 k1 w.(8) ; + round b c d e a f1 k1 w.(9) ; + round a b c d e f1 k1 w.(10) ; + round e a b c d f1 k1 w.(11) ; + round d e a b c f1 k1 w.(12) ; + round c d e a b f1 k1 w.(13) ; + round b c d e a f1 k1 w.(14) ; + round a b c d e f1 k1 w.(15) ; + round e a b c d f1 k1 (m 16) ; + round d e a b c f1 k1 (m 17) ; + round c d e a b f1 k1 (m 18) ; + round b c d e a f1 k1 (m 19) ; + round a b c d e f2 k2 (m 20) ; + round e a b c d f2 k2 (m 21) ; + round d e a b c f2 k2 (m 22) ; + round c d e a b f2 k2 (m 23) ; + round b c d e a f2 k2 (m 24) ; + round a b c d e f2 k2 (m 25) ; + round e a b c d f2 k2 (m 26) ; + round d e a b c f2 k2 (m 27) ; + round c d e a b f2 k2 (m 28) ; + round b c d e a f2 k2 (m 29) ; + round a b c d e f2 k2 (m 30) ; + round e a b c d f2 k2 (m 31) ; + round d e a b c f2 k2 (m 32) ; + round c d e a b f2 k2 (m 33) ; + round b c d e a f2 k2 (m 34) ; + round a b c d e f2 k2 (m 35) ; + round e a b c d f2 k2 (m 36) ; + round d e a b c f2 k2 (m 37) ; + round c d e a b f2 k2 (m 38) ; + round b c d e a f2 k2 (m 39) ; + round a b c d e f3 k3 (m 40) ; + round e a b c d f3 k3 (m 41) ; + round d e a b c f3 k3 (m 42) ; + round c d e a b f3 k3 (m 43) ; + round b c d e a f3 k3 (m 44) ; + round a b c d e f3 k3 (m 45) ; + round e a b c d f3 k3 (m 46) ; + round d e a b c f3 k3 (m 47) ; + round c d e a b f3 k3 (m 48) ; + round b c d e a f3 k3 (m 49) ; + round a b c d e f3 k3 (m 50) ; + round e a b c d f3 k3 (m 51) ; + round d e a b c f3 k3 (m 52) ; + round c d e a b f3 k3 (m 53) ; + round b c d e a f3 k3 (m 54) ; + round a b c d e f3 k3 (m 55) ; + round e a b c d f3 k3 (m 56) ; + round d e a b c f3 k3 (m 57) ; + round c d e a b f3 k3 (m 58) ; + round b c d e a f3 k3 (m 59) ; + round a b c d e f4 k4 (m 60) ; + round e a b c d f4 k4 (m 61) ; + round d e a b c f4 k4 (m 62) ; + round c d e a b f4 k4 (m 63) ; + round b c d e a f4 k4 (m 64) ; + round a b c d e f4 k4 (m 65) ; + round e a b c d f4 k4 (m 66) ; + round d e a b c f4 k4 (m 67) ; + round c d e a b f4 k4 (m 68) ; + round b c d e a f4 k4 (m 69) ; + round a b c d e f4 k4 (m 70) ; + round e a b c d f4 k4 (m 71) ; + round d e a b c f4 k4 (m 72) ; + round c d e a b f4 k4 (m 73) ; + round b c d e a f4 k4 (m 74) ; + round a b c d e f4 k4 (m 75) ; + round e a b c d f4 k4 (m 76) ; + round d e a b c f4 k4 (m 77) ; + round c d e a b f4 k4 (m 78) ; + round b c d e a f4 k4 (m 79) ; + ctx.h.(0) <- Int32.add ctx.h.(0) !a ; + ctx.h.(1) <- Int32.add ctx.h.(1) !b ; + ctx.h.(2) <- Int32.add ctx.h.(2) !c ; + ctx.h.(3) <- Int32.add ctx.h.(3) !d ; + ctx.h.(4) <- Int32.add ctx.h.(4) !e ; + () + + let feed : + type a. + blit:(a -> int -> By.t -> int -> int -> unit) -> + be32_to_cpu:(a -> int -> int32) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~blit ~be32_to_cpu ctx buf off len -> + let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in + let len = ref len in + let off = ref off in + let to_fill = 64 - !idx in + ctx.size <- Int64.add ctx.size (Int64.of_int !len) ; + if !idx <> 0 && !len >= to_fill + then ( + blit buf !off ctx.b !idx to_fill ; + sha1_do_chunk ~be32_to_cpu:By.be32_to_cpu ctx ctx.b 0 ; + len := !len - to_fill ; + off := !off + to_fill ; + idx := 0) ; + while !len >= 64 do + sha1_do_chunk ~be32_to_cpu ctx buf !off ; + len := !len - 64 ; + off := !off + 64 + done ; + if !len <> 0 then blit buf !off ctx.b !idx !len ; + () + + let unsafe_feed_bytes = feed ~blit:By.blit ~be32_to_cpu:By.be32_to_cpu + + let unsafe_feed_bigstring = + feed ~blit:By.blit_from_bigstring ~be32_to_cpu:Bi.be32_to_cpu + + let unsafe_get ctx = + let index = Int64.(to_int (ctx.size land 0x3FL)) in + let padlen = if index < 56 then 56 - index else 64 + 56 - index in + let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in + let bits = By.create 8 in + By.cpu_to_be64 bits 0 Int64.(ctx.size lsl 3) ; + unsafe_feed_bytes ctx padding 0 padlen ; + unsafe_feed_bytes ctx bits 0 8 ; + let res = By.create (5 * 4) in + for i = 0 to 4 do + By.cpu_to_be32 res (i * 4) ctx.h.(i) + done ; + res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha224.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha224.ml new file mode 100644 index 00000000..b023dbbb --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha224.ml @@ -0,0 +1,41 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `SHA224 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA224 ] + + open Baijiu_sha256.Unsafe + + type nonrec ctx = ctx + + let init () = + let b = By.make 128 '\x00' in + { + size = 0L; + b; + h = + [| + 0xc1059ed8l; 0x367cd507l; 0x3070dd17l; 0xf70e5939l; 0xffc00b31l; + 0x68581511l; 0x64f98fa7l; 0xbefa4fa4l; + |]; + } + + let unsafe_get ctx = + let res = unsafe_get ctx in + By.sub res 0 28 + + let dup = dup + let unsafe_feed_bytes = unsafe_feed_bytes + let unsafe_feed_bigstring = unsafe_feed_bigstring +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha256.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha256.ml new file mode 100644 index 00000000..1c603975 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha256.ml @@ -0,0 +1,173 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module Int32 = struct + include Int32 + + let ( lsl ) = Int32.shift_left + let ( lsr ) = Int32.shift_right_logical + let ( asr ) = Int32.shift_right + let ( lor ) = Int32.logor + let ( lxor ) = Int32.logxor + let ( land ) = Int32.logand + let ( + ) = Int32.add + let rol32 a n = (a lsl n) lor (a lsr (32 - n)) + let ror32 a n = (a lsr n) lor (a lsl (32 - n)) +end + +module Int64 = struct + include Int64 + + let ( land ) = Int64.logand + let ( lsl ) = Int64.shift_left +end + +module type S = sig + type kind = [ `SHA256 ] + type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA256 ] + type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } + + let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } + + let init () = + let b = By.make 128 '\x00' in + { + size = 0L; + b; + h = + [| + 0x6a09e667l; 0xbb67ae85l; 0x3c6ef372l; 0xa54ff53al; 0x510e527fl; + 0x9b05688cl; 0x1f83d9abl; 0x5be0cd19l; + |]; + } + + let k = + [| + 0x428a2f98l; 0x71374491l; 0xb5c0fbcfl; 0xe9b5dba5l; 0x3956c25bl; + 0x59f111f1l; 0x923f82a4l; 0xab1c5ed5l; 0xd807aa98l; 0x12835b01l; + 0x243185bel; 0x550c7dc3l; 0x72be5d74l; 0x80deb1fel; 0x9bdc06a7l; + 0xc19bf174l; 0xe49b69c1l; 0xefbe4786l; 0x0fc19dc6l; 0x240ca1ccl; + 0x2de92c6fl; 0x4a7484aal; 0x5cb0a9dcl; 0x76f988dal; 0x983e5152l; + 0xa831c66dl; 0xb00327c8l; 0xbf597fc7l; 0xc6e00bf3l; 0xd5a79147l; + 0x06ca6351l; 0x14292967l; 0x27b70a85l; 0x2e1b2138l; 0x4d2c6dfcl; + 0x53380d13l; 0x650a7354l; 0x766a0abbl; 0x81c2c92el; 0x92722c85l; + 0xa2bfe8a1l; 0xa81a664bl; 0xc24b8b70l; 0xc76c51a3l; 0xd192e819l; + 0xd6990624l; 0xf40e3585l; 0x106aa070l; 0x19a4c116l; 0x1e376c08l; + 0x2748774cl; 0x34b0bcb5l; 0x391c0cb3l; 0x4ed8aa4al; 0x5b9cca4fl; + 0x682e6ff3l; 0x748f82eel; 0x78a5636fl; 0x84c87814l; 0x8cc70208l; + 0x90befffal; 0xa4506cebl; 0xbef9a3f7l; 0xc67178f2l; + |] + + let e0 x = Int32.(ror32 x 2 lxor ror32 x 13 lxor ror32 x 22) + let e1 x = Int32.(ror32 x 6 lxor ror32 x 11 lxor ror32 x 25) + let s0 x = Int32.(ror32 x 7 lxor ror32 x 18 lxor (x lsr 3)) + let s1 x = Int32.(ror32 x 17 lxor ror32 x 19 lxor (x lsr 10)) + + let sha256_do_chunk : + type a. be32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = + fun ~be32_to_cpu ctx buf off -> + let a, b, c, d, e, f, g, h, t1, t2 = + ( ref ctx.h.(0), + ref ctx.h.(1), + ref ctx.h.(2), + ref ctx.h.(3), + ref ctx.h.(4), + ref ctx.h.(5), + ref ctx.h.(6), + ref ctx.h.(7), + ref 0l, + ref 0l ) in + let w = Array.make 64 0l in + for i = 0 to 15 do + w.(i) <- be32_to_cpu buf (off + (i * 4)) + done ; + let ( -- ) a b = a - b in + for i = 16 to 63 do + w.(i) <- Int32.(s1 w.(i -- 2) + w.(i -- 7) + s0 w.(i -- 15) + w.(i -- 16)) + done ; + let round a b c d e f g h k w = + let open Int32 in + t1 := !h + e1 !e + (!g lxor (!e land (!f lxor !g))) + k + w ; + t2 := e0 !a + (!a land !b lor (!c land (!a lor !b))) ; + d := !d + !t1 ; + h := !t1 + !t2 in + for i = 0 to 7 do + round a b c d e f g h k.((i * 8) + 0) w.((i * 8) + 0) ; + round h a b c d e f g k.((i * 8) + 1) w.((i * 8) + 1) ; + round g h a b c d e f k.((i * 8) + 2) w.((i * 8) + 2) ; + round f g h a b c d e k.((i * 8) + 3) w.((i * 8) + 3) ; + round e f g h a b c d k.((i * 8) + 4) w.((i * 8) + 4) ; + round d e f g h a b c k.((i * 8) + 5) w.((i * 8) + 5) ; + round c d e f g h a b k.((i * 8) + 6) w.((i * 8) + 6) ; + round b c d e f g h a k.((i * 8) + 7) w.((i * 8) + 7) + done ; + let open Int32 in + ctx.h.(0) <- ctx.h.(0) + !a ; + ctx.h.(1) <- ctx.h.(1) + !b ; + ctx.h.(2) <- ctx.h.(2) + !c ; + ctx.h.(3) <- ctx.h.(3) + !d ; + ctx.h.(4) <- ctx.h.(4) + !e ; + ctx.h.(5) <- ctx.h.(5) + !f ; + ctx.h.(6) <- ctx.h.(6) + !g ; + ctx.h.(7) <- ctx.h.(7) + !h ; + () + + let feed : + type a. + blit:(a -> int -> By.t -> int -> int -> unit) -> + be32_to_cpu:(a -> int -> int32) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~blit ~be32_to_cpu ctx buf off len -> + let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in + let len = ref len in + let off = ref off in + let to_fill = 64 - !idx in + ctx.size <- Int64.add ctx.size (Int64.of_int !len) ; + if !idx <> 0 && !len >= to_fill + then ( + blit buf !off ctx.b !idx to_fill ; + sha256_do_chunk ~be32_to_cpu:By.be32_to_cpu ctx ctx.b 0 ; + len := !len - to_fill ; + off := !off + to_fill ; + idx := 0) ; + while !len >= 64 do + sha256_do_chunk ~be32_to_cpu ctx buf !off ; + len := !len - 64 ; + off := !off + 64 + done ; + if !len <> 0 then blit buf !off ctx.b !idx !len ; + () + + let unsafe_feed_bytes = feed ~blit:By.blit ~be32_to_cpu:By.be32_to_cpu + + let unsafe_feed_bigstring = + feed ~blit:By.blit_from_bigstring ~be32_to_cpu:Bi.be32_to_cpu + + let unsafe_get ctx = + let index = Int64.(to_int (ctx.size land 0x3FL)) in + let padlen = if index < 56 then 56 - index else 64 + 56 - index in + let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in + let bits = By.create 8 in + By.cpu_to_be64 bits 0 Int64.(ctx.size lsl 3) ; + unsafe_feed_bytes ctx padding 0 padlen ; + unsafe_feed_bytes ctx bits 0 8 ; + let res = By.create (8 * 4) in + for i = 0 to 7 do + By.cpu_to_be32 res (i * 4) ctx.h.(i) + done ; + res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3.ml new file mode 100644 index 00000000..2fe897b9 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3.ml @@ -0,0 +1,187 @@ +module By = Digestif_by +module Bi = Digestif_bi + +let nist_padding = 0x06L +let keccak_padding = 0x01L + +module Int64 = struct + include Int64 + + let ( lsl ) = Int64.shift_left + let ( lsr ) = Int64.shift_right_logical + let ( asr ) = Int64.shift_right + let ( lor ) = Int64.logor + let ( land ) = Int64.logand + let ( lxor ) = Int64.logxor + let ( + ) = Int64.add + let ror64 a n = (a lsr n) lor (a lsl (64 - n)) + let rol64 a n = (a lsl n) lor (a lsr (64 - n)) +end + +module Unsafe (P : sig + val padding : int64 +end) = +struct + type ctx = { + q : int64 array; + rsize : int; + (* block size *) + mdlen : int; + (* output size *) + mutable pt : int; + } + + let dup ctx = + { q = Array.copy ctx.q; rsize = ctx.rsize; mdlen = ctx.mdlen; pt = ctx.pt } + + let init mdlen = + let rsize = 200 - (2 * mdlen) in + { q = Array.make 25 0L; rsize; mdlen; pt = 0 } + + let keccakf_rounds = 24 + + let keccaft_rndc : int64 array = + [| + 0x0000000000000001L; 0x0000000000008082L; 0x800000000000808aL; + 0x8000000080008000L; 0x000000000000808bL; 0x0000000080000001L; + 0x8000000080008081L; 0x8000000000008009L; 0x000000000000008aL; + 0x0000000000000088L; 0x0000000080008009L; 0x000000008000000aL; + 0x000000008000808bL; 0x800000000000008bL; 0x8000000000008089L; + 0x8000000000008003L; 0x8000000000008002L; 0x8000000000000080L; + 0x000000000000800aL; 0x800000008000000aL; 0x8000000080008081L; + 0x8000000000008080L; 0x0000000080000001L; 0x8000000080008008L; + |] + + let keccaft_rotc : int array = + [| + 1; 3; 6; 10; 15; 21; 28; 36; 45; 55; 2; 14; 27; 41; 56; 8; 25; 43; 62; 18; + 39; 61; 20; 44; + |] + + let keccakf_piln : int array = + [| + 10; 7; 11; 17; 18; 3; 5; 16; 8; 21; 24; 4; 15; 23; 19; 13; 12; 2; 20; 14; + 22; 9; 6; 1; + |] + + let sha3_keccakf (q : int64 array) = + for r = 0 to keccakf_rounds - 1 do + let ( lxor ) = Int64.( lxor ) in + let lnot = Int64.lognot in + let ( land ) = Int64.( land ) in + (* Theta *) + let bc = + Array.init 5 (fun i -> + q.(i) lxor q.(i + 5) lxor q.(i + 10) lxor q.(i + 15) lxor q.(i + 20)) + in + for i = 0 to 4 do + let t = bc.((i + 4) mod 5) lxor Int64.rol64 bc.((i + 1) mod 5) 1 in + for k = 0 to 4 do + let j = k * 5 in + q.(j + i) <- q.(j + i) lxor t + done + done ; + + (* Rho Pi *) + let t = ref q.(1) in + let _ = + Array.iteri + (fun i rotc -> + let j = keccakf_piln.(i) in + bc.(0) <- q.(j) ; + q.(j) <- Int64.rol64 !t rotc ; + t := bc.(0)) + keccaft_rotc in + + (* Chi *) + for k = 0 to 4 do + let j = k * 5 in + let bc = Array.init 5 (fun i -> q.(j + i)) in + for i = 0 to 4 do + q.(j + i) <- + q.(j + i) lxor (lnot bc.((i + 1) mod 5) land bc.((i + 2) mod 5)) + done + done ; + + (* Iota *) + q.(0) <- q.(0) lxor keccaft_rndc.(r) + done + + let masks = + [| + 0xffffffffffffff00L; 0xffffffffffff00ffL; 0xffffffffff00ffffL; + 0xffffffff00ffffffL; 0xffffff00ffffffffL; 0xffff00ffffffffffL; + 0xff00ffffffffffffL; 0x00ffffffffffffffL; + |] + + let feed : + type a. get_uint8:(a -> int -> int) -> ctx -> a -> int -> int -> unit = + fun ~get_uint8 ctx buf off len -> + let ( && ) = ( land ) in + + let ( lxor ) = Int64.( lxor ) in + let ( land ) = Int64.( land ) in + let ( lor ) = Int64.( lor ) in + let ( lsr ) = Int64.( lsr ) in + let ( lsl ) = Int64.( lsl ) in + + let j = ref ctx.pt in + + for i = 0 to len - 1 do + let v = + (ctx.q.(!j / 8) land (0xffL lsl ((!j && 0x7) * 8))) lsr ((!j && 0x7) * 8) + in + let v = v lxor Int64.of_int (get_uint8 buf (off + i)) in + ctx.q.(!j / 8) <- + ctx.q.(!j / 8) land masks.(!j && 0x7) lor (v lsl ((!j && 0x7) * 8)) ; + incr j ; + if !j >= ctx.rsize + then ( + sha3_keccakf ctx.q ; + j := 0) + done ; + + ctx.pt <- !j + + let unsafe_feed_bytes ctx buf off len = + let get_uint8 buf off = Char.code (By.get buf off) in + feed ~get_uint8 ctx buf off len + + let unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit = + fun ctx buf off len -> + let get_uint8 buf off = Char.code (Bi.get buf off) in + feed ~get_uint8 ctx buf off len + + let unsafe_get ctx = + let ( && ) = ( land ) in + + let ( lxor ) = Int64.( lxor ) in + let ( lsl ) = Int64.( lsl ) in + + let v = ctx.q.(ctx.pt / 8) in + let v = v lxor (P.padding lsl ((ctx.pt && 0x7) * 8)) in + ctx.q.(ctx.pt / 8) <- v ; + + let v = ctx.q.((ctx.rsize - 1) / 8) in + let v = v lxor (0x80L lsl (((ctx.rsize - 1) && 0x7) * 8)) in + ctx.q.((ctx.rsize - 1) / 8) <- v ; + + sha3_keccakf ctx.q ; + + (* Get hash *) + (* if the hash size in bytes is not a multiple of 8 (meaning it is + not composed of whole int64 words, like for sha3_224), we + extract the whole last int64 word from the state [ctx.st] and + cut the hash at the right size after conversion to bytes. *) + let n = + let r = ctx.mdlen mod 8 in + ctx.mdlen + if r = 0 then 0 else 8 - r in + + let hash = By.create n in + for i = 0 to (n / 8) - 1 do + By.unsafe_set_64 hash (i * 8) + (if Sys.big_endian then By.swap64 ctx.q.(i) else ctx.q.(i)) + done ; + + By.sub hash 0 ctx.mdlen +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha384.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha384.ml new file mode 100644 index 00000000..93fed5f4 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha384.ml @@ -0,0 +1,42 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `SHA384 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA384 ] + + open Baijiu_sha512.Unsafe + + type nonrec ctx = ctx + + let init () = + let b = By.make 128 '\x00' in + { + size = [| 0L; 0L |]; + b; + h = + [| + 0xcbbb9d5dc1059ed8L; 0x629a292a367cd507L; 0x9159015a3070dd17L; + 0x152fecd8f70e5939L; 0x67332667ffc00b31L; 0x8eb44a8768581511L; + 0xdb0c2e0d64f98fa7L; 0x47b5481dbefa4fa4L; + |]; + } + + let unsafe_get ctx = + let res = unsafe_get ctx in + By.sub res 0 48 + + let dup = dup + let unsafe_feed_bytes = unsafe_feed_bytes + let unsafe_feed_bigstring = unsafe_feed_bigstring +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_224.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_224.ml new file mode 100644 index 00000000..a328d8e7 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_224.ml @@ -0,0 +1,31 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `SHA3_224 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA3_224 ] + + module U = Baijiu_sha3.Unsafe (struct + let padding = Baijiu_sha3.nist_padding + end) + + open U + + type nonrec ctx = ctx + + let init () = U.init 28 + let unsafe_get = unsafe_get + let dup = dup + let unsafe_feed_bytes = unsafe_feed_bytes + let unsafe_feed_bigstring = unsafe_feed_bigstring +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_256.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_256.ml new file mode 100644 index 00000000..58837b9d --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_256.ml @@ -0,0 +1,31 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `SHA3_256 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA3_256 ] + + module U = Baijiu_sha3.Unsafe (struct + let padding = Baijiu_sha3.nist_padding + end) + + open U + + type nonrec ctx = ctx + + let init () = U.init 32 + let unsafe_get = unsafe_get + let dup = dup + let unsafe_feed_bytes = unsafe_feed_bytes + let unsafe_feed_bigstring = unsafe_feed_bigstring +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_384.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_384.ml new file mode 100644 index 00000000..afa40406 --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_384.ml @@ -0,0 +1,31 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `SHA3_384 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA3_384 ] + + module U = Baijiu_sha3.Unsafe (struct + let padding = Baijiu_sha3.nist_padding + end) + + open U + + type nonrec ctx = ctx + + let init () = U.init 48 + let unsafe_get = unsafe_get + let dup = dup + let unsafe_feed_bytes = unsafe_feed_bytes + let unsafe_feed_bigstring = unsafe_feed_bigstring +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_512.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_512.ml new file mode 100644 index 00000000..cefdae8c --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha3_512.ml @@ -0,0 +1,31 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module type S = sig + type ctx + type kind = [ `SHA3_512 ] + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA3_512 ] + + module U = Baijiu_sha3.Unsafe (struct + let padding = Baijiu_sha3.nist_padding + end) + + open U + + type nonrec ctx = ctx + + let init () = U.init 64 + let unsafe_get = unsafe_get + let dup = dup + let unsafe_feed_bytes = unsafe_feed_bytes + let unsafe_feed_bigstring = unsafe_feed_bigstring +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_sha512.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha512.ml new file mode 100644 index 00000000..74bfb26b --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_sha512.ml @@ -0,0 +1,185 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module Int64 = struct + include Int64 + + let ( lsl ) = Int64.shift_left + let ( lsr ) = Int64.shift_right_logical + let ( asr ) = Int64.shift_right + let ( lor ) = Int64.logor + let ( land ) = Int64.logand + let ( lxor ) = Int64.logxor + let ( + ) = Int64.add + let ror64 a n = (a lsr n) lor (a lsl (64 - n)) + let rol64 a n = (a lsl n) lor (a lsr (64 - n)) +end + +module type S = sig + type kind = [ `SHA512 ] + type ctx = { mutable size : int64 array; b : Bytes.t; h : int64 array } + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `SHA512 ] + type ctx = { mutable size : int64 array; b : Bytes.t; h : int64 array } + + let dup ctx = + { size = Array.copy ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } + + let init () = + let b = By.make 128 '\x00' in + { + size = [| 0L; 0L |]; + b; + h = + [| + 0x6a09e667f3bcc908L; 0xbb67ae8584caa73bL; 0x3c6ef372fe94f82bL; + 0xa54ff53a5f1d36f1L; 0x510e527fade682d1L; 0x9b05688c2b3e6c1fL; + 0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L; + |]; + } + + let k = + [| + 0x428a2f98d728ae22L; 0x7137449123ef65cdL; 0xb5c0fbcfec4d3b2fL; + 0xe9b5dba58189dbbcL; 0x3956c25bf348b538L; 0x59f111f1b605d019L; + 0x923f82a4af194f9bL; 0xab1c5ed5da6d8118L; 0xd807aa98a3030242L; + 0x12835b0145706fbeL; 0x243185be4ee4b28cL; 0x550c7dc3d5ffb4e2L; + 0x72be5d74f27b896fL; 0x80deb1fe3b1696b1L; 0x9bdc06a725c71235L; + 0xc19bf174cf692694L; 0xe49b69c19ef14ad2L; 0xefbe4786384f25e3L; + 0x0fc19dc68b8cd5b5L; 0x240ca1cc77ac9c65L; 0x2de92c6f592b0275L; + 0x4a7484aa6ea6e483L; 0x5cb0a9dcbd41fbd4L; 0x76f988da831153b5L; + 0x983e5152ee66dfabL; 0xa831c66d2db43210L; 0xb00327c898fb213fL; + 0xbf597fc7beef0ee4L; 0xc6e00bf33da88fc2L; 0xd5a79147930aa725L; + 0x06ca6351e003826fL; 0x142929670a0e6e70L; 0x27b70a8546d22ffcL; + 0x2e1b21385c26c926L; 0x4d2c6dfc5ac42aedL; 0x53380d139d95b3dfL; + 0x650a73548baf63deL; 0x766a0abb3c77b2a8L; 0x81c2c92e47edaee6L; + 0x92722c851482353bL; 0xa2bfe8a14cf10364L; 0xa81a664bbc423001L; + 0xc24b8b70d0f89791L; 0xc76c51a30654be30L; 0xd192e819d6ef5218L; + 0xd69906245565a910L; 0xf40e35855771202aL; 0x106aa07032bbd1b8L; + 0x19a4c116b8d2d0c8L; 0x1e376c085141ab53L; 0x2748774cdf8eeb99L; + 0x34b0bcb5e19b48a8L; 0x391c0cb3c5c95a63L; 0x4ed8aa4ae3418acbL; + 0x5b9cca4f7763e373L; 0x682e6ff3d6b2b8a3L; 0x748f82ee5defb2fcL; + 0x78a5636f43172f60L; 0x84c87814a1f0ab72L; 0x8cc702081a6439ecL; + 0x90befffa23631e28L; 0xa4506cebde82bde9L; 0xbef9a3f7b2c67915L; + 0xc67178f2e372532bL; 0xca273eceea26619cL; 0xd186b8c721c0c207L; + 0xeada7dd6cde0eb1eL; 0xf57d4f7fee6ed178L; 0x06f067aa72176fbaL; + 0x0a637dc5a2c898a6L; 0x113f9804bef90daeL; 0x1b710b35131c471bL; + 0x28db77f523047d84L; 0x32caab7b40c72493L; 0x3c9ebe0a15c9bebcL; + 0x431d67c49c100d4cL; 0x4cc5d4becb3e42b6L; 0x597f299cfc657e2aL; + 0x5fcb6fab3ad6faecL; 0x6c44198c4a475817L; + |] + + let e0 x = Int64.(ror64 x 28 lxor ror64 x 34 lxor ror64 x 39) + let e1 x = Int64.(ror64 x 14 lxor ror64 x 18 lxor ror64 x 41) + let s0 x = Int64.(ror64 x 1 lxor ror64 x 8 lxor (x lsr 7)) + let s1 x = Int64.(ror64 x 19 lxor ror64 x 61 lxor (x lsr 6)) + + let sha512_do_chunk : + type a. be64_to_cpu:(a -> int -> int64) -> ctx -> a -> int -> unit = + fun ~be64_to_cpu ctx buf off -> + let a, b, c, d, e, f, g, h, t1, t2 = + ( ref ctx.h.(0), + ref ctx.h.(1), + ref ctx.h.(2), + ref ctx.h.(3), + ref ctx.h.(4), + ref ctx.h.(5), + ref ctx.h.(6), + ref ctx.h.(7), + ref 0L, + ref 0L ) in + let w = Array.make 80 0L in + for i = 0 to 15 do + w.(i) <- be64_to_cpu buf (off + (i * 8)) + done ; + let ( -- ) a b = a - b in + for i = 16 to 79 do + w.(i) <- Int64.(s1 w.(i -- 2) + w.(i -- 7) + s0 w.(i -- 15) + w.(i -- 16)) + done ; + let round a b c d e f g h k w = + let open Int64 in + t1 := !h + e1 !e + (!g lxor (!e land (!f lxor !g))) + k + w ; + t2 := e0 !a + (!a land !b lor (!c land (!a lor !b))) ; + d := !d + !t1 ; + h := !t1 + !t2 in + for i = 0 to 9 do + round a b c d e f g h k.((i * 8) + 0) w.((i * 8) + 0) ; + round h a b c d e f g k.((i * 8) + 1) w.((i * 8) + 1) ; + round g h a b c d e f k.((i * 8) + 2) w.((i * 8) + 2) ; + round f g h a b c d e k.((i * 8) + 3) w.((i * 8) + 3) ; + round e f g h a b c d k.((i * 8) + 4) w.((i * 8) + 4) ; + round d e f g h a b c k.((i * 8) + 5) w.((i * 8) + 5) ; + round c d e f g h a b k.((i * 8) + 6) w.((i * 8) + 6) ; + round b c d e f g h a k.((i * 8) + 7) w.((i * 8) + 7) + done ; + let open Int64 in + ctx.h.(0) <- ctx.h.(0) + !a ; + ctx.h.(1) <- ctx.h.(1) + !b ; + ctx.h.(2) <- ctx.h.(2) + !c ; + ctx.h.(3) <- ctx.h.(3) + !d ; + ctx.h.(4) <- ctx.h.(4) + !e ; + ctx.h.(5) <- ctx.h.(5) + !f ; + ctx.h.(6) <- ctx.h.(6) + !g ; + ctx.h.(7) <- ctx.h.(7) + !h ; + () + + let feed : + type a. + blit:(a -> int -> By.t -> int -> int -> unit) -> + be64_to_cpu:(a -> int -> int64) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~blit ~be64_to_cpu ctx buf off len -> + let idx = ref Int64.(to_int (ctx.size.(0) land 0x7FL)) in + let len = ref len in + let off = ref off in + let to_fill = 128 - !idx in + ctx.size.(0) <- Int64.add ctx.size.(0) (Int64.of_int !len) ; + if ctx.size.(0) < Int64.of_int !len + then ctx.size.(1) <- Int64.succ ctx.size.(1) ; + if !idx <> 0 && !len >= to_fill + then ( + blit buf !off ctx.b !idx to_fill ; + sha512_do_chunk ~be64_to_cpu:By.be64_to_cpu ctx ctx.b 0 ; + len := !len - to_fill ; + off := !off + to_fill ; + idx := 0) ; + while !len >= 128 do + sha512_do_chunk ~be64_to_cpu ctx buf !off ; + len := !len - 128 ; + off := !off + 128 + done ; + if !len <> 0 then blit buf !off ctx.b !idx !len ; + () + + let unsafe_feed_bytes = feed ~blit:By.blit ~be64_to_cpu:By.be64_to_cpu + + let unsafe_feed_bigstring = + feed ~blit:By.blit_from_bigstring ~be64_to_cpu:Bi.be64_to_cpu + + let unsafe_get ctx = + let index = Int64.(to_int (ctx.size.(0) land 0x7FL)) in + let padlen = if index < 112 then 112 - index else 128 + 112 - index in + let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in + let bits = By.create 16 in + By.cpu_to_be64 bits 0 Int64.((ctx.size.(1) lsl 3) lor (ctx.size.(0) lsr 61)) ; + By.cpu_to_be64 bits 8 Int64.(ctx.size.(0) lsl 3) ; + unsafe_feed_bytes ctx padding 0 padlen ; + unsafe_feed_bytes ctx bits 0 16 ; + let res = By.create (8 * 8) in + for i = 0 to 7 do + By.cpu_to_be64 res (i * 8) ctx.h.(i) + done ; + res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/baijiu_whirlpool.ml b/unikernel/duniverse/digestif/src-ocaml/baijiu_whirlpool.ml new file mode 100644 index 00000000..03cb46fd --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/baijiu_whirlpool.ml @@ -0,0 +1,844 @@ +module By = Digestif_by +module Bi = Digestif_bi + +module Int64 = struct + include Int64 + + let ( lsl ) = Int64.shift_left + let ( lsr ) = Int64.shift_right_logical + let ( asr ) = Int64.shift_right + let ( lor ) = Int64.logor + let ( land ) = Int64.logand + let ( lxor ) = Int64.logxor + let ( + ) = Int64.add + let ror64 a n = (a lsr n) lor (a lsl (64 - n)) + let rol64 a n = (a lsl n) lor (a lsr (64 - n)) +end + +module type S = sig + type kind = [ `WHIRLPOOL ] + type ctx = { mutable size : int64; b : Bytes.t; h : int64 array } + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe : S = struct + type kind = [ `WHIRLPOOL ] + type ctx = { mutable size : int64; b : Bytes.t; h : int64 array } + + let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } + + let init () = + let b = By.make 64 '\x00' in + { size = 0L; b; h = Array.make 8 Int64.zero } + + let k = + [| + [| + 0x18186018c07830d8L; 0x23238c2305af4626L; 0xc6c63fc67ef991b8L; + 0xe8e887e8136fcdfbL; 0x878726874ca113cbL; 0xb8b8dab8a9626d11L; + 0x0101040108050209L; 0x4f4f214f426e9e0dL; 0x3636d836adee6c9bL; + 0xa6a6a2a6590451ffL; 0xd2d26fd2debdb90cL; 0xf5f5f3f5fb06f70eL; + 0x7979f979ef80f296L; 0x6f6fa16f5fcede30L; 0x91917e91fcef3f6dL; + 0x52525552aa07a4f8L; 0x60609d6027fdc047L; 0xbcbccabc89766535L; + 0x9b9b569baccd2b37L; 0x8e8e028e048c018aL; 0xa3a3b6a371155bd2L; + 0x0c0c300c603c186cL; 0x7b7bf17bff8af684L; 0x3535d435b5e16a80L; + 0x1d1d741de8693af5L; 0xe0e0a7e05347ddb3L; 0xd7d77bd7f6acb321L; + 0xc2c22fc25eed999cL; 0x2e2eb82e6d965c43L; 0x4b4b314b627a9629L; + 0xfefedffea321e15dL; 0x575741578216aed5L; 0x15155415a8412abdL; + 0x7777c1779fb6eee8L; 0x3737dc37a5eb6e92L; 0xe5e5b3e57b56d79eL; + 0x9f9f469f8cd92313L; 0xf0f0e7f0d317fd23L; 0x4a4a354a6a7f9420L; + 0xdada4fda9e95a944L; 0x58587d58fa25b0a2L; 0xc9c903c906ca8fcfL; + 0x2929a429558d527cL; 0x0a0a280a5022145aL; 0xb1b1feb1e14f7f50L; + 0xa0a0baa0691a5dc9L; 0x6b6bb16b7fdad614L; 0x85852e855cab17d9L; + 0xbdbdcebd8173673cL; 0x5d5d695dd234ba8fL; 0x1010401080502090L; + 0xf4f4f7f4f303f507L; 0xcbcb0bcb16c08bddL; 0x3e3ef83eedc67cd3L; + 0x0505140528110a2dL; 0x676781671fe6ce78L; 0xe4e4b7e47353d597L; + 0x27279c2725bb4e02L; 0x4141194132588273L; 0x8b8b168b2c9d0ba7L; + 0xa7a7a6a7510153f6L; 0x7d7de97dcf94fab2L; 0x95956e95dcfb3749L; + 0xd8d847d88e9fad56L; 0xfbfbcbfb8b30eb70L; 0xeeee9fee2371c1cdL; + 0x7c7ced7cc791f8bbL; 0x6666856617e3cc71L; 0xdddd53dda68ea77bL; + 0x17175c17b84b2eafL; 0x4747014702468e45L; 0x9e9e429e84dc211aL; + 0xcaca0fca1ec589d4L; 0x2d2db42d75995a58L; 0xbfbfc6bf9179632eL; + 0x07071c07381b0e3fL; 0xadad8ead012347acL; 0x5a5a755aea2fb4b0L; + 0x838336836cb51befL; 0x3333cc3385ff66b6L; 0x636391633ff2c65cL; + 0x02020802100a0412L; 0xaaaa92aa39384993L; 0x7171d971afa8e2deL; + 0xc8c807c80ecf8dc6L; 0x19196419c87d32d1L; 0x494939497270923bL; + 0xd9d943d9869aaf5fL; 0xf2f2eff2c31df931L; 0xe3e3abe34b48dba8L; + 0x5b5b715be22ab6b9L; 0x88881a8834920dbcL; 0x9a9a529aa4c8293eL; + 0x262698262dbe4c0bL; 0x3232c8328dfa64bfL; 0xb0b0fab0e94a7d59L; + 0xe9e983e91b6acff2L; 0x0f0f3c0f78331e77L; 0xd5d573d5e6a6b733L; + 0x80803a8074ba1df4L; 0xbebec2be997c6127L; 0xcdcd13cd26de87ebL; + 0x3434d034bde46889L; 0x48483d487a759032L; 0xffffdbffab24e354L; + 0x7a7af57af78ff48dL; 0x90907a90f4ea3d64L; 0x5f5f615fc23ebe9dL; + 0x202080201da0403dL; 0x6868bd6867d5d00fL; 0x1a1a681ad07234caL; + 0xaeae82ae192c41b7L; 0xb4b4eab4c95e757dL; 0x54544d549a19a8ceL; + 0x93937693ece53b7fL; 0x222288220daa442fL; 0x64648d6407e9c863L; + 0xf1f1e3f1db12ff2aL; 0x7373d173bfa2e6ccL; 0x12124812905a2482L; + 0x40401d403a5d807aL; 0x0808200840281048L; 0xc3c32bc356e89b95L; + 0xecec97ec337bc5dfL; 0xdbdb4bdb9690ab4dL; 0xa1a1bea1611f5fc0L; + 0x8d8d0e8d1c830791L; 0x3d3df43df5c97ac8L; 0x97976697ccf1335bL; + 0x0000000000000000L; 0xcfcf1bcf36d483f9L; 0x2b2bac2b4587566eL; + 0x7676c57697b3ece1L; 0x8282328264b019e6L; 0xd6d67fd6fea9b128L; + 0x1b1b6c1bd87736c3L; 0xb5b5eeb5c15b7774L; 0xafaf86af112943beL; + 0x6a6ab56a77dfd41dL; 0x50505d50ba0da0eaL; 0x45450945124c8a57L; + 0xf3f3ebf3cb18fb38L; 0x3030c0309df060adL; 0xefef9bef2b74c3c4L; + 0x3f3ffc3fe5c37edaL; 0x55554955921caac7L; 0xa2a2b2a2791059dbL; + 0xeaea8fea0365c9e9L; 0x656589650fecca6aL; 0xbabad2bab9686903L; + 0x2f2fbc2f65935e4aL; 0xc0c027c04ee79d8eL; 0xdede5fdebe81a160L; + 0x1c1c701ce06c38fcL; 0xfdfdd3fdbb2ee746L; 0x4d4d294d52649a1fL; + 0x92927292e4e03976L; 0x7575c9758fbceafaL; 0x06061806301e0c36L; + 0x8a8a128a249809aeL; 0xb2b2f2b2f940794bL; 0xe6e6bfe66359d185L; + 0x0e0e380e70361c7eL; 0x1f1f7c1ff8633ee7L; 0x6262956237f7c455L; + 0xd4d477d4eea3b53aL; 0xa8a89aa829324d81L; 0x96966296c4f43152L; + 0xf9f9c3f99b3aef62L; 0xc5c533c566f697a3L; 0x2525942535b14a10L; + 0x59597959f220b2abL; 0x84842a8454ae15d0L; 0x7272d572b7a7e4c5L; + 0x3939e439d5dd72ecL; 0x4c4c2d4c5a619816L; 0x5e5e655eca3bbc94L; + 0x7878fd78e785f09fL; 0x3838e038ddd870e5L; 0x8c8c0a8c14860598L; + 0xd1d163d1c6b2bf17L; 0xa5a5aea5410b57e4L; 0xe2e2afe2434dd9a1L; + 0x616199612ff8c24eL; 0xb3b3f6b3f1457b42L; 0x2121842115a54234L; + 0x9c9c4a9c94d62508L; 0x1e1e781ef0663ceeL; 0x4343114322528661L; + 0xc7c73bc776fc93b1L; 0xfcfcd7fcb32be54fL; 0x0404100420140824L; + 0x51515951b208a2e3L; 0x99995e99bcc72f25L; 0x6d6da96d4fc4da22L; + 0x0d0d340d68391a65L; 0xfafacffa8335e979L; 0xdfdf5bdfb684a369L; + 0x7e7ee57ed79bfca9L; 0x242490243db44819L; 0x3b3bec3bc5d776feL; + 0xabab96ab313d4b9aL; 0xcece1fce3ed181f0L; 0x1111441188552299L; + 0x8f8f068f0c890383L; 0x4e4e254e4a6b9c04L; 0xb7b7e6b7d1517366L; + 0xebeb8beb0b60cbe0L; 0x3c3cf03cfdcc78c1L; 0x81813e817cbf1ffdL; + 0x94946a94d4fe3540L; 0xf7f7fbf7eb0cf31cL; 0xb9b9deb9a1676f18L; + 0x13134c13985f268bL; 0x2c2cb02c7d9c5851L; 0xd3d36bd3d6b8bb05L; + 0xe7e7bbe76b5cd38cL; 0x6e6ea56e57cbdc39L; 0xc4c437c46ef395aaL; + 0x03030c03180f061bL; 0x565645568a13acdcL; 0x44440d441a49885eL; + 0x7f7fe17fdf9efea0L; 0xa9a99ea921374f88L; 0x2a2aa82a4d825467L; + 0xbbbbd6bbb16d6b0aL; 0xc1c123c146e29f87L; 0x53535153a202a6f1L; + 0xdcdc57dcae8ba572L; 0x0b0b2c0b58271653L; 0x9d9d4e9d9cd32701L; + 0x6c6cad6c47c1d82bL; 0x3131c43195f562a4L; 0x7474cd7487b9e8f3L; + 0xf6f6fff6e309f115L; 0x464605460a438c4cL; 0xacac8aac092645a5L; + 0x89891e893c970fb5L; 0x14145014a04428b4L; 0xe1e1a3e15b42dfbaL; + 0x16165816b04e2ca6L; 0x3a3ae83acdd274f7L; 0x6969b9696fd0d206L; + 0x09092409482d1241L; 0x7070dd70a7ade0d7L; 0xb6b6e2b6d954716fL; + 0xd0d067d0ceb7bd1eL; 0xeded93ed3b7ec7d6L; 0xcccc17cc2edb85e2L; + 0x424215422a578468L; 0x98985a98b4c22d2cL; 0xa4a4aaa4490e55edL; + 0x2828a0285d885075L; 0x5c5c6d5cda31b886L; 0xf8f8c7f8933fed6bL; + 0x8686228644a411c2L; + |]; + [| + 0xd818186018c07830L; 0x2623238c2305af46L; 0xb8c6c63fc67ef991L; + 0xfbe8e887e8136fcdL; 0xcb878726874ca113L; 0x11b8b8dab8a9626dL; + 0x0901010401080502L; 0x0d4f4f214f426e9eL; 0x9b3636d836adee6cL; + 0xffa6a6a2a6590451L; 0x0cd2d26fd2debdb9L; 0x0ef5f5f3f5fb06f7L; + 0x967979f979ef80f2L; 0x306f6fa16f5fcedeL; 0x6d91917e91fcef3fL; + 0xf852525552aa07a4L; 0x4760609d6027fdc0L; 0x35bcbccabc897665L; + 0x379b9b569baccd2bL; 0x8a8e8e028e048c01L; 0xd2a3a3b6a371155bL; + 0x6c0c0c300c603c18L; 0x847b7bf17bff8af6L; 0x803535d435b5e16aL; + 0xf51d1d741de8693aL; 0xb3e0e0a7e05347ddL; 0x21d7d77bd7f6acb3L; + 0x9cc2c22fc25eed99L; 0x432e2eb82e6d965cL; 0x294b4b314b627a96L; + 0x5dfefedffea321e1L; 0xd5575741578216aeL; 0xbd15155415a8412aL; + 0xe87777c1779fb6eeL; 0x923737dc37a5eb6eL; 0x9ee5e5b3e57b56d7L; + 0x139f9f469f8cd923L; 0x23f0f0e7f0d317fdL; 0x204a4a354a6a7f94L; + 0x44dada4fda9e95a9L; 0xa258587d58fa25b0L; 0xcfc9c903c906ca8fL; + 0x7c2929a429558d52L; 0x5a0a0a280a502214L; 0x50b1b1feb1e14f7fL; + 0xc9a0a0baa0691a5dL; 0x146b6bb16b7fdad6L; 0xd985852e855cab17L; + 0x3cbdbdcebd817367L; 0x8f5d5d695dd234baL; 0x9010104010805020L; + 0x07f4f4f7f4f303f5L; 0xddcbcb0bcb16c08bL; 0xd33e3ef83eedc67cL; + 0x2d0505140528110aL; 0x78676781671fe6ceL; 0x97e4e4b7e47353d5L; + 0x0227279c2725bb4eL; 0x7341411941325882L; 0xa78b8b168b2c9d0bL; + 0xf6a7a7a6a7510153L; 0xb27d7de97dcf94faL; 0x4995956e95dcfb37L; + 0x56d8d847d88e9fadL; 0x70fbfbcbfb8b30ebL; 0xcdeeee9fee2371c1L; + 0xbb7c7ced7cc791f8L; 0x716666856617e3ccL; 0x7bdddd53dda68ea7L; + 0xaf17175c17b84b2eL; 0x454747014702468eL; 0x1a9e9e429e84dc21L; + 0xd4caca0fca1ec589L; 0x582d2db42d75995aL; 0x2ebfbfc6bf917963L; + 0x3f07071c07381b0eL; 0xacadad8ead012347L; 0xb05a5a755aea2fb4L; + 0xef838336836cb51bL; 0xb63333cc3385ff66L; 0x5c636391633ff2c6L; + 0x1202020802100a04L; 0x93aaaa92aa393849L; 0xde7171d971afa8e2L; + 0xc6c8c807c80ecf8dL; 0xd119196419c87d32L; 0x3b49493949727092L; + 0x5fd9d943d9869aafL; 0x31f2f2eff2c31df9L; 0xa8e3e3abe34b48dbL; + 0xb95b5b715be22ab6L; 0xbc88881a8834920dL; 0x3e9a9a529aa4c829L; + 0x0b262698262dbe4cL; 0xbf3232c8328dfa64L; 0x59b0b0fab0e94a7dL; + 0xf2e9e983e91b6acfL; 0x770f0f3c0f78331eL; 0x33d5d573d5e6a6b7L; + 0xf480803a8074ba1dL; 0x27bebec2be997c61L; 0xebcdcd13cd26de87L; + 0x893434d034bde468L; 0x3248483d487a7590L; 0x54ffffdbffab24e3L; + 0x8d7a7af57af78ff4L; 0x6490907a90f4ea3dL; 0x9d5f5f615fc23ebeL; + 0x3d202080201da040L; 0x0f6868bd6867d5d0L; 0xca1a1a681ad07234L; + 0xb7aeae82ae192c41L; 0x7db4b4eab4c95e75L; 0xce54544d549a19a8L; + 0x7f93937693ece53bL; 0x2f222288220daa44L; 0x6364648d6407e9c8L; + 0x2af1f1e3f1db12ffL; 0xcc7373d173bfa2e6L; 0x8212124812905a24L; + 0x7a40401d403a5d80L; 0x4808082008402810L; 0x95c3c32bc356e89bL; + 0xdfecec97ec337bc5L; 0x4ddbdb4bdb9690abL; 0xc0a1a1bea1611f5fL; + 0x918d8d0e8d1c8307L; 0xc83d3df43df5c97aL; 0x5b97976697ccf133L; + 0x0000000000000000L; 0xf9cfcf1bcf36d483L; 0x6e2b2bac2b458756L; + 0xe17676c57697b3ecL; 0xe68282328264b019L; 0x28d6d67fd6fea9b1L; + 0xc31b1b6c1bd87736L; 0x74b5b5eeb5c15b77L; 0xbeafaf86af112943L; + 0x1d6a6ab56a77dfd4L; 0xea50505d50ba0da0L; 0x5745450945124c8aL; + 0x38f3f3ebf3cb18fbL; 0xad3030c0309df060L; 0xc4efef9bef2b74c3L; + 0xda3f3ffc3fe5c37eL; 0xc755554955921caaL; 0xdba2a2b2a2791059L; + 0xe9eaea8fea0365c9L; 0x6a656589650feccaL; 0x03babad2bab96869L; + 0x4a2f2fbc2f65935eL; 0x8ec0c027c04ee79dL; 0x60dede5fdebe81a1L; + 0xfc1c1c701ce06c38L; 0x46fdfdd3fdbb2ee7L; 0x1f4d4d294d52649aL; + 0x7692927292e4e039L; 0xfa7575c9758fbceaL; 0x3606061806301e0cL; + 0xae8a8a128a249809L; 0x4bb2b2f2b2f94079L; 0x85e6e6bfe66359d1L; + 0x7e0e0e380e70361cL; 0xe71f1f7c1ff8633eL; 0x556262956237f7c4L; + 0x3ad4d477d4eea3b5L; 0x81a8a89aa829324dL; 0x5296966296c4f431L; + 0x62f9f9c3f99b3aefL; 0xa3c5c533c566f697L; 0x102525942535b14aL; + 0xab59597959f220b2L; 0xd084842a8454ae15L; 0xc57272d572b7a7e4L; + 0xec3939e439d5dd72L; 0x164c4c2d4c5a6198L; 0x945e5e655eca3bbcL; + 0x9f7878fd78e785f0L; 0xe53838e038ddd870L; 0x988c8c0a8c148605L; + 0x17d1d163d1c6b2bfL; 0xe4a5a5aea5410b57L; 0xa1e2e2afe2434dd9L; + 0x4e616199612ff8c2L; 0x42b3b3f6b3f1457bL; 0x342121842115a542L; + 0x089c9c4a9c94d625L; 0xee1e1e781ef0663cL; 0x6143431143225286L; + 0xb1c7c73bc776fc93L; 0x4ffcfcd7fcb32be5L; 0x2404041004201408L; + 0xe351515951b208a2L; 0x2599995e99bcc72fL; 0x226d6da96d4fc4daL; + 0x650d0d340d68391aL; 0x79fafacffa8335e9L; 0x69dfdf5bdfb684a3L; + 0xa97e7ee57ed79bfcL; 0x19242490243db448L; 0xfe3b3bec3bc5d776L; + 0x9aabab96ab313d4bL; 0xf0cece1fce3ed181L; 0x9911114411885522L; + 0x838f8f068f0c8903L; 0x044e4e254e4a6b9cL; 0x66b7b7e6b7d15173L; + 0xe0ebeb8beb0b60cbL; 0xc13c3cf03cfdcc78L; 0xfd81813e817cbf1fL; + 0x4094946a94d4fe35L; 0x1cf7f7fbf7eb0cf3L; 0x18b9b9deb9a1676fL; + 0x8b13134c13985f26L; 0x512c2cb02c7d9c58L; 0x05d3d36bd3d6b8bbL; + 0x8ce7e7bbe76b5cd3L; 0x396e6ea56e57cbdcL; 0xaac4c437c46ef395L; + 0x1b03030c03180f06L; 0xdc565645568a13acL; 0x5e44440d441a4988L; + 0xa07f7fe17fdf9efeL; 0x88a9a99ea921374fL; 0x672a2aa82a4d8254L; + 0x0abbbbd6bbb16d6bL; 0x87c1c123c146e29fL; 0xf153535153a202a6L; + 0x72dcdc57dcae8ba5L; 0x530b0b2c0b582716L; 0x019d9d4e9d9cd327L; + 0x2b6c6cad6c47c1d8L; 0xa43131c43195f562L; 0xf37474cd7487b9e8L; + 0x15f6f6fff6e309f1L; 0x4c464605460a438cL; 0xa5acac8aac092645L; + 0xb589891e893c970fL; 0xb414145014a04428L; 0xbae1e1a3e15b42dfL; + 0xa616165816b04e2cL; 0xf73a3ae83acdd274L; 0x066969b9696fd0d2L; + 0x4109092409482d12L; 0xd77070dd70a7ade0L; 0x6fb6b6e2b6d95471L; + 0x1ed0d067d0ceb7bdL; 0xd6eded93ed3b7ec7L; 0xe2cccc17cc2edb85L; + 0x68424215422a5784L; 0x2c98985a98b4c22dL; 0xeda4a4aaa4490e55L; + 0x752828a0285d8850L; 0x865c5c6d5cda31b8L; 0x6bf8f8c7f8933fedL; + 0xc28686228644a411L; + |]; + [| + 0x30d818186018c078L; 0x462623238c2305afL; 0x91b8c6c63fc67ef9L; + 0xcdfbe8e887e8136fL; 0x13cb878726874ca1L; 0x6d11b8b8dab8a962L; + 0x0209010104010805L; 0x9e0d4f4f214f426eL; 0x6c9b3636d836adeeL; + 0x51ffa6a6a2a65904L; 0xb90cd2d26fd2debdL; 0xf70ef5f5f3f5fb06L; + 0xf2967979f979ef80L; 0xde306f6fa16f5fceL; 0x3f6d91917e91fcefL; + 0xa4f852525552aa07L; 0xc04760609d6027fdL; 0x6535bcbccabc8976L; + 0x2b379b9b569baccdL; 0x018a8e8e028e048cL; 0x5bd2a3a3b6a37115L; + 0x186c0c0c300c603cL; 0xf6847b7bf17bff8aL; 0x6a803535d435b5e1L; + 0x3af51d1d741de869L; 0xddb3e0e0a7e05347L; 0xb321d7d77bd7f6acL; + 0x999cc2c22fc25eedL; 0x5c432e2eb82e6d96L; 0x96294b4b314b627aL; + 0xe15dfefedffea321L; 0xaed5575741578216L; 0x2abd15155415a841L; + 0xeee87777c1779fb6L; 0x6e923737dc37a5ebL; 0xd79ee5e5b3e57b56L; + 0x23139f9f469f8cd9L; 0xfd23f0f0e7f0d317L; 0x94204a4a354a6a7fL; + 0xa944dada4fda9e95L; 0xb0a258587d58fa25L; 0x8fcfc9c903c906caL; + 0x527c2929a429558dL; 0x145a0a0a280a5022L; 0x7f50b1b1feb1e14fL; + 0x5dc9a0a0baa0691aL; 0xd6146b6bb16b7fdaL; 0x17d985852e855cabL; + 0x673cbdbdcebd8173L; 0xba8f5d5d695dd234L; 0x2090101040108050L; + 0xf507f4f4f7f4f303L; 0x8bddcbcb0bcb16c0L; 0x7cd33e3ef83eedc6L; + 0x0a2d050514052811L; 0xce78676781671fe6L; 0xd597e4e4b7e47353L; + 0x4e0227279c2725bbL; 0x8273414119413258L; 0x0ba78b8b168b2c9dL; + 0x53f6a7a7a6a75101L; 0xfab27d7de97dcf94L; 0x374995956e95dcfbL; + 0xad56d8d847d88e9fL; 0xeb70fbfbcbfb8b30L; 0xc1cdeeee9fee2371L; + 0xf8bb7c7ced7cc791L; 0xcc716666856617e3L; 0xa77bdddd53dda68eL; + 0x2eaf17175c17b84bL; 0x8e45474701470246L; 0x211a9e9e429e84dcL; + 0x89d4caca0fca1ec5L; 0x5a582d2db42d7599L; 0x632ebfbfc6bf9179L; + 0x0e3f07071c07381bL; 0x47acadad8ead0123L; 0xb4b05a5a755aea2fL; + 0x1bef838336836cb5L; 0x66b63333cc3385ffL; 0xc65c636391633ff2L; + 0x041202020802100aL; 0x4993aaaa92aa3938L; 0xe2de7171d971afa8L; + 0x8dc6c8c807c80ecfL; 0x32d119196419c87dL; 0x923b494939497270L; + 0xaf5fd9d943d9869aL; 0xf931f2f2eff2c31dL; 0xdba8e3e3abe34b48L; + 0xb6b95b5b715be22aL; 0x0dbc88881a883492L; 0x293e9a9a529aa4c8L; + 0x4c0b262698262dbeL; 0x64bf3232c8328dfaL; 0x7d59b0b0fab0e94aL; + 0xcff2e9e983e91b6aL; 0x1e770f0f3c0f7833L; 0xb733d5d573d5e6a6L; + 0x1df480803a8074baL; 0x6127bebec2be997cL; 0x87ebcdcd13cd26deL; + 0x68893434d034bde4L; 0x903248483d487a75L; 0xe354ffffdbffab24L; + 0xf48d7a7af57af78fL; 0x3d6490907a90f4eaL; 0xbe9d5f5f615fc23eL; + 0x403d202080201da0L; 0xd00f6868bd6867d5L; 0x34ca1a1a681ad072L; + 0x41b7aeae82ae192cL; 0x757db4b4eab4c95eL; 0xa8ce54544d549a19L; + 0x3b7f93937693ece5L; 0x442f222288220daaL; 0xc86364648d6407e9L; + 0xff2af1f1e3f1db12L; 0xe6cc7373d173bfa2L; 0x248212124812905aL; + 0x807a40401d403a5dL; 0x1048080820084028L; 0x9b95c3c32bc356e8L; + 0xc5dfecec97ec337bL; 0xab4ddbdb4bdb9690L; 0x5fc0a1a1bea1611fL; + 0x07918d8d0e8d1c83L; 0x7ac83d3df43df5c9L; 0x335b97976697ccf1L; + 0x0000000000000000L; 0x83f9cfcf1bcf36d4L; 0x566e2b2bac2b4587L; + 0xece17676c57697b3L; 0x19e68282328264b0L; 0xb128d6d67fd6fea9L; + 0x36c31b1b6c1bd877L; 0x7774b5b5eeb5c15bL; 0x43beafaf86af1129L; + 0xd41d6a6ab56a77dfL; 0xa0ea50505d50ba0dL; 0x8a5745450945124cL; + 0xfb38f3f3ebf3cb18L; 0x60ad3030c0309df0L; 0xc3c4efef9bef2b74L; + 0x7eda3f3ffc3fe5c3L; 0xaac755554955921cL; 0x59dba2a2b2a27910L; + 0xc9e9eaea8fea0365L; 0xca6a656589650fecL; 0x6903babad2bab968L; + 0x5e4a2f2fbc2f6593L; 0x9d8ec0c027c04ee7L; 0xa160dede5fdebe81L; + 0x38fc1c1c701ce06cL; 0xe746fdfdd3fdbb2eL; 0x9a1f4d4d294d5264L; + 0x397692927292e4e0L; 0xeafa7575c9758fbcL; 0x0c3606061806301eL; + 0x09ae8a8a128a2498L; 0x794bb2b2f2b2f940L; 0xd185e6e6bfe66359L; + 0x1c7e0e0e380e7036L; 0x3ee71f1f7c1ff863L; 0xc4556262956237f7L; + 0xb53ad4d477d4eea3L; 0x4d81a8a89aa82932L; 0x315296966296c4f4L; + 0xef62f9f9c3f99b3aL; 0x97a3c5c533c566f6L; 0x4a102525942535b1L; + 0xb2ab59597959f220L; 0x15d084842a8454aeL; 0xe4c57272d572b7a7L; + 0x72ec3939e439d5ddL; 0x98164c4c2d4c5a61L; 0xbc945e5e655eca3bL; + 0xf09f7878fd78e785L; 0x70e53838e038ddd8L; 0x05988c8c0a8c1486L; + 0xbf17d1d163d1c6b2L; 0x57e4a5a5aea5410bL; 0xd9a1e2e2afe2434dL; + 0xc24e616199612ff8L; 0x7b42b3b3f6b3f145L; 0x42342121842115a5L; + 0x25089c9c4a9c94d6L; 0x3cee1e1e781ef066L; 0x8661434311432252L; + 0x93b1c7c73bc776fcL; 0xe54ffcfcd7fcb32bL; 0x0824040410042014L; + 0xa2e351515951b208L; 0x2f2599995e99bcc7L; 0xda226d6da96d4fc4L; + 0x1a650d0d340d6839L; 0xe979fafacffa8335L; 0xa369dfdf5bdfb684L; + 0xfca97e7ee57ed79bL; 0x4819242490243db4L; 0x76fe3b3bec3bc5d7L; + 0x4b9aabab96ab313dL; 0x81f0cece1fce3ed1L; 0x2299111144118855L; + 0x03838f8f068f0c89L; 0x9c044e4e254e4a6bL; 0x7366b7b7e6b7d151L; + 0xcbe0ebeb8beb0b60L; 0x78c13c3cf03cfdccL; 0x1ffd81813e817cbfL; + 0x354094946a94d4feL; 0xf31cf7f7fbf7eb0cL; 0x6f18b9b9deb9a167L; + 0x268b13134c13985fL; 0x58512c2cb02c7d9cL; 0xbb05d3d36bd3d6b8L; + 0xd38ce7e7bbe76b5cL; 0xdc396e6ea56e57cbL; 0x95aac4c437c46ef3L; + 0x061b03030c03180fL; 0xacdc565645568a13L; 0x885e44440d441a49L; + 0xfea07f7fe17fdf9eL; 0x4f88a9a99ea92137L; 0x54672a2aa82a4d82L; + 0x6b0abbbbd6bbb16dL; 0x9f87c1c123c146e2L; 0xa6f153535153a202L; + 0xa572dcdc57dcae8bL; 0x16530b0b2c0b5827L; 0x27019d9d4e9d9cd3L; + 0xd82b6c6cad6c47c1L; 0x62a43131c43195f5L; 0xe8f37474cd7487b9L; + 0xf115f6f6fff6e309L; 0x8c4c464605460a43L; 0x45a5acac8aac0926L; + 0x0fb589891e893c97L; 0x28b414145014a044L; 0xdfbae1e1a3e15b42L; + 0x2ca616165816b04eL; 0x74f73a3ae83acdd2L; 0xd2066969b9696fd0L; + 0x124109092409482dL; 0xe0d77070dd70a7adL; 0x716fb6b6e2b6d954L; + 0xbd1ed0d067d0ceb7L; 0xc7d6eded93ed3b7eL; 0x85e2cccc17cc2edbL; + 0x8468424215422a57L; 0x2d2c98985a98b4c2L; 0x55eda4a4aaa4490eL; + 0x50752828a0285d88L; 0xb8865c5c6d5cda31L; 0xed6bf8f8c7f8933fL; + 0x11c28686228644a4L; + |]; + [| + 0x7830d818186018c0L; 0xaf462623238c2305L; 0xf991b8c6c63fc67eL; + 0x6fcdfbe8e887e813L; 0xa113cb878726874cL; 0x626d11b8b8dab8a9L; + 0x0502090101040108L; 0x6e9e0d4f4f214f42L; 0xee6c9b3636d836adL; + 0x0451ffa6a6a2a659L; 0xbdb90cd2d26fd2deL; 0x06f70ef5f5f3f5fbL; + 0x80f2967979f979efL; 0xcede306f6fa16f5fL; 0xef3f6d91917e91fcL; + 0x07a4f852525552aaL; 0xfdc04760609d6027L; 0x766535bcbccabc89L; + 0xcd2b379b9b569bacL; 0x8c018a8e8e028e04L; 0x155bd2a3a3b6a371L; + 0x3c186c0c0c300c60L; 0x8af6847b7bf17bffL; 0xe16a803535d435b5L; + 0x693af51d1d741de8L; 0x47ddb3e0e0a7e053L; 0xacb321d7d77bd7f6L; + 0xed999cc2c22fc25eL; 0x965c432e2eb82e6dL; 0x7a96294b4b314b62L; + 0x21e15dfefedffea3L; 0x16aed55757415782L; 0x412abd15155415a8L; + 0xb6eee87777c1779fL; 0xeb6e923737dc37a5L; 0x56d79ee5e5b3e57bL; + 0xd923139f9f469f8cL; 0x17fd23f0f0e7f0d3L; 0x7f94204a4a354a6aL; + 0x95a944dada4fda9eL; 0x25b0a258587d58faL; 0xca8fcfc9c903c906L; + 0x8d527c2929a42955L; 0x22145a0a0a280a50L; 0x4f7f50b1b1feb1e1L; + 0x1a5dc9a0a0baa069L; 0xdad6146b6bb16b7fL; 0xab17d985852e855cL; + 0x73673cbdbdcebd81L; 0x34ba8f5d5d695dd2L; 0x5020901010401080L; + 0x03f507f4f4f7f4f3L; 0xc08bddcbcb0bcb16L; 0xc67cd33e3ef83eedL; + 0x110a2d0505140528L; 0xe6ce78676781671fL; 0x53d597e4e4b7e473L; + 0xbb4e0227279c2725L; 0x5882734141194132L; 0x9d0ba78b8b168b2cL; + 0x0153f6a7a7a6a751L; 0x94fab27d7de97dcfL; 0xfb374995956e95dcL; + 0x9fad56d8d847d88eL; 0x30eb70fbfbcbfb8bL; 0x71c1cdeeee9fee23L; + 0x91f8bb7c7ced7cc7L; 0xe3cc716666856617L; 0x8ea77bdddd53dda6L; + 0x4b2eaf17175c17b8L; 0x468e454747014702L; 0xdc211a9e9e429e84L; + 0xc589d4caca0fca1eL; 0x995a582d2db42d75L; 0x79632ebfbfc6bf91L; + 0x1b0e3f07071c0738L; 0x2347acadad8ead01L; 0x2fb4b05a5a755aeaL; + 0xb51bef838336836cL; 0xff66b63333cc3385L; 0xf2c65c636391633fL; + 0x0a04120202080210L; 0x384993aaaa92aa39L; 0xa8e2de7171d971afL; + 0xcf8dc6c8c807c80eL; 0x7d32d119196419c8L; 0x70923b4949394972L; + 0x9aaf5fd9d943d986L; 0x1df931f2f2eff2c3L; 0x48dba8e3e3abe34bL; + 0x2ab6b95b5b715be2L; 0x920dbc88881a8834L; 0xc8293e9a9a529aa4L; + 0xbe4c0b262698262dL; 0xfa64bf3232c8328dL; 0x4a7d59b0b0fab0e9L; + 0x6acff2e9e983e91bL; 0x331e770f0f3c0f78L; 0xa6b733d5d573d5e6L; + 0xba1df480803a8074L; 0x7c6127bebec2be99L; 0xde87ebcdcd13cd26L; + 0xe468893434d034bdL; 0x75903248483d487aL; 0x24e354ffffdbffabL; + 0x8ff48d7a7af57af7L; 0xea3d6490907a90f4L; 0x3ebe9d5f5f615fc2L; + 0xa0403d202080201dL; 0xd5d00f6868bd6867L; 0x7234ca1a1a681ad0L; + 0x2c41b7aeae82ae19L; 0x5e757db4b4eab4c9L; 0x19a8ce54544d549aL; + 0xe53b7f93937693ecL; 0xaa442f222288220dL; 0xe9c86364648d6407L; + 0x12ff2af1f1e3f1dbL; 0xa2e6cc7373d173bfL; 0x5a24821212481290L; + 0x5d807a40401d403aL; 0x2810480808200840L; 0xe89b95c3c32bc356L; + 0x7bc5dfecec97ec33L; 0x90ab4ddbdb4bdb96L; 0x1f5fc0a1a1bea161L; + 0x8307918d8d0e8d1cL; 0xc97ac83d3df43df5L; 0xf1335b97976697ccL; + 0x0000000000000000L; 0xd483f9cfcf1bcf36L; 0x87566e2b2bac2b45L; + 0xb3ece17676c57697L; 0xb019e68282328264L; 0xa9b128d6d67fd6feL; + 0x7736c31b1b6c1bd8L; 0x5b7774b5b5eeb5c1L; 0x2943beafaf86af11L; + 0xdfd41d6a6ab56a77L; 0x0da0ea50505d50baL; 0x4c8a574545094512L; + 0x18fb38f3f3ebf3cbL; 0xf060ad3030c0309dL; 0x74c3c4efef9bef2bL; + 0xc37eda3f3ffc3fe5L; 0x1caac75555495592L; 0x1059dba2a2b2a279L; + 0x65c9e9eaea8fea03L; 0xecca6a656589650fL; 0x686903babad2bab9L; + 0x935e4a2f2fbc2f65L; 0xe79d8ec0c027c04eL; 0x81a160dede5fdebeL; + 0x6c38fc1c1c701ce0L; 0x2ee746fdfdd3fdbbL; 0x649a1f4d4d294d52L; + 0xe0397692927292e4L; 0xbceafa7575c9758fL; 0x1e0c360606180630L; + 0x9809ae8a8a128a24L; 0x40794bb2b2f2b2f9L; 0x59d185e6e6bfe663L; + 0x361c7e0e0e380e70L; 0x633ee71f1f7c1ff8L; 0xf7c4556262956237L; + 0xa3b53ad4d477d4eeL; 0x324d81a8a89aa829L; 0xf4315296966296c4L; + 0x3aef62f9f9c3f99bL; 0xf697a3c5c533c566L; 0xb14a102525942535L; + 0x20b2ab59597959f2L; 0xae15d084842a8454L; 0xa7e4c57272d572b7L; + 0xdd72ec3939e439d5L; 0x6198164c4c2d4c5aL; 0x3bbc945e5e655ecaL; + 0x85f09f7878fd78e7L; 0xd870e53838e038ddL; 0x8605988c8c0a8c14L; + 0xb2bf17d1d163d1c6L; 0x0b57e4a5a5aea541L; 0x4dd9a1e2e2afe243L; + 0xf8c24e616199612fL; 0x457b42b3b3f6b3f1L; 0xa542342121842115L; + 0xd625089c9c4a9c94L; 0x663cee1e1e781ef0L; 0x5286614343114322L; + 0xfc93b1c7c73bc776L; 0x2be54ffcfcd7fcb3L; 0x1408240404100420L; + 0x08a2e351515951b2L; 0xc72f2599995e99bcL; 0xc4da226d6da96d4fL; + 0x391a650d0d340d68L; 0x35e979fafacffa83L; 0x84a369dfdf5bdfb6L; + 0x9bfca97e7ee57ed7L; 0xb44819242490243dL; 0xd776fe3b3bec3bc5L; + 0x3d4b9aabab96ab31L; 0xd181f0cece1fce3eL; 0x5522991111441188L; + 0x8903838f8f068f0cL; 0x6b9c044e4e254e4aL; 0x517366b7b7e6b7d1L; + 0x60cbe0ebeb8beb0bL; 0xcc78c13c3cf03cfdL; 0xbf1ffd81813e817cL; + 0xfe354094946a94d4L; 0x0cf31cf7f7fbf7ebL; 0x676f18b9b9deb9a1L; + 0x5f268b13134c1398L; 0x9c58512c2cb02c7dL; 0xb8bb05d3d36bd3d6L; + 0x5cd38ce7e7bbe76bL; 0xcbdc396e6ea56e57L; 0xf395aac4c437c46eL; + 0x0f061b03030c0318L; 0x13acdc565645568aL; 0x49885e44440d441aL; + 0x9efea07f7fe17fdfL; 0x374f88a9a99ea921L; 0x8254672a2aa82a4dL; + 0x6d6b0abbbbd6bbb1L; 0xe29f87c1c123c146L; 0x02a6f153535153a2L; + 0x8ba572dcdc57dcaeL; 0x2716530b0b2c0b58L; 0xd327019d9d4e9d9cL; + 0xc1d82b6c6cad6c47L; 0xf562a43131c43195L; 0xb9e8f37474cd7487L; + 0x09f115f6f6fff6e3L; 0x438c4c464605460aL; 0x2645a5acac8aac09L; + 0x970fb589891e893cL; 0x4428b414145014a0L; 0x42dfbae1e1a3e15bL; + 0x4e2ca616165816b0L; 0xd274f73a3ae83acdL; 0xd0d2066969b9696fL; + 0x2d12410909240948L; 0xade0d77070dd70a7L; 0x54716fb6b6e2b6d9L; + 0xb7bd1ed0d067d0ceL; 0x7ec7d6eded93ed3bL; 0xdb85e2cccc17cc2eL; + 0x578468424215422aL; 0xc22d2c98985a98b4L; 0x0e55eda4a4aaa449L; + 0x8850752828a0285dL; 0x31b8865c5c6d5cdaL; 0x3fed6bf8f8c7f893L; + 0xa411c28686228644L; + |]; + [| + 0xc07830d818186018L; 0x05af462623238c23L; 0x7ef991b8c6c63fc6L; + 0x136fcdfbe8e887e8L; 0x4ca113cb87872687L; 0xa9626d11b8b8dab8L; + 0x0805020901010401L; 0x426e9e0d4f4f214fL; 0xadee6c9b3636d836L; + 0x590451ffa6a6a2a6L; 0xdebdb90cd2d26fd2L; 0xfb06f70ef5f5f3f5L; + 0xef80f2967979f979L; 0x5fcede306f6fa16fL; 0xfcef3f6d91917e91L; + 0xaa07a4f852525552L; 0x27fdc04760609d60L; 0x89766535bcbccabcL; + 0xaccd2b379b9b569bL; 0x048c018a8e8e028eL; 0x71155bd2a3a3b6a3L; + 0x603c186c0c0c300cL; 0xff8af6847b7bf17bL; 0xb5e16a803535d435L; + 0xe8693af51d1d741dL; 0x5347ddb3e0e0a7e0L; 0xf6acb321d7d77bd7L; + 0x5eed999cc2c22fc2L; 0x6d965c432e2eb82eL; 0x627a96294b4b314bL; + 0xa321e15dfefedffeL; 0x8216aed557574157L; 0xa8412abd15155415L; + 0x9fb6eee87777c177L; 0xa5eb6e923737dc37L; 0x7b56d79ee5e5b3e5L; + 0x8cd923139f9f469fL; 0xd317fd23f0f0e7f0L; 0x6a7f94204a4a354aL; + 0x9e95a944dada4fdaL; 0xfa25b0a258587d58L; 0x06ca8fcfc9c903c9L; + 0x558d527c2929a429L; 0x5022145a0a0a280aL; 0xe14f7f50b1b1feb1L; + 0x691a5dc9a0a0baa0L; 0x7fdad6146b6bb16bL; 0x5cab17d985852e85L; + 0x8173673cbdbdcebdL; 0xd234ba8f5d5d695dL; 0x8050209010104010L; + 0xf303f507f4f4f7f4L; 0x16c08bddcbcb0bcbL; 0xedc67cd33e3ef83eL; + 0x28110a2d05051405L; 0x1fe6ce7867678167L; 0x7353d597e4e4b7e4L; + 0x25bb4e0227279c27L; 0x3258827341411941L; 0x2c9d0ba78b8b168bL; + 0x510153f6a7a7a6a7L; 0xcf94fab27d7de97dL; 0xdcfb374995956e95L; + 0x8e9fad56d8d847d8L; 0x8b30eb70fbfbcbfbL; 0x2371c1cdeeee9feeL; + 0xc791f8bb7c7ced7cL; 0x17e3cc7166668566L; 0xa68ea77bdddd53ddL; + 0xb84b2eaf17175c17L; 0x02468e4547470147L; 0x84dc211a9e9e429eL; + 0x1ec589d4caca0fcaL; 0x75995a582d2db42dL; 0x9179632ebfbfc6bfL; + 0x381b0e3f07071c07L; 0x012347acadad8eadL; 0xea2fb4b05a5a755aL; + 0x6cb51bef83833683L; 0x85ff66b63333cc33L; 0x3ff2c65c63639163L; + 0x100a041202020802L; 0x39384993aaaa92aaL; 0xafa8e2de7171d971L; + 0x0ecf8dc6c8c807c8L; 0xc87d32d119196419L; 0x7270923b49493949L; + 0x869aaf5fd9d943d9L; 0xc31df931f2f2eff2L; 0x4b48dba8e3e3abe3L; + 0xe22ab6b95b5b715bL; 0x34920dbc88881a88L; 0xa4c8293e9a9a529aL; + 0x2dbe4c0b26269826L; 0x8dfa64bf3232c832L; 0xe94a7d59b0b0fab0L; + 0x1b6acff2e9e983e9L; 0x78331e770f0f3c0fL; 0xe6a6b733d5d573d5L; + 0x74ba1df480803a80L; 0x997c6127bebec2beL; 0x26de87ebcdcd13cdL; + 0xbde468893434d034L; 0x7a75903248483d48L; 0xab24e354ffffdbffL; + 0xf78ff48d7a7af57aL; 0xf4ea3d6490907a90L; 0xc23ebe9d5f5f615fL; + 0x1da0403d20208020L; 0x67d5d00f6868bd68L; 0xd07234ca1a1a681aL; + 0x192c41b7aeae82aeL; 0xc95e757db4b4eab4L; 0x9a19a8ce54544d54L; + 0xece53b7f93937693L; 0x0daa442f22228822L; 0x07e9c86364648d64L; + 0xdb12ff2af1f1e3f1L; 0xbfa2e6cc7373d173L; 0x905a248212124812L; + 0x3a5d807a40401d40L; 0x4028104808082008L; 0x56e89b95c3c32bc3L; + 0x337bc5dfecec97ecL; 0x9690ab4ddbdb4bdbL; 0x611f5fc0a1a1bea1L; + 0x1c8307918d8d0e8dL; 0xf5c97ac83d3df43dL; 0xccf1335b97976697L; + 0x0000000000000000L; 0x36d483f9cfcf1bcfL; 0x4587566e2b2bac2bL; + 0x97b3ece17676c576L; 0x64b019e682823282L; 0xfea9b128d6d67fd6L; + 0xd87736c31b1b6c1bL; 0xc15b7774b5b5eeb5L; 0x112943beafaf86afL; + 0x77dfd41d6a6ab56aL; 0xba0da0ea50505d50L; 0x124c8a5745450945L; + 0xcb18fb38f3f3ebf3L; 0x9df060ad3030c030L; 0x2b74c3c4efef9befL; + 0xe5c37eda3f3ffc3fL; 0x921caac755554955L; 0x791059dba2a2b2a2L; + 0x0365c9e9eaea8feaL; 0x0fecca6a65658965L; 0xb9686903babad2baL; + 0x65935e4a2f2fbc2fL; 0x4ee79d8ec0c027c0L; 0xbe81a160dede5fdeL; + 0xe06c38fc1c1c701cL; 0xbb2ee746fdfdd3fdL; 0x52649a1f4d4d294dL; + 0xe4e0397692927292L; 0x8fbceafa7575c975L; 0x301e0c3606061806L; + 0x249809ae8a8a128aL; 0xf940794bb2b2f2b2L; 0x6359d185e6e6bfe6L; + 0x70361c7e0e0e380eL; 0xf8633ee71f1f7c1fL; 0x37f7c45562629562L; + 0xeea3b53ad4d477d4L; 0x29324d81a8a89aa8L; 0xc4f4315296966296L; + 0x9b3aef62f9f9c3f9L; 0x66f697a3c5c533c5L; 0x35b14a1025259425L; + 0xf220b2ab59597959L; 0x54ae15d084842a84L; 0xb7a7e4c57272d572L; + 0xd5dd72ec3939e439L; 0x5a6198164c4c2d4cL; 0xca3bbc945e5e655eL; + 0xe785f09f7878fd78L; 0xddd870e53838e038L; 0x148605988c8c0a8cL; + 0xc6b2bf17d1d163d1L; 0x410b57e4a5a5aea5L; 0x434dd9a1e2e2afe2L; + 0x2ff8c24e61619961L; 0xf1457b42b3b3f6b3L; 0x15a5423421218421L; + 0x94d625089c9c4a9cL; 0xf0663cee1e1e781eL; 0x2252866143431143L; + 0x76fc93b1c7c73bc7L; 0xb32be54ffcfcd7fcL; 0x2014082404041004L; + 0xb208a2e351515951L; 0xbcc72f2599995e99L; 0x4fc4da226d6da96dL; + 0x68391a650d0d340dL; 0x8335e979fafacffaL; 0xb684a369dfdf5bdfL; + 0xd79bfca97e7ee57eL; 0x3db4481924249024L; 0xc5d776fe3b3bec3bL; + 0x313d4b9aabab96abL; 0x3ed181f0cece1fceL; 0x8855229911114411L; + 0x0c8903838f8f068fL; 0x4a6b9c044e4e254eL; 0xd1517366b7b7e6b7L; + 0x0b60cbe0ebeb8bebL; 0xfdcc78c13c3cf03cL; 0x7cbf1ffd81813e81L; + 0xd4fe354094946a94L; 0xeb0cf31cf7f7fbf7L; 0xa1676f18b9b9deb9L; + 0x985f268b13134c13L; 0x7d9c58512c2cb02cL; 0xd6b8bb05d3d36bd3L; + 0x6b5cd38ce7e7bbe7L; 0x57cbdc396e6ea56eL; 0x6ef395aac4c437c4L; + 0x180f061b03030c03L; 0x8a13acdc56564556L; 0x1a49885e44440d44L; + 0xdf9efea07f7fe17fL; 0x21374f88a9a99ea9L; 0x4d8254672a2aa82aL; + 0xb16d6b0abbbbd6bbL; 0x46e29f87c1c123c1L; 0xa202a6f153535153L; + 0xae8ba572dcdc57dcL; 0x582716530b0b2c0bL; 0x9cd327019d9d4e9dL; + 0x47c1d82b6c6cad6cL; 0x95f562a43131c431L; 0x87b9e8f37474cd74L; + 0xe309f115f6f6fff6L; 0x0a438c4c46460546L; 0x092645a5acac8aacL; + 0x3c970fb589891e89L; 0xa04428b414145014L; 0x5b42dfbae1e1a3e1L; + 0xb04e2ca616165816L; 0xcdd274f73a3ae83aL; 0x6fd0d2066969b969L; + 0x482d124109092409L; 0xa7ade0d77070dd70L; 0xd954716fb6b6e2b6L; + 0xceb7bd1ed0d067d0L; 0x3b7ec7d6eded93edL; 0x2edb85e2cccc17ccL; + 0x2a57846842421542L; 0xb4c22d2c98985a98L; 0x490e55eda4a4aaa4L; + 0x5d8850752828a028L; 0xda31b8865c5c6d5cL; 0x933fed6bf8f8c7f8L; + 0x44a411c286862286L; + |]; + [| + 0x18c07830d8181860L; 0x2305af462623238cL; 0xc67ef991b8c6c63fL; + 0xe8136fcdfbe8e887L; 0x874ca113cb878726L; 0xb8a9626d11b8b8daL; + 0x0108050209010104L; 0x4f426e9e0d4f4f21L; 0x36adee6c9b3636d8L; + 0xa6590451ffa6a6a2L; 0xd2debdb90cd2d26fL; 0xf5fb06f70ef5f5f3L; + 0x79ef80f2967979f9L; 0x6f5fcede306f6fa1L; 0x91fcef3f6d91917eL; + 0x52aa07a4f8525255L; 0x6027fdc04760609dL; 0xbc89766535bcbccaL; + 0x9baccd2b379b9b56L; 0x8e048c018a8e8e02L; 0xa371155bd2a3a3b6L; + 0x0c603c186c0c0c30L; 0x7bff8af6847b7bf1L; 0x35b5e16a803535d4L; + 0x1de8693af51d1d74L; 0xe05347ddb3e0e0a7L; 0xd7f6acb321d7d77bL; + 0xc25eed999cc2c22fL; 0x2e6d965c432e2eb8L; 0x4b627a96294b4b31L; + 0xfea321e15dfefedfL; 0x578216aed5575741L; 0x15a8412abd151554L; + 0x779fb6eee87777c1L; 0x37a5eb6e923737dcL; 0xe57b56d79ee5e5b3L; + 0x9f8cd923139f9f46L; 0xf0d317fd23f0f0e7L; 0x4a6a7f94204a4a35L; + 0xda9e95a944dada4fL; 0x58fa25b0a258587dL; 0xc906ca8fcfc9c903L; + 0x29558d527c2929a4L; 0x0a5022145a0a0a28L; 0xb1e14f7f50b1b1feL; + 0xa0691a5dc9a0a0baL; 0x6b7fdad6146b6bb1L; 0x855cab17d985852eL; + 0xbd8173673cbdbdceL; 0x5dd234ba8f5d5d69L; 0x1080502090101040L; + 0xf4f303f507f4f4f7L; 0xcb16c08bddcbcb0bL; 0x3eedc67cd33e3ef8L; + 0x0528110a2d050514L; 0x671fe6ce78676781L; 0xe47353d597e4e4b7L; + 0x2725bb4e0227279cL; 0x4132588273414119L; 0x8b2c9d0ba78b8b16L; + 0xa7510153f6a7a7a6L; 0x7dcf94fab27d7de9L; 0x95dcfb374995956eL; + 0xd88e9fad56d8d847L; 0xfb8b30eb70fbfbcbL; 0xee2371c1cdeeee9fL; + 0x7cc791f8bb7c7cedL; 0x6617e3cc71666685L; 0xdda68ea77bdddd53L; + 0x17b84b2eaf17175cL; 0x4702468e45474701L; 0x9e84dc211a9e9e42L; + 0xca1ec589d4caca0fL; 0x2d75995a582d2db4L; 0xbf9179632ebfbfc6L; + 0x07381b0e3f07071cL; 0xad012347acadad8eL; 0x5aea2fb4b05a5a75L; + 0x836cb51bef838336L; 0x3385ff66b63333ccL; 0x633ff2c65c636391L; + 0x02100a0412020208L; 0xaa39384993aaaa92L; 0x71afa8e2de7171d9L; + 0xc80ecf8dc6c8c807L; 0x19c87d32d1191964L; 0x497270923b494939L; + 0xd9869aaf5fd9d943L; 0xf2c31df931f2f2efL; 0xe34b48dba8e3e3abL; + 0x5be22ab6b95b5b71L; 0x8834920dbc88881aL; 0x9aa4c8293e9a9a52L; + 0x262dbe4c0b262698L; 0x328dfa64bf3232c8L; 0xb0e94a7d59b0b0faL; + 0xe91b6acff2e9e983L; 0x0f78331e770f0f3cL; 0xd5e6a6b733d5d573L; + 0x8074ba1df480803aL; 0xbe997c6127bebec2L; 0xcd26de87ebcdcd13L; + 0x34bde468893434d0L; 0x487a75903248483dL; 0xffab24e354ffffdbL; + 0x7af78ff48d7a7af5L; 0x90f4ea3d6490907aL; 0x5fc23ebe9d5f5f61L; + 0x201da0403d202080L; 0x6867d5d00f6868bdL; 0x1ad07234ca1a1a68L; + 0xae192c41b7aeae82L; 0xb4c95e757db4b4eaL; 0x549a19a8ce54544dL; + 0x93ece53b7f939376L; 0x220daa442f222288L; 0x6407e9c86364648dL; + 0xf1db12ff2af1f1e3L; 0x73bfa2e6cc7373d1L; 0x12905a2482121248L; + 0x403a5d807a40401dL; 0x0840281048080820L; 0xc356e89b95c3c32bL; + 0xec337bc5dfecec97L; 0xdb9690ab4ddbdb4bL; 0xa1611f5fc0a1a1beL; + 0x8d1c8307918d8d0eL; 0x3df5c97ac83d3df4L; 0x97ccf1335b979766L; + 0x0000000000000000L; 0xcf36d483f9cfcf1bL; 0x2b4587566e2b2bacL; + 0x7697b3ece17676c5L; 0x8264b019e6828232L; 0xd6fea9b128d6d67fL; + 0x1bd87736c31b1b6cL; 0xb5c15b7774b5b5eeL; 0xaf112943beafaf86L; + 0x6a77dfd41d6a6ab5L; 0x50ba0da0ea50505dL; 0x45124c8a57454509L; + 0xf3cb18fb38f3f3ebL; 0x309df060ad3030c0L; 0xef2b74c3c4efef9bL; + 0x3fe5c37eda3f3ffcL; 0x55921caac7555549L; 0xa2791059dba2a2b2L; + 0xea0365c9e9eaea8fL; 0x650fecca6a656589L; 0xbab9686903babad2L; + 0x2f65935e4a2f2fbcL; 0xc04ee79d8ec0c027L; 0xdebe81a160dede5fL; + 0x1ce06c38fc1c1c70L; 0xfdbb2ee746fdfdd3L; 0x4d52649a1f4d4d29L; + 0x92e4e03976929272L; 0x758fbceafa7575c9L; 0x06301e0c36060618L; + 0x8a249809ae8a8a12L; 0xb2f940794bb2b2f2L; 0xe66359d185e6e6bfL; + 0x0e70361c7e0e0e38L; 0x1ff8633ee71f1f7cL; 0x6237f7c455626295L; + 0xd4eea3b53ad4d477L; 0xa829324d81a8a89aL; 0x96c4f43152969662L; + 0xf99b3aef62f9f9c3L; 0xc566f697a3c5c533L; 0x2535b14a10252594L; + 0x59f220b2ab595979L; 0x8454ae15d084842aL; 0x72b7a7e4c57272d5L; + 0x39d5dd72ec3939e4L; 0x4c5a6198164c4c2dL; 0x5eca3bbc945e5e65L; + 0x78e785f09f7878fdL; 0x38ddd870e53838e0L; 0x8c148605988c8c0aL; + 0xd1c6b2bf17d1d163L; 0xa5410b57e4a5a5aeL; 0xe2434dd9a1e2e2afL; + 0x612ff8c24e616199L; 0xb3f1457b42b3b3f6L; 0x2115a54234212184L; + 0x9c94d625089c9c4aL; 0x1ef0663cee1e1e78L; 0x4322528661434311L; + 0xc776fc93b1c7c73bL; 0xfcb32be54ffcfcd7L; 0x0420140824040410L; + 0x51b208a2e3515159L; 0x99bcc72f2599995eL; 0x6d4fc4da226d6da9L; + 0x0d68391a650d0d34L; 0xfa8335e979fafacfL; 0xdfb684a369dfdf5bL; + 0x7ed79bfca97e7ee5L; 0x243db44819242490L; 0x3bc5d776fe3b3becL; + 0xab313d4b9aabab96L; 0xce3ed181f0cece1fL; 0x1188552299111144L; + 0x8f0c8903838f8f06L; 0x4e4a6b9c044e4e25L; 0xb7d1517366b7b7e6L; + 0xeb0b60cbe0ebeb8bL; 0x3cfdcc78c13c3cf0L; 0x817cbf1ffd81813eL; + 0x94d4fe354094946aL; 0xf7eb0cf31cf7f7fbL; 0xb9a1676f18b9b9deL; + 0x13985f268b13134cL; 0x2c7d9c58512c2cb0L; 0xd3d6b8bb05d3d36bL; + 0xe76b5cd38ce7e7bbL; 0x6e57cbdc396e6ea5L; 0xc46ef395aac4c437L; + 0x03180f061b03030cL; 0x568a13acdc565645L; 0x441a49885e44440dL; + 0x7fdf9efea07f7fe1L; 0xa921374f88a9a99eL; 0x2a4d8254672a2aa8L; + 0xbbb16d6b0abbbbd6L; 0xc146e29f87c1c123L; 0x53a202a6f1535351L; + 0xdcae8ba572dcdc57L; 0x0b582716530b0b2cL; 0x9d9cd327019d9d4eL; + 0x6c47c1d82b6c6cadL; 0x3195f562a43131c4L; 0x7487b9e8f37474cdL; + 0xf6e309f115f6f6ffL; 0x460a438c4c464605L; 0xac092645a5acac8aL; + 0x893c970fb589891eL; 0x14a04428b4141450L; 0xe15b42dfbae1e1a3L; + 0x16b04e2ca6161658L; 0x3acdd274f73a3ae8L; 0x696fd0d2066969b9L; + 0x09482d1241090924L; 0x70a7ade0d77070ddL; 0xb6d954716fb6b6e2L; + 0xd0ceb7bd1ed0d067L; 0xed3b7ec7d6eded93L; 0xcc2edb85e2cccc17L; + 0x422a578468424215L; 0x98b4c22d2c98985aL; 0xa4490e55eda4a4aaL; + 0x285d8850752828a0L; 0x5cda31b8865c5c6dL; 0xf8933fed6bf8f8c7L; + 0x8644a411c2868622L; + |]; + [| + 0x6018c07830d81818L; 0x8c2305af46262323L; 0x3fc67ef991b8c6c6L; + 0x87e8136fcdfbe8e8L; 0x26874ca113cb8787L; 0xdab8a9626d11b8b8L; + 0x0401080502090101L; 0x214f426e9e0d4f4fL; 0xd836adee6c9b3636L; + 0xa2a6590451ffa6a6L; 0x6fd2debdb90cd2d2L; 0xf3f5fb06f70ef5f5L; + 0xf979ef80f2967979L; 0xa16f5fcede306f6fL; 0x7e91fcef3f6d9191L; + 0x5552aa07a4f85252L; 0x9d6027fdc0476060L; 0xcabc89766535bcbcL; + 0x569baccd2b379b9bL; 0x028e048c018a8e8eL; 0xb6a371155bd2a3a3L; + 0x300c603c186c0c0cL; 0xf17bff8af6847b7bL; 0xd435b5e16a803535L; + 0x741de8693af51d1dL; 0xa7e05347ddb3e0e0L; 0x7bd7f6acb321d7d7L; + 0x2fc25eed999cc2c2L; 0xb82e6d965c432e2eL; 0x314b627a96294b4bL; + 0xdffea321e15dfefeL; 0x41578216aed55757L; 0x5415a8412abd1515L; + 0xc1779fb6eee87777L; 0xdc37a5eb6e923737L; 0xb3e57b56d79ee5e5L; + 0x469f8cd923139f9fL; 0xe7f0d317fd23f0f0L; 0x354a6a7f94204a4aL; + 0x4fda9e95a944dadaL; 0x7d58fa25b0a25858L; 0x03c906ca8fcfc9c9L; + 0xa429558d527c2929L; 0x280a5022145a0a0aL; 0xfeb1e14f7f50b1b1L; + 0xbaa0691a5dc9a0a0L; 0xb16b7fdad6146b6bL; 0x2e855cab17d98585L; + 0xcebd8173673cbdbdL; 0x695dd234ba8f5d5dL; 0x4010805020901010L; + 0xf7f4f303f507f4f4L; 0x0bcb16c08bddcbcbL; 0xf83eedc67cd33e3eL; + 0x140528110a2d0505L; 0x81671fe6ce786767L; 0xb7e47353d597e4e4L; + 0x9c2725bb4e022727L; 0x1941325882734141L; 0x168b2c9d0ba78b8bL; + 0xa6a7510153f6a7a7L; 0xe97dcf94fab27d7dL; 0x6e95dcfb37499595L; + 0x47d88e9fad56d8d8L; 0xcbfb8b30eb70fbfbL; 0x9fee2371c1cdeeeeL; + 0xed7cc791f8bb7c7cL; 0x856617e3cc716666L; 0x53dda68ea77bddddL; + 0x5c17b84b2eaf1717L; 0x014702468e454747L; 0x429e84dc211a9e9eL; + 0x0fca1ec589d4cacaL; 0xb42d75995a582d2dL; 0xc6bf9179632ebfbfL; + 0x1c07381b0e3f0707L; 0x8ead012347acadadL; 0x755aea2fb4b05a5aL; + 0x36836cb51bef8383L; 0xcc3385ff66b63333L; 0x91633ff2c65c6363L; + 0x0802100a04120202L; 0x92aa39384993aaaaL; 0xd971afa8e2de7171L; + 0x07c80ecf8dc6c8c8L; 0x6419c87d32d11919L; 0x39497270923b4949L; + 0x43d9869aaf5fd9d9L; 0xeff2c31df931f2f2L; 0xabe34b48dba8e3e3L; + 0x715be22ab6b95b5bL; 0x1a8834920dbc8888L; 0x529aa4c8293e9a9aL; + 0x98262dbe4c0b2626L; 0xc8328dfa64bf3232L; 0xfab0e94a7d59b0b0L; + 0x83e91b6acff2e9e9L; 0x3c0f78331e770f0fL; 0x73d5e6a6b733d5d5L; + 0x3a8074ba1df48080L; 0xc2be997c6127bebeL; 0x13cd26de87ebcdcdL; + 0xd034bde468893434L; 0x3d487a7590324848L; 0xdbffab24e354ffffL; + 0xf57af78ff48d7a7aL; 0x7a90f4ea3d649090L; 0x615fc23ebe9d5f5fL; + 0x80201da0403d2020L; 0xbd6867d5d00f6868L; 0x681ad07234ca1a1aL; + 0x82ae192c41b7aeaeL; 0xeab4c95e757db4b4L; 0x4d549a19a8ce5454L; + 0x7693ece53b7f9393L; 0x88220daa442f2222L; 0x8d6407e9c8636464L; + 0xe3f1db12ff2af1f1L; 0xd173bfa2e6cc7373L; 0x4812905a24821212L; + 0x1d403a5d807a4040L; 0x2008402810480808L; 0x2bc356e89b95c3c3L; + 0x97ec337bc5dfececL; 0x4bdb9690ab4ddbdbL; 0xbea1611f5fc0a1a1L; + 0x0e8d1c8307918d8dL; 0xf43df5c97ac83d3dL; 0x6697ccf1335b9797L; + 0x0000000000000000L; 0x1bcf36d483f9cfcfL; 0xac2b4587566e2b2bL; + 0xc57697b3ece17676L; 0x328264b019e68282L; 0x7fd6fea9b128d6d6L; + 0x6c1bd87736c31b1bL; 0xeeb5c15b7774b5b5L; 0x86af112943beafafL; + 0xb56a77dfd41d6a6aL; 0x5d50ba0da0ea5050L; 0x0945124c8a574545L; + 0xebf3cb18fb38f3f3L; 0xc0309df060ad3030L; 0x9bef2b74c3c4efefL; + 0xfc3fe5c37eda3f3fL; 0x4955921caac75555L; 0xb2a2791059dba2a2L; + 0x8fea0365c9e9eaeaL; 0x89650fecca6a6565L; 0xd2bab9686903babaL; + 0xbc2f65935e4a2f2fL; 0x27c04ee79d8ec0c0L; 0x5fdebe81a160dedeL; + 0x701ce06c38fc1c1cL; 0xd3fdbb2ee746fdfdL; 0x294d52649a1f4d4dL; + 0x7292e4e039769292L; 0xc9758fbceafa7575L; 0x1806301e0c360606L; + 0x128a249809ae8a8aL; 0xf2b2f940794bb2b2L; 0xbfe66359d185e6e6L; + 0x380e70361c7e0e0eL; 0x7c1ff8633ee71f1fL; 0x956237f7c4556262L; + 0x77d4eea3b53ad4d4L; 0x9aa829324d81a8a8L; 0x6296c4f431529696L; + 0xc3f99b3aef62f9f9L; 0x33c566f697a3c5c5L; 0x942535b14a102525L; + 0x7959f220b2ab5959L; 0x2a8454ae15d08484L; 0xd572b7a7e4c57272L; + 0xe439d5dd72ec3939L; 0x2d4c5a6198164c4cL; 0x655eca3bbc945e5eL; + 0xfd78e785f09f7878L; 0xe038ddd870e53838L; 0x0a8c148605988c8cL; + 0x63d1c6b2bf17d1d1L; 0xaea5410b57e4a5a5L; 0xafe2434dd9a1e2e2L; + 0x99612ff8c24e6161L; 0xf6b3f1457b42b3b3L; 0x842115a542342121L; + 0x4a9c94d625089c9cL; 0x781ef0663cee1e1eL; 0x1143225286614343L; + 0x3bc776fc93b1c7c7L; 0xd7fcb32be54ffcfcL; 0x1004201408240404L; + 0x5951b208a2e35151L; 0x5e99bcc72f259999L; 0xa96d4fc4da226d6dL; + 0x340d68391a650d0dL; 0xcffa8335e979fafaL; 0x5bdfb684a369dfdfL; + 0xe57ed79bfca97e7eL; 0x90243db448192424L; 0xec3bc5d776fe3b3bL; + 0x96ab313d4b9aababL; 0x1fce3ed181f0ceceL; 0x4411885522991111L; + 0x068f0c8903838f8fL; 0x254e4a6b9c044e4eL; 0xe6b7d1517366b7b7L; + 0x8beb0b60cbe0ebebL; 0xf03cfdcc78c13c3cL; 0x3e817cbf1ffd8181L; + 0x6a94d4fe35409494L; 0xfbf7eb0cf31cf7f7L; 0xdeb9a1676f18b9b9L; + 0x4c13985f268b1313L; 0xb02c7d9c58512c2cL; 0x6bd3d6b8bb05d3d3L; + 0xbbe76b5cd38ce7e7L; 0xa56e57cbdc396e6eL; 0x37c46ef395aac4c4L; + 0x0c03180f061b0303L; 0x45568a13acdc5656L; 0x0d441a49885e4444L; + 0xe17fdf9efea07f7fL; 0x9ea921374f88a9a9L; 0xa82a4d8254672a2aL; + 0xd6bbb16d6b0abbbbL; 0x23c146e29f87c1c1L; 0x5153a202a6f15353L; + 0x57dcae8ba572dcdcL; 0x2c0b582716530b0bL; 0x4e9d9cd327019d9dL; + 0xad6c47c1d82b6c6cL; 0xc43195f562a43131L; 0xcd7487b9e8f37474L; + 0xfff6e309f115f6f6L; 0x05460a438c4c4646L; 0x8aac092645a5acacL; + 0x1e893c970fb58989L; 0x5014a04428b41414L; 0xa3e15b42dfbae1e1L; + 0x5816b04e2ca61616L; 0xe83acdd274f73a3aL; 0xb9696fd0d2066969L; + 0x2409482d12410909L; 0xdd70a7ade0d77070L; 0xe2b6d954716fb6b6L; + 0x67d0ceb7bd1ed0d0L; 0x93ed3b7ec7d6ededL; 0x17cc2edb85e2ccccL; + 0x15422a5784684242L; 0x5a98b4c22d2c9898L; 0xaaa4490e55eda4a4L; + 0xa0285d8850752828L; 0x6d5cda31b8865c5cL; 0xc7f8933fed6bf8f8L; + 0x228644a411c28686L; + |]; + [| + 0x186018c07830d818L; 0x238c2305af462623L; 0xc63fc67ef991b8c6L; + 0xe887e8136fcdfbe8L; 0x8726874ca113cb87L; 0xb8dab8a9626d11b8L; + 0x0104010805020901L; 0x4f214f426e9e0d4fL; 0x36d836adee6c9b36L; + 0xa6a2a6590451ffa6L; 0xd26fd2debdb90cd2L; 0xf5f3f5fb06f70ef5L; + 0x79f979ef80f29679L; 0x6fa16f5fcede306fL; 0x917e91fcef3f6d91L; + 0x525552aa07a4f852L; 0x609d6027fdc04760L; 0xbccabc89766535bcL; + 0x9b569baccd2b379bL; 0x8e028e048c018a8eL; 0xa3b6a371155bd2a3L; + 0x0c300c603c186c0cL; 0x7bf17bff8af6847bL; 0x35d435b5e16a8035L; + 0x1d741de8693af51dL; 0xe0a7e05347ddb3e0L; 0xd77bd7f6acb321d7L; + 0xc22fc25eed999cc2L; 0x2eb82e6d965c432eL; 0x4b314b627a96294bL; + 0xfedffea321e15dfeL; 0x5741578216aed557L; 0x155415a8412abd15L; + 0x77c1779fb6eee877L; 0x37dc37a5eb6e9237L; 0xe5b3e57b56d79ee5L; + 0x9f469f8cd923139fL; 0xf0e7f0d317fd23f0L; 0x4a354a6a7f94204aL; + 0xda4fda9e95a944daL; 0x587d58fa25b0a258L; 0xc903c906ca8fcfc9L; + 0x29a429558d527c29L; 0x0a280a5022145a0aL; 0xb1feb1e14f7f50b1L; + 0xa0baa0691a5dc9a0L; 0x6bb16b7fdad6146bL; 0x852e855cab17d985L; + 0xbdcebd8173673cbdL; 0x5d695dd234ba8f5dL; 0x1040108050209010L; + 0xf4f7f4f303f507f4L; 0xcb0bcb16c08bddcbL; 0x3ef83eedc67cd33eL; + 0x05140528110a2d05L; 0x6781671fe6ce7867L; 0xe4b7e47353d597e4L; + 0x279c2725bb4e0227L; 0x4119413258827341L; 0x8b168b2c9d0ba78bL; + 0xa7a6a7510153f6a7L; 0x7de97dcf94fab27dL; 0x956e95dcfb374995L; + 0xd847d88e9fad56d8L; 0xfbcbfb8b30eb70fbL; 0xee9fee2371c1cdeeL; + 0x7ced7cc791f8bb7cL; 0x66856617e3cc7166L; 0xdd53dda68ea77bddL; + 0x175c17b84b2eaf17L; 0x47014702468e4547L; 0x9e429e84dc211a9eL; + 0xca0fca1ec589d4caL; 0x2db42d75995a582dL; 0xbfc6bf9179632ebfL; + 0x071c07381b0e3f07L; 0xad8ead012347acadL; 0x5a755aea2fb4b05aL; + 0x8336836cb51bef83L; 0x33cc3385ff66b633L; 0x6391633ff2c65c63L; + 0x020802100a041202L; 0xaa92aa39384993aaL; 0x71d971afa8e2de71L; + 0xc807c80ecf8dc6c8L; 0x196419c87d32d119L; 0x4939497270923b49L; + 0xd943d9869aaf5fd9L; 0xf2eff2c31df931f2L; 0xe3abe34b48dba8e3L; + 0x5b715be22ab6b95bL; 0x881a8834920dbc88L; 0x9a529aa4c8293e9aL; + 0x2698262dbe4c0b26L; 0x32c8328dfa64bf32L; 0xb0fab0e94a7d59b0L; + 0xe983e91b6acff2e9L; 0x0f3c0f78331e770fL; 0xd573d5e6a6b733d5L; + 0x803a8074ba1df480L; 0xbec2be997c6127beL; 0xcd13cd26de87ebcdL; + 0x34d034bde4688934L; 0x483d487a75903248L; 0xffdbffab24e354ffL; + 0x7af57af78ff48d7aL; 0x907a90f4ea3d6490L; 0x5f615fc23ebe9d5fL; + 0x2080201da0403d20L; 0x68bd6867d5d00f68L; 0x1a681ad07234ca1aL; + 0xae82ae192c41b7aeL; 0xb4eab4c95e757db4L; 0x544d549a19a8ce54L; + 0x937693ece53b7f93L; 0x2288220daa442f22L; 0x648d6407e9c86364L; + 0xf1e3f1db12ff2af1L; 0x73d173bfa2e6cc73L; 0x124812905a248212L; + 0x401d403a5d807a40L; 0x0820084028104808L; 0xc32bc356e89b95c3L; + 0xec97ec337bc5dfecL; 0xdb4bdb9690ab4ddbL; 0xa1bea1611f5fc0a1L; + 0x8d0e8d1c8307918dL; 0x3df43df5c97ac83dL; 0x976697ccf1335b97L; + 0x0000000000000000L; 0xcf1bcf36d483f9cfL; 0x2bac2b4587566e2bL; + 0x76c57697b3ece176L; 0x82328264b019e682L; 0xd67fd6fea9b128d6L; + 0x1b6c1bd87736c31bL; 0xb5eeb5c15b7774b5L; 0xaf86af112943beafL; + 0x6ab56a77dfd41d6aL; 0x505d50ba0da0ea50L; 0x450945124c8a5745L; + 0xf3ebf3cb18fb38f3L; 0x30c0309df060ad30L; 0xef9bef2b74c3c4efL; + 0x3ffc3fe5c37eda3fL; 0x554955921caac755L; 0xa2b2a2791059dba2L; + 0xea8fea0365c9e9eaL; 0x6589650fecca6a65L; 0xbad2bab9686903baL; + 0x2fbc2f65935e4a2fL; 0xc027c04ee79d8ec0L; 0xde5fdebe81a160deL; + 0x1c701ce06c38fc1cL; 0xfdd3fdbb2ee746fdL; 0x4d294d52649a1f4dL; + 0x927292e4e0397692L; 0x75c9758fbceafa75L; 0x061806301e0c3606L; + 0x8a128a249809ae8aL; 0xb2f2b2f940794bb2L; 0xe6bfe66359d185e6L; + 0x0e380e70361c7e0eL; 0x1f7c1ff8633ee71fL; 0x62956237f7c45562L; + 0xd477d4eea3b53ad4L; 0xa89aa829324d81a8L; 0x966296c4f4315296L; + 0xf9c3f99b3aef62f9L; 0xc533c566f697a3c5L; 0x25942535b14a1025L; + 0x597959f220b2ab59L; 0x842a8454ae15d084L; 0x72d572b7a7e4c572L; + 0x39e439d5dd72ec39L; 0x4c2d4c5a6198164cL; 0x5e655eca3bbc945eL; + 0x78fd78e785f09f78L; 0x38e038ddd870e538L; 0x8c0a8c148605988cL; + 0xd163d1c6b2bf17d1L; 0xa5aea5410b57e4a5L; 0xe2afe2434dd9a1e2L; + 0x6199612ff8c24e61L; 0xb3f6b3f1457b42b3L; 0x21842115a5423421L; + 0x9c4a9c94d625089cL; 0x1e781ef0663cee1eL; 0x4311432252866143L; + 0xc73bc776fc93b1c7L; 0xfcd7fcb32be54ffcL; 0x0410042014082404L; + 0x515951b208a2e351L; 0x995e99bcc72f2599L; 0x6da96d4fc4da226dL; + 0x0d340d68391a650dL; 0xfacffa8335e979faL; 0xdf5bdfb684a369dfL; + 0x7ee57ed79bfca97eL; 0x2490243db4481924L; 0x3bec3bc5d776fe3bL; + 0xab96ab313d4b9aabL; 0xce1fce3ed181f0ceL; 0x1144118855229911L; + 0x8f068f0c8903838fL; 0x4e254e4a6b9c044eL; 0xb7e6b7d1517366b7L; + 0xeb8beb0b60cbe0ebL; 0x3cf03cfdcc78c13cL; 0x813e817cbf1ffd81L; + 0x946a94d4fe354094L; 0xf7fbf7eb0cf31cf7L; 0xb9deb9a1676f18b9L; + 0x134c13985f268b13L; 0x2cb02c7d9c58512cL; 0xd36bd3d6b8bb05d3L; + 0xe7bbe76b5cd38ce7L; 0x6ea56e57cbdc396eL; 0xc437c46ef395aac4L; + 0x030c03180f061b03L; 0x5645568a13acdc56L; 0x440d441a49885e44L; + 0x7fe17fdf9efea07fL; 0xa99ea921374f88a9L; 0x2aa82a4d8254672aL; + 0xbbd6bbb16d6b0abbL; 0xc123c146e29f87c1L; 0x535153a202a6f153L; + 0xdc57dcae8ba572dcL; 0x0b2c0b582716530bL; 0x9d4e9d9cd327019dL; + 0x6cad6c47c1d82b6cL; 0x31c43195f562a431L; 0x74cd7487b9e8f374L; + 0xf6fff6e309f115f6L; 0x4605460a438c4c46L; 0xac8aac092645a5acL; + 0x891e893c970fb589L; 0x145014a04428b414L; 0xe1a3e15b42dfbae1L; + 0x165816b04e2ca616L; 0x3ae83acdd274f73aL; 0x69b9696fd0d20669L; + 0x092409482d124109L; 0x70dd70a7ade0d770L; 0xb6e2b6d954716fb6L; + 0xd067d0ceb7bd1ed0L; 0xed93ed3b7ec7d6edL; 0xcc17cc2edb85e2ccL; + 0x4215422a57846842L; 0x985a98b4c22d2c98L; 0xa4aaa4490e55eda4L; + 0x28a0285d88507528L; 0x5c6d5cda31b8865cL; 0xf8c7f8933fed6bf8L; + 0x86228644a411c286L; + |]; + |] + + let whirlpool_do_chunk : + type a. be64_to_cpu:(a -> int -> int64) -> ctx -> a -> int -> unit = + fun ~be64_to_cpu ctx buf off -> + let key = Array.init 2 (fun _ -> Array.make 8 Int64.zero) in + let state = Array.init 2 (fun _ -> Array.make 8 Int64.zero) in + let m = ref 0 in + let rc = + [| + 0x1823c6e887b8014fL; 0x36a6d2f5796f9152L; 0x60bc9b8ea30c7b35L; + 0x1de0d7c22e4bfe57L; 0x157737e59ff04adaL; 0x58c9290ab1a06b85L; + 0xbd5d10f4cb3e0567L; 0xe427418ba77d95d8L; 0xfbee7c66dd17479eL; + 0xca2dbf07ad5a8333L; + |] in + for i = 0 to 7 do + key.(0).(i) <- ctx.h.(i) ; + let off = off + (i * 8) in + state.(0).(i) <- Int64.(be64_to_cpu buf off lxor ctx.h.(i)) ; + ctx.h.(i) <- state.(0).(i) + done ; + let wp_op src shift = + let mask v = Int64.(to_int (v land 0xffL)) in + let get_k i = + k.(i).(mask + (Int64.shift_right src.((shift + 8 - i) land 7) (56 - (8 * i)))) + in + Array.fold_left Int64.logxor Int64.zero (Array.init 8 get_k) in + for i = 0 to 9 do + let m0, m1 = (!m, !m lxor 1) in + let upd_key i = key.(m1).(i) <- wp_op key.(m0) i in + let upd_state i = + state.(m1).(i) <- Int64.(wp_op state.(m0) i lxor key.(m1).(i)) in + for i = 0 to 7 do + upd_key i + done ; + key.(m1).(0) <- Int64.(key.(m1).(0) lxor rc.(i)) ; + for i = 0 to 7 do + upd_state i + done ; + m := !m lxor 1 + done ; + let upd_hash i = Int64.(ctx.h.(i) <- ctx.h.(i) lxor state.(0).(i)) in + for i = 0 to 7 do + upd_hash i + done ; + () + + let feed : + type a. + blit:(a -> int -> By.t -> int -> int -> unit) -> + be64_to_cpu:(a -> int -> int64) -> + ctx -> + a -> + int -> + int -> + unit = + fun ~blit ~be64_to_cpu ctx buf off len -> + let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in + let len = ref len in + let off = ref off in + let to_fill = 64 - !idx in + ctx.size <- Int64.add ctx.size (Int64.of_int !len) ; + if !idx <> 0 && !len >= to_fill + then ( + blit buf !off ctx.b !idx to_fill ; + whirlpool_do_chunk ~be64_to_cpu:By.be64_to_cpu ctx ctx.b 0 ; + len := !len - to_fill ; + off := !off + to_fill ; + idx := 0) ; + while !len >= 64 do + whirlpool_do_chunk ~be64_to_cpu ctx buf !off ; + len := !len - 64 ; + off := !off + 64 + done ; + if !len <> 0 then blit buf !off ctx.b !idx !len ; + () + + let unsafe_feed_bytes = feed ~blit:By.blit ~be64_to_cpu:By.be64_to_cpu + + let unsafe_feed_bigstring = + feed ~blit:By.blit_from_bigstring ~be64_to_cpu:Bi.be64_to_cpu + + let unsafe_get ctx = + let index = Int64.(to_int (ctx.size land 0x3FL)) + 1 in + By.set ctx.b (index - 1) '\x80' ; + if index > 32 + then ( + By.fill ctx.b index (64 - index) '\x00' ; + whirlpool_do_chunk ~be64_to_cpu:By.be64_to_cpu ctx ctx.b 0 ; + By.fill ctx.b 0 56 '\x00') + else By.fill ctx.b index (56 - index) '\x00' ; + By.cpu_to_be64 ctx.b 56 Int64.(ctx.size lsl 3) ; + whirlpool_do_chunk ~be64_to_cpu:By.be64_to_cpu ctx ctx.b 0 ; + let res = By.create (8 * 8) in + for i = 0 to 7 do + By.cpu_to_be64 res (i * 8) ctx.h.(i) + done ; + res +end diff --git a/unikernel/duniverse/digestif/src-ocaml/digestif.ml b/unikernel/duniverse/digestif/src-ocaml/digestif.ml new file mode 100644 index 00000000..fab088ad --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/digestif.ml @@ -0,0 +1,732 @@ +type bigstring = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +type 'a iter = ('a -> unit) -> unit +type 'a compare = 'a -> 'a -> int +type 'a equal = 'a -> 'a -> bool +type 'a pp = Format.formatter -> 'a -> unit + +module By = Digestif_by +module Bi = Digestif_bi +module Eq = Digestif_eq +module Conv = Digestif_conv + +let failwith fmt = Format.ksprintf failwith fmt + +module type S = sig + val digest_size : int + + type ctx + type hmac + type t + + val empty : ctx + val init : unit -> ctx + val feed_bytes : ctx -> ?off:int -> ?len:int -> Bytes.t -> ctx + val feed_string : ctx -> ?off:int -> ?len:int -> String.t -> ctx + val feed_bigstring : ctx -> ?off:int -> ?len:int -> bigstring -> ctx + val feedi_bytes : ctx -> Bytes.t iter -> ctx + val feedi_string : ctx -> String.t iter -> ctx + val feedi_bigstring : ctx -> bigstring iter -> ctx + val get : ctx -> t + val hmac_init : key:string -> hmac + val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac + val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac + val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac + val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac + val hmac_feedi_string : hmac -> String.t iter -> hmac + val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac + val hmac_get : hmac -> t + val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t + val digest_string : ?off:int -> ?len:int -> String.t -> t + val digest_bigstring : ?off:int -> ?len:int -> bigstring -> t + val digesti_bytes : Bytes.t iter -> t + val digesti_string : String.t iter -> t + val digesti_bigstring : bigstring iter -> t + val digestv_bytes : Bytes.t list -> t + val digestv_string : String.t list -> t + val digestv_bigstring : bigstring list -> t + val hmac_bytes : key:string -> ?off:int -> ?len:int -> Bytes.t -> t + val hmac_string : key:string -> ?off:int -> ?len:int -> String.t -> t + val hmac_bigstring : key:string -> ?off:int -> ?len:int -> bigstring -> t + val hmaci_bytes : key:string -> Bytes.t iter -> t + val hmaci_string : key:string -> String.t iter -> t + val hmaci_bigstring : key:string -> bigstring iter -> t + val hmacv_bytes : key:string -> Bytes.t list -> t + val hmacv_string : key:string -> String.t list -> t + val hmacv_bigstring : key:string -> bigstring list -> t + val unsafe_compare : t compare + val equal : t equal + val pp : t pp + val of_hex : string -> t + val of_hex_opt : string -> t option + val consistent_of_hex : string -> t + val consistent_of_hex_opt : string -> t option + val to_hex : t -> string + val of_raw_string : string -> t + val of_raw_string_opt : string -> t option + val to_raw_string : t -> string + val get_into_bytes : ctx -> ?off:int -> bytes -> unit +end + +module type MAC = sig + type t + + val mac_bytes : key:string -> ?off:int -> ?len:int -> Bytes.t -> t + val mac_string : key:string -> ?off:int -> ?len:int -> String.t -> t + val mac_bigstring : key:string -> ?off:int -> ?len:int -> bigstring -> t + val maci_bytes : key:string -> Bytes.t iter -> t + val maci_string : key:string -> String.t iter -> t + val maci_bigstring : key:string -> bigstring iter -> t + val macv_bytes : key:string -> Bytes.t list -> t + val macv_string : key:string -> String.t list -> t + val macv_bigstring : key:string -> bigstring list -> t +end + +module type Desc = sig + val digest_size : int + val block_size : int +end + +module type Hash = sig + type ctx + + val init : unit -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx +end + +module Unsafe (Hash : Hash) (D : Desc) = struct + open Hash + + let digest_size = D.digest_size + let block_size = D.block_size + let empty = init () + let init = init + + let unsafe_feed_bytes ctx ?off ?len buf = + let off, len = + match (off, len) with + | Some off, Some len -> (off, len) + | Some off, None -> (off, By.length buf - off) + | None, Some len -> (0, len) + | None, None -> (0, By.length buf) in + if off < 0 || len < 0 || off > By.length buf - len + then invalid_arg "offset out of bounds" + else unsafe_feed_bytes ctx buf off len + + let unsafe_feed_string ctx ?off ?len buf = + unsafe_feed_bytes ctx ?off ?len (By.unsafe_of_string buf) + + let unsafe_feed_bigstring ctx ?off ?len buf = + let off, len = + match (off, len) with + | Some off, Some len -> (off, len) + | Some off, None -> (off, Bi.length buf - off) + | None, Some len -> (0, len) + | None, None -> (0, Bi.length buf) in + if off < 0 || len < 0 || off > Bi.length buf - len + then invalid_arg "offset out of bounds" + else unsafe_feed_bigstring ctx buf off len + + let unsafe_get = unsafe_get + + let get_into_bytes ctx ?(off = 0) buf = + if off < 0 || off >= Bytes.length buf + then invalid_arg "offset out of bounds" ; + if Bytes.length buf - off < digest_size + then invalid_arg "destination too small" ; + let raw = unsafe_get (Hash.dup ctx) in + Bytes.blit raw 0 buf off digest_size +end + +module Core (Hash : Hash) (D : Desc) = struct + type t = string + type ctx = Hash.ctx + + include Unsafe (Hash) (D) + include Conv.Make (D) + include Eq.Make (D) + + let get t = + let t = Hash.dup t in + unsafe_get t |> By.unsafe_to_string + + let feed_bytes t ?off ?len buf = + let t = Hash.dup t in + unsafe_feed_bytes t ?off ?len buf ; + t + + let feed_string t ?off ?len buf = + let t = Hash.dup t in + unsafe_feed_string t ?off ?len buf ; + t + + let feed_bigstring t ?off ?len buf = + let t = Hash.dup t in + unsafe_feed_bigstring t ?off ?len buf ; + t + + let feedi_bytes t iter = + let t = Hash.dup t in + let feed buf = unsafe_feed_bytes t buf in + iter feed ; + t + + let feedi_string t iter = + let t = Hash.dup t in + let feed buf = unsafe_feed_string t buf in + iter feed ; + t + + let feedi_bigstring t iter = + let t = Hash.dup t in + let feed buf = unsafe_feed_bigstring t buf in + iter feed ; + t + + let digest_bytes ?off ?len buf = feed_bytes empty ?off ?len buf |> get + let digest_string ?off ?len buf = feed_string empty ?off ?len buf |> get + let digest_bigstring ?off ?len buf = feed_bigstring empty ?off ?len buf |> get + let digesti_bytes iter = feedi_bytes empty iter |> get + let digesti_string iter = feedi_string empty iter |> get + let digesti_bigstring iter = feedi_bigstring empty iter |> get + let digestv_bytes lst = digesti_bytes (fun f -> List.iter f lst) + let digestv_string lst = digesti_string (fun f -> List.iter f lst) + let digestv_bigstring lst = digesti_bigstring (fun f -> List.iter f lst) +end + +module Make (H : Hash) (D : Desc) = struct + include Core (H) (D) + + type hmac = ctx * string + + let bytes_opad = By.init block_size (fun _ -> '\x5c') + let bytes_ipad = By.init block_size (fun _ -> '\x36') + + let rec norm_bytes key = + match Stdlib.compare (String.length key) block_size with + | 1 -> norm_bytes (digest_string key) + | -1 -> By.rpad (Bytes.unsafe_of_string key) block_size '\000' + | _ -> By.of_string key + + let hmac_init ~key = + let key = norm_bytes key in + let outer = Xor.Bytes.xor key bytes_opad in + let inner = Xor.Bytes.xor key bytes_ipad in + let ctx = feed_bytes empty inner in + (ctx, Bytes.unsafe_to_string outer) + + let hmac_feed_bytes (t, outer) ?off ?len buf = + (feed_bytes t ?off ?len buf, outer) + + let hmac_feed_string (t, outer) ?off ?len buf = + (feed_string t ?off ?len buf, outer) + + let hmac_feed_bigstring (t, outer) ?off ?len buf = + (feed_bigstring t ?off ?len buf, outer) + + let hmac_get (ctx, outer) = + feed_string (feed_string empty outer) (get ctx) |> get + + let hmac_feedi_bytes (t, outer) iter = (feedi_bytes t iter, outer) + let hmac_feedi_string (t, outer) iter = (feedi_string t iter, outer) + let hmac_feedi_bigstring (t, outer) iter = (feedi_bigstring t iter, outer) + + let hmaci_bytes ~key iter = + let t = hmac_init ~key in + hmac_feedi_bytes t iter |> hmac_get + + let hmaci_string ~key iter = + let t = hmac_init ~key in + hmac_feedi_string t iter |> hmac_get + + let hmaci_bigstring ~key iter = + let t = hmac_init ~key in + hmac_feedi_bigstring t iter |> hmac_get + + let hmac_bytes ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> By.sub buf off len + | Some off, None -> By.sub buf off (By.length buf - off) + | None, Some len -> By.sub buf 0 len + | None, None -> buf in + hmaci_bytes ~key (fun f -> f buf) + + let hmac_string ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> String.sub buf off len + | Some off, None -> String.sub buf off (String.length buf - off) + | None, Some len -> String.sub buf 0 len + | None, None -> buf in + hmaci_string ~key (fun f -> f buf) + + let hmac_bigstring ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> Bi.sub buf off len + | Some off, None -> Bi.sub buf off (Bi.length buf - off) + | None, Some len -> Bi.sub buf 0 len + | None, None -> buf in + hmaci_bigstring ~key (fun f -> f buf) + + let hmacv_bytes ~key bufs = hmaci_bytes ~key (fun f -> List.iter f bufs) + let hmacv_string ~key bufs = hmaci_string ~key (fun f -> List.iter f bufs) + + let hmacv_bigstring ~key bufs = + hmaci_bigstring ~key (fun f -> List.iter f bufs) +end + +module type Hash_BLAKE2 = sig + type ctx + + val with_outlen_and_bytes_key : int -> By.t -> int -> int -> ctx + val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit + val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit + val unsafe_get : ctx -> By.t + val dup : ctx -> ctx + val max_outlen : int +end + +module Make_BLAKE2 (H : Hash_BLAKE2) (D : Desc) = struct + let () = + if D.digest_size > H.max_outlen + then + failwith "Invalid digest_size:%d to make a BLAKE2{S,B} implementation" + D.digest_size + + include + Make + (struct + type ctx = H.ctx + + let init () = H.with_outlen_and_bytes_key D.digest_size By.empty 0 0 + let unsafe_feed_bytes = H.unsafe_feed_bytes + let unsafe_feed_bigstring = H.unsafe_feed_bigstring + let unsafe_get = H.unsafe_get + let dup = H.dup + end) + (D) + + type outer = t + + module Keyed = struct + type t = outer + + let maci_bytes ~key iter = + let ctx = + H.with_outlen_and_bytes_key digest_size + (Bytes.unsafe_of_string key) + 0 (String.length key) in + feedi_bytes ctx iter |> get + + let maci_string ~key iter = + let ctx = + H.with_outlen_and_bytes_key digest_size + (Bytes.unsafe_of_string key) + 0 (String.length key) in + feedi_string ctx iter |> get + + let maci_bigstring ~key iter = + let ctx = + H.with_outlen_and_bytes_key digest_size + (Bytes.unsafe_of_string key) + 0 (String.length key) in + feedi_bigstring ctx iter |> get + + let mac_bytes ~key ?off ?len buf : t = + let buf = + match (off, len) with + | Some off, Some len -> By.sub buf off len + | Some off, None -> By.sub buf off (By.length buf - off) + | None, Some len -> By.sub buf 0 len + | None, None -> buf in + maci_bytes ~key (fun f -> f buf) + + let mac_string ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> String.sub buf off len + | Some off, None -> String.sub buf off (String.length buf - off) + | None, Some len -> String.sub buf 0 len + | None, None -> buf in + maci_string ~key (fun f -> f buf) + + let mac_bigstring ~key ?off ?len buf = + let buf = + match (off, len) with + | Some off, Some len -> Bi.sub buf off len + | Some off, None -> Bi.sub buf off (Bi.length buf - off) + | None, Some len -> Bi.sub buf 0 len + | None, None -> buf in + maci_bigstring ~key (fun f -> f buf) + + let macv_bytes ~key bufs = maci_bytes ~key (fun f -> List.iter f bufs) + let macv_string ~key bufs = maci_string ~key (fun f -> List.iter f bufs) + + let macv_bigstring ~key bufs = + maci_bigstring ~key (fun f -> List.iter f bufs) + end +end + +module MD5 : S = + Make + (Baijiu_md5.Unsafe) + (struct + let digest_size, block_size = (16, 64) + end) + +module SHA1 : S = + Make + (Baijiu_sha1.Unsafe) + (struct + let digest_size, block_size = (20, 64) + end) + +module SHA224 : S = + Make + (Baijiu_sha224.Unsafe) + (struct + let digest_size, block_size = (28, 64) + end) + +module SHA256 : S = + Make + (Baijiu_sha256.Unsafe) + (struct + let digest_size, block_size = (32, 64) + end) + +module SHA384 : S = + Make + (Baijiu_sha384.Unsafe) + (struct + let digest_size, block_size = (48, 128) + end) + +module SHA512 : S = + Make + (Baijiu_sha512.Unsafe) + (struct + let digest_size, block_size = (64, 128) + end) + +module SHA3_224 : S = + Make + (Baijiu_sha3_224.Unsafe) + (struct + let digest_size, block_size = (28, 144) + end) + +module SHA3_256 : S = + Make + (Baijiu_sha3_256.Unsafe) + (struct + let digest_size, block_size = (32, 136) + end) + +module KECCAK_256 : S = + Make + (Baijiu_keccak_256.Unsafe) + (struct + let digest_size, block_size = (32, 136) + end) + +module SHA3_384 : S = + Make + (Baijiu_sha3_384.Unsafe) + (struct + let digest_size, block_size = (48, 104) + end) + +module SHA3_512 : S = + Make + (Baijiu_sha3_512.Unsafe) + (struct + let digest_size, block_size = (64, 72) + end) + +module WHIRLPOOL : S = + Make + (Baijiu_whirlpool.Unsafe) + (struct + let digest_size, block_size = (64, 64) + end) + +module BLAKE2B : sig + include S + module Keyed : MAC with type t = t +end = + Make_BLAKE2 + (Baijiu_blake2b.Unsafe) + (struct + let digest_size, block_size = (64, 128) + end) + +module BLAKE2S : sig + include S + module Keyed : MAC with type t = t +end = + Make_BLAKE2 + (Baijiu_blake2s.Unsafe) + (struct + let digest_size, block_size = (32, 64) + end) + +module RMD160 : S = + Make + (Baijiu_rmd160.Unsafe) + (struct + let digest_size, block_size = (20, 64) + end) + +module Make_BLAKE2B (D : sig + val digest_size : int +end) : S = struct + include + Make_BLAKE2 + (Baijiu_blake2b.Unsafe) + (struct + let digest_size, block_size = (D.digest_size, 128) + end) +end + +module Make_BLAKE2S (D : sig + val digest_size : int +end) : S = struct + include + Make_BLAKE2 + (Baijiu_blake2s.Unsafe) + (struct + let digest_size, block_size = (D.digest_size, 64) + end) +end + +type 'k hash = + | MD5 : MD5.t hash + | SHA1 : SHA1.t hash + | RMD160 : RMD160.t hash + | SHA224 : SHA224.t hash + | SHA256 : SHA256.t hash + | SHA384 : SHA384.t hash + | SHA512 : SHA512.t hash + | SHA3_224 : SHA3_224.t hash + | SHA3_256 : SHA3_256.t hash + | KECCAK_256 : KECCAK_256.t hash + | SHA3_384 : SHA3_384.t hash + | SHA3_512 : SHA3_512.t hash + | WHIRLPOOL : WHIRLPOOL.t hash + | BLAKE2B : BLAKE2B.t hash + | BLAKE2S : BLAKE2S.t hash + +let md5 = MD5 +let sha1 = SHA1 +let rmd160 = RMD160 +let sha224 = SHA224 +let sha256 = SHA256 +let sha384 = SHA384 +let sha512 = SHA512 +let sha3_224 = SHA3_224 +let sha3_256 = SHA3_256 +let keccak_256 = KECCAK_256 +let sha3_384 = SHA3_384 +let sha3_512 = SHA3_512 +let whirlpool = WHIRLPOOL +let blake2b = BLAKE2B +let blake2s = BLAKE2S + +type hash' = + [ `MD5 + | `SHA1 + | `RMD160 + | `SHA224 + | `SHA256 + | `SHA384 + | `SHA512 + | `SHA3_224 + | `SHA3_256 + | `KECCAK_256 + | `SHA3_384 + | `SHA3_512 + | `WHIRLPOOL + | `BLAKE2B + | `BLAKE2S ] + +let hash_to_hash' : type a. a hash -> hash' = function + | MD5 -> `MD5 + | SHA1 -> `SHA1 + | RMD160 -> `RMD160 + | SHA224 -> `SHA224 + | SHA256 -> `SHA256 + | SHA384 -> `SHA384 + | SHA512 -> `SHA512 + | SHA3_224 -> `SHA3_224 + | SHA3_256 -> `SHA3_256 + | KECCAK_256 -> `KECCAK_256 + | SHA3_384 -> `SHA3_384 + | SHA3_512 -> `SHA3_512 + | WHIRLPOOL -> `WHIRLPOOL + | BLAKE2B -> `BLAKE2B + | BLAKE2S -> `BLAKE2S + +let module_of_hash' : hash' -> (module S) = function + | `MD5 -> (module MD5) + | `SHA1 -> (module SHA1) + | `RMD160 -> (module RMD160) + | `SHA224 -> (module SHA224) + | `SHA256 -> (module SHA256) + | `SHA384 -> (module SHA384) + | `SHA512 -> (module SHA512) + | `SHA3_224 -> (module SHA3_224) + | `SHA3_256 -> (module SHA3_256) + | `KECCAK_256 -> (module KECCAK_256) + | `SHA3_384 -> (module SHA3_384) + | `SHA3_512 -> (module SHA3_512) + | `WHIRLPOOL -> (module WHIRLPOOL) + | `BLAKE2B -> (module BLAKE2B) + | `BLAKE2S -> (module BLAKE2S) + +let module_of : type k. k hash -> (module S with type t = k) = function + | MD5 -> (module MD5) + | SHA1 -> (module SHA1) + | RMD160 -> (module RMD160) + | SHA224 -> (module SHA224) + | SHA256 -> (module SHA256) + | SHA384 -> (module SHA384) + | SHA512 -> (module SHA512) + | SHA3_224 -> (module SHA3_224) + | SHA3_256 -> (module SHA3_256) + | KECCAK_256 -> (module KECCAK_256) + | SHA3_384 -> (module SHA3_384) + | SHA3_512 -> (module SHA3_512) + | WHIRLPOOL -> (module WHIRLPOOL) + | BLAKE2B -> (module BLAKE2B) + | BLAKE2S -> (module BLAKE2S) + +type 'hash t = 'hash + +let digest_bytes : type k. k hash -> Bytes.t -> k t = + fun hash buf -> + let module H = (val module_of hash) in + H.digest_bytes buf + +let digest_string : type k. k hash -> String.t -> k t = + fun hash buf -> + let module H = (val module_of hash) in + H.digest_string buf + +let digest_bigstring : type k. k hash -> bigstring -> k t = + fun hash buf -> + let module H = (val module_of hash) in + H.digest_bigstring buf + +let digesti_bytes : type k. k hash -> Bytes.t iter -> k t = + fun hash iter -> + let module H = (val module_of hash) in + H.digesti_bytes iter + +let digesti_string : type k. k hash -> String.t iter -> k t = + fun hash iter -> + let module H = (val module_of hash) in + H.digesti_string iter + +let digesti_bigstring : type k. k hash -> bigstring iter -> k t = + fun hash iter -> + let module H = (val module_of hash) in + H.digesti_bigstring iter + +let hmaci_bytes : type k. k hash -> key:string -> Bytes.t iter -> k t = + fun hash ~key iter -> + let module H = (val module_of hash) in + H.hmaci_bytes ~key iter + +let hmaci_string : type k. k hash -> key:string -> String.t iter -> k t = + fun hash ~key iter -> + let module H = (val module_of hash) in + H.hmaci_string ~key iter + +let hmaci_bigstring : type k. k hash -> key:string -> bigstring iter -> k t = + fun hash ~key iter -> + let module H = (val module_of hash) in + H.hmaci_bigstring ~key iter + +(* XXX(dinosaure): unsafe part to avoid overhead. *) + +let unsafe_compare : type k. k hash -> k t -> k t -> int = + fun hash a b -> + let module H = (val module_of hash) in + H.unsafe_compare a b + +let equal : type k. k hash -> k t equal = + fun hash a b -> + let module H = (val module_of hash) in + H.equal a b + +let pp : type k. k hash -> k t pp = + fun hash ppf t -> + let module H = (val module_of hash) in + H.pp ppf t + +let of_hex : type k. k hash -> string -> k t = + fun hash hex -> + let module H = (val module_of hash) in + H.of_hex hex + +let of_hex_opt : type k. k hash -> string -> k t option = + fun hash hex -> + let module H = (val module_of hash) in + H.of_hex_opt hex + +let consistent_of_hex : type k. k hash -> string -> k t = + fun hash hex -> + let module H = (val module_of hash) in + H.consistent_of_hex hex + +let consistent_of_hex_opt : type k. k hash -> string -> k t option = + fun hash hex -> + let module H = (val module_of hash) in + H.consistent_of_hex_opt hex + +let to_hex : type k. k hash -> k t -> string = + fun hash t -> + let module H = (val module_of hash) in + H.to_hex t + +let of_raw_string : type k. k hash -> string -> k t = + fun hash s -> + let module H = (val module_of hash) in + H.of_raw_string s + +let of_raw_string_opt : type k. k hash -> string -> k t option = + fun hash s -> + let module H = (val module_of hash) in + H.of_raw_string_opt s + +let to_raw_string : type k. k hash -> k t -> string = + fun hash t -> + let module H = (val module_of hash) in + H.to_raw_string t + +let of_digest (type hash) (module H : S with type t = hash) (hash : H.t) : + hash t = + hash + +let of_md5 hash = hash +let of_sha1 hash = hash +let of_rmd160 hash = hash +let of_sha224 hash = hash +let of_sha256 hash = hash +let of_sha384 hash = hash +let of_sha512 hash = hash +let of_sha3_224 hash = hash +let of_sha3_256 hash = hash +let of_keccak_256 hash = hash +let of_sha3_384 hash = hash +let of_sha3_512 hash = hash +let of_whirlpool hash = hash +let of_blake2b hash = hash +let of_blake2s hash = hash diff --git a/unikernel/duniverse/digestif/src-ocaml/dune b/unikernel/duniverse/digestif/src-ocaml/dune new file mode 100644 index 00000000..b53fcd9e --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/dune @@ -0,0 +1,13 @@ +(library + (name digestif_ocaml) + (public_name digestif.ocaml) + (implements digestif) + (libraries eqaf) + (private_modules xor digestif_eq digestif_conv digestif_by digestif_bi + baijiu_whirlpool baijiu_sha1 baijiu_sha256 baijiu_sha384 baijiu_sha224 + baijiu_sha512 baijiu_sha3_224 baijiu_sha256 baijiu_sha3_384 + baijiu_sha3_512 baijiu_rmd160 baijiu_md5 baijiu_blake2s baijiu_blake2b) + (flags + (:standard -no-keep-locs))) + +(copy_files# ../src/*.ml) diff --git a/unikernel/duniverse/digestif/src-ocaml/xor.ml b/unikernel/duniverse/digestif/src-ocaml/xor.ml new file mode 100644 index 00000000..480f9d3d --- /dev/null +++ b/unikernel/duniverse/digestif/src-ocaml/xor.ml @@ -0,0 +1,57 @@ +module Nat = struct + include Nativeint + + let ( lxor ) = Nativeint.logxor +end + +module type BUFFER = sig + type t + + val length : t -> int + val sub : t -> int -> int -> t + val copy : t -> t + val benat_to_cpu : t -> int -> nativeint + val cpu_to_benat : t -> int -> nativeint -> unit +end + +let imin (a : int) (b : int) = if a < b then a else b + +module Make (B : BUFFER) = struct + let size_of_long = Sys.word_size / 8 + + (* XXX(dinosaure): I'm not sure about this code. May be we don't need the + first loop and the _optimization_ is irrelevant. *) + let xor_into src src_off dst dst_off n = + let n = ref n in + let i = ref 0 in + while !n >= size_of_long do + B.cpu_to_benat dst (dst_off + !i) + Nat.( + B.benat_to_cpu dst (dst_off + !i) + lxor B.benat_to_cpu src (src_off + !i)) ; + n := !n - size_of_long ; + i := !i + size_of_long + done ; + while !n > 0 do + B.cpu_to_benat dst (dst_off + !i) + Nat.( + B.benat_to_cpu src (src_off + !i) + lxor B.benat_to_cpu dst (dst_off + !i)) ; + incr i ; + decr n + done + + let xor_into a b n = + if n > imin (B.length a) (B.length b) + then raise (Invalid_argument "Baijiu.Xor.xor_inrot: buffers to small") + else xor_into a 0 b 0 n + + let xor a b = + let l = imin (B.length a) (B.length b) in + let r = B.copy (B.sub b 0 l) in + xor_into a r l ; + r +end + +module Bytes = Make (Digestif_by) +module Bigstring = Make (Digestif_bi) diff --git a/unikernel/duniverse/digestif/src/digestif.mli b/unikernel/duniverse/digestif/src/digestif.mli new file mode 100644 index 00000000..4a93e60e --- /dev/null +++ b/unikernel/duniverse/digestif/src/digestif.mli @@ -0,0 +1,392 @@ +type bigstring = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +type 'a iter = ('a -> unit) -> unit +(** A general (inner) iterator. It applies the provided function to a collection + of elements. For instance: + + - [let iter_k : 'a -> 'a iter = fun x f -> f x] + - [let iter_pair : 'a * 'a -> 'a iter = fun (x, y) -> f x; f y] + - [let iter_list : 'a list -> 'a iter = fun l f -> List.iter f l] *) + +type 'a compare = 'a -> 'a -> int +type 'a equal = 'a -> 'a -> bool +type 'a pp = Format.formatter -> 'a -> unit + +module type S = sig + val digest_size : int + (** Size of hash results, in bytes. *) + + type ctx + type hmac + type t + + val empty : ctx + (** An empty hash context. *) + + val init : unit -> ctx + (** Create a new hash state. *) + + val feed_bytes : ctx -> ?off:int -> ?len:int -> Bytes.t -> ctx + (** [feed_bytes msg t] adds informations in [msg] to [t]. [feed] is analogous + to appending: [feed (feed t msg1) msg2 = feed t (append msg1 msg2)] *) + + val feed_string : ctx -> ?off:int -> ?len:int -> String.t -> ctx + (** Same as {!feed_bytes} but for {!String.t}. *) + + val feed_bigstring : ctx -> ?off:int -> ?len:int -> bigstring -> ctx + (** Same as {!feed_bytes} but for {!bigstring}. *) + + val feedi_bytes : ctx -> Bytes.t iter -> ctx + (** [feedi_bytes t iter = let r = ref t in iter (fun msg -> r := feed !r msg); + !r] *) + + val feedi_string : ctx -> String.t iter -> ctx + (** Same as {!feed_bytes} but for {!String.t}. *) + + val feedi_bigstring : ctx -> bigstring iter -> ctx + (** Same as {!feed_bytes} but for {!bigstring}. *) + + val get : ctx -> t + (** [get t] is the digest corresponding to [t]. *) + + val hmac_init : key:string -> hmac + (** Create a new hmac state. *) + + val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac + (** [hmac_feed_bytes msg t] adds informations in [msg] to [t]. [hmac_feed] is + analogous to appending: + [hmac_feed (hmac_feed t msg1) msg2 = hmac_feed t + (append msg1 msg2)] *) + + val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac + (** Same as {!hmac_feed_bytes} but for {!String.t}. *) + + val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac + (** Same as {!hmac_feed_bytes} but for {!bigstring}. *) + + val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac + (** [hmac_feedi_bytes t iter = let r = ref t in iter (fun msg -> r := hmac_feed !r msg); + !r] *) + + val hmac_feedi_string : hmac -> String.t iter -> hmac + (** Same as {!hmac_feedi_bytes} but for {!String.t}. *) + + val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac + (** Same as {!hmac_feedi_bytes} but for {!bigstring}. *) + + val hmac_get : hmac -> t + (** [hmac_get t] is the hmac corresponding to [t]. *) + + val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t + (** [digest_bytes msg] is the digest of [msg]. + + [digest_bytes msg = get (feed_bytes empty msg)]. *) + + val digest_string : ?off:int -> ?len:int -> String.t -> t + (** Same as {!digest_bytes} but for a {!String.t}. *) + + val digest_bigstring : ?off:int -> ?len:int -> bigstring -> t + (** Same as {!digest_bytes} but for a {!bigstring}. *) + + val digesti_bytes : Bytes.t iter -> t + (** [digesti_bytes iter = feedi_bytes empty iter |> get]. *) + + val digesti_string : String.t iter -> t + (** Same as {!digesti_bytes} but for {!String.t}. *) + + val digesti_bigstring : bigstring iter -> t + (** Same as {!digesti_bigstring} but for {!bigstring}. *) + + val digestv_bytes : Bytes.t list -> t + (** Specialization of {!digesti_bytes} with a list of {!Bytes.t} (see + {!iter}). *) + + val digestv_string : String.t list -> t + (** Same as {!digestv_bytes} but for {!String.t}. *) + + val digestv_bigstring : bigstring list -> t + (** Same as {!digestv_bytes} but for {!bigstring}. *) + + val hmac_bytes : key:string -> ?off:int -> ?len:int -> Bytes.t -> t + (** [hmac_bytes ~key bytes] is the authentication code for {!Bytes.t} under + the secret [key], generated using the standard HMAC construction over this + hash algorithm. *) + + val hmac_string : key:string -> ?off:int -> ?len:int -> String.t -> t + (** Same as {!hmac_bytes} but for {!String.t}. *) + + val hmac_bigstring : key:string -> ?off:int -> ?len:int -> bigstring -> t + (** Same as {!hmac_bytes} but for {!bigstring}. *) + + val hmaci_bytes : key:string -> Bytes.t iter -> t + (** Authentication code under the secret [key] over a collection of + {!Bytes.t}. *) + + val hmaci_string : key:string -> String.t iter -> t + (** Same as {!hmaci_bytes} but for {!String.t}. *) + + val hmaci_bigstring : key:string -> bigstring iter -> t + (** Same as {!hmaci_bytes} but for {!bigstring}. *) + + val hmacv_bytes : key:string -> Bytes.t list -> t + (** Specialization of {!hmaci_bytes} with a list of {!Bytes.t} (see {!iter}). *) + + val hmacv_string : key:string -> String.t list -> t + (** Same as {!hmacv_bytes} but for {!String.t}. *) + + val hmacv_bigstring : key:string -> bigstring list -> t + (** Same as {!hmacv_bigstring} but for {!bigstring}. *) + + val unsafe_compare : t compare + (** [unsafe_compare] function returns [0] on equality and a negative/positive + [int] depending on the difference (like {!String.compare}). This is + usually OK, but this is not constant time, so in some cases it could leak + some information. *) + + val equal : t equal + (** The equal (constant-time) function for {!t}. *) + + val pp : t pp + (** Pretty-printer of {!t}. *) + + val of_hex : string -> t + (** [of_hex] tries to parse an hexadecimal representation of {!t}. [of_hex] + raises an [invalid_argument] when input is malformed. We take only firsts + {!digest_size} hexadecimal values and ignore rest of input. If it has not + enough hexadecimal values, trailing values of the output hash are zero + ([\x00]), *) + + val of_hex_opt : string -> t option + (** [of_hex] tries to parse an hexadecimal representation of {!t}. [of_hex] + returns [None] when input is malformed. We take only first {!digest_size} + hexadecimal values and ignore rest of input. If it has not enough + hexadecimal values, trailing values of the output hash are zero ([\x00]). *) + + val consistent_of_hex : string -> t + (** [consistent_of_hex] tries to parse an hexadecimal representation of {!t}. + [consistent_of_hex] raises an [invalid_argument] when input is malformed. + However, instead {!of_hex}, [consistent_of_hex] expects exactly + [{!digest_size} * 2] hexadecimal values (but continues to ignore + whitespaces). *) + + val consistent_of_hex_opt : string -> t option + (** [consistent_of_hex_opt] tries to parse an hexadecimal representation of + {!t}. [consistent_of_hex] returns [None] when input is malformed. However, + instead {!of_hex}, [consistent_of_hex] expects exactly + [{!digest_size} * 2] hexadecimal values (but continues to ignore + whitespaces). *) + + val to_hex : t -> string + (** [to_hex] makes a hex-decimal representation of {!t}. *) + + val of_raw_string : string -> t + (** [of_raw_string s] see [s] as a hash. Useful when reading serialized + hashes. *) + + val of_raw_string_opt : string -> t option + (** [of_raw_string_opt s] see [s] as a hash. Useful when reading serialized + hashes. Returns [None] if [s] is not the {!digest_size} bytes long. *) + + val to_raw_string : t -> string + (** [to_raw_string s] is [(s :> string)]. *) + + val get_into_bytes : ctx -> ?off:int -> bytes -> unit + (** [get_into_bytes ctx ?off buf] writes the result into the given [buf] at + [off] (defaults to [0]). + + It's equivalent to: + + {[ + let get_into_bytes ctx ?(off = 0) buf = + let t = get ctx in + let str = to_raw_string t in + Bytes.blit_string str 0 buf off digest_size + ]} + + except [get_into_bytes] does not allocate an intermediate string. *) +end + +(** Some hash algorithms expose extra MAC constructs. The interface is similar + to the [hmac_*] functions in [S]. *) +module type MAC = sig + type t + + val mac_bytes : key:string -> ?off:int -> ?len:int -> Bytes.t -> t + val mac_string : key:string -> ?off:int -> ?len:int -> String.t -> t + val mac_bigstring : key:string -> ?off:int -> ?len:int -> bigstring -> t + val maci_bytes : key:string -> Bytes.t iter -> t + val maci_string : key:string -> String.t iter -> t + val maci_bigstring : key:string -> bigstring iter -> t + val macv_bytes : key:string -> Bytes.t list -> t + val macv_string : key:string -> String.t list -> t + val macv_bigstring : key:string -> bigstring list -> t +end + +module MD5 : S +module SHA1 : S +module SHA224 : S +module SHA256 : S +module SHA384 : S +module SHA512 : S + +module SHA3_224 : S +(** SHA3 224 hash algorithm. + + @since 0.9.0 *) + +module SHA3_256 : S +(** SHA3 256 hash algorithm. + + @since 0.9.0 *) + +module KECCAK_256 : S +(** KECCAK 256 hash algorithm. + + @since 1.1.0 *) + +module SHA3_384 : S +(** SHA3 384 hash algorithm. + + @since 0.9.0 *) + +module SHA3_512 : S +(** SHA3 512 hash algorithm. + + @since 0.9.0 *) + +module WHIRLPOOL : S +(** WHIRLPOOL hash algorithm. + + @since 0.7.1 *) + +module BLAKE2B : sig + include S + module Keyed : MAC with type t = t +end + +module BLAKE2S : sig + include S + module Keyed : MAC with type t = t +end + +module RMD160 : S +(** RMD160 hash algorithm. + + @since 0.4 *) + +module Make_BLAKE2B (D : sig + val digest_size : int +end) : S + +module Make_BLAKE2S (D : sig + val digest_size : int +end) : S + +type 'k hash = + | MD5 : MD5.t hash + | SHA1 : SHA1.t hash + | RMD160 : RMD160.t hash + | SHA224 : SHA224.t hash + | SHA256 : SHA256.t hash + | SHA384 : SHA384.t hash + | SHA512 : SHA512.t hash + | SHA3_224 : SHA3_224.t hash + | SHA3_256 : SHA3_256.t hash + | KECCAK_256 : KECCAK_256.t hash + | SHA3_384 : SHA3_384.t hash + | SHA3_512 : SHA3_512.t hash + | WHIRLPOOL : WHIRLPOOL.t hash + | BLAKE2B : BLAKE2B.t hash + | BLAKE2S : BLAKE2S.t hash + +type hash' = + [ `MD5 + | `SHA1 + | `RMD160 + | `SHA224 + | `SHA256 + | `SHA384 + | `SHA512 + | `SHA3_224 + | `SHA3_256 + | `KECCAK_256 + | `SHA3_384 + | `SHA3_512 + | `WHIRLPOOL + | `BLAKE2B + | `BLAKE2S ] + +val module_of_hash' : hash' -> (module S) +val hash_to_hash' : _ hash -> hash' +val md5 : MD5.t hash +val sha1 : SHA1.t hash +val rmd160 : RMD160.t hash +val sha224 : SHA224.t hash +val sha256 : SHA256.t hash +val sha384 : SHA384.t hash +val sha512 : SHA512.t hash +val sha3_224 : SHA3_224.t hash +val sha3_256 : SHA3_256.t hash +val keccak_256 : KECCAK_256.t hash +val sha3_384 : SHA3_384.t hash +val sha3_512 : SHA3_512.t hash +val whirlpool : WHIRLPOOL.t hash +val blake2b : BLAKE2B.t hash +val blake2s : BLAKE2S.t hash + +type 'kind t + +val module_of : 'k hash -> (module S with type t = 'k) +val digest_bytes : 'k hash -> Bytes.t -> 'k t +val digest_string : 'k hash -> String.t -> 'k t +val digest_bigstring : 'k hash -> bigstring -> 'k t +val digesti_bytes : 'k hash -> Bytes.t iter -> 'k t +val digesti_string : 'k hash -> String.t iter -> 'k t +val digesti_bigstring : 'k hash -> bigstring iter -> 'k t +val hmaci_bytes : 'k hash -> key:string -> Bytes.t iter -> 'k t +val hmaci_string : 'k hash -> key:string -> String.t iter -> 'k t +val hmaci_bigstring : 'k hash -> key:string -> bigstring iter -> 'k t +val pp : 'k hash -> 'k t pp +val equal : 'k hash -> 'k t equal +val unsafe_compare : 'k hash -> 'k t compare +val to_hex : 'k hash -> 'k t -> string +val of_hex : 'k hash -> string -> 'k t +val of_hex_opt : 'k hash -> string -> 'k t option +val consistent_of_hex : 'k hash -> string -> 'k t +val consistent_of_hex_opt : 'k hash -> string -> 'k t option +val of_raw_string : 'k hash -> string -> 'k t +val of_raw_string_opt : 'k hash -> string -> 'k t option +val to_raw_string : 'k hash -> 'k t -> string +val of_digest : (module S with type t = 'hash) -> 'hash -> 'hash t +val of_md5 : MD5.t -> MD5.t t +val of_sha1 : SHA1.t -> SHA1.t t + +val of_rmd160 : RMD160.t -> RMD160.t t +(** @since 0.4 *) + +val of_sha224 : SHA224.t -> SHA224.t t +val of_sha256 : SHA256.t -> SHA256.t t +val of_sha384 : SHA384.t -> SHA384.t t +val of_sha512 : SHA512.t -> SHA512.t t + +val of_sha3_224 : SHA3_224.t -> SHA3_224.t t +(** @since 0.9.0 *) + +val of_sha3_256 : SHA3_256.t -> SHA3_256.t t +(** @since 0.9.0 *) + +val of_keccak_256 : KECCAK_256.t -> KECCAK_256.t t +(** @since 1.1.0 *) + +val of_sha3_384 : SHA3_384.t -> SHA3_384.t t +(** @since 0.9.0 *) + +val of_sha3_512 : SHA3_512.t -> SHA3_512.t t +(** @since 0.9.0 *) + +val of_whirlpool : WHIRLPOOL.t -> WHIRLPOOL.t t +(** @since 0.7.1 *) + +val of_blake2b : BLAKE2B.t -> BLAKE2B.t t +val of_blake2s : BLAKE2S.t -> BLAKE2S.t t diff --git a/unikernel/duniverse/digestif/src/digestif_bi.ml b/unikernel/duniverse/digestif/src/digestif_bi.ml new file mode 100644 index 00000000..57cd4758 --- /dev/null +++ b/unikernel/duniverse/digestif/src/digestif_bi.ml @@ -0,0 +1,82 @@ +open Bigarray + +type t = (char, int8_unsigned_elt, c_layout) Array1.t + +let create n = Array1.create Char c_layout n +let length = Array1.dim +let sub = Array1.sub +let empty = Array1.create Char c_layout 0 +let get = Array1.get + +let copy t = + let r = create (length t) in + Array1.blit t r ; + r + +let init l f = + let v = Array1.create Char c_layout l in + for i = 0 to l - 1 do + Array1.set v i (f i) + done ; + v + +external unsafe_get_32 : t -> int -> int32 = "%caml_bigstring_get32u" +external unsafe_get_64 : t -> int -> int64 = "%caml_bigstring_get64u" + +let unsafe_get_nat : t -> int -> nativeint = + fun s i -> + if Sys.word_size = 32 + then Nativeint.of_int32 @@ unsafe_get_32 s i + else Int64.to_nativeint @@ unsafe_get_64 s i + +external unsafe_set_32 : t -> int -> int32 -> unit = "%caml_bigstring_set32u" +external unsafe_set_64 : t -> int -> int64 -> unit = "%caml_bigstring_set64u" + +let unsafe_set_nat : t -> int -> nativeint -> unit = + fun s i v -> + if Sys.word_size = 32 + then unsafe_set_32 s i (Nativeint.to_int32 v) + else unsafe_set_64 s i (Int64.of_nativeint v) + +let to_string v = String.init (length v) (Array1.get v) + +let blit_from_bytes src src_off dst dst_off len = + for i = 0 to len - 1 do + Array1.set dst (dst_off + i) (Bytes.get src (src_off + i)) + done + +external swap32 : int32 -> int32 = "%bswap_int32" +external swap64 : int64 -> int64 = "%bswap_int64" +external swapnat : nativeint -> nativeint = "%bswap_native" + +let cpu_to_be32 s i v = + if Sys.big_endian then unsafe_set_32 s i v else unsafe_set_32 s i (swap32 v) + +let cpu_to_le32 s i v = + if Sys.big_endian then unsafe_set_32 s i (swap32 v) else unsafe_set_32 s i v + +let cpu_to_be64 s i v = + if Sys.big_endian then unsafe_set_64 s i v else unsafe_set_64 s i (swap64 v) + +let cpu_to_le64 s i v = + if Sys.big_endian then unsafe_set_64 s i (swap64 v) else unsafe_set_64 s i v + +let be32_to_cpu s i = + if Sys.big_endian then unsafe_get_32 s i else swap32 @@ unsafe_get_32 s i + +let le32_to_cpu s i = + if Sys.big_endian then swap32 @@ unsafe_get_32 s i else unsafe_get_32 s i + +let be64_to_cpu s i = + if Sys.big_endian then unsafe_get_64 s i else swap64 @@ unsafe_get_64 s i + +let le64_to_cpu s i = + if Sys.big_endian then swap64 @@ unsafe_get_64 s i else unsafe_get_64 s i + +let benat_to_cpu s i = + if Sys.big_endian then unsafe_get_nat s i else swapnat @@ unsafe_get_nat s i + +let cpu_to_benat s i v = + if Sys.big_endian + then unsafe_set_nat s i v + else unsafe_set_nat s i (swapnat v) diff --git a/unikernel/duniverse/digestif/src/digestif_by.ml b/unikernel/duniverse/digestif/src/digestif_by.ml new file mode 100644 index 00000000..26eb450e --- /dev/null +++ b/unikernel/duniverse/digestif/src/digestif_by.ml @@ -0,0 +1,67 @@ +include Bytes + +external unsafe_get_32 : t -> int -> int32 = "%caml_bytes_get32u" +external unsafe_get_64 : t -> int -> int64 = "%caml_bytes_get64u" + +let unsafe_get_nat : t -> int -> nativeint = + fun s i -> + if Sys.word_size = 32 + then Nativeint.of_int32 @@ unsafe_get_32 s i + else Int64.to_nativeint @@ unsafe_get_64 s i + +external unsafe_set_32 : t -> int -> int32 -> unit = "%caml_bytes_set32u" +external unsafe_set_64 : t -> int -> int64 -> unit = "%caml_bytes_set64u" + +let unsafe_set_nat : t -> int -> nativeint -> unit = + fun s i v -> + if Sys.word_size = 32 + then unsafe_set_32 s i (Nativeint.to_int32 v) + else unsafe_set_64 s i (Int64.of_nativeint v) + +let blit_from_bigstring src src_off dst dst_off len = + for i = 0 to len - 1 do + set dst (dst_off + i) src.{src_off + i} + done + +let rpad a size x = + let l = length a in + let b = create size in + blit a 0 b 0 l ; + fill b l (size - l) x ; + b + +external swap32 : int32 -> int32 = "%bswap_int32" +external swap64 : int64 -> int64 = "%bswap_int64" +external swapnat : nativeint -> nativeint = "%bswap_native" + +let cpu_to_be32 s i v = + if Sys.big_endian then unsafe_set_32 s i v else unsafe_set_32 s i (swap32 v) + +let cpu_to_le32 s i v = + if Sys.big_endian then unsafe_set_32 s i (swap32 v) else unsafe_set_32 s i v + +let cpu_to_be64 s i v = + if Sys.big_endian then unsafe_set_64 s i v else unsafe_set_64 s i (swap64 v) + +let cpu_to_le64 s i v = + if Sys.big_endian then unsafe_set_64 s i (swap64 v) else unsafe_set_64 s i v + +let be32_to_cpu s i = + if Sys.big_endian then unsafe_get_32 s i else swap32 @@ unsafe_get_32 s i + +let le32_to_cpu s i = + if Sys.big_endian then swap32 @@ unsafe_get_32 s i else unsafe_get_32 s i + +let be64_to_cpu s i = + if Sys.big_endian then unsafe_get_64 s i else swap64 @@ unsafe_get_64 s i + +let le64_to_cpu s i = + if Sys.big_endian then swap64 @@ unsafe_get_64 s i else unsafe_get_64 s i + +let benat_to_cpu s i = + if Sys.big_endian then unsafe_get_nat s i else swapnat @@ unsafe_get_nat s i + +let cpu_to_benat s i v = + if Sys.big_endian + then unsafe_set_nat s i v + else unsafe_set_nat s i (swapnat v) diff --git a/unikernel/duniverse/digestif/src/digestif_conv.ml b/unikernel/duniverse/digestif/src/digestif_conv.ml new file mode 100644 index 00000000..ee7bd384 --- /dev/null +++ b/unikernel/duniverse/digestif/src/digestif_conv.ml @@ -0,0 +1,104 @@ +let invalid_arg fmt = Format.ksprintf (fun s -> invalid_arg s) fmt + +module Make (D : sig + val digest_size : int +end) = +struct + let to_hex hash = + let res = Bytes.create (D.digest_size * 2) in + let chr x = + match x with + | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 -> Char.chr (48 + x) + | _ -> Char.chr (97 + (x - 10)) in + for i = 0 to D.digest_size - 1 do + let v = Char.code hash.[i] in + Bytes.unsafe_set res (i * 2) (chr (v lsr 4)) ; + Bytes.unsafe_set res ((i * 2) + 1) (chr (v land 0x0F)) + done ; + Bytes.unsafe_to_string res + + let code x = + match x with + | '0' .. '9' -> Char.code x - Char.code '0' + | 'A' .. 'F' -> Char.code x - Char.code 'A' + 10 + | 'a' .. 'f' -> Char.code x - Char.code 'a' + 10 + | _ -> invalid_arg "of_hex: %02X" (Char.code x) + + let decode chr1 chr2 = Char.chr ((code chr1 lsl 4) lor code chr2) + + let of_hex hex = + let offset = ref 0 in + let rec go have_first idx = + if !offset + idx >= String.length hex + then '\x00' + else + match hex.[!offset + idx] with + | ' ' | '\t' | '\r' | '\n' -> + incr offset ; + go have_first idx + | chr2 when have_first -> chr2 + | chr1 -> + incr offset ; + let chr2 = go true idx in + if chr2 <> '\x00' + then decode chr1 chr2 + else invalid_arg "of_hex: odd number of hex characters" in + String.init D.digest_size (go false) + + let of_hex_opt hex = + match of_hex hex with + | digest -> Some digest + | exception Invalid_argument _ -> None + + let consistent_of_hex str = + let offset = ref 0 in + let rec go have_first idx = + if !offset + idx >= String.length str + then invalid_arg "Not enough hex value" + else + match str.[!offset + idx] with + | ' ' | '\t' | '\r' | '\n' -> + incr offset ; + go have_first idx + | chr2 when have_first -> chr2 + | chr1 -> + incr offset ; + let chr2 = go true idx in + decode chr1 chr2 in + let res = String.init D.digest_size (go false) in + let is_wsp = function ' ' | '\t' | '\r' | '\n' -> true | _ -> false in + while + D.digest_size + !offset < String.length str + && is_wsp str.[!offset + (D.digest_size * 2)] + do + incr offset + done ; + if !offset + D.digest_size = String.length str + then res + else + invalid_arg "Too much enough bytes (reach: %d, expect: %d)" + (!offset + (D.digest_size * 2)) + (String.length str) + + let consistent_of_hex_opt hex = + match consistent_of_hex hex with + | digest -> Some digest + | exception Invalid_argument _ -> None + + let pp ppf hash = + for i = 0 to D.digest_size - 1 do + Format.fprintf ppf "%02x" (Char.code hash.[i]) + done + + let of_raw_string x = + if String.length x <> D.digest_size + then invalid_arg "invalid hash size" + else x + + let of_raw_string_opt x = + match of_raw_string x with + | digest -> Some digest + | exception Invalid_argument _ -> None + + let to_raw_string x = x +end diff --git a/unikernel/duniverse/digestif/src/digestif_eq.ml b/unikernel/duniverse/digestif/src/digestif_eq.ml new file mode 100644 index 00000000..3420863f --- /dev/null +++ b/unikernel/duniverse/digestif/src/digestif_eq.ml @@ -0,0 +1,8 @@ +module Make (D : sig + val digest_size : int +end) = +struct + let _ = D.digest_size + let equal a b = Eqaf.equal a b + let unsafe_compare a b = String.compare a b +end diff --git a/unikernel/duniverse/digestif/src/dune b/unikernel/duniverse/digestif/src/dune new file mode 100644 index 00000000..b6849e68 --- /dev/null +++ b/unikernel/duniverse/digestif/src/dune @@ -0,0 +1,8 @@ +(library + (name digestif) + (public_name digestif) + (modules digestif) + (wrapped false) + (virtual_modules digestif) + (default_implementation digestif.c) + (libraries eqaf)) diff --git a/unikernel/duniverse/digestif/test/blake2b.test b/unikernel/duniverse/digestif/test/blake2b.test new file mode 100644 index 00000000..d9438ef1 --- /dev/null +++ b/unikernel/duniverse/digestif/test/blake2b.test @@ -0,0 +1,1025 @@ + + +in: +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 10ebb67700b1868efb4417987acf4690ae9d972fb7a590c2f02871799aaa4786b5e996e8f0f4eb981fc214b005f42d2ff4233499391653df7aefcbc13fc51568 + +in: 00 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 961f6dd1e4dd30f63901690c512e78e4b45e4742ed197c3c5e45c549fd25f2e4187b0bc9fe30492b16b0d0bc4ef9b0f34c7003fac09a5ef1532e69430234cebd + +in: 0001 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: da2cfbe2d8409a0f38026113884f84b50156371ae304c4430173d08a99d9fb1b983164a3770706d537f49e0c916d9f32b95cc37a95b99d857436f0232c88a965 + +in: 000102 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 33d0825dddf7ada99b0e7e307104ad07ca9cfd9692214f1561356315e784f3e5a17e364ae9dbb14cb2036df932b77f4b292761365fb328de7afdc6d8998f5fc1 + +in: 00010203 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: beaa5a3d08f3807143cf621d95cd690514d0b49efff9c91d24b59241ec0eefa5f60196d407048bba8d2146828ebcb0488d8842fd56bb4f6df8e19c4b4daab8ac + +in: 0001020304 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 098084b51fd13deae5f4320de94a688ee07baea2800486689a8636117b46c1f4c1f6af7f74ae7c857600456a58a3af251dc4723a64cc7c0a5ab6d9cac91c20bb + +in: 000102030405 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 6044540d560853eb1c57df0077dd381094781cdb9073e5b1b3d3f6c7829e12066bbaca96d989a690de72ca3133a83652ba284a6d62942b271ffa2620c9e75b1f + +in: 00010203040506 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7a8cfe9b90f75f7ecb3acc053aaed6193112b6f6a4aeeb3f65d3de541942deb9e2228152a3c4bbbe72fc3b12629528cfbb09fe630f0474339f54abf453e2ed52 + +in: 0001020304050607 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 380beaf6ea7cc9365e270ef0e6f3a64fb902acae51dd5512f84259ad2c91f4bc4108db73192a5bbfb0cbcf71e46c3e21aee1c5e860dc96e8eb0b7b8426e6abe9 + +in: 000102030405060708 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 60fe3c4535e1b59d9a61ea8500bfac41a69dffb1ceadd9aca323e9a625b64da5763bad7226da02b9c8c4f1a5de140ac5a6c1124e4f718ce0b28ea47393aa6637 + +in: 00010203040506070809 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 4fe181f54ad63a2983feaaf77d1e7235c2beb17fa328b6d9505bda327df19fc37f02c4b6f0368ce23147313a8e5738b5fa2a95b29de1c7f8264eb77b69f585cd + +in: 000102030405060708090a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f228773ce3f3a42b5f144d63237a72d99693adb8837d0e112a8a0f8ffff2c362857ac49c11ec740d1500749dac9b1f4548108bf3155794dcc9e4082849e2b85b + +in: 000102030405060708090a0b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 962452a8455cc56c8511317e3b1f3b2c37df75f588e94325fdd77070359cf63a9ae6e930936fdf8e1e08ffca440cfb72c28f06d89a2151d1c46cd5b268ef8563 + +in: 000102030405060708090a0b0c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 43d44bfa18768c59896bf7ed1765cb2d14af8c260266039099b25a603e4ddc5039d6ef3a91847d1088d401c0c7e847781a8a590d33a3c6cb4df0fab1c2f22355 + +in: 000102030405060708090a0b0c0d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: dcffa9d58c2a4ca2cdbb0c7aa4c4c1d45165190089f4e983bb1c2cab4aaeff1fa2b5ee516fecd780540240bf37e56c8bcca7fab980e1e61c9400d8a9a5b14ac6 + +in: 000102030405060708090a0b0c0d0e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 6fbf31b45ab0c0b8dad1c0f5f4061379912dde5aa922099a030b725c73346c524291adef89d2f6fd8dfcda6d07dad811a9314536c2915ed45da34947e83de34e + +in: 000102030405060708090a0b0c0d0e0f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: a0c65bddde8adef57282b04b11e7bc8aab105b99231b750c021f4a735cb1bcfab87553bba3abb0c3e64a0b6955285185a0bd35fb8cfde557329bebb1f629ee93 + +in: 000102030405060708090a0b0c0d0e0f10 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f99d815550558e81eca2f96718aed10d86f3f1cfb675cce06b0eff02f617c5a42c5aa760270f2679da2677c5aeb94f1142277f21c7f79f3c4f0cce4ed8ee62b1 + +in: 000102030405060708090a0b0c0d0e0f1011 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 95391da8fc7b917a2044b3d6f5374e1ca072b41454d572c7356c05fd4bc1e0f40b8bb8b4a9f6bce9be2c4623c399b0dca0dab05cb7281b71a21b0ebcd9e55670 + +in: 000102030405060708090a0b0c0d0e0f101112 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 04b9cd3d20d221c09ac86913d3dc63041989a9a1e694f1e639a3ba7e451840f750c2fc191d56ad61f2e7936bc0ac8e094b60caeed878c18799045402d61ceaf9 + +in: 000102030405060708090a0b0c0d0e0f10111213 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ec0e0ef707e4ed6c0c66f9e089e4954b058030d2dd86398fe84059631f9ee591d9d77375355149178c0cf8f8e7c49ed2a5e4f95488a2247067c208510fadc44c + +in: 000102030405060708090a0b0c0d0e0f1011121314 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 9a37cce273b79c09913677510eaf7688e89b3314d3532fd2764c39de022a2945b5710d13517af8ddc0316624e73bec1ce67df15228302036f330ab0cb4d218dd + +in: 000102030405060708090a0b0c0d0e0f101112131415 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 4cf9bb8fb3d4de8b38b2f262d3c40f46dfe747e8fc0a414c193d9fcf753106ce47a18f172f12e8a2f1c26726545358e5ee28c9e2213a8787aafbc516d2343152 + +in: 000102030405060708090a0b0c0d0e0f10111213141516 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 64e0c63af9c808fd893137129867fd91939d53f2af04be4fa268006100069b2d69daa5c5d8ed7fddcb2a70eeecdf2b105dd46a1e3b7311728f639ab489326bc9 + +in: 000102030405060708090a0b0c0d0e0f1011121314151617 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5e9c93158d659b2def06b0c3c7565045542662d6eee8a96a89b78ade09fe8b3dcc096d4fe48815d88d8f82620156602af541955e1f6ca30dce14e254c326b88f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7775dff889458dd11aef417276853e21335eb88e4dec9cfb4e9edb49820088551a2ca60339f12066101169f0dfe84b098fddb148d9da6b3d613df263889ad64b + +in: 000102030405060708090a0b0c0d0e0f10111213141516171819 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f0d2805afbb91f743951351a6d024f9353a23c7ce1fc2b051b3a8b968c233f46f50f806ecb1568ffaa0b60661e334b21dde04f8fa155ac740eeb42e20b60d764 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 86a2af316e7d7754201b942e275364ac12ea8962ab5bd8d7fb276dc5fbffc8f9a28cae4e4867df6780d9b72524160927c855da5b6078e0b554aa91e31cb9ca1d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 10bdf0caa0802705e706369baf8a3f79d72c0a03a80675a7bbb00be3a45e516424d1ee88efb56f6d5777545ae6e27765c3a8f5e493fc308915638933a1dfee55 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b01781092b1748459e2e4ec178696627bf4ebafebba774ecf018b79a68aeb84917bf0b84bb79d17b743151144cd66b7b33a4b9e52c76c4e112050ff5385b7f0b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c6dbc61dec6eaeac81e3d5f755203c8e220551534a0b2fd105a91889945a638550204f44093dd998c076205dffad703a0e5cd3c7f438a7e634cd59fededb539e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: eba51acffb4cea31db4b8d87e9bf7dd48fe97b0253ae67aa580f9ac4a9d941f2bea518ee286818cc9f633f2a3b9fb68e594b48cdd6d515bf1d52ba6c85a203a7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 86221f3ada52037b72224f105d7999231c5e5534d03da9d9c0a12acb68460cd375daf8e24386286f9668f72326dbf99ba094392437d398e95bb8161d717f8991 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5595e05c13a7ec4dc8f41fb70cb50a71bce17c024ff6de7af618d0cc4e9c32d9570d6d3ea45b86525491030c0d8f2b1836d5778c1ce735c17707df364d054347 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f2021 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ce0f4f6aca89590a37fe034dd74dd5fa65eb1cbd0a41508aaddc09351a3cea6d18cb2189c54b700c009f4cbf0521c7ea01be61c5ae09cb54f27bc1b44d658c82 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7ee80b06a215a3bca970c77cda8761822bc103d44fa4b33f4d07dcb997e36d55298bceae12241b3fa07fa63be5576068da387b8d5859aeab701369848b176d42 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20212223 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 940a84b6a84d109aab208c024c6ce9647676ba0aaa11f86dbb7018f9fd2220a6d901a9027f9abcf935372727cbf09ebd61a2a2eeb87653e8ecad1bab85dc8327 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f2021222324 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 2020b78264a82d9f4151141adba8d44bf20c5ec062eee9b595a11f9e84901bf148f298e0c9f8777dcdbc7cc4670aac356cc2ad8ccb1629f16f6a76bcefbee760 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d1b897b0e075ba68ab572adf9d9c436663e43eb3d8e62d92fc49c9be214e6f27873fe215a65170e6bea902408a25b49506f47babd07cecf7113ec10c5dd31252 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20212223242526 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b14d0c62abfa469a357177e594c10c194243ed2025ab8aa5ad2fa41ad318e0ff48cd5e60bec07b13634a711d2326e488a985f31e31153399e73088efc86a5c55 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f2021222324252627 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 4169c5cc808d2697dc2a82430dc23e3cd356dc70a94566810502b8d655b39abf9e7f902fe717e0389219859e1945df1af6ada42e4ccda55a197b7100a30c30a1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 258a4edb113d66c839c8b1c91f15f35ade609f11cd7f8681a4045b9fef7b0b24c82cda06a5f2067b368825e3914e53d6948ede92efd6e8387fa2e537239b5bee + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20212223242526272829 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 79d2d8696d30f30fb34657761171a11e6c3f1e64cbe7bebee159cb95bfaf812b4f411e2f26d9c421dc2c284a3342d823ec293849e42d1e46b0a4ac1e3c86abaa + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8b9436010dc5dee992ae38aea97f2cd63b946d94fedd2ec9671dcde3bd4ce9564d555c66c15bb2b900df72edb6b891ebcadfeff63c9ea4036a998be7973981e7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c8f68e696ed28242bf997f5b3b34959508e42d613810f1e2a435c96ed2ff560c7022f361a9234b9837feee90bf47922ee0fd5f8ddf823718d86d1e16c6090071 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b02d3eee4860d5868b2c39ce39bfe81011290564dd678c85e8783f29302dfc1399ba95b6b53cd9ebbf400cca1db0ab67e19a325f2d115812d25d00978ad1bca4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7693ea73af3ac4dad21ca0d8da85b3118a7d1c6024cfaf557699868217bc0c2f44a199bc6c0edd519798ba05bd5b1b4484346a47c2cadf6bf30b785cc88b2baf + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: a0e5c1c0031c02e48b7f09a5e896ee9aef2f17fc9e18e997d7f6cac7ae316422c2b1e77984e5f3a73cb45deed5d3f84600105e6ee38f2d090c7d0442ea34c46d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 41daa6adcfdb69f1440c37b596440165c15ada596813e2e22f060fcd551f24dee8e04ba6890387886ceec4a7a0d7fc6b44506392ec3822c0d8c1acfc7d5aebe8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 14d4d40d5984d84c5cf7523b7798b254e275a3a8cc0a1bd06ebc0bee726856acc3cbf516ff667cda2058ad5c3412254460a82c92187041363cc77a4dc215e487 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f3031 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d0e7a1e2b9a447fee83e2277e9ff8010c2f375ae12fa7aaa8ca5a6317868a26a367a0b69fbc1cf32a55d34eb370663016f3d2110230eba754028a56f54acf57c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e771aa8db5a3e043e8178f39a0857ba04a3f18e4aa05743cf8d222b0b095825350ba422f63382a23d92e4149074e816a36c1cd28284d146267940b31f8818ea2 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30313233 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: feb4fd6f9e87a56bef398b3284d2bda5b5b0e166583a66b61e538457ff0584872c21a32962b9928ffab58de4af2edd4e15d8b35570523207ff4e2a5aa7754caa + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f3031323334 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 462f17bf005fb1c1b9e671779f665209ec2873e3e411f98dabf240a1d5ec3f95ce6796b6fc23fe171903b502023467dec7273ff74879b92967a2a43a5a183d33 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d3338193b64553dbd38d144bea71c5915bb110e2d88180dbc5db364fd6171df317fc7268831b5aef75e4342b2fad8797ba39eddcef80e6ec08159350b1ad696d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30313233343536 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e1590d585a3d39f7cb599abd479070966409a6846d4377acf4471d065d5db94129cc9be92573b05ed226be1e9b7cb0cabe87918589f80dadd4ef5ef25a93d28e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f3031323334353637 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f8f3726ac5a26cc80132493a6fedcb0e60760c09cfc84cad178175986819665e76842d7b9fedf76dddebf5d3f56faaad4477587af21606d396ae570d8e719af2 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 30186055c07949948183c850e9a756cc09937e247d9d928e869e20bafc3cd9721719d34e04a0899b92c736084550186886efba2e790d8be6ebf040b209c439a4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30313233343536373839 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f3c4276cb863637712c241c444c5cc1e3554e0fddb174d035819dd83eb700b4ce88df3ab3841ba02085e1a99b4e17310c5341075c0458ba376c95a6818fbb3e2 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 0aa007c4dd9d5832393040a1583c930bca7dc5e77ea53add7e2b3f7c8e231368043520d4a3ef53c969b6bbfd025946f632bd7f765d53c21003b8f983f75e2a6a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 08e9464720533b23a04ec24f7ae8c103145f765387d738777d3d343477fd1c58db052142cab754ea674378e18766c53542f71970171cc4f81694246b717d7564 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d37ff7ad297993e7ec21e0f1b4b5ae719cdc83c5db687527f27516cbffa822888a6810ee5c1ca7bfe3321119be1ab7bfa0a502671c8329494df7ad6f522d440f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: dd9042f6e464dcf86b1262f6accfafbd8cfd902ed3ed89abf78ffa482dbdeeb6969842394c9a1168ae3d481a017842f660002d42447c6b22f7b72f21aae021c9 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: bd965bf31e87d70327536f2a341cebc4768eca275fa05ef98f7f1b71a0351298de006fba73fe6733ed01d75801b4a928e54231b38e38c562b2e33ea1284992fa + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 65676d800617972fbd87e4b9514e1c67402b7a331096d3bfac22f1abb95374abc942f16e9ab0ead33b87c91968a6e509e119ff07787b3ef483e1dcdccf6e3022 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 939fa189699c5d2c81ddd1ffc1fa207c970b6a3685bb29ce1d3e99d42f2f7442da53e95a72907314f4588399a3ff5b0a92beb3f6be2694f9f86ecf2952d5b41c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f4041 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c516541701863f91005f314108ceece3c643e04fc8c42fd2ff556220e616aaa6a48aeb97a84bad74782e8dff96a1a2fa949339d722edcaa32b57067041df88cc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 987fd6e0d6857c553eaebb3d34970a2c2f6e89a3548f492521722b80a1c21a153892346d2cba6444212d56da9a26e324dccbc0dcde85d4d2ee4399eec5a64e8f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40414243 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ae56deb1c2328d9c4017706bce6e99d41349053ba9d336d677c4c27d9fd50ae6aee17e853154e1f4fe7672346da2eaa31eea53fcf24a22804f11d03da6abfc2b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f4041424344 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 49d6a608c9bde4491870498572ac31aac3fa40938b38a7818f72383eb040ad39532bc06571e13d767e6945ab77c0bdc3b0284253343f9f6c1244ebf2ff0df866 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: da582ad8c5370b4469af862aa6467a2293b2b28bd80ae0e91f425ad3d47249fdf98825cc86f14028c3308c9804c78bfeeeee461444ce243687e1a50522456a1d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40414243444546 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d5266aa3331194aef852eed86d7b5b2633a0af1c735906f2e13279f14931a9fc3b0eac5ce9245273bd1aa92905abe16278ef7efd47694789a7283b77da3c70f8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f4041424344454647 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 2962734c28252186a9a1111c732ad4de4506d4b4480916303eb7991d659ccda07a9911914bc75c418ab7a4541757ad054796e26797feaf36e9f6ad43f14b35a4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e8b79ec5d06e111bdfafd71e9f5760f00ac8ac5d8bf768f9ff6f08b8f026096b1cc3a4c973333019f1e3553e77da3f98cb9f542e0a90e5f8a940cc58e59844b3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40414243444546474849 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: dfb320c44f9d41d1efdcc015f08dd5539e526e39c87d509ae6812a969e5431bf4fa7d91ffd03b981e0d544cf72d7b1c0374f8801482e6dea2ef903877eba675e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d88675118fdb55a5fb365ac2af1d217bf526ce1ee9c94b2f0090b2c58a06ca58187d7fe57c7bed9d26fca067b4110eefcd9a0a345de872abe20de368001b0745 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b893f2fc41f7b0dd6e2f6aa2e0370c0cff7df09e3acfcc0e920b6e6fad0ef747c40668417d342b80d2351e8c175f20897a062e9765e6c67b539b6ba8b9170545 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 6c67ec5697accd235c59b486d7b70baeedcbd4aa64ebd4eef3c7eac189561a726250aec4d48cadcafbbe2ce3c16ce2d691a8cce06e8879556d4483ed7165c063 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f1aa2b044f8f0c638a3f362e677b5d891d6fd2ab0765f6ee1e4987de057ead357883d9b405b9d609eea1b869d97fb16d9b51017c553f3b93c0a1e0f1296fedcd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: cbaa259572d4aebfc1917acddc582b9f8dfaa928a198ca7acd0f2aa76a134a90252e6298a65b08186a350d5b7626699f8cb721a3ea5921b753ae3a2dce24ba3a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: fa1549c9796cd4d303dcf452c1fbd5744fd9b9b47003d920b92de34839d07ef2a29ded68f6fc9e6c45e071a2e48bd50c5084e96b657dd0404045a1ddefe282ed + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5cf2ac897ab444dcb5c8d87c495dbdb34e1838b6b629427caa51702ad0f9688525f13bec503a3c3a2c80a65e0b5715e8afab00ffa56ec455a49a1ad30aa24fcd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f5051 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 9aaf80207bace17bb7ab145757d5696bde32406ef22b44292ef65d4519c3bb2ad41a59b62cc3e94b6fa96d32a7faadae28af7d35097219aa3fd8cda31e40c275 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: af88b163402c86745cb650c2988fb95211b94b03ef290eed9662034241fd51cf398f8073e369354c43eae1052f9b63b08191caa138aa54fea889cc7024236897 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 48fa7d64e1ceee27b9864db5ada4b53d00c9bc7626555813d3cd6730ab3cc06ff342d727905e33171bde6e8476e77fb1720861e94b73a2c538d254746285f430 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f5051525354 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 0e6fd97a85e904f87bfe85bbeb34f69e1f18105cf4ed4f87aec36c6e8b5f68bd2a6f3dc8a9ecb2b61db4eedb6b2ea10bf9cb0251fb0f8b344abf7f366b6de5ab + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 06622da5787176287fdc8fed440bad187d830099c94e6d04c8e9c954cda70c8bb9e1fc4a6d0baa831b9b78ef6648681a4867a11da93ee36e5e6a37d87fc63f6f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253545556 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 1da6772b58fabf9c61f68d412c82f182c0236d7d575ef0b58dd22458d643cd1dfc93b03871c316d8430d312995d4197f0874c99172ba004a01ee295abac24e46 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f5051525354555657 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3cd2d9320b7b1d5fb9aab951a76023fa667be14a9124e394513918a3f44096ae4904ba0ffc150b63bc7ab1eeb9a6e257e5c8f000a70394a5afd842715de15f29 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 04cdc14f7434e0b4be70cb41db4c779a88eaef6accebcb41f2d42fffe7f32a8e281b5c103a27021d0d08362250753cdf70292195a53a48728ceb5844c2d98bab + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253545556575859 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 9071b7a8a075d0095b8fb3ae5113785735ab98e2b52faf91d5b89e44aac5b5d4ebbf91223b0ff4c71905da55342e64655d6ef8c89a4768c3f93a6dc0366b5bc8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ebb30240dd96c7bc8d0abe49aa4edcbb4afdc51ff9aaf720d3f9e7fbb0f9c6d6571350501769fc4ebd0b2141247ff400d4fd4be414edf37757bb90a32ac5c65a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8532c58bf3c8015d9d1cbe00eef1f5082f8f3632fbe9f1ed4f9dfb1fa79e8283066d77c44c4af943d76b300364aecbd0648c8a8939bd204123f4b56260422dec + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: fe9846d64f7c7708696f840e2d76cb4408b6595c2f81ec6a28a7f2f20cb88cfe6ac0b9e9b8244f08bd7095c350c1d0842f64fb01bb7f532dfcd47371b0aeeb79 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 28f17ea6fb6c42092dc264257e29746321fb5bdaea9873c2a7fa9d8f53818e899e161bc77dfe8090afd82bf2266c5c1bc930a8d1547624439e662ef695f26f24 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ec6b7d7f030d4850acae3cb615c21dd25206d63e84d1db8d957370737ba0e98467ea0ce274c66199901eaec18a08525715f53bfdb0aacb613d342ebdceeddc3b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b403d3691c03b0d3418df327d5860d34bbfcc4519bfbce36bf33b208385fadb9186bc78a76c489d89fd57e7dc75412d23bcd1dae8470ce9274754bb8585b13c5 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 31fc79738b8772b3f55cd8178813b3b52d0db5a419d30ba9495c4b9da0219fac6df8e7c23a811551a62b827f256ecdb8124ac8a6792ccfecc3b3012722e94463 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f6061 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: bb2039ec287091bcc9642fc90049e73732e02e577e2862b32216ae9bedcd730c4c284ef3968c368b7d37584f97bd4b4dc6ef6127acfe2e6ae2509124e66c8af4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f53d68d13f45edfcb9bd415e2831e938350d5380d3432278fc1c0c381fcb7c65c82dafe051d8c8b0d44e0974a0e59ec7bf7ed0459f86e96f329fc79752510fd3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60616263 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8d568c7984f0ecdf7640fbc483b5d8c9f86634f6f43291841b309a350ab9c1137d24066b09da9944bac54d5bb6580d836047aac74ab724b887ebf93d4b32eca9 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f6061626364 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c0b65ce5a96ff774c456cac3b5f2c4cd359b4ff53ef93a3da0778be4900d1e8da1601e769e8f1b02d2a2f8c5b9fa10b44f1c186985468feeb008730283a6657d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 4900bba6f5fb103ece8ec96ada13a5c3c85488e05551da6b6b33d988e611ec0fe2e3c2aa48ea6ae8986a3a231b223c5d27cec2eadde91ce07981ee652862d1e4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60616263646566 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c7f5c37c7285f927f76443414d4357ff789647d7a005a5a787e03c346b57f49f21b64fa9cf4b7e45573e23049017567121a9c3d4b2b73ec5e9413577525db45a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f6061626364656667 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ec7096330736fdb2d64b5653e7475da746c23a4613a82687a28062d3236364284ac01720ffb406cfe265c0df626a188c9e5963ace5d3d5bb363e32c38c2190a6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 82e744c75f4649ec52b80771a77d475a3bc091989556960e276a5f9ead92a03f718742cdcfeaee5cb85c44af198adc43a4a428f5f0c2ddb0be36059f06d7df73 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60616263646566676869 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 2834b7a7170f1f5b68559ab78c1050ec21c919740b784a9072f6e5d69f828d70c919c5039fb148e39e2c8a52118378b064ca8d5001cd10a5478387b966715ed6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 16b4ada883f72f853bb7ef253efcab0c3e2161687ad61543a0d2824f91c1f81347d86be709b16996e17f2dd486927b0288ad38d13063c4a9672c39397d3789b6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 78d048f3a69d8b54ae0ed63a573ae350d89f7c6cf1f3688930de899afa037697629b314e5cd303aa62feea72a25bf42b304b6c6bcb27fae21c16d925e1fbdac3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 0f746a48749287ada77a82961f05a4da4abdb7d77b1220f836d09ec814359c0ec0239b8c7b9ff9e02f569d1b301ef67c4612d1de4f730f81c12c40cc063c5caa + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f0fc859d3bd195fbdc2d591e4cdac15179ec0f1dc821c11df1f0c1d26e6260aaa65b79fafacafd7d3ad61e600f250905f5878c87452897647a35b995bcadc3a3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 2620f687e8625f6a412460b42e2cef67634208ce10a0cbd4dff7044a41b7880077e9f8dc3b8d1216d3376a21e015b58fb279b521d83f9388c7382c8505590b9b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 227e3aed8d2cb10b918fcb04f9de3e6d0a57e08476d93759cd7b2ed54a1cbf0239c528fb04bbf288253e601d3bc38b21794afef90b17094a182cac557745e75f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 1a929901b09c25f27d6b35be7b2f1c4745131fdebca7f3e2451926720434e0db6e74fd693ad29b777dc3355c592a361c4873b01133a57c2e3b7075cbdb86f4fc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f7071 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5fd7968bc2fe34f220b5e3dc5af9571742d73b7d60819f2888b629072b96a9d8ab2d91b82d0a9aaba61bbd39958132fcc4257023d1eca591b3054e2dc81c8200 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: dfcce8cf32870cc6a503eadafc87fd6f78918b9b4d0737db6810be996b5497e7e5cc80e312f61e71ff3e9624436073156403f735f56b0b01845c18f6caf772e6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 02f7ef3a9ce0fff960f67032b296efca3061f4934d690749f2d01c35c81c14f39a67fa350bc8a0359bf1724bffc3bca6d7c7bba4791fd522a3ad353c02ec5aa8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f7071727374 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 64be5c6aba65d594844ae78bb022e5bebe127fd6b6ffa5a13703855ab63b624dcd1a363f99203f632ec386f3ea767fc992e8ed9686586aa27555a8599d5b808f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f78585505c4eaa54a8b5be70a61e735e0ff97af944ddb3001e35d86c4e2199d976104b6ae31750a36a726ed285064f5981b503889fef822fcdc2898dddb7889a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273747576 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e4b5566033869572edfd87479a5bb73c80e8759b91232879d96b1dda36c012076ee5a2ed7ae2de63ef8406a06aea82c188031b560beafb583fb3de9e57952a7e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f7071727374757677 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e1b3e7ed867f6c9484a2a97f7715f25e25294e992e41f6a7c161ffc2adc6daaeb7113102d5e6090287fe6ad94ce5d6b739c6ca240b05c76fb73f25dd024bf935 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 85fd085fdc12a080983df07bd7012b0d402a0f4043fcb2775adf0bad174f9b08d1676e476985785c0a5dcc41dbff6d95ef4d66a3fbdc4a74b82ba52da0512b74 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273747576777879 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: aed8fa764b0fbff821e05233d2f7b0900ec44d826f95e93c343c1bc3ba5a24374b1d616e7e7aba453a0ada5e4fab5382409e0d42ce9c2bc7fb39a99c340c20f0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7ba3b2e297233522eeb343bd3ebcfd835a04007735e87f0ca300cbee6d416565162171581e4020ff4cf176450f1291ea2285cb9ebffe4c56660627685145051c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: de748bcf89ec88084721e16b85f30adb1a6134d664b5843569babc5bbd1a15ca9b61803c901a4fef32965a1749c9f3a4e243e173939dc5a8dc495c671ab52145 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: aaf4d2bdf200a919706d9842dce16c98140d34bc433df320aba9bd429e549aa7a3397652a4d768277786cf993cde2338673ed2e6b66c961fefb82cd20c93338f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c408218968b788bf864f0997e6bc4c3dba68b276e2125a4843296052ff93bf5767b8cdce7131f0876430c1165fec6c4f47adaa4fd8bcfacef463b5d3d0fa61a0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 76d2d819c92bce55fa8e092ab1bf9b9eab237a25267986cacf2b8ee14d214d730dc9a5aa2d7b596e86a1fd8fa0804c77402d2fcd45083688b218b1cdfa0dcbcb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 72065ee4dd91c2d8509fa1fc28a37c7fc9fa7d5b3f8ad3d0d7a25626b57b1b44788d4caf806290425f9890a3a2a35a905ab4b37acfd0da6e4517b2525c9651e4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 64475dfe7600d7171bea0b394e27c9b00d8e74dd1e416a79473682ad3dfdbb706631558055cfc8a40e07bd015a4540dcdea15883cbbf31412df1de1cd4152b91 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f8081 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 12cd1674a4488a5d7c2b3160d2e2c4b58371bedad793418d6f19c6ee385d70b3e06739369d4df910edb0b0a54cbff43d54544cd37ab3a06cfa0a3ddac8b66c89 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 60756966479dedc6dd4bcff8ea7d1d4ce4d4af2e7b097e32e3763518441147cc12b3c0ee6d2ecabf1198cec92e86a3616fba4f4e872f5825330adbb4c1dee444 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80818283 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: a7803bcb71bc1d0f4383dde1e0612e04f872b715ad30815c2249cf34abb8b024915cb2fc9f4e7cc4c8cfd45be2d5a91eab0941c7d270e2da4ca4a9f7ac68663a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f8081828384 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b84ef6a7229a34a750d9a98ee2529871816b87fbe3bc45b45fa5ae82d5141540211165c3c5d7a7476ba5a4aa06d66476f0d9dc49a3f1ee72c3acabd498967414 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: fae4b6d8efc3f8c8e64d001dabec3a21f544e82714745251b2b4b393f2f43e0da3d403c64db95a2cb6e23ebb7b9e94cdd5ddac54f07c4a61bd3cb10aa6f93b49 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80818283848586 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 34f7286605a122369540141ded79b8957255da2d4155abbf5a8dbb89c8eb7ede8eeef1daa46dc29d751d045dc3b1d658bb64b80ff8589eddb3824b13da235a6b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f8081828384858687 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3b3b48434be27b9eababba43bf6b35f14b30f6a88dc2e750c358470d6b3aa3c18e47db4017fa55106d8252f016371a00f5f8b070b74ba5f23cffc5511c9f09f0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ba289ebd6562c48c3e10a8ad6ce02e73433d1e93d7c9279d4d60a7e879ee11f441a000f48ed9f7c4ed87a45136d7dccdca482109c78a51062b3ba4044ada2469 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80818283848586878889 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 022939e2386c5a37049856c850a2bb10a13dfea4212b4c732a8840a9ffa5faf54875c5448816b2785a007da8a8d2bc7d71a54e4e6571f10b600cbdb25d13ede3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e6fec19d89ce8717b1a087024670fe026f6c7cbda11caef959bb2d351bf856f8055d1c0ebdaaa9d1b17886fc2c562b5e99642fc064710c0d3488a02b5ed7f6fd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 94c96f02a8f576aca32ba61c2b206f907285d9299b83ac175c209a8d43d53bfe683dd1d83e7549cb906c28f59ab7c46f8751366a28c39dd5fe2693c9019666c8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 31a0cd215ebd2cb61de5b9edc91e6195e31c59a5648d5c9f737e125b2605708f2e325ab3381c8dce1a3e958886f1ecdc60318f882cfe20a24191352e617b0f21 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 91ab504a522dce78779f4c6c6ba2e6b6db5565c76d3e7e7c920caf7f757ef9db7c8fcf10e57f03379ea9bf75eb59895d96e149800b6aae01db778bb90afbc989 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d85cabc6bd5b1a01a5afd8c6734740da9fd1c1acc6db29bfc8a2e5b668b028b6b3154bfb8703fa3180251d589ad38040ceb707c4bad1b5343cb426b61eaa49c1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d62efbec2ca9c1f8bd66ce8b3f6a898cb3f7566ba6568c618ad1feb2b65b76c3ce1dd20f7395372faf28427f61c9278049cf0140df434f5633048c86b81e0399 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7c8fdc6175439e2c3db15bafa7fb06143a6a23bc90f449e79deef73c3d492a671715c193b6fea9f036050b946069856b897e08c00768f5ee5ddcf70b7cd6d0e0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f9091 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 58602ee7468e6bc9df21bd51b23c005f72d6cb013f0a1b48cbec5eca299299f97f09f54a9a01483eaeb315a6478bad37ba47ca1347c7c8fc9e6695592c91d723 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 27f5b79ed256b050993d793496edf4807c1d85a7b0a67c9c4fa99860750b0ae66989670a8ffd7856d7ce411599e58c4d77b232a62bef64d15275be46a68235ff + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90919293 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3957a976b9f1887bf004a8dca942c92d2b37ea52600f25e0c9bc5707d0279c00c6e85a839b0d2d8eb59c51d94788ebe62474a791cadf52cccf20f5070b6573fc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f9091929394 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: eaa2376d55380bf772ecca9cb0aa4668c95c707162fa86d518c8ce0ca9bf7362b9f2a0adc3ff59922df921b94567e81e452f6c1a07fc817cebe99604b3505d38 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c1e2c78b6b2734e2480ec550434cb5d613111adcc21d475545c3b1b7e6ff12444476e5c055132e2229dc0f807044bb919b1a5662dd38a9ee65e243a3911aed1a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90919293949596 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8ab48713389dd0fcf9f965d3ce66b1e559a1f8c58741d67683cd971354f452e62d0207a65e436c5d5d8f8ee71c6abfe50e669004c302b31a7ea8311d4a916051 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f9091929394959697 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 24ce0addaa4c65038bd1b1c0f1452a0b128777aabc94a29df2fd6c7e2f85f8ab9ac7eff516b0e0a825c84a24cfe492eaad0a6308e46dd42fe8333ab971bb30ca + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5154f929ee03045b6b0c0004fa778edee1d139893267cc84825ad7b36c63de32798e4a166d24686561354f63b00709a1364b3c241de3febf0754045897467cd4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90919293949596979899 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e74e907920fd87bd5ad636dd11085e50ee70459c443e1ce5809af2bc2eba39f9e6d7128e0e3712c316da06f4705d78a4838e28121d4344a2c79c5e0db307a677 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: bf91a22334bac20f3fd80663b3cd06c4e8802f30e6b59f90d3035cc9798a217ed5a31abbda7fa6842827bdf2a7a1c21f6fcfccbb54c6c52926f32da816269be1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d9d5c74be5121b0bd742f26bffb8c89f89171f3f934913492b0903c271bbe2b3395ef259669bef43b57f7fcc3027db01823f6baee66e4f9fead4d6726c741fce + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 50c8b8cf34cd879f80e2faab3230b0c0e1cc3e9dcadeb1b9d97ab923415dd9a1fe38addd5c11756c67990b256e95ad6d8f9fedce10bf1c90679cde0ecf1be347 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 0a386e7cd5dd9b77a035e09fe6fee2c8ce61b5383c87ea43205059c5e4cd4f4408319bb0a82360f6a58e6c9ce3f487c446063bf813bc6ba535e17fc1826cfc91 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 1f1459cb6b61cbac5f0efe8fc487538f42548987fcd56221cfa7beb22504769e792c45adfb1d6b3d60d7b749c8a75b0bdf14e8ea721b95dca538ca6e25711209 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e58b3836b7d8fedbb50ca5725c6571e74c0785e97821dab8b6298c10e4c079d4a6cdf22f0fedb55032925c16748115f01a105e77e00cee3d07924dc0d8f90659 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b929cc6505f020158672deda56d0db081a2ee34c00c1100029bdf8ea98034fa4bf3e8655ec697fe36f40553c5bb46801644a627d3342f4fc92b61f03290fb381 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 72d353994b49d3e03153929a1e4d4f188ee58ab9e72ee8e512f29bc773913819ce057ddd7002c0433ee0a16114e3d156dd2c4a7e80ee53378b8670f23e33ef56 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c70ef9bfd775d408176737a0736d68517ce1aaad7e81a93c8c1ed967ea214f56c8a377b1763e676615b60f3988241eae6eab9685a5124929d28188f29eab06f7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c230f0802679cb33822ef8b3b21bf7a9a28942092901d7dac3760300831026cf354c9232df3e084d9903130c601f63c1f4a4a4b8106e468cd443bbe5a734f45f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 6f43094cafb5ebf1f7a4937ec50f56a4c9da303cbb55ac1f27f1f1976cd96beda9464f0e7b9c54620b8a9fba983164b8be3578425a024f5fe199c36356b88972 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3745273f4c38225db2337381871a0c6aafd3af9b018c88aa02025850a5dc3a42a1a3e03e56cbf1b0876d63a441f1d2856a39b8801eb5af325201c415d65e97fe + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c50c44cca3ec3edaae779a7e179450ebdda2f97067c690aa6c5a4ac7c30139bb27c0df4db3220e63cb110d64f37ffe078db72653e2daacf93ae3f0a2d1a7eb2e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8aef263e385cbc61e19b28914243262af5afe8726af3ce39a79c27028cf3ecd3f8d2dfd9cfc9ad91b58f6f20778fd5f02894a3d91c7d57d1e4b866a7f364b6be + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 28696141de6e2d9bcb3235578a66166c1448d3e905a1b482d423be4bc5369bc8c74dae0acc9cc123e1d8ddce9f97917e8c019c552da32d39d2219b9abf0fa8c8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 2fb9eb2085830181903a9dafe3db428ee15be7662224efd643371fb25646aee716e531eca69b2bdc8233f1a8081fa43da1500302975a77f42fa592136710e9dc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aa +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 66f9a7143f7a3314a669bf2e24bbb35014261d639f495b6c9c1f104fe8e320aca60d4550d69d52edbd5a3cdeb4014ae65b1d87aa770b69ae5c15f4330b0b0ad8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaab +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f4c4dd1d594c3565e3e25ca43dad82f62abea4835ed4cd811bcd975e46279828d44d4c62c3679f1b7f7b9dd4571d7b49557347b8c5460cbdc1bef690fb2a08c0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabac +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8f1dc9649c3a84551f8f6e91cac68242a43b1f8f328ee92280257387fa7559aa6db12e4aeadc2d26099178749c6864b357f3f83b2fb3efa8d2a8db056bed6bcc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacad +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3139c1a7f97afd1675d460ebbc07f2728aa150df849624511ee04b743ba0a833092f18c12dc91b4dd243f333402f59fe28abdbbbae301e7b659c7a26d5c0f979 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadae +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 06f94a2996158a819fe34c40de3cf0379fd9fb85b3e363ba3926a0e7d960e3f4c2e0c70c7ce0ccb2a64fc29869f6e7ab12bd4d3f14fce943279027e785fb5c29 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeaf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c29c399ef3eee8961e87565c1ce263925fc3d0ce267d13e48dd9e732ee67b0f69fad56401b0f10fcaac119201046cca28c5b14abdea3212ae65562f7f138db3d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 4cec4c9df52eef05c3f6faaa9791bc7445937183224ecc37a1e58d0132d35617531d7e795f52af7b1eb9d147de1292d345fe341823f8e6bc1e5badca5c656108 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 898bfbae93b3e18d00697eab7d9704fa36ec339d076131cefdf30edbe8d9cc81c3a80b129659b163a323bab9793d4feed92d54dae966c77529764a09be88db45 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ee9bd0469d3aaf4f14035be48a2c3b84d9b4b1fff1d945e1f1c1d38980a951be197b25fe22c731f20aeacc930ba9c4a1f4762227617ad350fdabb4e80273a0f4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3d4d3113300581cd96acbf091c3d0f3c310138cd6979e6026cde623e2dd1b24d4a8638bed1073344783ad0649cc6305ccec04beb49f31c633088a99b65130267 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 95c0591ad91f921ac7be6d9ce37e0663ed8011c1cfd6d0162a5572e94368bac02024485e6a39854aa46fe38e97d6c6b1947cd272d86b06bb5b2f78b9b68d559d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 227b79ded368153bf46c0a3ca978bfdbef31f3024a5665842468490b0ff748ae04e7832ed4c9f49de9b1706709d623e5c8c15e3caecae8d5e433430ff72f20eb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5d34f3952f0105eef88ae8b64c6ce95ebfade0e02c69b08762a8712d2e4911ad3f941fc4034dc9b2e479fdbcd279b902faf5d838bb2e0c6495d372b5b7029813 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7f939bf8353abce49e77f14f3750af20b7b03902e1a1e7fb6aaf76d0259cd401a83190f15640e74f3e6c5a90e839c7821f6474757f75c7bf9002084ddc7a62dc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 062b61a2f9a33a71d7d0a06119644c70b0716a504de7e5e1be49bd7b86e7ed6817714f9f0fc313d06129597e9a2235ec8521de36f7290a90ccfc1ffa6d0aee29 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f29e01eeae64311eb7f1c6422f946bf7bea36379523e7b2bbaba7d1d34a22d5ea5f1c5a09d5ce1fe682cced9a4798d1a05b46cd72dff5c1b355440b2a2d476bc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9ba +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ec38cd3bbab3ef35d7cb6d5c914298351d8a9dc97fcee051a8a02f58e3ed6184d0b7810a5615411ab1b95209c3c810114fdeb22452084e77f3f847c6dbaafe16 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c2aef5e0ca43e82641565b8cb943aa8ba53550caef793b6532fafad94b816082f0113a3ea2f63608ab40437ecc0f0229cb8fa224dcf1c478a67d9b64162b92d1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 15f534efff7105cd1c254d074e27d5898b89313b7d366dc2d7d87113fa7d53aae13f6dba487ad8103d5e854c91fdb6e1e74b2ef6d1431769c30767dde067a35c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 89acbca0b169897a0a2714c2df8c95b5b79cb69390142b7d6018bb3e3076b099b79a964152a9d912b1b86412b7e372e9cecad7f25d4cbab8a317be36492a67d7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbe +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e3c0739190ed849c9c962fd9dbb55e207e624fcac1eb417691515499eea8d8267b7e8f1287a63633af5011fde8c4ddf55bfdf722edf88831414f2cfaed59cb9a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8d6cf87c08380d2d1506eee46fd4222d21d8c04e585fbfd08269c98f702833a156326a0724656400ee09351d57b440175e2a5de93cc5f80db6daf83576cf75fa + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: da24bede383666d563eeed37f6319baf20d5c75d1635a6ba5ef4cfa1ac95487e96f8c08af600aab87c986ebad49fc70a58b4890b9c876e091016daf49e1d322e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f9d1d1b1e87ea7ae753a029750cc1cf3d0157d41805e245c5617bb934e732f0ae3180b78e05bfe76c7c3051e3e3ac78b9b50c05142657e1e03215d6ec7bfd0fc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 11b7bc1668032048aa43343de476395e814bbbc223678db951a1b03a021efac948cfbe215f97fe9a72a2f6bc039e3956bfa417c1a9f10d6d7ba5d3d32ff323e5 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b8d9000e4fc2b066edb91afee8e7eb0f24e3a201db8b6793c0608581e628ed0bcc4e5aa6787992a4bcc44e288093e63ee83abd0bc3ec6d0934a674a4da13838a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ce325e294f9b6719d6b61278276ae06a2564c03bb0b783fafe785bdf89c7d5acd83e78756d301b445699024eaeb77b54d477336ec2a4f332f2b3f88765ddb0c3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 29acc30e9603ae2fccf90bf97e6cc463ebe28c1b2f9b4b765e70537c25c702a29dcbfbf14c99c54345ba2b51f17b77b5f15db92bbad8fa95c471f5d070a137cc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3379cbaae562a87b4c0425550ffdd6bfe1203f0d666cc7ea095be407a5dfe61ee91441cd5154b3e53b4f5fb31ad4c7a9ad5c7af4ae679aa51a54003a54ca6b2d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3095a349d245708c7cf550118703d7302c27b60af5d4e67fc978f8a4e60953c7a04f92fcf41aee64321ccb707a895851552b1e37b00bc5e6b72fa5bcef9e3fff + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 07262d738b09321f4dbccec4bb26f48cb0f0ed246ce0b31b9a6e7bc683049f1f3e5545f28ce932dd985c5ab0f43bd6de0770560af329065ed2e49d34624c2cbb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b6405eca8ee3316c87061cc6ec18dba53e6c250c63ba1f3bae9e55dd3498036af08cd272aa24d713c6020d77ab2f3919af1a32f307420618ab97e73953994fb4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9ca +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 7ee682f63148ee45f6e5315da81e5c6e557c2c34641fc509c7a5701088c38a74756168e2cd8d351e88fd1a451f360a01f5b2580f9b5a2e8cfc138f3dd59a3ffc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 1d263c179d6b268f6fa016f3a4f29e943891125ed8593c81256059f5a7b44af2dcb2030d175c00e62ecaf7ee96682aa07ab20a611024a28532b1c25b86657902 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 106d132cbdb4cd2597812846e2bc1bf732fec5f0a5f65dbb39ec4e6dc64ab2ce6d24630d0f15a805c3540025d84afa98e36703c3dbee713e72dde8465bc1be7e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 0e79968226650667a8d862ea8da4891af56a4e3a8b6d1750e394f0dea76d640d85077bcec2cc86886e506751b4f6a5838f7f0b5fef765d9dc90dcdcbaf079f08 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdce +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 521156a82ab0c4e566e5844d5e31ad9aaf144bbd5a464fdca34dbd5717e8ff711d3ffebbfa085d67fe996a34f6d3e4e60b1396bf4b1610c263bdbb834d560816 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 1aba88befc55bc25efbce02db8b9933e46f57661baeabeb21cc2574d2a518a3cba5dc5a38e49713440b25f9c744e75f6b85c9d8f4681f676160f6105357b8406 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5a9949fcb2c473cda968ac1b5d08566dc2d816d960f57e63b898fa701cf8ebd3f59b124d95bfbbedc5f1cf0e17d5eaed0c02c50b69d8a402cabcca4433b51fd4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b0cead09807c672af2eb2b0f06dde46cf5370e15a4096b1a7d7cbb36ec31c205fbefca00b7a4162fa89fb4fb3eb78d79770c23f44e7206664ce3cd931c291e5d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: bb6664931ec97044e45b2ae420ae1c551a8874bc937d08e969399c3964ebdba8346cdd5d09caafe4c28ba7ec788191ceca65ddd6f95f18583e040d0f30d0364d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 65bc770a5faa3792369803683e844b0be7ee96f29f6d6a35568006bd5590f9a4ef639b7a8061c7b0424b66b60ac34af3119905f33a9d8c3ae18382ca9b689900 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: ea9b4dca333336aaf839a45c6eaa48b8cb4c7ddabffea4f643d6357ea6628a480a5b45f2b052c1b07d1fedca918b6f1139d80f74c24510dcbaa4be70eacc1b06 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: e6342fb4a780ad975d0e24bce149989b91d360557e87994f6b457b895575cc02d0c15bad3ce7577f4c63927ff13f3e381ff7e72bdbe745324844a9d27e3f1c01 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3e209c9b33e8e461178ab46b1c64b49a07fb745f1c8bc95fbfb94c6b87c69516651b264ef980937fad41238b91ddc011a5dd777c7efd4494b4b6ecd3a9c22ac0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: fd6a3d5b1875d80486d6e69694a56dbb04a99a4d051f15db2689776ba1c4882e6d462a603b7015dc9f4b7450f05394303b8652cfb404a266962c41bae6e18a94 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 951e27517e6bad9e4195fc8671dee3e7e9be69cee1422cb9fecfce0dba875f7b310b93ee3a3d558f941f635f668ff832d2c1d033c5e2f0997e4c66f147344e02 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8eba2f874f1ae84041903c7c4253c82292530fc8509550bfdc34c95c7e2889d5650b0ad8cb988e5c4894cb87fbfbb19612ea93ccc4c5cad17158b9763464b492 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9da +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 16f712eaa1b7c6354719a8e7dbdfaf55e4063a4d277d947550019b38dfb564830911057d50506136e2394c3b28945cc964967d54e3000c2181626cfb9b73efd2 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c39639e7d5c7fb8cdd0fd3e6a52096039437122f21c78f1679cea9d78a734c56ecbeb28654b4f18e342c331f6f7229ec4b4bc281b2d80a6eb50043f31796c88c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 72d081af99f8a173dcc9a0ac4eb3557405639a29084b54a40172912a2f8a395129d5536f0918e902f9e8fa6000995f4168ddc5f893011be6a0dbc9b8a1a3f5bb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c11aa81e5efd24d5fc27ee586cfd8847fbb0e27601ccece5ecca0198e3c7765393bb74457c7e7a27eb9170350e1fb53857177506be3e762cc0f14d8c3afe9077 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcddde +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c28f2150b452e6c0c424bcde6f8d72007f9310fed7f2f87de0dbb64f4479d6c1441ba66f44b2accee61609177ed340128b407ecec7c64bbe50d63d22d8627727 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f63d88122877ec30b8c8b00d22e89000a966426112bd44166e2f525b769ccbe9b286d437a0129130dde1a86c43e04bedb594e671d98283afe64ce331de9828fd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 348b0532880b88a6614a8d7408c3f913357fbb60e995c60205be9139e74998aede7f4581e42f6b52698f7fa1219708c14498067fd1e09502de83a77dd281150c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 5133dc8bef725359dff59792d85eaf75b7e1dcd1978b01c35b1b85fcebc63388ad99a17b6346a217dc1a9622ebd122ecf6913c4d31a6b52a695b86af00d741a0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 2753c4c0e98ecad806e88780ec27fccd0f5c1ab547f9e4bf1659d192c23aa2cc971b58b6802580baef8adc3b776ef7086b2545c2987f348ee3719cdef258c403 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b1663573ce4b9d8caefc865012f3e39714b9898a5da6ce17c25a6a47931a9ddb9bbe98adaa553beed436e89578455416c2a52a525cf2862b8d1d49a2531b7391 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 64f58bd6bfc856f5e873b2a2956ea0eda0d6db0da39c8c7fc67c9f9feefcff3072cdf9e6ea37f69a44f0c61aa0da3693c2db5b54960c0281a088151db42b11e8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 0764c7be28125d9065c4b98a69d60aede703547c66a12e17e1c618994132f5ef82482c1e3fe3146cc65376cc109f0138ed9a80e49f1f3c7d610d2f2432f20605 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: f748784398a2ff03ebeb07e155e66116a839741a336e32da71ec696001f0ad1b25cd48c69cfca7265eca1dd71904a0ce748ac4124f3571076dfa7116a9cf00e9 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3f0dbc0186bceb6b785ba78d2a2a013c910be157bdaffae81bb6663b1a73722f7f1228795f3ecada87cf6ef0078474af73f31eca0cc200ed975b6893f761cb6d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d4762cd4599876ca75b2b8fe249944dbd27ace741fdab93616cbc6e425460feb51d4e7adcc38180e7fc47c89024a7f56191adb878dfde4ead62223f5a2610efe + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: cd36b3d5b4c91b90fcbba79513cfee1907d8645a162afd0cd4cf4192d4a5f4c892183a8eacdb2b6b6a9d9aa8c11ac1b261b380dbee24ca468f1bfd043c58eefe + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9ea +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 98593452281661a53c48a9d8cd790826c1a1ce567738053d0bee4a91a3d5bd92eefdbabebe3204f2031ca5f781bda99ef5d8ae56e5b04a9e1ecd21b0eb05d3e1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaeb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 771f57dd2775ccdab55921d3e8e30ccf484d61fe1c1b9c2ae819d0fb2a12fab9be70c4a7a138da84e8280435daade5bbe66af0836a154f817fb17f3397e725a3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebec +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: c60897c6f828e21f16fbb5f15b323f87b6c8955eabf1d38061f707f608abdd993fac3070633e286cf8339ce295dd352df4b4b40b2f29da1dd50b3a05d079e6bb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebeced +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 8210cd2c2d3b135c2cf07fa0d1433cd771f325d075c6469d9c7f1ba0943cd4ab09808cabf4acb9ce5bb88b498929b4b847f681ad2c490d042db2aec94214b06b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedee +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 1d4edfffd8fd80f7e4107840fa3aa31e32598491e4af7013c197a65b7f36dd3ac4b478456111cd4309d9243510782fa31b7c4c95fa951520d020eb7e5c36e4ef + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeef +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: af8e6e91fab46ce4873e1a50a8ef448cc29121f7f74deef34a71ef89cc00d9274bc6c2454bbb3230d8b2ec94c62b1dec85f3593bfa30ea6f7a44d7c09465a253 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 29fd384ed4906f2d13aa9fe7af905990938bed807f1832454a372ab412eea1f5625a1fcc9ac8343b7c67c5aba6e0b1cc4644654913692c6b39eb9187ceacd3ec + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: a268c7885d9874a51c44dffed8ea53e94f78456e0b2ed99ff5a3924760813826d960a15edbedbb5de5226ba4b074e71b05c55b9756bb79e55c02754c2c7b6c8a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 0cf8545488d56a86817cd7ecb10f7116b7ea530a45b6ea497b6c72c997e09e3d0da8698f46bb006fc977c2cd3d1177463ac9057fdd1662c85d0c126443c10473 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b39614268fdd8781515e2cfebf89b4d5402bab10c226e6344e6b9ae000fb0d6c79cb2f3ec80e80eaeb1980d2f8698916bd2e9f747236655116649cd3ca23a837 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 74bef092fc6f1e5dba3663a3fb003b2a5ba257496536d99f62b9d73f8f9eb3ce9ff3eec709eb883655ec9eb896b9128f2afc89cf7d1ab58a72f4a3bf034d2b4a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 3a988d38d75611f3ef38b8774980b33e573b6c57bee0469ba5eed9b44f29945e7347967fba2c162e1c3be7f310f2f75ee2381e7bfd6b3f0baea8d95dfb1dafb1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 58aedfce6f67ddc85a28c992f1c0bd0969f041e66f1ee88020a125cbfcfebcd61709c9c4eba192c15e69f020d462486019fa8dea0cd7a42921a19d2fe546d43d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 9347bd291473e6b4e368437b8e561e065f649a6d8ada479ad09b1999a8f26b91cf6120fd3bfe014e83f23acfa4c0ad7b3712b2c3c0733270663112ccd9285cd9 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: b32163e7c5dbb5f51fdc11d2eac875efbbcb7e7699090a7e7ff8a8d50795af5d74d9ff98543ef8cdf89ac13d0485278756e0ef00c817745661e1d59fe38e7537 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 1085d78307b1c4b008c57a2e7e5b234658a0a82e4ff1e4aaac72b312fda0fe27d233bc5b10e9cc17fdc7697b540c7d95eb215a19a1a0e20e1abfa126efd568c7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fa +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 4e5c734c7dde011d83eac2b7347b373594f92d7091b9ca34cb9c6f39bdf5a8d2f134379e16d822f6522170ccf2ddd55c84b9e6c64fc927ac4cf8dfb2a17701f2 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 695d83bd990a1117b3d0ce06cc888027d12a054c2677fd82f0d4fbfc93575523e7991a5e35a3752e9b70ce62992e268a877744cdd435f5f130869c9a2074b338 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: a6213743568e3b3158b9184301f3690847554c68457cb40fc9a4b8cfd8d4a118c301a07737aeda0f929c68913c5f51c80394f53bff1c3e83b2e40ca97eba9e15 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: d444bfa2362a96df213d070e33fa841f51334e4e76866b8139e8af3bb3398be2dfaddcbc56b9146de9f68118dc5829e74b0c28d7711907b121f9161cb92b69a9 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfe +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +hash: 142709d62e28fcccd0af97fad0f8465b971e82201dc51070faa0372aa43e92484be1c1e73ba10906d5d1853db6a4106e0a7bf9800d373d6dee2d46d62ef2a461 diff --git a/unikernel/duniverse/digestif/test/blake2s.test b/unikernel/duniverse/digestif/test/blake2s.test new file mode 100644 index 00000000..99690cd3 --- /dev/null +++ b/unikernel/duniverse/digestif/test/blake2s.test @@ -0,0 +1,1025 @@ + + +in: +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 48a8997da407876b3d79c0d92325ad3b89cbb754d86ab71aee047ad345fd2c49 + +in: 00 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 40d15fee7c328830166ac3f918650f807e7e01e177258cdc0a39b11f598066f1 + +in: 0001 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 6bb71300644cd3991b26ccd4d274acd1adeab8b1d7914546c1198bbe9fc9d803 + +in: 000102 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1d220dbe2ee134661fdf6d9e74b41704710556f2f6e5a091b227697445dbea6b + +in: 00010203 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f6c3fbadb4cc687a0064a5be6e791bec63b868ad62fba61b3757ef9ca52e05b2 + +in: 0001020304 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 49c1f21188dfd769aea0e911dd6b41f14dab109d2b85977aa3088b5c707e8598 + +in: 000102030405 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: fdd8993dcd43f696d44f3cea0ff35345234ec8ee083eb3cada017c7f78c17143 + +in: 00010203040506 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e6c8125637438d0905b749f46560ac89fd471cf8692e28fab982f73f019b83a9 + +in: 0001020304050607 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 19fc8ca6979d60e6edd3b4541e2f967ced740df6ec1eaebbfe813832e96b2974 + +in: 000102030405060708 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a6ad777ce881b52bb5a4421ab6cdd2dfba13e963652d4d6d122aee46548c14a7 + +in: 00010203040506070809 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f5c4b2ba1a00781b13aba0425242c69cb1552f3f71a9a3bb22b4a6b4277b46dd + +in: 000102030405060708090a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e33c4c9bd0cc7e45c80e65c77fa5997fec7002738541509e68a9423891e822a3 + +in: 000102030405060708090a0b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: fba16169b2c3ee105be6e1e650e5cbf40746b6753d036ab55179014ad7ef6651 + +in: 000102030405060708090a0b0c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f5c4bec6d62fc608bf41cc115f16d61c7efd3ff6c65692bbe0afffb1fede7475 + +in: 000102030405060708090a0b0c0d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a4862e76db847f05ba17ede5da4e7f91b5925cf1ad4ba12732c3995742a5cd6e + +in: 000102030405060708090a0b0c0d0e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 65f4b860cd15b38ef814a1a804314a55be953caa65fd758ad989ff34a41c1eea + +in: 000102030405060708090a0b0c0d0e0f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 19ba234f0a4f38637d1839f9d9f76ad91c8522307143c97d5f93f69274cec9a7 + +in: 000102030405060708090a0b0c0d0e0f10 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1a67186ca4a5cb8e65fca0e2ecbc5ddc14ae381bb8bffeb9e0a103449e3ef03c + +in: 000102030405060708090a0b0c0d0e0f1011 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: afbea317b5a2e89c0bd90ccf5d7fd0ed57fe585e4be3271b0a6bf0f5786b0f26 + +in: 000102030405060708090a0b0c0d0e0f101112 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f1b01558ce541262f5ec34299d6fb4090009e3434be2f49105cf46af4d2d4124 + +in: 000102030405060708090a0b0c0d0e0f10111213 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 13a0a0c86335635eaa74ca2d5d488c797bbb4f47dc07105015ed6a1f3309efce + +in: 000102030405060708090a0b0c0d0e0f1011121314 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1580afeebebb346f94d59fe62da0b79237ead7b1491f5667a90e45edf6ca8b03 + +in: 000102030405060708090a0b0c0d0e0f101112131415 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 20be1a875b38c573dd7faaa0de489d655c11efb6a552698e07a2d331b5f655c3 + +in: 000102030405060708090a0b0c0d0e0f10111213141516 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: be1fe3c4c04018c54c4a0f6b9a2ed3c53abe3a9f76b4d26de56fc9ae95059a99 + +in: 000102030405060708090a0b0c0d0e0f1011121314151617 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e3e3ace537eb3edd8463d9ad3582e13cf86533ffde43d668dd2e93bbdbd7195a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 110c50c0bf2c6e7aeb7e435d92d132ab6655168e78a2decdec3330777684d9c1 + +in: 000102030405060708090a0b0c0d0e0f10111213141516171819 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e9ba8f505c9c80c08666a701f3367e6cc665f34b22e73c3c0417eb1c2206082f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 26cd66fca02379c76df12317052bcafd6cd8c3a7b890d805f36c49989782433a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 213f3596d6e3a5d0e9932cd2159146015e2abc949f4729ee2632fe1edb78d337 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1015d70108e03be1c702fe97253607d14aee591f2413ea6787427b6459ff219a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 3ca989de10cfe609909472c8d35610805b2f977734cf652cc64b3bfc882d5d89 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b6156f72d380ee9ea6acd190464f2307a5c179ef01fd71f99f2d0f7a57360aea + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c03bc642b20959cbe133a0303e0c1abff3e31ec8e1a328ec8565c36decff5265 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 2c3e08176f760c6264c3a2cd66fec6c3d78de43fc192457b2a4a660a1e0eb22b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f2021 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f738c02f3c1b190c512b1a32deabf353728e0e9ab034490e3c3409946a97aeec + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8b1880df301cc963418811088964839287ff7fe31c49ea6ebd9e48bdeee497c5 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20212223 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1e75cb21c60989020375f1a7a242839f0b0b68973a4c2a05cf7555ed5aaec4c1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f2021222324 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 62bf8a9c32a5bccf290b6c474d75b2a2a4093f1a9e27139433a8f2b3bce7b8d7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 166c8350d3173b5e702b783dfd33c66ee0432742e9b92b997fd23c60dc6756ca + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20212223242526 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 044a14d822a90cacf2f5a101428adc8f4109386ccb158bf905c8618b8ee24ec3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f2021222324252627 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 387d397ea43a994be84d2d544afbe481a2000f55252696bba2c50c8ebd101347 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 56f8ccf1f86409b46ce36166ae9165138441577589db08cbc5f66ca29743b9fd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20212223242526272829 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9706c092b04d91f53dff91fa37b7493d28b576b5d710469df79401662236fc03 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 877968686c068ce2f7e2adcff68bf8748edf3cf862cfb4d3947a3106958054e3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8817e5719879acf7024787eccdb271035566cfa333e049407c0178ccc57a5b9f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8938249e4b50cadaccdf5b18621326cbb15253e33a20f5636e995d72478de472 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f164abba4963a44d107257e3232d90aca5e66a1408248c51741e991db5227756 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d05563e2b1cba0c4a2a1e8bde3a1a0d9f5b40c85a070d6f5fb21066ead5d0601 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 03fbb16384f0a3866f4c3117877666efbf124597564b293d4aab0d269fabddfa + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 5fa8486ac0e52964d1881bbe338eb54be2f719549224892057b4da04ba8b3475 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f3031 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: cdfabcee46911111236a31708b2539d71fc211d9b09c0d8530a11e1dbf6eed01 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4f82de03b9504793b82a07a0bdcdff314d759e7b62d26b784946b0d36f916f52 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30313233 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 259ec7f173bcc76a0994c967b4f5f024c56057fb79c965c4fae41875f06a0e4c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f3031323334 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 193cc8e7c3e08bb30f5437aa27ade1f142369b246a675b2383e6da9b49a9809e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 5c10896f0e2856b2a2eee0fe4a2c1633565d18f0e93e1fab26c373e8f829654d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30313233343536 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f16012d93f28851a1eb989f5d0b43f3f39ca73c9a62d5181bff237536bd348c3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f3031323334353637 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 2966b3cfae1e44ea996dc5d686cf25fa053fb6f67201b9e46eade85d0ad6b806 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ddb8782485e900bc60bcf4c33a6fd585680cc683d516efa03eb9985fad8715fb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f30313233343536373839 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4c4d6e71aea05786413148fc7a786b0ecaf582cff1209f5a809fba8504ce662c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: fb4c5e86d7b2229b99b8ba6d94c247ef964aa3a2bae8edc77569f28dbbff2d4e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e94f526de9019633ecd54ac6120f23958d7718f1e7717bf329211a4faeed4e6d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: cbd6660a10db3f23f7a03d4b9d4044c7932b2801ac89d60bc9eb92d65a46c2a0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8818bbd3db4dc123b25cbba5f54c2bc4b3fcf9bf7d7a7709f4ae588b267c4ece + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c65382513f07460da39833cb666c5ed82e61b9e998f4b0c4287cee56c3cc9bcd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8975b0577fd35566d750b362b0897a26c399136df07bababbde6203ff2954ed4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 21fe0ceb0052be7fb0f004187cacd7de67fa6eb0938d927677f2398c132317a8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f4041 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 2ef73f3c26f12d93889f3c78b6a66c1d52b649dc9e856e2c172ea7c58ac2b5e3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 388a3cd56d73867abb5f8401492b6e2681eb69851e767fd84210a56076fb3dd3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40414243 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: af533e022fc9439e4e3cb838ecd18692232adf6fe9839526d3c3dd1b71910b1a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f4041424344 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 751c09d41a9343882a81cd13ee40818d12eb44c6c7f40df16e4aea8fab91972a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 5b73ddb68d9d2b0aa265a07988d6b88ae9aac582af83032f8a9b21a2e1b7bf18 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40414243444546 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 3da29126c7c5d7f43e64242a79feaa4ef3459cdeccc898ed59a97f6ec93b9dab + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f4041424344454647 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 566dc920293da5cb4fe0aa8abda8bbf56f552313bff19046641e3615c1e3ed3f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4115bea02f73f97f629e5c5590720c01e7e449ae2a6697d4d2783321303692f9 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40414243444546474849 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4ce08f4762468a7670012164878d68340c52a35e66c1884d5c864889abc96677 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 81ea0b7804124e0c22ea5fc71104a2afcb52a1fa816f3ecb7dcb5d9dea1786d0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: fe362733b05f6bedaf9379d7f7936ede209b1f8323c3922549d9e73681b5db7b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: eff37d30dfd20359be4e73fdf40d27734b3df90a97a55ed745297294ca85d09f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 172ffc67153d12e0ca76a8b6cd5d4731885b39ce0cac93a8972a18006c8b8baf + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c47957f1cc88e83ef9445839709a480a036bed5f88ac0fcc8e1e703ffaac132c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 30f3548370cfdceda5c37b569b6175e799eef1a62aaa943245ae7669c227a7b5 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c95dcb3cf1f27d0eef2f25d2413870904a877c4a56c2de1e83e2bc2ae2e46821 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f5051 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d5d0b5d705434cd46b185749f66bfb5836dcdf6ee549a2b7a4aee7f58007caaf + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: bbc124a712f15d07c300e05b668389a439c91777f721f8320c1c9078066d2c7e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a451b48c35a6c7854cfaae60262e76990816382ac0667e5a5c9e1b46c4342ddf + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f5051525354 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b0d150fb55e778d01147f0b5d89d99ecb20ff07e5e6760d6b645eb5b654c622b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 34f737c0ab219951eee89a9f8dac299c9d4c38f33fa494c5c6eefc92b6db08bc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253545556 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1a62cc3a00800dcbd99891080c1e098458193a8cc9f970ea99fbeff00318c289 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f5051525354555657 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: cfce55ebafc840d7ae48281c7fd57ec8b482d4b704437495495ac414cf4a374b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 6746facf71146d999dabd05d093ae586648d1ee28e72617b99d0f0086e1e45bf + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253545556575859 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 571ced283b3f23b4e750bf12a2caf1781847bd890e43603cdc5976102b7bb11b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: cfcb765b048e35022c5d089d26e85a36b005a2b80493d03a144e09f409b6afd1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4050c7a27705bb27f42089b299f3cbe5054ead68727e8ef9318ce6f25cd6f31d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 184070bd5d265fbdc142cd1c5cd0d7e414e70369a266d627c8fba84fa5e84c34 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9edda9a4443902a9588c0d0ccc62b930218479a6841e6fe7d43003f04b1fd643 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e412feef7908324a6da1841629f35d3d358642019310ec57c614836b63d30763 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1a2b8edff3f9acc1554fcbae3cf1d6298c6462e22e5eb0259684f835012bd13f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 288c4ad9b9409762ea07c24a41f04f69a7d74bee2d95435374bde946d7241c7b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f6061 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 805691bb286748cfb591d3aebe7e6f4e4dc6e2808c65143cc004e4eb6fd09d43 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d4ac8d3a0afc6cfa7b460ae3001baeb36dadb37da07d2e8ac91822df348aed3d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60616263 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c376617014d20158bced3d3ba552b6eccf84e62aa3eb650e90029c84d13eea69 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f6061626364 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c41f09f43cecae7293d6007ca0a357087d5ae59be500c1cd5b289ee810c7b082 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 03d1ced1fba5c39155c44b7765cb760c78708dcfc80b0bd8ade3a56da8830b29 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60616263646566 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 09bde6f152218dc92c41d7f45387e63e5869d807ec70b821405dbd884b7fcf4b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f6061626364656667 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 71c9036e18179b90b37d39e9f05eb89cc5fc341fd7c477d0d7493285faca08a4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 5916833ebb05cd919ca7fe83b692d3205bef72392b2cf6bb0a6d43f994f95f11 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f60616263646566676869 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f63aab3ec641b3b024964c2b437c04f6043c4c7e0279239995401958f86bbe54 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f172b180bfb09740493120b6326cbdc561e477def9bbcfd28cc8c1c5e3379a31 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: cb9b89cc18381dd9141ade588654d4e6a231d5bf49d4d59ac27d869cbe100cf3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 7bd8815046fdd810a923e1984aaebdcdf84d87c8992d68b5eeb460f93eb3c8d7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 607be66862fd08ee5b19facac09dfdbcd40c312101d66e6ebd2b841f1b9a9325 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9fe03bbe69ab1834f5219b0da88a08b30a66c5913f0151963c360560db0387b3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 90a83585717b75f0e9b725e055eeeeb9e7a028ea7e6cbc07b20917ec0363e38c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 336ea0530f4a7469126e0218587ebbde3358a0b31c29d200f7dc7eb15c6aadd8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f7071 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a79e76dc0abca4396f0747cd7b748df913007626b1d659da0c1f78b9303d01a3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 44e78a773756e0951519504d7038d28d0213a37e0ce375371757bc996311e3b8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 77ac012a3f754dcfeab5eb996be9cd2d1f96111b6e49f3994df181f28569d825 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f7071727374 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ce5a10db6fccdaf140aaa4ded6250a9c06e9222bc9f9f3658a4aff935f2b9f3a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ecc203a7fe2be4abd55bb53e6e673572e0078da8cd375ef430cc97f9f80083af + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273747576 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 14a5186de9d7a18b0412b8563e51cc5433840b4a129a8ff963b33a3c4afe8ebb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f7071727374757677 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 13f8ef95cb86e6a638931c8e107673eb76ba10d7c2cd70b9d9920bbeed929409 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 0b338f4ee12f2dfcb78713377941e0b0632152581d1332516e4a2cab1942cca4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273747576777879 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: eaab0ec37b3b8ab796e9f57238de14a264a076f3887d86e29bb5906db5a00e02 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 23cb68b8c0e6dc26dc27766ddc0a13a99438fd55617aa4095d8f969720c872df + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 091d8ee30d6f2968d46b687dd65292665742de0bb83dcc0004c72ce10007a549 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 7f507abc6d19ba00c065a876ec5657868882d18a221bc46c7a6912541f5bc7ba + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a0607c24e14e8c223db0d70b4d30ee88014d603f437e9e02aa7dafa3cdfbad94 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ddbfea75cc467882eb3483ce5e2e756a4f4701b76b445519e89f22d60fa86e06 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 0c311f38c35a4fb90d651c289d486856cd1413df9b0677f53ece2cd9e477c60a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 46a73a8dd3e70f59d3942c01df599def783c9da82fd83222cd662b53dce7dbdf + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f8081 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ad038ff9b14de84a801e4e621ce5df029dd93520d0c2fa38bff176a8b1d1698c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ab70c5dfbd1ea817fed0cd067293abf319e5d7901c2141d5d99b23f03a38e748 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80818283 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1fffda67932b73c8ecaf009a3491a026953babfe1f663b0697c3c4ae8b2e7dcb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f8081828384 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b0d2cc19472dd57f2b17efc03c8d58c2283dbb19da572f7755855aa9794317a0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a0d19a6ee33979c325510e276622df41f71583d07501b87071129a0ad94732a5 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80818283848586 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 724642a7032d1062b89e52bea34b75df7d8fe772d9fe3c93ddf3c4545ab5a99b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f8081828384858687 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ade5eaa7e61f672d587ea03dae7d7b55229c01d06bc0a5701436cbd18366a626 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 013b31ebd228fcdda51fabb03bb02d60ac20ca215aafa83bdd855e3755a35f0b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80818283848586878889 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 332ed40bb10dde3c954a75d7b8999d4b26a1c063c1dc6e32c1d91bab7bbb7d16 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c7a197b3a05b566bcc9facd20e441d6f6c2860ac9651cd51d6b9d2cdeeea0390 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: bd9cf64ea8953c037108e6f654914f3958b68e29c16700dc184d94a21708ff60 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8835b0ac021151df716474ce27ce4d3c15f0b2dab48003cf3f3efd0945106b9a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 3bfefa3301aa55c080190cffda8eae51d9af488b4c1f24c3d9a75242fd8ea01d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 08284d14993cd47d53ebaecf0df0478cc182c89c00e1859c84851686ddf2c1b7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1ed7ef9f04c2ac8db6a864db131087f27065098e69c3fe78718d9b947f4a39d0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c161f2dcd57e9c1439b31a9dd43d8f3d7dd8f0eb7cfac6fb25a0f28e306f0661 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f9091 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c01969ad34c52caf3dc4d80d19735c29731ac6e7a92085ab9250c48dea48a3fc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1720b3655619d2a52b3521ae0e49e345cb3389ebd6208acaf9f13fdacca8be49 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90919293 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 756288361c83e24c617cf95c905b22d017cdc86f0bf1d658f4756c7379873b7f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f9091929394 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e7d0eda3452693b752abcda1b55e276f82698f5f1605403eff830bea0071a394 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 2c82ecaa6b84803e044af63118afe544687cb6e6c7df49ed762dfd7c8693a1bc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90919293949596 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 6136cbf4b441056fa1e2722498125d6ded45e17b52143959c7f4d4e395218ac2 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f9091929394959697 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 721d3245aafef27f6a624f47954b6c255079526ffa25e9ff77e5dcff473b1597 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9dd2fbd8cef16c353c0ac21191d509eb28dd9e3e0d8cea5d26ca839393851c3a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90919293949596979899 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b2394ceacdebf21bf9df2ced98e58f1c3a4bbbff660dd900f62202d6785cc46e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 57089f222749ad7871765f062b114f43ba20ec56422a8b1e3f87192c0ea718c6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e49a9459961cd33cdf4aae1b1078a5dea7c040e0fea340c93a724872fc4af806 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ede67f720effd2ca9c88994152d0201dee6b0a2d2c077aca6dae29f73f8b6309 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e0f434bf22e3088039c21f719ffc67f0f2cb5e98a7a0194c76e96bf4e8e17e61 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 277c04e2853484a4eba910ad336d01b477b67cc200c59f3c8d77eef8494f29cd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 156d5747d0c99c7f27097d7b7e002b2e185cb72d8dd7eb424a0321528161219f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 20ddd1ed9b1ca803946d64a83ae4659da67fba7a1a3eddb1e103c0f5e03e3a2c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f0af604d3dabbf9a0f2a7d3dda6bd38bba72c6d09be494fcef713ff10189b6e6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9802bb87def4cc10c4a5fd49aa58dfe2f3fddb46b4708814ead81d23ba95139b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4f8ce1e51d2fe7f24043a904d898ebfc91975418753413aa099b795ecb35cedb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: bddc6514d7ee6ace0a4ac1d0e068112288cbcf560454642705630177cba608bd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d635994f6291517b0281ffdd496afa862712e5b3c4e52e4cd5fdae8c0e72fb08 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 878d9ca600cf87e769cc305c1b35255186615a73a0da613b5f1c98dbf81283ea + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a64ebe5dc185de9fdde7607b6998702eb23456184957307d2fa72e87a47702d6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ce50eab7b5eb52bdc9ad8e5a480ab780ca9320e44360b1fe37e03f2f7ad7de01 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: eeddb7c0db6e30abe66d79e327511e61fcebbc29f159b40a86b046ecf0513823 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aa +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 787fc93440c1ec96b5ad01c16cf77916a1405f9426356ec921d8dff3ea63b7e0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaab +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 7f0d5eab47eefda696c0bf0fbf86ab216fce461e9303aba6ac374120e890e8df + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabac +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b68004b42f14ad029f4c2e03b1d5eb76d57160e26476d21131bef20ada7d27f4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacad +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b0c4eb18ae250b51a41382ead92d0dc7455f9379fc9884428e4770608db0faec + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadae +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f92b7a870c059f4d46464c824ec96355140bdce681322cc3a992ff103e3fea52 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeaf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 5364312614813398cc525d4c4e146edeb371265fba19133a2c3d2159298a1742 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f6620e68d37fb2af5000fc28e23b832297ecd8bce99e8be4d04e85309e3d3374 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 5316a27969d7fe04ff27b283961bffc3bf5dfb32fb6a89d101c6c3b1937c2871 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 81d1664fdf3cb33c24eebac0bd64244b77c4abea90bbe8b5ee0b2aafcf2d6a53 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 345782f295b0880352e924a0467b5fbc3e8f3bfbc3c7e48b67091fb5e80a9442 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 794111ea6cd65e311f74ee41d476cb632ce1e4b051dc1d9e9d061a19e1d0bb49 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 2a85daf6138816b99bf8d08ba2114b7ab07975a78420c1a3b06a777c22dd8bcb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 89b0d5f289ec16401a069a960d0b093e625da3cf41ee29b59b930c5820145455 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d0fdcb543943fc27d20864f52181471b942cc77ca675bcb30df31d358ef7b1eb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b17ea8d77063c709d4dc6b879413c343e3790e9e62ca85b7900b086f6b75c672 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e71a3e2c274db842d92114f217e2c0eac8b45093fdfd9df4ca7162394862d501 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9ba +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c0476759ab7aa333234f6b44f5fd858390ec23694c622cb986e769c78edd733e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9ab8eabb1416434d85391341d56993c55458167d4418b19a0f2ad8b79a83a75b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 7992d0bbb15e23826f443e00505d68d3ed7372995a5c3e498654102fbcd0964e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c021b30085151435df33b007ccecc69df1269f39ba25092bed59d932ac0fdc28 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbe +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 91a25ec0ec0d9a567f89c4bfe1a65a0e432d07064b4190e27dfb81901fd3139b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 5950d39a23e1545f301270aa1a12f2e6c453776e4d6355de425cc153f9818867 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d79f14720c610af179a3765d4b7c0968f977962dbf655b521272b6f1e194488e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e9531bfc8b02995aeaa75ba27031fadbcbf4a0dab8961d9296cd7e84d25d6006 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 34e9c26a01d7f16181b454a9d1623c233cb99d31c694656e9413aca3e918692f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d9d7422f437bd439ddd4d883dae2a08350173414be78155133fff1964c3d7972 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4aee0c7aaf075414ff1793ead7eaca601775c615dbd60b640b0a9f0ce505d435 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 6bfdd15459c83b99f096bfb49ee87b063d69c1974c6928acfcfb4099f8c4ef67 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9fd1c408fd75c336193a2a14d94f6af5adf050b80387b4b010fb29f4cc72707c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 13c88480a5d00d6c8c7ad2110d76a82d9b70f4fa6696d4e5dd42a066dcaf9920 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 820e725ee25fe8fd3a8d5abe4c46c3ba889de6fa9191aa22ba67d5705421542b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 32d93a0eb02f42fbbcaf2bad0085b282e46046a4df7ad10657c9d6476375b93e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9ca +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: adc5187905b1669cd8ec9c721e1953786b9d89a9bae30780f1e1eab24a00523c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: e90756ff7f9ad810b239a10ced2cf9b2284354c1f8c7e0accc2461dc796d6e89 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1251f76e56978481875359801db589a0b22f86d8d634dc04506f322ed78f17e8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 3afa899fd980e73ecb7f4d8b8f291dc9af796bc65d27f974c6f193c9191a09fd + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdce +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: aa305be26e5deddc3c1010cbc213f95f051c785c5b431e6a7cd048f161787528 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8ea1884ff32e9d10f039b407d0d44e7e670abd884aeee0fb757ae94eaa97373d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d482b2155d4dec6b4736a1f1617b53aaa37310277d3fef0c37ad41768fc235b4 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 4d413971387e7a8898a8dc2a27500778539ea214a2dfe9b3d7e8ebdce5cf3db3 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 696e5d46e6c57e8796e4735d08916e0b7929b3cf298c296d22e9d3019653371c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1f5647c1d3b088228885865c8940908bf40d1a8272821973b160008e7a3ce2eb + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b6e76c330f021a5bda65875010b0edf09126c0f510ea849048192003aef4c61c + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 3cd952a0beada41abb424ce47f94b42be64e1ffb0fd0782276807946d0d0bc55 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 98d92677439b41b7bb513312afb92bcc8ee968b2e3b238cecb9b0f34c9bb63d0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ecbca2cf08ae57d517ad16158a32bfa7dc0382eaeda128e91886734c24a0b29d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 942cc7c0b52e2b16a4b89fa4fc7e0bf609e29a08c1a8543452b77c7bfd11bb28 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8a065d8b61a0dffb170d5627735a76b0e9506037808cba16c345007c9f79cf8f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9da +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 1b9fa19714659c78ff413871849215361029ac802b1cbcd54e408bd87287f81f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8dab071bcd6c7292a9ef727b4ae0d86713301da8618d9a48adce55f303a869a1 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8253e3e7c7b684b9cb2beb014ce330ff3d99d17abbdbabe4f4d674ded53ffc6b + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: f195f321e9e3d6bd7d074504dd2ab0e6241f92e784b1aa271ff648b1cab6d7f6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcddde +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 27e4cc72090f241266476a7c09495f2db153d5bcbd761903ef79275ec56b2ed8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedf +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 899c2405788e25b99a1846355e646d77cf400083415f7dc5afe69d6e17c00023 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a59b78c4905744076bfee894de707d4f120b5c6893ea0400297d0bb834727632 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 59dc78b105649707a2bb4419c48f005400d3973de3736610230435b10424b24f + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c0149d1d7e7a6353a6d906efe728f2f329fe14a4149a3ea77609bc42b975ddfa + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: a32f241474a6c16932e9243be0cf09bcdc7e0ca0e7a6a1b9b1a0f01e41502377 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b239b2e4f81841361c1339f68e2c359f929af9ad9f34e01aab4631ad6d5500b0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 85fb419c7002a3e0b4b6ea093b4c1ac6936645b65dac5ac15a8528b7b94c1754 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9619720625f190b93a3fad186ab314189633c0d3a01e6f9bc8c4a8f82f383dbf + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 7d620d90fe69fa469a6538388970a1aa09bb48a2d59b347b97e8ce71f48c7f46 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 294383568596fb37c75bbacd979c5ff6f20a556bf8879cc72924855df9b8240e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 16b18ab314359c2b833c1c6986d48c55a9fc97cde9a3c1f10a3177140f73f738 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9ea +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8cbbdd14bc33f04cf45813e4a153a273d36adad5ce71f499eeb87fb8ac63b729 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaeb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 69c9a498db174ecaefcc5a3ac9fdedf0f813a5bec727f1e775babdec7718816e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebec +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: b462c3be40448f1d4f80626254e535b08bc9cdcff599a768578d4b2881a8e3f0 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebeced +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 553e9d9c5f360ac0b74a7d44e5a391dad4ced03e0c24183b7e8ecabdf1715a64 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedee +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 7a7c55a56fa9ae51e655e01975d8a6ff4ae9e4b486fcbe4eac044588f245ebea + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeef +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 2afdf3c82abc4867f5de111286c2b3be7d6e48657ba923cfbf101a6dfcf9db9a + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 41037d2edcdce0c49b7fb4a6aa0999ca66976c7483afe631d4eda283144f6dfc + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c4466f8497ca2eeb4583a0b08e9d9ac74395709fda109d24f2e4462196779c5d + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 75f609338aa67d969a2ae2a2362b2da9d77c695dfd1df7224a6901db932c3364 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 68606ceb989d5488fc7cf649f3d7c272ef055da1a93faecd55fe06f6967098ca + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 44346bdeb7e052f6255048f0d9b42c425bab9c3dd24168212c3ecf1ebf34e6ae + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 8e9cf6e1f366471f2ac7d2ee9b5e6266fda71f8f2e4109f2237ed5f8813fc718 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 84bbeb8406d250951f8c1b3e86a7c010082921833dfd9555a2f909b1086eb4b8 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: ee666f3eef0f7e2a9c222958c97eaf35f51ced393d714485ab09a069340fdf88 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: c153d34a65c47b4a62c5cacf24010975d0356b2f32c8f5da530d338816ad5de6 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9 +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 9fc5450109e1b779f6c7ae79d56c27635c8dd426c5a9d54e2578db989b8c3b4e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fa +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: d12bf3732ef4af5c22fa90356af8fc50fcb40f8f2ea5c8594737a3b3d5abdbd7 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafb +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 11030b9289bba5af65260672ab6fee88b87420acef4a1789a2073b7ec2f2a09e + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfc +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 69cb192b8444005c8c0ceb12c846860768188cda0aec27a9c8a55cdee2123632 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfd +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: db444c15597b5f1a03d1f9edd16e4a9f43a667cc275175dfa2b704e3bb1a9b83 + +in: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfe +key: 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f +hash: 3fb735061abc519dfe979e54c1ee5bfad0a9d858b3315bad34bde999efd724dd diff --git a/unikernel/duniverse/digestif/test/c/dune b/unikernel/duniverse/digestif/test/c/dune new file mode 100644 index 00000000..62911df3 --- /dev/null +++ b/unikernel/duniverse/digestif/test/c/dune @@ -0,0 +1,44 @@ +(executable + (name test) + (modules test) + (libraries fmt alcotest digestif.c)) + +(rule + (alias runtest) + (deps + (:test test.exe) + ../blake2b.test + ../blake2s.test + ../sha3_224_fips_202.txt + ../sha3_256_fips_202.txt + ../sha3_384_fips_202.txt + ../sha3_512_fips_202.txt + ../keccak_256.txt) + (action + (run %{test} --color=always))) + +(executable + (name test_cve) + (modules test_cve) + (enabled_if + (or + (= %{architecture} "arm64") + (= %{architecture} "amd64"))) + (libraries fmt alcotest digestif.c)) + +(rule + (alias runtest) + (enabled_if + (or + (= %{architecture} "arm64") + (= %{architecture} "amd64"))) + (deps + (:test test_cve.exe)) + (action + (run %{test} --quick-tests --color=always))) + +(rule + (copy# ../test.ml test.ml)) + +(rule + (copy# ../test_cve.ml test_cve.ml)) diff --git a/unikernel/duniverse/digestif/test/conv/dune b/unikernel/duniverse/digestif/test/conv/dune new file mode 100644 index 00000000..f14e5c71 --- /dev/null +++ b/unikernel/duniverse/digestif/test/conv/dune @@ -0,0 +1,11 @@ +(executable + (name test_conv) + (modules test_conv) + (libraries digestif.c fmt alcotest)) + +(rule + (alias runtest) + (enabled_if + (= ${os_type} "Unix")) + (action + (run ./test_conv.exe --color=always))) diff --git a/unikernel/duniverse/digestif/test/conv/test_conv.ml b/unikernel/duniverse/digestif/test/conv/test_conv.ml new file mode 100644 index 00000000..7ca20f6a --- /dev/null +++ b/unikernel/duniverse/digestif/test/conv/test_conv.ml @@ -0,0 +1,112 @@ +external random_seed : unit -> int array = "caml_sys_random_seed" + +let seed = random_seed () +let () = Random.full_init seed +let () = Fmt.epr "seed: %a.\n%!" Fmt.(Dump.array int) seed +let strf = Fmt.str +let invalid_arg = Fmt.invalid_arg + +let list_init f l = + let rec go acc = function + | 0 -> List.rev acc + | n -> go (f n :: acc) (pred n) in + go [] l + +let random_string length _ = + let ic = open_in_bin "/dev/urandom" in + let rs = really_input_string ic length in + close_in ic ; + rs + +let hashes = list_init (random_string Digestif.SHA1.digest_size) 32 +let hashes = List.map Digestif.SHA1.of_raw_string hashes + +let consistent_hex = + List.map Digestif.SHA1.to_hex (* XXX(dinosaure): an oracle [to_hex]? *) hashes + +let random_wsp length = + let go _ = + match Random.int 4 with + | 0 -> ' ' + | 1 -> '\t' + | 2 -> '\n' + | 3 -> '\r' + | _ -> assert false in + String.init length go + +let spaces_expand hex = + let rt = ref [] in + String.iter + (fun chr -> rt := !rt @ [ random_wsp (Random.int 10); String.make 1 chr ]) + hex ; + String.concat "" !rt + +let spaces_hex = List.map spaces_expand consistent_hex + +let random_hex length = + let go _ = + match Random.int (10 + 26 + 26) with + | n when n < 10 -> Char.chr (Char.code '0' + n) + | n when n < 10 + 26 -> Char.chr (Char.code 'a' + n - 10) + | n -> Char.chr (Char.code 'A' + n - (10 + 26)) in + String.init length go + +let inconsistent_hex = + let expand hex = + String.concat "" + [ spaces_expand hex; spaces_expand (random_hex (5 + Random.int 20)) ] + in + List.map expand consistent_hex + +let test_consistent_hex_success i hex = + Alcotest.test_case (strf "consistent hex:%d" i) `Quick @@ fun () -> + ignore @@ Digestif.SHA1.consistent_of_hex hex + +let test_hex_success i hex = + Alcotest.test_case (strf "hex:%d" i) `Quick @@ fun () -> + ignore @@ Digestif.SHA1.of_hex hex + +let test_consistent_hex_fail i hex = + Alcotest.test_case (strf "consistent hex fail:%d" i) `Quick @@ fun () -> + try + let _ = Digestif.SHA1.consistent_of_hex hex in + assert false + with Invalid_argument _ -> () + +let sha1 = Alcotest.testable Digestif.SHA1.pp Digestif.SHA1.equal + +let test_hex_iso i random_input = + Alcotest.test_case (strf "iso:%d" i) `Quick @@ fun () -> + let hash : Digestif.SHA1.t = Digestif.SHA1.of_raw_string random_input in + let hex = Digestif.SHA1.to_hex hash in + Alcotest.(check sha1) "iso hex" (Digestif.SHA1.of_hex hex) hash + +let test_consistent_hex_iso i random_input = + Alcotest.test_case (strf "iso:%d" i) `Quick @@ fun () -> + let hash : Digestif.SHA1.t = Digestif.SHA1.of_raw_string random_input in + let hex = Digestif.SHA1.to_hex hash in + Alcotest.(check sha1) + "iso consistent hex" + (Digestif.SHA1.consistent_of_hex hex) + hash + +let tests () = + Alcotest.run "digestif" + [ + ("of_hex 0", List.mapi test_hex_success consistent_hex); + ( "consistent_of_hex 0", + List.mapi test_consistent_hex_success consistent_hex ); + ("of_hex 1", List.mapi test_hex_success spaces_hex); + ("consistent_of_hex 1", List.mapi test_consistent_hex_success spaces_hex); + ("of_hex 2", List.mapi test_hex_success inconsistent_hex); + ( "consistent_of_hex 2", + List.mapi test_consistent_hex_fail inconsistent_hex ); + ( "iso of_hex", + List.mapi test_hex_iso + (list_init (random_string Digestif.SHA1.digest_size) 64) ); + ( "iso consistent_of_hex", + List.mapi test_consistent_hex_iso + (list_init (random_string Digestif.SHA1.digest_size) 64) ); + ] + +let () = tests () diff --git a/unikernel/duniverse/digestif/test/ocaml/dune b/unikernel/duniverse/digestif/test/ocaml/dune new file mode 100644 index 00000000..6c9b89de --- /dev/null +++ b/unikernel/duniverse/digestif/test/ocaml/dune @@ -0,0 +1,44 @@ +(executable + (name test) + (modules test) + (libraries fmt alcotest digestif.ocaml)) + +(rule + (alias runtest) + (deps + (:test test.exe) + ../blake2b.test + ../blake2s.test + ../sha3_224_fips_202.txt + ../sha3_256_fips_202.txt + ../sha3_384_fips_202.txt + ../sha3_512_fips_202.txt + ../keccak_256.txt) + (action + (run %{test} --quick-tests --color=always))) + +(executable + (name test_cve) + (modules test_cve) + (enabled_if + (or + (= %{architecture} "arm64") + (= %{architecture} "amd64"))) + (libraries fmt alcotest digestif.ocaml)) + +(rule + (alias runtest) + (enabled_if + (or + (= %{architecture} "arm64") + (= %{architecture} "amd64"))) + (deps + (:test test_cve.exe)) + (action + (run %{test} --quick-tests --color=always))) + +(rule + (copy# ../test.ml test.ml)) + +(rule + (copy# ../test_cve.ml test_cve.ml)) diff --git a/unikernel/duniverse/digestif/test/sha3_512_fips_202.txt b/unikernel/duniverse/digestif/test/sha3_512_fips_202.txt new file mode 100644 index 00000000..af25bb35 --- /dev/null +++ b/unikernel/duniverse/digestif/test/sha3_512_fips_202.txt @@ -0,0 +1,695 @@ +AlgorithmType: MessageDigest +Source: SHA-3 Hash Function Test Vectors for Hashing Byte-Oriented Messages (http://csrc.nist.gov/groups/STM/cavp/secure-hashing.html) +Name: SHA3-512 +Comment: length 0 +Message: "" +Digest: a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26 +Test: Verify +Comment: length 8 +Message: e5 +Digest: 150240baf95fb36f8ccb87a19a41767e7aed95125075a2b2dbba6e565e1ce8575f2b042b62e29a04e9440314a821c6224182964d8b557b16a492b3806f4c39c1 +Test: Verify +Comment: length 16 +Message: ef26 +Digest: 809b4124d2b174731db14585c253194c8619a68294c8c48947879316fef249b1575da81ab72aad8fae08d24ece75ca1be46d0634143705d79d2f5177856a0437 +Test: Verify +Comment: length 24 +Message: 37d518 +Digest: 4aa96b1547e6402c0eee781acaa660797efe26ec00b4f2e0aec4a6d10688dd64cbd7f12b3b6c7f802e2096c041208b9289aec380d1a748fdfcd4128553d781e3 +Test: Verify +Comment: length 32 +Message: fc7b8cda +Digest: 58a5422d6b15eb1f223ebe4f4a5281bc6824d1599d979f4c6fe45695ca89014260b859a2d46ebf75f51ff204927932c79270dd7aef975657bb48fe09d8ea008e +Test: Verify +Comment: length 40 +Message: 4775c86b1c +Digest: ce96da8bcd6bc9d81419f0dd3308e3ef541bc7b030eee1339cf8b3c4e8420cd303180f8da77037c8c1ae375cab81ee475710923b9519adbddedb36db0c199f70 +Test: Verify +Comment: length 48 +Message: 71a986d2f662 +Digest: def6aac2b08c98d56a0501a8cb93f5b47d6322daf99e03255457c303326395f765576930f8571d89c01e727cc79c2d4497f85c45691b554e20da810c2bc865ef +Test: Verify +Comment: length 56 +Message: ec83d707a1414a +Digest: 84fd3775bac5b87e550d03ec6fe4905cc60e851a4c33a61858d4e7d8a34d471f05008b9a1d63044445df5a9fce958cb012a6ac778ecf45104b0fcb979aa4692d +Test: Verify +Comment: length 64 +Message: af53fa3ff8a3cfb2 +Digest: 03c2ac02de1765497a0a6af466fb64758e3283ed83d02c0edb3904fd3cf296442e790018d4bf4ce55bc869cebb4aa1a799afc9d987e776fef5dfe6628e24de97 +Test: Verify +Comment: length 72 +Message: 3d6093966950abd846 +Digest: 53e30da8b74ae76abf1f65761653ebfbe87882e9ea0ea564addd7cfd5a6524578ad6be014d7799799ef5e15c679582b791159add823b95c91e26de62dcb74cfa +Test: Verify +Comment: length 80 +Message: 1ca984dcc913344370cf +Digest: 6915ea0eeffb99b9b246a0e34daf3947852684c3d618260119a22835659e4f23d4eb66a15d0affb8e93771578f5e8f25b7a5f2a55f511fb8b96325ba2cd14816 +Test: Verify +Comment: length 88 +Message: fc7b8cdadebe48588f6851 +Digest: c8439bb1285120b3c43631a00a3b5ac0badb4113586a3dd4f7c66c5d81012f7412617b169fa6d70f8e0a19e5e258e99a0ed2dcfa774c864c62a010e9b90ca00d +Test: Verify +Comment: length 96 +Message: ecb907adfb85f9154a3c23e8 +Digest: 94ae34fed2ef51a383fb853296e4b797e48e00cad27f094d2f411c400c4960ca4c610bf3dc40e94ecfd0c7a18e418877e182ca3ae5ca5136e2856a5531710f48 +Test: Verify +Comment: length 104 +Message: d91a9c324ece84b072d0753618 +Digest: fb1f06c4d1c0d066bdd850ab1a78b83296eba0ca423bb174d74283f46628e6095539214adfd82b462e8e9204a397a83c6842b721a32e8bb030927a568f3c29e6 +Test: Verify +Comment: length 112 +Message: c61a9188812ae73994bc0d6d4021 +Digest: 069e6ab1675fed8d44105f3b62bbf5b8ff7ae804098986879b11e0d7d9b1b4cb7bc47aeb74201f509ddc92e5633abd2cbe0ddca2480e9908afa632c8c8d5af2a +Test: Verify +Comment: length 120 +Message: a6e7b218449840d134b566290dc896 +Digest: 3605a21ce00b289022193b70b535e6626f324739542978f5b307194fcf0a5988f542c0838a0443bb9bb8ff922a6a177fdbd12cf805f3ed809c48e9769c8bbd91 +Test: Verify +Comment: length 128 +Message: 054095ba531eec22113cc345e83795c7 +Digest: f3adf5ccf2830cd621958021ef998252f2b6bc4c135096839586d5064a2978154ea076c600a97364bce0e9aab43b7f1f2da93537089de950557674ae6251ca4d +Test: Verify +Comment: length 136 +Message: 5b1ec1c4e920f5b995b6a788b6e989ac29 +Digest: 135eea17ca4785482c19cd668b8dd2913216903311fa21f6b670b9b573264f8875b5d3c071d92d63556549e523b2af1f1a508bd1f105d29a436f455cd2ca1604 +Test: Verify +Comment: length 144 +Message: 133b497b00932773a53ba9bf8e61d59f05f4 +Digest: 783964a1cf41d6d210a8d7c81ce6970aa62c9053cb89e15f88053957ecf607f42af08804e76f2fbdbb31809c9eefc60e233d6624367a3b9c30f8ee5f65be56ac +Test: Verify +Comment: length 152 +Message: 88c050ea6b66b01256bda299f399398e1e3162 +Digest: 6bf7fc8e9014f35c4bde6a2c7ce1965d9c1793f25c141021cc1c697d111363b3854953c2b4009df41878b5558e78a9a9092c22b8baa0ed6baca005455c6cca70 +Test: Verify +Comment: length 160 +Message: d7d5363350709e96939e6b68b3bbdef6999ac8d9 +Digest: 7a46beca553fffa8021b0989f40a6563a8afb641e8133090bc034ab6763e96d7b7a0da4de3abd5a67d8085f7c28b21a24aefb359c37fac61d3a5374b4b1fb6bb +Test: Verify +Comment: length 168 +Message: 54746a7ba28b5f263d2496bd0080d83520cd2dc503 +Digest: d77048df60e20d03d336bfa634bc9931c2d3c1e1065d3a07f14ae01a085fe7e7fe6a89dc4c7880f1038938aa8fcd99d2a782d1bbe5eec790858173c7830c87a2 +Test: Verify +Comment: length 176 +Message: 73df7885830633fc66c9eb16940b017e9c6f9f871978 +Digest: 0edee1ea019a5c004fd8ae9dc8c2dd38d4331abe2968e1e9e0c128d2506db981a307c0f19bc2e62487a92992af77588d3ab7854fe1b68302f796b9dcd9f336df +Test: Verify +Comment: length 184 +Message: 14cb35fa933e49b0d0a400183cbbea099c44995fae1163 +Digest: af2ef4b0c01e381b4c382208b66ad95d759ec91e386e953984aa5f07774632d53b581eba32ed1d369c46b0a57fee64a02a0e5107c22f14f2227b1d11424becb5 +Test: Verify +Comment: length 192 +Message: 75a06869ca2a6ea857e26e78bb78a139a671ccb098d8205a +Digest: 88be1934385522ae1d739666f395f1d7f99978d62883a261adf5d618d012dfab5224575634446876b86b3e5f7609d397d338a784b4311027b1024ddfd4995a0a +Test: Verify +Comment: length 200 +Message: b413ab364dd410573b53f4c2f28982ca07061726e5d999f3c2 +Digest: 289e889b25f9f38facfccf3bdbceea06ef3baad6e9612b7232cd553f4884a7a642f6583a1a589d4dcb2dc771f1ff6d711b85f731145a89b100680f9a55dcbb3f +Test: Verify +Comment: length 208 +Message: d7f9053984213ebabc842fd8ce483609a9af5dc140ecdbe63336 +Digest: f167cb30e4bacbdc5ed53bc615f8c9ea19ad4f6bd85ca0ff5fb1f1cbe5b576bda49276aa5814291a7e320f1d687b16ba8d7daab2b3d7e9af3cd9f84a1e9979a1 +Test: Verify +Comment: length 216 +Message: 9b7f9d11be48e786a11a472ab2344c57adf62f7c1d4e6d282074b6 +Digest: 82fa525d5efaa3cce39bffef8eee01afb52067097f8965cde71703345322645eae59dbaebed0805693104dfb0c5811c5828da9a75d812e5562615248c03ff880 +Test: Verify +Comment: length 224 +Message: 115784b1fccfabca457c4e27a24a7832280b7e7d6a123ffce5fdab72 +Digest: ec12c4ed5ae84808883c5351003f7e26e1eaf509c866b357f97472e5e19c84f99f16dbbb8bfff060d6c0fe0ca9c34a210c909b05f6a81f441627ce8e666f6dc7 +Test: Verify +Comment: length 232 +Message: c3b1ad16b2877def8d080477d8b59152fe5e84f3f3380d55182f36eb5f +Digest: 4b9144edeeec28fd52ba4176a78e080e57782d2329b67d8ac8780bb6e8c2057583172af1d068922feaaff759be5a6ea548f5db51f4c34dfe7236ca09a67921c7 +Test: Verify +Comment: length 240 +Message: 4c66ca7a01129eaca1d99a08dd7226a5824b840d06d0059c60e97d291dc4 +Digest: 567c46f2f636223bd5ed3dc98c3f7a739b42898e70886f132eac43c2a6fadabe0dd9f1b6bc4a9365e5232295ac1ac34701b0fb181d2f7f07a79d033dd426d5a2 +Test: Verify +Comment: length 248 +Message: 481041c2f56662316ee85a10b98e103c8d48804f6f9502cf1b51cfa525cec1 +Digest: 46f0058abe678195b576df5c7eb8d739468cad1908f7953ea39c93fa1d96845c38a2934d23804864a8368dae38191d983053ccd045a9ab87ef2619e9dd50c8c1 +Test: Verify +Comment: length 256 +Message: 7c1688217b313278b9eae8edcf8aa4271614296d0c1e8916f9e0e940d28b88c5 +Digest: 627ba4de74d05bb6df8991112e4d373bfced37acde1304e0f664f29fa126cb497c8a1b717b9929120883ec8898968e4649013b760a2180a9dc0fc9b27f5b7f3b +Test: Verify +Comment: length 264 +Message: 785f6513fcd92b674c450e85da22257b8e85bfa65e5d9b1b1ffc5c469ad337d1e3 +Digest: 5c11d6e4c5c5f76d26876c5976b6f555c255c785b2f28b6700ca2d8b3b3fa585636239277773330f4cf8c5d5203bcc091b8d47e7743bbc0b5a2c54444ee2acce +Test: Verify +Comment: length 272 +Message: 34f4468e2d567b1e326c0942970efa32c5ca2e95d42c98eb5d3cab2889490ea16ee5 +Digest: 49adfa335e183c94b3160154d6698e318c8b5dd100b0227e3e34cabea1fe0f745326220f64263961349996bbe1aae9054de6406e8b350408ab0b9f656bb8daf7 +Test: Verify +Comment: length 280 +Message: 53a0121c8993b6f6eec921d2445035dd90654add1298c6727a2aed9b59bafb7dd62070 +Digest: 918b4d92e1fcb65a4c1fa0bd75c562ac9d83186bb2fbfae5c4784de31a14654546e107df0e79076b8687bb3841c83ba9181f9956cd43428ba72f603881b33a71 +Test: Verify +Comment: length 288 +Message: d30fa4b40c9f84ac9bcbb535e86989ec6d1bec9b1b22e9b0f97370ed0f0d566082899d96 +Digest: 39f104c1da4af314d6bceb34eca1dfe4e67484519eb76ba38e4701e113e6cbc0200df86e4439d674b0f42c72233360478ba5244384d28e388c87aaa817007c69 +Test: Verify +Comment: length 296 +Message: f34d100269aee3ead156895e8644d4749464d5921d6157dffcbbadf7a719aee35ae0fd4872 +Digest: 565a1dd9d49f8ddefb79a3c7a209f53f0bc9f5396269b1ce2a2b283a3cb45ee3ae652e4ca10b26ced7e5236227006c94a37553db1b6fe5c0c2eded756c896bb1 +Test: Verify +Comment: length 304 +Message: 12529769fe5191d3fce860f434ab1130ce389d340fca232cc50b7536e62ad617742e022ea38a +Digest: daee10e815fff0f0985d208886e22f9bf20a3643eb9a29fda469b6a7dcd54b5213c851d6f19338d63688fe1f02936c5dae1b7c6d5906a13a9eeb934400b6fe8c +Test: Verify +Comment: length 312 +Message: b2e3a0eb36bf16afb618bfd42a56789179147effecc684d8e39f037ec7b2d23f3f57f6d7a7d0bb +Digest: 04029d6d9e8e394afa387f1d03ab6b8a0a6cbab4b6b3c86ef62f7142ab3c108388d42cb87258b9e6d36e5814d8a662657cf717b35a5708365e8ec0396ec5546b +Test: Verify +Comment: length 320 +Message: 25c4a5f4a07f2b81e0533313664bf615c73257e6b2930e752fe5050e25ff02731fd2872f4f56f727 +Digest: ec2d38e5bb5d7b18438d5f2029c86d05a03510db0e66aa299c28635abd0988c58be203f04b7e0cc25451d18f2341cd46f8705d46c2066dafab30d90d63bf3d2c +Test: Verify +Comment: length 328 +Message: 134bb8e7ea5ff9edb69e8f6bbd498eb4537580b7fba7ad31d0a09921237acd7d66f4da23480b9c1222 +Digest: 8f966aef96831a1499d63560b2578021ad970bf7557b8bf8078b3e12cefab122fe71b1212dc704f7094a40b36b71d3ad7ce2d30f72c1baa4d4bbccb3251198ac +Test: Verify +Comment: length 336 +Message: f793256f039fad11af24cee4d223cd2a771598289995ab802b5930ba5c666a24188453dcd2f0842b8152 +Digest: 22c3d9712535153a3e206b1033929c0fd9d937c39ba13cf1a6544dfbd68ebc94867b15fda3f1d30b00bf47f2c4bf41dabdeaa5c397dae901c57db9cd77ddbcc0 +Test: Verify +Comment: length 344 +Message: 23cc7f9052d5e22e6712fab88e8dfaa928b6e015ca589c3b89cb745b756ca7c7634a503bf0228e71c28ee2 +Digest: 6ecf3ad6064218ee101a555d20fab6cbeb6b145b4eeb9c8c971fc7ce05581a34b3c52179590e8a134be2e88c7e549875f4ff89b96374c6995960de3a5098cced +Test: Verify +Comment: length 352 +Message: a60b7b3df15b3f1b19db15d480388b0f3b00837369aa2cc7c3d7315775d7309a2d6f6d1371d9c875350dec0a +Digest: 8d651605c6b32bf022ea06ce6306b2ca6b5ba2781af87ca2375860315c83ad88743030d148ed8d73194c461ec1e84c045fc914705747614c04c8865b51da94f7 +Test: Verify +Comment: length 360 +Message: 2745dd2f1b215ea509a912e5761cccc4f19fa93ba38445c528cb2f099de99ab9fac955baa211fd8539a671cdb6 +Digest: 4af918eb676ce278c730212ef79d818773a76a43c74d643f238e9b61acaf4030c617c4d6b3b7514c59b3e5e95d82e1e1e35443e851718b13b63e70b123d1b72c +Test: Verify +Comment: length 368 +Message: 88adee4b46d2a109c36fcfb660f17f48062f7a74679fb07e86cad84f79fd57c86d426356ec8e68c65b3caa5bc7ba +Digest: 6257acb9f589c919c93c0adc4e907fe011bef6018fbb18e618ba6fcc8cbc5e40641be589e86dbb0cf7d7d6bf33b98d8458cce0af7857f5a7c7647cf350e25af0 +Test: Verify +Comment: length 376 +Message: 7d40f2dc4af3cfa12b00d64940dc32a22d66d81cb628be2b8dda47ed6728020d55b695e75260f4ec18c6d74839086a +Digest: 5c46c84a0a02d898ed5885ce99c47c77afd29ae015d027f2485d630f9b41d00b7c1f1faf6ce57a08b604b35021f7f79600381994b731bd8e6a5b010aeb90e1eb +Test: Verify +Comment: length 384 +Message: 3689d8836af0dc132f85b212eb670b41ecf9d4aba141092a0a8eca2e6d5eb0ba4b7e61af9273624d14192df7388a8436 +Digest: 17355e61d66e40f750d0a9a8e8a88cd6f9bf6070b7efa76442698740b4487ea6c644d1654ef16a265204e03084a14cafdccf8ff298cd54c0b4009967b6dd47cc +Test: Verify +Comment: length 392 +Message: 58ff23dee2298c2ca7146227789c1d4093551047192d862fc34c1112d13f1f744456cecc4d4a02410523b4b15e598df75a +Digest: aca89aa547c46173b4b2a380ba980da6f9ac084f46ac9ddea5e4164aeef31a9955b814a45aec1d8ce340bd37680952c5d68226dda1cac2677f73c9fd9174fd13 +Test: Verify +Comment: length 400 +Message: 67f3f23df3bd8ebeb0096452fe4775fd9cc71fbb6e72fdcc7eb8094f42c903121d0817a927bcbabd3109d5a70420253deab2 +Digest: f4207cc565f266a245f29bf20b95b5d9a83e1bb68ad988edc91faa25f25286c8398bac7dd6628259bff98f28360f263dfc54c4228bc437c5691de1219b758d9f +Test: Verify +Comment: length 408 +Message: a225070c2cb122c3354c74a254fc7b84061cba33005cab88c409fbd3738ff67ce23c41ebef46c7a61610f5b93fa92a5bda9569 +Digest: e815a9a4e4887be014635e97958341e0519314b3a3289e1835121b153b462272b0aca418be96d60e5ab355d3eb463697c0191eb522b60b8463d89f4c3f1bf142 +Test: Verify +Comment: length 416 +Message: 6aa0886777e99c9acd5f1db6e12bda59a807f92411ae99c9d490b5656acb4b115c57beb3c1807a1b029ad64be1f03e15bafd91ec +Digest: 241f2ebaf7ad09e173b184244e69acd7ebc94774d0fa3902cbf267d4806063b044131bcf4af4cf180eb7bd4e7960ce5fe3dc6aebfc6b90eec461f414f79a67d9 +Test: Verify +Comment: length 424 +Message: 6a06092a3cd221ae86b286b31f326248270472c5ea510cb9064d6024d10efee7f59e98785d4f09da554e97cdec7b75429d788c112f +Digest: d14a1a47f2bef9e0d4b3e90a6be9ab5893e1110b12db38d33ffb9a61e1661aecc4ea100839cfee58a1c5aff72915c14170dd99e13f71b0a5fc1985bf43415cb0 +Test: Verify +Comment: length 432 +Message: dfc3fa61f7fffc7c88ed90e51dfc39a4f288b50d58ac83385b58a3b2a3a39d729862c40fcaf9bc308f713a43eecb0b72bb9458d204ba +Digest: 947bc873dc41df195f8045deb6ea1b840f633917e79c70a88d38b8862197dc2ab0cc6314e974fb5ba7e1703b22b1309e37bd430879056bdc166573075a9c5e04 +Test: Verify +Comment: length 440 +Message: 52958b1ff0049efa5d050ab381ec99732e554dcd03725da991a37a80bd4756cf65d367c54721e93f1e0a22f70d36e9f841336956d3c523 +Digest: 9cc5aad0f529f4bac491d733537b69c8ec700fe38ab423d815e0927c8657f9cb8f4207762d816ab697580122066bc2b68f4177335d0a6e9081540779e572c41f +Test: Verify +Comment: length 448 +Message: 302fa84fdaa82081b1192b847b81ddea10a9f05a0f04138fd1da84a39ba5e18e18bc3cea062e6df92ff1ace89b3c5f55043130108abf631e +Digest: 8c8eaae9a445643a37df34cfa6a7f09deccab2a222c421d2fc574bbc5641e504354391e81eb5130280b1226812556d474e951bb78dbdd9b77d19f647e2e7d7be +Test: Verify +Comment: length 456 +Message: b82f500d6bc2dddcdc162d46cbfaa5ae64025d5c1cd72472dcd2c42161c9871ce329f94df445f0c8aceecafd0344f6317ecbb62f0ec2223a35 +Digest: 55c69d7accd179d5d9fcc522f794e7af5f0eec7198ffa39f80fb55b866c0857ff3e7aeef33e130d9c74ef90606ca821d20b7608b12e6e561f9e6c7122ace3db0 +Test: Verify +Comment: length 464 +Message: 86da9107ca3e16a2b58950e656a15c085b88033e79313e2c0f92f99f06fa187efba5b8fea08eb7145f8476304180dd280f36a072b7eac197f085 +Digest: 0d3b1a0459b4eca801e0737ff9ea4a12b9a483a73a8a92742a93c297b7149326bd92c1643c8177c8924482ab3bbd916c417580cc75d3d3ae096de531bc5dc355 +Test: Verify +Comment: length 472 +Message: 141a6eafe157053e780ac7a57b97990616ce1759ed132cb453bcdfcabdbb70b3767da4eb94125d9c2a8d6d20bfaeacc1ffbe49c4b1bb5da7e9b5c6 +Digest: bdbdd5b94cdc89466e7670c63ba6a55b58294e93b351261a5457bf5a40f1b5b2e0acc7fceb1bfb4c8872777eeeaff7927fd3635ca18c996d870bf86b12b89ba5 +Test: Verify +Comment: length 480 +Message: 6e0c65ee0943e34d9bbd27a8547690f2291f5a86d713c2be258e6ac16919fe9c4d491895d3a961bb97f5fac255891a0eaa18f80e1fa1ebcb639fcfc1 +Digest: 39ebb992b8d39daae973e3813a50e9e79a67d8458a6f17f97a6dd30dd7d11d95701a11129ffeaf7d45781b21cac0c4c034e389d7590df5beeb9805072d0183b9 +Test: Verify +Comment: length 488 +Message: 57780b1c79e67fc3beaabead4a67a8cc98b83fa7647eae50c8798b96a516597b448851e93d1a62a098c4767333fcf7b463ce91edde2f3ad0d98f70716d +Digest: 3ef36c3effad6eb5ad2d0a67780f80d1b90efcb74db20410c2261a3ab0f784429df874814748dc1b6efaab3d06dd0a41ba54fce59b67d45838eaa4aa1fadfa0f +Test: Verify +Comment: length 496 +Message: bcc9849da4091d0edfe908e7c3386b0cadadb2859829c9dfee3d8ecf9dec86196eb2ceb093c5551f7e9a4927faabcfaa7478f7c899cbef4727417738fc06 +Digest: 1fcd8a2c7b4fd98fcdc5fa665bab49bde3f9f556aa66b3646638f5a2d3806192f8a33145d8d0c535c85adff3cc0ea3c2715b33cec9f8886e9f4377b3632e9055 +Test: Verify +Comment: length 504 +Message: 05a32829642ed4808d6554d16b9b8023353ce65a935d126602970dba791623004dede90b52ac7f0d4335130a63cba68c656c139989614de20913e83db320db +Digest: 49d8747bb53ddde6d1485965208670d1130bf35619d7506a2f2040d1129fcf0320207e5b36fea083e84ffc98755e691ad8bd5dc66f8972cb9857389344e11aad +Test: Verify +Comment: length 512 +Message: 56ac4f6845a451dac3e8886f97f7024b64b1b1e9c5181c059b5755b9a6042be653a2a0d5d56a9e1e774be5c9312f48b4798019345beae2ffcc63554a3c69862e +Digest: 5fde5c57a31febb98061f27e4506fa5c245506336ee90d595c91d791a5975c712b3ab9b3b5868f941db0aeb4c6d2837c4447442f8402e0e150a9dc0ef178dca8 +Test: Verify +Comment: length 520 +Message: 8a229f8d0294fe90d4cc8c875460d5d623f93287f905a999a2ab0f9a47046f78ef88b09445c671189c59388b3017cca2af8bdf59f8a6f04322b1701ec08624ab63 +Digest: 16b0fd239cc632842c443e1b92d286dd519cfc616a41f2456dd5cddebd10703c3e9cb669004b7f169bb4f99f350ec96904b0e8dd4de8e6be9953dc892c65099f +Test: Verify +Comment: length 528 +Message: 87d6aa9979025b2437ea8159ea1d3e5d6f17f0a5b913b56970212f56de7884840c0da9a72865e1892aa780b8b8f5f57b46fc070b81ca5f00eee0470ace89b1e1466a +Digest: d816acf1797decfe34f4cc49e52aa505cc59bd17fe69dc9543fad82e9cf96298183021f704054d3d06adde2bf54e82a090a57b239e88daa04cb76c4fc9127843 +Test: Verify +Comment: length 536 +Message: 0823616ab87e4904308628c2226e721bb4169b7d34e8744a0700b721e38fe05e3f813fe4075d4c1a936d3a33da20cfb3e3ac722e7df7865330b8f62a73d9119a1f2199 +Digest: e1da6be4403a4fd784c59be4e71c658a78bb8c5d7d571c5e816fbb3e218a4162f62de1c285f3779781cb5506e29c94e1b7c7d65af2aa71ea5c96d9585b5e45d5 +Test: Verify +Comment: length 544 +Message: 7d2d913c2460c09898b20366ae34775b1564f10edea49c073cebe41989bb93f38a533af1f425d3382f8aa40159b567358ee5a73b67df6d0dc09c1c92bf3f9a28124ab07f +Digest: 3aa1e19a52b86cf414d977768bb535b7e5817117d436b4425ec8d775e8cb0e0b538072213884c7ff1bb9ca9984c82d65cb0115cc07332b0ea903e3b38650e88e +Test: Verify +Comment: length 552 +Message: fca5f68fd2d3a52187b349a8d2726b608fccea7db42e906b8718e85a0ec654fac70f5a839a8d3ff90cfed7aeb5ea9b08f487fc84e1d9f7fb831dea254468a65ba18cc5a126 +Digest: 2c74f846ecc722ea4a1eb1162e231b6903291fffa95dd5e1d17dbc2c2be7dfe549a80dd34487d714130ddc9924aed904ad55f49c91c80ceb05c0c034dae0a0a4 +Test: Verify +Comment: length 560 +Message: 881ff70ca34a3e1a0e864fd2615ca2a0e63def254e688c37a20ef6297cb3ae4c76d746b5e3d6bb41bd0d05d7df3eeded74351f4eb0ac801abe6dc10ef9b635055ee1dfbf4144 +Digest: 9a10a7ce23c0497fe8783927f833232ae664f1e1b91302266b6ace25a9c253d1ecab1aaaa62f865469480b2145ed0e489ae3f3f9f7e6da27492c81b07e606fb6 +Test: Verify +Comment: length 568 +Message: b0de0430c200d74bf41ea0c92f8f28e11b68006a884e0d4b0d884533ee58b38a438cc1a75750b6434f467e2d0cd9aa4052ceb793291b93ef83fd5d8620456ce1aff2941b3605a4 +Digest: 9e9e469ca9226cd012f5c9cc39c96adc22f420030fcee305a0ed27974e3c802701603dac873ae4476e9c3d57e55524483fc01adaef87daa9e304078c59802757 +Test: Verify +Comment: length 576 +Message: 0ce9f8c3a990c268f34efd9befdb0f7c4ef8466cfdb01171f8de70dc5fefa92acbe93d29e2ac1a5c2979129f1ab08c0e77de7924ddf68a209cdfa0adc62f85c18637d9c6b33f4ff8 +Digest: b018a20fcf831dde290e4fb18c56342efe138472cbe142da6b77eea4fce52588c04c808eb32912faa345245a850346faec46c3a16d39bd2e1ddb1816bc57d2da +Test: Verify +Comment: length 1160 +Message: 664ef2e3a7059daf1c58caf52008c5227e85cdcb83b4c59457f02c508d4f4f69f826bd82c0cffc5cb6a97af6e561c6f96970005285e58f21ef6511d26e709889a7e513c434c90a3cf7448f0caeec7114c747b2a0758a3b4503a7cf0c69873ed31d94dbef2b7b2f168830ef7da3322c3d3e10cafb7c2c33c83bbf4c46a31da90cff3bfd4ccc6ed4b310758491eeba603a76 +Digest: e5825ff1a3c070d5a52fbbe711854a440554295ffb7a7969a17908d10163bfbe8f1d52a676e8a0137b56a11cdf0ffbb456bc899fc727d14bd8882232549d914e +Test: Verify +Comment: length 1744 +Message: 991c4e7402c7da689dd5525af76fcc58fe9cc1451308c0c4600363586ccc83c9ec10a8c9ddaec3d7cfbd206484d09634b9780108440bf27a5fa4a428446b3214fa17084b6eb197c5c59a4e8df1cfc521826c3b1cbf6f4212f6bfb9bc106dfb5568395643de58bffa2774c31e67f5c1e7017f57caadbb1a56cc5b8a5cf9584552e17e7af9542ba13e9c54695e0dc8f24eddb93d5a3678e10c8a80ff4f27b677d40bef5cb5f9b3a659cc4127970cd2c11ebf22d514812dfefdd73600dfc10efba38e93e5bff47736126043e50f8b9b941e4ec3083fb762dbf15c86 +Digest: cd0f2a48e9aa8cc700d3f64efb013f3600ebdbb524930c682d21025eab990eb6d7c52e611f884031fafd9360e5225ab7e4ec24cbe97f3af6dbe4a86a4f068ba7 +Test: Verify +Comment: length 2328 +Message: 22e1df25c30d6e7806cae35cd4317e5f94db028741a76838bfb7d5576fbccab001749a95897122c8d51bb49cfef854563e2b27d9013b28833f161d520856ca4b61c2641c4e184800300aede3518617c7be3a4e6655588f181e9641f8df7a6a42ead423003a8c4ae6be9d767af5623078bb116074638505c10540299219b0155f45b1c18a74548e4328de37a911140531deb6434c534af2449c1abe67e18030681a61240225f87ede15d519b7ce2500bccf33e1364e2fbe6a8a2fe6c15d73242610ed36b0740080812e8902ee531c88e0359020797cbdd1fb78848ae6b5105961d05cdddb8af5fef21b02db94c9810464b8d3ea5f047b94bf0d23931f12df37e102b603cd8e5f5ffa83488df257ddde110106262e0ef16d7ef213e7b49c69276d4d048f +Digest: a6375ff04af0a18fb4c8175f671181b4cf79653a3d70847c6d99694b3f5d41601f1dbef809675c63cac4ec83153b1c78131a7b61024ce36244f320ab8740cb7e +Test: Verify +Comment: length 2912 +Message: 8237ce9396ccde3a616754414cdf7b5a958c1eb7f25a48c2781b4e0dba220f8c350d7b02ece252b94f5e2e766189c4ac1a8e67f00acacead402316196a9b0a673e24a33f18b7cb6be4a066d33e1c93abd8252feb1c8d9cff134ac0c0861150a463264e316172d0b8e7d6043f2bbf71bf97fa7f9070ca3a21b93853ec55ab67a96db884c2113bea0822a70ea46f9ae5501eb55ec74eaa3179fa96d7842092d9e023844ed96f3c9fc35bbc8ee953d677c636fdd578fd5507719e0c55702fed2eaf4f32b35ec29a7a515bbc8bf61f9baf89a77aeb8bc6f247706c41d398cae5ec80b76abc3a5380001aea500eb31b10160139d5a8e8f1a976dd2dde5ce439a29dba24d370536a14bb87cf201e088e5e3397b3b61477c6a41e22a98af53cc34bc8c55f15d7924e7e32fed4d3c3ddc2ac8eb1dfc438218c08c6a6a8eea888b208f6092dd9f9df49e7ede8bf11051afd23b0b983a81bcc8d00f7d1f2b27cb04c03aeee59c7df23a17775ae5984eda7 +Digest: f08819ec3a9a9806a1f55be4f0e56bce084e66fa271784974bf80e1bed7b2be559ebf5b6396ce52f7db7ef45543965f83064095a70328489178718b491a4100d +Test: Verify +Comment: length 3496 +Message: cfa6c0413dfc1a619417ac3f80fd38247b56941da8c2adf3ff70cc5dabed1875b0395d69d1200b73b1c7820b38868c5b38f52bf3514a96be12e27e34601d95d21c6f51c700b4edf1cac4b2079d487418a4cc5f34f815f469c4b44ef1a7dbaaa9597026c59260c9c22736c49d76ecf7430500b74866cbcfdb5e0fc4fa46cf5ee2b06363ca4ecba6d0104440348d191ec4a4bcbc9763152ffe271a69b805a0b9656970913dfd9e8c02cd16af33a878f083c926f48ab79b1db969fec493aef6c31accc1378867808440a5d5990490b07568bc66e9872904a0f46ae25ef4077b85ea217bdd12541a9472e2a9840e0d6ab55cc4a523f782f8c19774efbd41dad506bbafc90c438c14c780cab9fab9e74eb9452a0b29438a21878bcd4c6be4edac4e77bfd14a83d6152253a62e826de503880d37bf82d10924fab6bd23f04308a9660499bb223afcc5afd1bd2fa592d0322a9a30eab90bc7ac22018e99d2c8f573554c85b019d0c4cd75e359e5e9907082a8d660b353588b5f085486d89bd97bb32335cbd8b9adf7d57c72c078d9d08d9c09a70e43da1f1fe5b398ef08d2e06111d9a9b25a893a5d84cd643b0ffab8ef2755f781c1d6ca49 +Digest: 3a4c2c9284c90515cb34a0895d0374e87467ffbbc7c1dda3239893a12aeae3b9951169fe85605ef7aa2c483662f3a65c72ff12becde50c23ec6a2bc8864c27c1 +Test: Verify +Comment: length 4080 +Message: 43025615521d66fe8ec3a3f8ccc5abfab870a462c6b3d1396b8462b98c7f910c37d0ea579154eaf70ffbcc0be971a032ccfd9d96d0a9b829a9a3762e21e3fefcc60e72fedf9a7fffa53433a4b05e0f3ab05d5eb25d52c5eab1a71a2f54ac79ff5882951326394d9db83580ce09d6219bca588ec157f71d06e957f8c20d242c9f55f5fc9d4d777b59b0c75a8edc1ffedc84b5d5c8a5e0eb05bb7db8f234913d6325304fa43c9d32bbf6b269ee1182cd85453eddd12f55556d8edf02c4b13cd4d330f83531dbf2994cf0be56f59147b71f74b94be3dd9e83c8c9477c426c6d1a78de18564a12c0d99307b2c9ab42b6e3317befca0797029e9dd67bd1734e6c36d998565bfac94d1918a35869190d177943c1a8004445cace751c43a75f3d80517fc47cec46e8e382642d76df46dab1a3ddaeab95a2cf3f3ad70369a70f22f293f0cc50b03857c83cfe0bd5d23b92cd8788aac232291da60b4bf3b3788ae60a23b6169b50d7fe446e6ea73debfe1bb34dcb1db37fe2174a685954ebc2d86f102a590c24732bc5a1403d6876d2995fab1e2f6f4723d4a6727a8a8ed72f02a74ccf5f14b5c23d9525dbf2b5472e1345fd223b0846c707b06569650940650f75063b529814e514541a6715f879a875b4f08077517812841e6c5c732eed0c07c08595b9ff0a83b8ecc60b2f98d4e7c696cd616bb0a5ad52d9cf7b3a63a8cdf37212 +Digest: e7ba73407aa456aece211077d92087d5cd283e3868d284e07ed124b27cbc664a6a475a8d7b4cf6a8a4927ee059a2626a4f983923360145b265ebfd4f5b3c44fd +Test: Verify +Comment: length 4664 +Message: e34acd510cb32ca5f97298a3829244bb23322229fd7a07821dd40a8d01582d5558873f7c0a3d00d278e1872605dfe15dd558fbc1d518c19bfbc88803cf64a9f72af06fab3d673420d6f5c6f8df65108927ddf63066c980e77b153b1af79fdcb7dfec2785ae1a0fb69a151fbf180e1867a229dc1eb8768a912523eb7b83f00dbe01e22db2643cdabd4cab5824b9c14320cda47435d40829bf815a5fce7a3e8333183c4adb67b6de5c751e3acec966d7dc31b7881ac165a29a182361bae573873faa6146a8c07160bc9cd68d6650e41dc254c8de788777404971e4b7e7cb76610a41b9e9c07654ab04493b199357255dfbc04140f52f244af414062afe342f59bb64acfbcc9146065d04b5a5fee410dfaefd887439bf5607c58af282a72986b77b9ca243731a31b8ef56acfb4e028dea04910742ed42f4c0e25a0f8789b063c2716f038a5e18fc0ae1c688e12cb684c725062474b9bde6be730cc4014dd4aec3c667379834938f445cddb120400addbf38e449d0443a1446a1297bb79a9a4f02a10ca6359e94d2ae87218f803105801866b1dd2037c066a393389b72190c2ec72be5b9294421ad8f8b1c8ac8a8af561ad6f7482a3958c41b73c18cfa7231345a8b7ad63bcd4508318f560bc24c11450fb13df1b7f30916f8664cb5174c114702ea536735e205cbdabc567834c632363d1e0c428e0ddb4480966280914fb5500970f9d2dd2a6bded33aa43be7bd1b12ed46eba2792ed636fc2b8a542f242438b544f381fc4e7e296430c8baa3dad2bf685062793efe03d4b34d4d99ba7366e54f8fc9da59f54694d4 +Digest: a1416054e488c1e013762d642b2c63361b33e4fc528149845606de20998bf2afec05da53067477a3c27ebb3c0d24ad3dd6ed390335977f129f1b6b1526c0e0c8 +Test: Verify +Comment: length 5248 +Message: 0d542102f215c793f81cae2e79e5ae58b4439fa0d05577301eb6b2a19ff5f714c645f87e7e759a436f2256077d2bdec0926504109e90d8d3dc8a11f456c3af84abf1de0d10051c23955d9e3daa3bf0c3e176dd68f56f8eba0c47f6f7394f6d2345c09a57afad975cf135507905fd2c8828def04fdedae00e365527554f8178181b1bf605635551150b1332629859da38ef04066e5fb915f7e21c6cb4a0421a8cb568b8bf34e593776c5d0ea16a3841fabf52e66d83f4769c99048fbd357899a79c10a92c2b45a5aa9b7daadd8380aaf71e2f5af34f744b26e2755617150d3e90577c91f54f5dcfd520d9cebfec1b5d57970328a8cd1fdcbc46d78b6a48e751706e1338c2a915592184db44eeacefa241af37193604de70874c92f460d7f01a6e6a3c653a3f568ab54ee9d313cbe6c1ddf031f542fc9a50af7c0e5a9fc90ee0b3d261e2051b06acba066d42d652e70154e15a8477be39c55b5eb384cf262bed672ee975cc450f055735ce5ade48d9acce0a1a8d7a51a515b37bea3c99f72e87b0073ce737c357deb56274e3d4b5a60872f4dadaf6bdc488e05a1948a543fff7b9e3c2ffed9fc87efb15c7a55fa1355e69260031910b80680a83aa719a128685a84de38797e1492f52d62f6728156ef5db28f65bf342bffb587f037f206cab78a6ca0745dc8fc137e22e14f3d7183917ef832220c56a6b8bf3d58e3ae15a561adae4960365b31adfd2a4de0f13b37e0acdbeee47af8c6b5e030db16a82e36fb16d22f887d9543b6f4bc1f58484ed25179e61c19a58aea7bcafb0d6d6ae10de86860c9599e17b0c2f740bc119d3ce16868af502df69db07ef1f4564470be88be14e2bd503252f7566760cab98a85e3a9fb8011bdf8918733e7c54c38541735e09ed06218c4c785e5e784c19c7aaa677aa51 +Digest: 0cd249160510bdbc1a117600ed8dec1b68b541c684337ad39e8dcdf84bc7a9856cd8e210098e1ac47fabb3af0a4313a4a70f388b11ef53771651d95131936ce4 +Test: Verify +Comment: length 5832 +Message: 802c4c6faa7e25b79a985cc98b972847a2dfef587e5f7205101646e4add583f46147c0c987303ee996f263753e556a0cb4875aec4a62345a42ee7145e427ab26ce009b2a8ca74393680b6c5b839c531b2551a02c52f0970c9e8a92034244af066e5ec6dbe16d9e7eb8eb60c483f24b3e9e45aa60bf9003e2cbf19267eeb6f55dea692924af0ab5722d9b25f666e2ba3bc76a60d0b8cbe0a6722b57b91005e7f2e929ac4c1e04f2376f22a53a53f108db47c8aac36627971e3a41cb41d2b7ec8f14a7389d55e5bc942788c6d772a99ee6c7677183f02e8e13cc3ad5465a566bfa13eab35d7d347a52fdd67217ec91e224ee509b567f682e4ccf1e5c12d06acefc8dfa07d5bd7a963998139040e9313d5d658a12853b5cdf93ecf54aeb5d797c5d2be01a4d3e3e7711a147089b90121858d31dbc574b920aaecbc8861a290ddde594a3d60d270885a2bf7ac2700abbd9dee1128316d8921566139ef8e65bad595c704b215ca16128b49bb5a5077fb4eab737704e0809e56a836c8088991be2588969e1e584d4cfc80edcff9ba71686b1ab7c3f047707126fcd80751e7a93324235256b09cbe7dccd792b618c99f7b8988258878fa9f9a18e0cf485a2d0e8287f284cf4757a03109fbd30e25e264bd205037551d6e7081a2e0773b8fce44549772a878111d84ff2a6a2928afa943a5d62f778a4c1785c06b687a31714fed01f93037e1cc52ff40a4bf0fa61482bebe016260c8938a61ced90542ca9d265b131397ad8cc79c519e0f46e0f70303587e38958d70723b771552336b7771f631107d2593d9a15e4e7fd0be57abe9bf835ee235581266af482c8d7f5ec87e13e182ac766578c81d286e8f61de2536fbd1e8a4ce4b3eef6a578cd145872e3023fed217e6acbada5d71d291fdef03896cc693e6ccf1568ad127aed4228f29368aeb974612c4402693dd449ecf04c74f66d3f93ebdc4e9b7882b1aec92d139dfdd3a3acd7766895b64ad4cfc71a9d0f79e8c81031d40790403f449b122f7e +Digest: 238726f9c46f44f3457be33cd360e9a369b31280ab718b01c4b8e324e40712f8911aa4220bc5f0e9023f47f48028fa37108dcc8938a34943775617eb129bf7a5 +Test: Verify +Comment: length 6416 +Message: 1f93eb3cefd64eca5d7ec36cb7f21d768cd6854262ebc930a730f7eaea4e2bed4b32a54530fc1e973a185c6578aa058eda30b114e8634222b35d784e0c01c01bf5984dc255b86a32f06a0f55958bb29599735f9f85d50b660ce6266b40c26f3d050b0c3bc5d3daa165bc02c3785dcd93b3e8b969a10acc04981328ccec57e05962d40a39e81515ee83565d3788e8fd910fd7e4fca5cb2c02412ca7f67a89ba7af63b6e432645c421307f49392df4eb9595880be0f7ded36aee78ca735020a5a5a88761e2e72d8e405680ee52cf483eaa2d42549b010b6a448740bac9d8e44be460020a9d93931c55dca17309d6ad9fd5bf4fe7b72a1c9996f3cc9e83789d513e06f292fc92401567aa2a00e7abebb62033f5edbcd9d7076a1c649f269a1262bc83a020874cfc227fa863bf73b4ca2a92717d8e3078065dc7e950e53ca50c2464bd54ddc72a8eeba4be94d6355a12a433622ff19d6e6f42b642d7974d01533f409d56f04392c017ded4046db5058acb0cec523f8a23db5f3d0f43dddf15af5c580bed8283ed584f35d2fcad7c1efb4824f8309f80ff115c6738dae07c4be823b2f062bb10a41f3ab2a0c4bd110b2dc2846f0f3a066adbe039a6e5c8ab0ac53b5832fdc2711ddd815c26a4c6fc36e8e232373838a4ccff93bd3fabbdf5bb0f4d52bb06c02ec25acb3c4de4f0c605f450383af3c0e28d461efaec76e6e0c48e00a671c5dcd0fa5dc158fbcb62f6e218b39e5e87fa49157829f8968c6bf68e0afd5e3e823fde2cb00bba19a24514341db36a8d3e0f60cc5d5bc0233675bf814beb82098410e0c219506a90b1c0a863ccf9a6ae5e27af1bbc5d597dbc2cc205187318ba14785f2361386e4640fc3bd7eb2d59a93069bf685fd6cb8a66b787833b3d2a387a9fe2b7506dd025972154f742f78c66fcfe171c0c6f1f347c3e96617af0bf6dfeacf1e6ad949814fe567c2d9bfd46cc0a0e40a08cd05c6145eb78099e34e040e8c814184258ccfabcc33ae1bcea8fc5a1c0c05ba7a08afb0ae4b4e16fb394997f1ad4b5d55e76c11a9116796e646f390a3c21b42488b2e91351d253b412e3600ccbb8252f519d5060e8985e7913ef0e8eabea15cd2fda13a85b5ac637fcd57dd7 +Digest: d75e227a5ad2d3ea262dc663adac6e339126163ac683b3e62aff92653a3de00986329e4c6b79c0af3ed614a3d10135279b92d6f4100613f41feeaffa170bd098 +Test: Verify +Comment: length 7000 +Message: 09ab78274714140e9e25d81ca9a1cb475945094f39fb2296f651bd311e29813f28b23579b597250b1576c8a30d93a1c7d7ce636b6bd258c3fd900356c7ec055408b53d294ddb3352efdcb76fdd80c59a9bc6acf88b1e6f8d6cd86c5520dd3b90b29dd95d9748068a3441ebaba1d00069ad172d1d2247309e4a133e56b165ed9c2d50513e1c47655ced8cad7de2ea1adc13a72e03b7b5609b9f28c28303ede11f81b8edf3633e1a7021a5450d2638db9ad760f7d1d2cfca2f73ff40029ddbe0c2b7bcf5a4f496eb6dd874fb84f8210b4c0128cfb0fbff3500cf8000fb0798b22dd643b07b58b8a1fc1ae0170add0d719997e900c8bbad68b6ba934997ca8d1f07e637679d160a04c4f0d3e0c65f64d62aa38ad040993f2cfa3d2065fd6d21eff8f07f6235b6f6db6e61359fe1058f02a62cf388411e1e49745f0f9a5778bbe9aafa03e969c1e3f0a176ec9d8357f4bdb63b0c6ff2d0b287cb284831ca74c5d7c20fab4461be39090636e11fd2defccf02d7bdcf7c3a63aea7a0b37180e8a67feb345fba46355fef44a9fc70f9210fff3108eeee06e19a85b2d039a4a15cc6a9cb73079440aebf6a04d726d71ea99616ecd68716b94fbdd591bfc01054588d1f0ad38b1b76b2c041eec9459b6afcf7ddda4a708dbd0b3666ef7531ffc26563a8515dd39411c8ca3ea986420504a49c19a46b919b399d6b0072fb75b7130ab00b4817c74a38794527de16065d1429eb95f142d28a558ec66bc25872816ed0dc11960b5084144c99c5348278ebc4114e186ad51ca03b64ad6e889412a4fb3e4f82e3415489cdc92fe054d17ff63ae62c69b72e552710aa8ad36cb83c6ae4dc7126d9bfbca28a786d40e50b05c89e2fed517f556765ffe5c46015cbd8194e32abc41e8f711773e2bcac9039f1a71975f8986a5038a32d9fc3de2cd5cdfa63c963265ab95a30b28e85edfd612bdcd33fb7062229b228c55fef1458df05554b28021236435e356c042ecbd38e9aaef31591624ce8bc3eedaeb0cc42ef67722ed7f1515937676dcccd210ebbc52867a17fee7693933d2bcd136ecc9210db98335f97ab6d9c5c21f770c47e5c10bc4e070636089c341f388f1691ddef47491082475be7177b2499187581e35f763eaa4a31d2e112d249ad583f81c7019e99234417a7cf01dba91d5565bf046b0097c4958928c99b76a3d25317a652711cb316a158e229d3c4d2f5d6c7e5aa29b4ade4 +Digest: 2c1182eee0a90b686a14e5c7f7bd47f89d44d531a53c84e88c459c1460ac7d2cc7922b7be672596d55654cb388cf9b3300a9f31f18fbb45f89a7dbee27ed462d +Test: Verify +Comment: length 7584 +Message: 85ff5f072442756665a41f36cb2c99d3152f3458bfc3fcb5cc759901c33f7311f8b41a490c7ee4b2b70ad84dc582caa75ffcc8ae8cf1b5c3f8f03410f393c81cbcb3399c00d8398d9ef3477fad50d434c0c6a469683178f4fb22ea0f94d498f45b6284aa0738bb1ea1c735758a7efda1bff591325c6b8c6f5f7282a6afe92cc05d2bc5182986b38e48ef6ad764f38e17e5f157b16f873a5dab4ac67c4bbacca94875c2916eaa69041bd1ae4c4499cebdb822be8da96dcae668117c3a702fbfd7a6a744bbdf8c25a9a3d6c97c315707bcc2f18e6f120584311d2e6d8726304f71fe2b133e83152fa46766821033157f3b8bc48efeb338af67520b610c76a5c29fd968f7c3632bce1eefeaa2b052bb8063990487e393ec95af900f20716776618bbec6b8f285b74c3fc4c8f2039732505b761a42c5ba0a7c325da2715d028b745a35ad1d72f3a2ef2e6d6a37b20960374caa6c844d317bad18442c1d784ecc4337c685f0ecb5d2001472363c64b02e7f5ebb641823ff257088ca15ed6b53221548fab6f707d131c6185c96c8c295846eb83369c5ee2cf20daa79c6a6de197334b558a8fb6c51a68b63b2f1a274bf4b4e839ae25256c1c9cba7d8a51378a9a9e6a769c4c3c23c18951cfcaf9321366965e676398805c591f3a76f1bfbe20aaa7446b37019b29b712e6cc337637103c8fc0a51d52fa04034cdd1c79125c4446026b9c015c3e475989c7b8df3da0e2d4e5a17b21e0fd23b99a14e676d5ac460b14329181c8affd2752770e54abf9dbce5c934227cef40bca8b746d718628d658715bd41eb36acbbf0197450a4dcc9b9748f8928579895ce4956e0a0fb05c55bc9e29ec5ec8f9236f1b8ae5869f7372be3f53f4c17d3777664c844497d0b154a5ff3f32c865c5a4e604e478402d9921a1a437e1624668fbee1539b5a053b243b3090e5fc2067ab082521665cd54a808f00c16d0fe71984ada8400d5cfd5e9b3526009cbf24762e6e287934694b12a9907fb735bec6b6fe4ba2d7c1d6cc3c2141288d3ffcf9528a8752a0d932cdf8b7287e6cfdab2a03a7a1b55fe050da9d5f661f7df63c07c3685b89dd7c40c1c54f5ce629ee5f7cca24b6ca2291528f49fcacf119eb06b69170f3b677451990411b369d36306122d12093ca66fd655307a11b87a943e26e834956c2b75d47a334c3bd8cdbea3986e1413e9b744b108ea1f6bcc975295897629c8c93e5ec526166eff99b6045700ec12fc12794a4dca8dda2969fc4c3f199f6109e134919c0319f46f3b30c688d243b9324540d305009844eb1f2e03934dc074e93282a0d1b7da670b2ba287b182f1515 +Digest: 6d87f523d51ebfc11fffb33357ed7ff3e4051f58a52d45fba208429ee5b53995e5129d35e3b8d3448a3f56d32dbfdc762a1458569c839a4a1c57b4d69251f565 +Test: Verify +Comment: length 8168 +Message: d43522210236c67e4981bf3f441b941cd52c5732b94ad76160fa16f3fc74fe7ed9a74f0bec7ddc77ae60f71a2bfd2aa7554828539fc0023ac7f49efef34666b100ef3df51743b76181368927bc203ef4cebd2c18d978a7e7f0e9745f299c800bf314d226aa0fbf04690c5dae200b3acde6944dc990fa2c3182e1805ec5feb6535a1ef8e8ce6a5c280fe95bf77e4684f845d471adebcffbe026e5aa42f0f46f53dc169681abdbf6941ad56b49ff5a863d9485820d137e7abc83fbda55d10714d12203943a68eaf51133d975eecbcea6667baf67312f8f138c422ef8dd91be0b96d4edd95b2e1fc16702fb612c092a4e39a15b0861688b2d1a0a83ec2357a2bd6a99dc4f2c2403c25e2e45174ce1f7e580af914de5e6f92f2c84049e6f4c3a921419d9ddf5731d61bd60bf7f957cbbd3014c571e04d061838b57b8f709970ef35efdeb6bfd42f5044e3f70825102017f8521b763084e4b90ff2ca7dd3862a6460eed1be28dba1415d7746006c69b4e53d3d6b804378a40be50abda3945d28bf4ed907028ed0301fa21a697f43e6d2cb6b51262e9daa9c775457b58f478114466c38ff2266544441df47e1e35ffa32210f17dbefb38d6691da74529f4194759035891a9c43da566e418a4fcaf5163b9ca50c0d3209b37ad1e3eb05623709b5232733f9eebbc4feeb954bf394c7ed5774a9a83aa4149f41be1d265e668c536b85dde41d8812b6a64037177def3cd23e7f9976d49478b363bcc2b0be1aa5f4013eb5f3e5f6fd21d51293876f18c85728e3f0e27ba18a9259648104b50d387e0e944bfdf3c9ef9913c956e617dfeefedf685c959059eebe8b3be4bcd3aca853ec4d0c5cb76f5e8eeadaedee3873353b9a6318eaa30bf99a81a94a238a777a1832bf63baa155be65b2cdc4fa21912f90126ad26c24565fa8c5434de359fc223d7a721e72622ba3d00428788463a8328ebff5f594a4b7757bde804c76b2b935261bfb693e5a3f9330676175278f36e299fb8b1eeea4bddf8625e6e248352d2774afb1e058fa300119551f475e04bbb4546d90aaf494c7f25a43fd8bf241d67dab9e3c106cd27b71fd45a87b9254a53c108ead16210564526ab12ac5ef7923ac3d700075d473906a4ec1936e6eff81ce80c7470d0e67117429e5f51caa3bc347accd959d4a4e0d5ea05166ac3e85eff017bff4ec174a6ddc3a5af2fcbd1a03b46bff61d318c250c3745da8c19b683e4537c11d3fd62fc7fefea88ae2829483871d8e0bd3da90e93d4d7ec02b0016fb4273834674b577ce50f927536ab52bb1441411e9fc0a0a65209e1d43650722b55c5d7ef7274fb2df76ac8fb2f1af501b5ff1f382d821cf2311d8c1b8ec1b0beb17580ca5c41f7179e4ab2a4013eb92305f29db7cd4ac3fc195aff4874ca6430af7f5b4e8d77f342c0f578f714df4728eb64e0 +Digest: 3e2fd51b402408073de5e665b81cd82052a11805345132a80f769f9574779081de8604f9a40699db3473fba4807eb1287dc2eb3e59763f21d81737b0ac6915f4 +Test: Verify +Comment: length 8752 +Message: 211909dedf08fb0d8aa87bab8d45f6894b458761625e5fb031066ac3982b3015fe25f9d899e934d2e97f196a86b68e031c164788b4163248358f12052a716947c5b59cf624925228d4f41d38942a5c185bde60e89c4bcdc7c8aa43e915ed3ee97eb03b610a6d1db952efce3c3d0929710f8718a8a265f9d3f23f4797e00976a32f001e41d3e05c2a6b58769f0cbbbdb540f8b8f14ecc7e14bc366438132cd81ce28c8dbd0555d92627175b8886a8e08df61987ea29e824342d77e3f436bd2efd9e3cd0fd2a335a538f14c52035385aa13ad2cfbcba22b3d84eeb0cf2d2263eed6cf82e2ac9e2a859aa38fe8fa0d4f298130bd68e89e0f2aa2578265b6eced19553a8f16c6bca8be181694dfc4fe2721b8aace6891f8baa52bd077b56931dae9d5b345fea9753ca931a90f98fcbcca0d1a69d45d4038ca3781b81510cc87b9fac8c84c1cdd5e52f167f964b729bf844636fc63b99bd49a5c349ccf1a595506a6aef815e3cade88013b8618bca47d02878ed1012fdd62c78db4ed2a3488204d8818b118060a8c48631cbdb01c258ba13b92961102ad59ce3693279ae1d18ffb196681d6d614de10919c2ebf47f5520cccd2aa37f484201b015fdab5c4ddeaabd548f8e6e6625a7d172a478ae2cc6691c5ef8bca57ea6c2a586b84ff3005d6bc360074acb97b77fa5e57a6c75ef33fdcb119c96cbf588498b656b4dbc5d1bab8d65d83bcc1d8bcf4e1a4bae92f02544a1901d1738d570fd29591c8dff8da2d3e1090b48b920290095b81f264d5824a6668383293645e646490bd5f604b87a4988f4a758d9c71a7b4068ffbced4fb68be191d7b30b6d738cb1229d72120429774acfb455753be5a717d1f158bcfc655bdb63209c00769e372a477de9729c39c3ee423b26d5a412ebe49c00e20088b87e1ca166ce5d88f0af7c227b416da632973ef442b3412929b16d703142021b375c6cf2b1306acaf05d6f5aa263494b9a5a008ed4e401f2b3607bf68e600adb6b5d93fe0aaa6f6526a7cb98f7374eb2fb74fdb7f6a15c28385fd6d51e245ff3dbea586e7824b3811af6578384a5c604dc4dfd18b2d29cf33e1846b6e9774b89106984ea04867f4455b3dcc45096f768c64dc8590f5f077a4ff29341f83f14c69044df19b5b81bd95e44220263f02a0740dc25211630e6e6f255841d526603d1e5e131a493a3cf66bd13f1e6c69da808d262dd18cd2d805eb0a9e3f3ffd260d396aa4232a62de314fb8611188083b6940447b8e73e3f1f0b0f57766a086d73f32c05da6cf73f9e0a9f07493f998c9fd35ff37e36714c091599c5062b741d835a2e5cc0fa8dc2497131fd63031a9fa9ec6acef7ac6c3d87a3d65c5add4bccda2f2416bd83709c2c7039d0250e0aa31e08ad41ebf239fbe1dd4d843c299661be9b979b99afa9b78f3040e758057182444eb1b221b0e06d5fec86a672b75cc478c60e531c283ff9bad8cdacc493572364e7fd8a628d677a49f80928c52ea5dd50d711a60d933a4cf4916986305ec56ec5fa1a327631d80ce6285f74 +Digest: 07a66b976af9b5982d5d776da8a7db28746161bd43a43e562c136357b0aefa7b8c33b8ad2af6add3b95cc962cd9617341322fdd2c07b4d65becc43a80f3df2a9 +Test: Verify +Comment: length 9336 +Message: 97a89d3246067de18c799589040075c9e0d2083280a2c7a944222c0c9ec66a196bca5b8b8376ba858ea192341a74f6b1eb70f32492b2c32f4276438adedba8ea56e66d2834c88f9f7264fdd68f0c4a5fe28ba6fe2d690c0e756abd211158ece70202bb51828566f5dfcabeb58a50da9b6b2c0908784e0a0e8605801a5fc6a0d614292d4d9534a6517edcbe1934c90c2f315a048a9ce926f61d5075bdefab2b803760ab66945db779f7a1e34cb5fe49e1da1d7fcbc1c2c690e1518451ea92f5ad11b11de2a7890135f12116953477fa7b0f7d62140d6254a27b129620770066244a236b0af83eec4f1565403bd9bd85c3778395adab5036f5929b9170bf7fe6af8bbe7d26ac07e08d0a744787ce575482bb3600dec114d651cff25f8aea96dd147c8b3b7eee6945b9785715c138cdcd7f829f8cef78379a7eda21e6b61fceb31cc4918e59e4ee83990914903142a85a8475c41f27f740ec435a30103b86add08f0bd95c01b61d02f663b5a21e116f62573cafa2cf67b73369f825c36348bd9c35fb698fbc8d7e2a972e4132d2d0aa4dc17e68fe2fef24d6b95b0ae9748d8680d63a4b0dd3919a644613c12793a5e2828ae3f5198fb8103ff82be669b77c8fe2397087c08ee9f816c9b93c6baab89d6b7a1560dd37e903d5f112c22b743e602b2746238e34be21aae9cabae55f32666f59b9b1316eab83006bb6a517f3fa81c4686329610f379b866eeb447df93bc2f6ee7aeefc7e261a282dbf97157bd97b13c471a020657df01420c6e01bc2fa3b6802fd2128ad814fb500d6a10d5503d482031591b37fb7a7bac70399a70098582e5ded519c44e5aa0faca3c9e7ca9f1778ecf90301a50e49e22a4a7409fc3da1aec7f087408a79b49ff9cd198b20d6c95d48c5fef41eaa5df312417b2afe0f9f5108aecafcc966f4cbaffd99e19fcf7498df218b7334b26b554793b5f04d39d97fe7d122b847d3f3fc95da50d291b39f9379b3b0672d4efc6f91e62a4433e1d8a12efe975c4ee9379b740d46443ca9d3b5de2677b652a897abb8e3e30ff630221da3df32d024cf4a0e143d8320eada9766d520e849ebe5c4708331e737df4d415d0f1cfafc11aeb4bf3d13104fe16d730e28490a0840300b27bb783ea63660bdc7395df8c95faefb14b736f4b8698bef159d4be5db98aff5362862f14243931cc5eb49321d54f6a97749503742cc5c94e4fdcb81ab3d8a0906929507f54d0ce8beeb88b2e23aaf454fbd06e2d75007e9e10f74e75e75eacfffc1b988a59ef3a81a02c380fe57005804d902fb5e3fb577759deb1ede89f7d0897d777d3c7c71e540f8a2a25bf41269fe66ec8dbedf8dc4086ddb2e11c1d8930d8d77eda130ae269a95cc22df580d00a42b6b9de179b85a0349ea20e164b6a1f1ba60e0bc02d1f38fa1ea0774cd18a660f22835ae545dc1ccf7c0fb35bcb8809fccda5e753902d487e3a35a01995be19981cb5c0dbaa57fcd3f06c7f40f07ba7d8b8f70b41f6b52ea24a0226d05ff3cb8a1fb1be6f1b81e6deb648c08a6cad7f5be241d61fa31f4212c8867a2592c3c231a60792142bd2613c1815358c92a5d6e2f446e64137f4392c3043287dd096b43b4a37ea7f5dc1d298b0623ccbf4fd650a49569a5b27bc6a6 +Digest: 767272f34a51e2ee0b69bc9d7a8b15f71c7f1d6c392ad37b4d2b43d8e989f076ff7167e368639eaad6df910eacf848c5f47979935988265bea455a15466876fc +Test: Verify +Comment: length 9920 +Message: dfb77844e75f85583be98d8b02b601d95449ea7c954cd81001d31bf487e536f3db399124c73d6e0ec25c1e10c381750157d77b13f2d464fd8275c3594acbfa4aeeb6f563caf118c4884e7586f243435a04a68b6c46b5258e5959e392cfac0cf740b80cc9998269c2b847f9b53605532d843d83513af7020aab08e568bd905442f8c63e1ddcf84b4f78cd126538ce8dc1ff24c98875a3e2bba3082fa3bd7fba733e69f3293a5ba5b5f06a285da0a6d9609ce4c7d9a0c1afe766e32b0b768226d13c2793b35cb45e3a4aa5a36615951f508304e40e635750d71f203f6791a080a5178b8684ea0a6027ab06ec483fa447dadd0c87ed656fadd3f448d581b5e2b037fa1a34648b6692c43d1669cbc7da3946d2851a404f10ae220de2541f8b4e9ecf0b5e061ae7cfdc58285c83b65540dddc89f604cdc8433b0e9376240abaef33b572de6270a74d262d9461a2d390dc1be42be7ad5d790f3cddae8dad0aebca55305822b12c73e85889a8ab2fe821b8dca5dfe07db70a7c99d885ae56e7c6e9ed8ae5b35c17f2a95bb58cc490beafdc0668ce6adca522923a4741618968f253e4094018c9f9cd9715f969342f1de34e83751f0c32ed695a0772092eae56181020f692d9629aacbb6f9c678173cd65183914fb4fe75889dbe9a0069e2b79df298b99027f8ec1351b51e8ad35c395dc42128d8aba63ae271dc61b60386999f0a50c39b991b43813c1a42364d7893ef1d2f527f3d50eb7ee2988293e84d07ef28c8a1fde973ec5ecb54e96b3f02c914bd2c92b5f28513a83061513c80bc9ef8ee6ef949a19933169fd3989c3071453934978e1f53c920191bc57212854bab66cbc22de15a01b4331a34b43bba4a94f7040e991de983ad2be54349a83e80c9933150b4576b33ec5edaf6e0ec450524c8bbe048341c4b276b2d596c8044d28618cfa9213e6db647d4427893006917a118bcbb1ff474961b5164764f1d00d74d61e729f8e8c9ff535df1584f2a8f28667196fd84c18aeae5692b3865e12b05abf92851a00918759b36580479cd3f8df16ddb361b3db7b0323cd20e357f0bc41e58f3bebaf1c1bf8c07f71b976ae2dede67e9e347cb939c7e27096652392bb9111be9dfae456e43b23d5efc4c86218189fa5393aefd96f615c221df30c2134b109c6b22fe6666988a60e024fd91641c908f98b595364a53b598cbe7558c5b00b95518373ff7532480fd2b243f2f33166ea239c7af28163bca15680d450a5b6067f0416ac75abc8e427cb08865b216f590dca74861259324cfb276cf63ceace0a8e8975c4912fb2c2b69f0b015cc7830839971c63fc13995330a788c464bb807f8988a8a19b2a784c84f6c49c3d0df6dd36319bfbf8d82139097fde260f4155ce39a8b52ddbc3a3e958793940451c4f3ecb42f9344dd050674b57760587a4d45d6692a64e9823ba00fbcf74d3bd1c1695c26f3ef84522b143c1d65647120b8695d7ee83ee1c7145fb36a17d3eed35d449e162732e26f7c93632a588d6f99ef1de566352f4add6cd41cf975a6a1d8d0fc2f1c3a0be397622a9656c149884879fa1a9991d48947ad93a8e58153e954f5268b939cb8fc6c8430223d20077faeb18449939ebd21984f14e3d8db6a19ca122a3036dfe8b1514b4ab347f565aa5f5e231eeebc57a831d9de5a2dd437d7cab09db950740996d83fe0a601c1e28cbca87ce7056b2281c6c666787f1c6b97b968e7838ae9aa1183da8896f515ecbb5 +Digest: c6844ef20c8d121ce80dd8a3cee4f36501003232dc3e71519de69a4cf77329ece5f08967517804941bb00d65a864a0e82df5b5452d3700e4cc0f5b539ced454a +Test: Verify +Comment: length 10504 +Message: 1d024b761257e905688412b42057f150daba54c4ec7d5ef4b5557be82f24992dc47a9678635cf48dd245d45f466b227931430d9c5b47baaa34f739c2691eb8adb556f679facefb63904b07fbdc6dc8822534cf97a4c24513da63da3127cafff2979e55bfff356550499f91ce0ce64a34609484fbf07667f650a0487b91b1d7c313589a939b179a1ca5475c21fc5d1257876b131166ea891c3eb669e8d05aa9e9d18ead3df5fe028f4e4d4e3bd45a87b345c264212fa6114e4aae27c20c4ddb2d7847760537710571e9b85166bd65110f3fa05f73723269521f8f694f6c13d755b08cdc3386f90b8921914ce8df071835200dec4e5817f7f0636116d9193303292364ca0e0d1d7ca09bdf260a61c704eb8e11f3fc09dc25f2bf2c18a63b35c97377d725dff165c07e02aac9146b2e3efa31b55cc3ac095a1edaf956fef9a290f954edd6ee5d593febfcfb1c4e27c32c2ab3000fec6926fd3e5dcfb82b7b01bf8463afc583778261af31d907ffbb0e3742b9fbf4be69bc7818efb72674eadac0dc4b24dae667678f914b4c72714f97c70ceeacf483d452327539b888206eb6fac9b554fe5e56902f5bef5c45ea0ce7454ef71df581d271931ce2dac6782e1bd513494817356c86abd3c71268b3198517d17f56e00289a003d79325c9c45394b981ae070eb1d0d069c27b75c4149ff9a75d2c5d9e4c2467ea6cf4a2774c04a60edd8d99cc1babf6d3efb38d3f54c6cc5cbaa63c16a7c94eb0a4ac58b9576adb3ced8d0738bb24814f241663c2bdb5859daf96fb2f5da1debd476450782eacbaab7a575839d864f847274cfe369595acd405a4a0d3b5d39e7a1dc3909a1af4cbc44b9294b9bb92e322c1fe6781258dc968847735e9f687174ded722208616797ed2ae7c49fadd7cb48bad4a48db5c665c1f4b8c15869e7cf9f81180dab4b2fa58fddfeefd3f45b3621da75bf408d6807471d0e4d0a561850d99f5e5a6a22747d132d7e1d3cd845af15e98abf84f49a3862c722e0e60545226110ec102c2c5da8dfe21056c4a3bdbb8caebaad4034847f7ab99c82d4bd94cba19c6937dbb313ad5dc45ba3529bede4eef2ae905c934f64f7bc233bbcc72dd5ff0a7ed85efdbe14f49a080bcf0afbb1a37d0d70bf5a236f41985f14866b39c8e524d2fa9d5284660b2ebe9721360faa1317805653d02729c015f9141bf1e02abab00ea580fc902a0c46264e31685258a688af48ff3f8419dcfa994461a14985e677d9e1ef4208e85eabe738e7e7eb42c5974151abed61c8fe11e6aa41c39d60d141dcb7d26b15296925aa5d2bfd03f1d60edf763f23e7bc8c208950a39e0344e3d6be2e11c0de73957c17c6e6f0c2eb43b330c1a4293e7ff0f0293e707ba4b884fd284f94898c514a77d57afe094fba724fdd39c0478d9990496f7b8ea2a8441c80c221430e4648f0df8d815d90d3e5cda98de67cc5fc90d6f3030fe75b3670132533ac079635e2ef7ce6e4e9cd75f5ba8be9d1c1eab5ee29b58c0262ee76c5d1b524f8c66a80a6af1689aa8c075e71a3bb98017500dd3af058b35ce6a291cabef73c0e6ad3511c99751ddb2d88b5e1ef02437e814d9ffd95a51f265dc1af0842b524f5d917cdcd13604b80b496a3ce06289251ce1a21be7f617868ae91f705c6b583b5fd7e1e4086a1bb9f087a50bf50f52c8143ae8b0516576828c15b924bb0c00257bc526cfd5bfe1443137ce33c3531ba16c753065bc24e95707e66a8626a9e49e100d9de8df840ff71bce385cd1da3e319444fba46eb0da747cdfc60d05a17ff5eb05d9d77c72f2333ebf95dfb70145091a1ebce50f95d47b69663e21feaf3ccd3b424d0432e9229 +Digest: b250f9455a5a90e3b7d2e2c7a70e42547b63550cab908ab514de782b6215584404971db76d6e2f2c604f0697bc309e7f53672b617c8967943a896ba260d65eab +Test: Verify +Comment: length 11088 +Message: ea850f0e319762b788d715889a51d30b160d54ab0de3df249c900d37ca0acfa2b311b24fe70762cc0d016dfbcc1e4a0beb189aa6b618ad6ca4cf48a138c2a62225e5bc9eb56cc2026bdeee35e86b83060b7f0a635c97dfcbab54f005f4cdc213862ab562646f8843ec951f9fb6df84e5bf6b2d48c7087d28f7478ccdc7d52b5b1f072302bcb7be76d64f899f002357914f0489bebe118d6ad1d1a560797feae438a590e885ed6b837233b29e8cde04f10371a82e0b5d197b811ac226d2750694192c837b87b89851086a240523b991ec22db12fe749228424f496b879a5f875509c385238ac14ccae01b673a8d5c086cf6694d98c259c3a7838629eb98e4760e52921d4855af8fd5416f01a7926e7058c544e362bd59f19264fb82ba95addaa73ac2d352b12b695a758e7cb2fa98d297d8935cc62c3bbaeb3bcd005c5962bb070a7b2faa66dde342c29f60c58c813513777f3e2ad8a6269a50272b3aacaa211809e4bab63c6c047371ca334711d1a1b3ea3013f88a433e88eb2f8aba562d15c18126fbdffb81d5d6c9397fa052321f5f78cd629708ba099b540da5451e949eeab8687a8d6ac35c531411cb37144ab5ff6a7eb46f1ab28fbcd2ea0444cd87c57bf7d3c02952dba3d3987da07622c16e7c086d90e88ad3d9d4afee301d2bad915d868f54197b70b23c9fa385c443404fbc9abf7e6a1fc6eec93140b03a00af0a76adc3bec7ad2b8f786fab02893e6f62a8689f065da033d785a1090c01143438afb4988799b0b4446d50be9f2edcf5ae28ba33b129d6c19aee4770cddc2fe524f1e23536f94bb2d9058c04e519e57b3b25d7a30636891941ee6a9e7a32186ad52281c2534e48cd54266aa45bb321a8128508188eed80e3d36c53ba9b6a986a532bd76967006daebfba31c68a6457253a3295bacfb485c6594f4bedb8ee778ea7f52d50f97783fd21a82a94f8955199bb12c6b053f45e6ada81985f5a257d7dd867ca9f911a516183d89d332facd5ad9e0fe223a216d4785ee98237087771dfee68f87fb753a183ec32d1ceb713ac09ea10333a4280af98ee6f539e4b4c1d5ef2e2fd18f48a390b649e108b16309e54a7fcff1ebd9cb77190fb51bbaa0c47a0ebbc2291cf25e2a0f404a092d66d7236ddbd8ff69bd1b4ac4e75c6b7ad1fb84de1deaf12d18d64eaa24cca0c7e31f259953a2beb62866df030c5f8b9dcee380edc30ecc5802a8793785ed62197e3e462d75b1b259c25abe63dd430eac0df8f8be59920d0676413407e220cf8a8ed11fca908a6cbd01536367d88b571e05b846b0304955b0ba4cf9bbb81b4ba39b641cd1529150587bed687f8cad177c4cbe0563f56918ff650844c3761158ed3a63b7d22a6b0fd48885381b783ca24f5956bf6a0785d93afd2fafbfaac789dfd25c9b5d867bfd89bdb74cdc199e99ffa23edf02e524190be90f94f0d48250f3f9bb11d40558ac1081f02131ef676115bdb2eeff1cc84aeacf449f0771f640b2170bc5c615659de18bcc6fad780b9a1a127f599f2cf7014ff64b18740177db92c0cb21b44537357521a852bf321f978536e0c9638414beb424afbbc711ab742e7d85b01ef3521553fa10a4e7ac080bdf917398fcb0c5e5afa0ded36100f5cceda3a7fb76ce2ab0065ba1c0a754494991c8c452cb416f18ab115509e28ddb2848e9be5e4c344597f4ecb8207eb977e344334f814fa494ca3eecaeb9bbe6e028d8a645631fa4272fb823e05eee4a086b5f67719f0a58bb6cc3a9488d6dca9931156fb9a451bc3409b87796d676847f345bdbd7267bec6792d1cdbedf68976af377bca79ca2db10988e7e6821980740f0b216ec9224be1dbef1c07e3a4cebd9c278037bb6539f316e92aeb0bad330f2030a9f2e7c857c4253ac2803288b266a30aedac27c04671afe7d6f2d2ca8a006fdbdeb29402e7579e3597aea2493d5a0c08 +Digest: 74aa96e89e9ad0f23e1cb37ed4cecc53a0af47a68fa3289dd2c91da6f8b0ddd5d290418ea43abf0f3700bef12ce62de3f9969d45f8410381153c5d698f1f4406 +Test: Verify +Comment: length 11672 +Message: e6e9e74abc89e6f6021a4db140520c7c02e0271d894f0a1fc12e1e1a736e9934bc0b9ae8beef750695134bfb8ce7df5391f4a47ce7bf1bcd1bf15bc639b6f19a3f63ebead25b30d43033132c66142709c36154848c9a2abcf181761e407b13e3593803d96296be67bcc3cacb35a28ca77f715ebce1a8e2f52c2495a7f184a717f1d40a3dd569c9c71f0b9b61615ab834ac6aebac4cb1e87fb223e1ebb29b543fef7d279c9399f6fd4353ac75520150b8349522dd367ce7626dc68171ec86c2613a7c828004f1ef100ee3258f6f62ff3cfe3a2cd608d285a744549dc1080e9a88bc19447090385c086a022f3822446bc6f2a1301f287b6a551e175f646cfb84b95c9b95f59f35e4ee3efaf2f6d36e3c61f8115741003f3f74e555ede1821527fe024c9c9699b130c972119554e8a91b12f8d4c9c3f6e6ac0d80576fc0b1242c5e967282dbe674e8a1ed9040d7cabdb0e3da30ad2d74375826d7650e8a60ef3ae201566e4cee46b37e99bf1d09e172a2db866e2b08e1fbeccad2c6f1c6f93ffa902940897219ef39695de5517195909902e5d56ddba5fa0ffe59c442fce3dc1472f777fbd4d0362369214b07974fde3f61ddaf982e28fc6acc54a526b4868e2f905345ebfa79e51987cd3a6504752539ff5742d78ad1c9a53babb2c7774a1df3f026f0816d7ec2c2ca4af8933f712d32e53cd850750a28675346334dcc97500a9c56c1e7b44596c73a7ecdbad0a9bed01972b72b793be3581d0d70e03cd5f0199ccd0042573828cfdf5203024087a0bba5e327911ecac021a0e9b0a64e6cc5cbf671f5bddfbd4283c2aee19216719a9c907572aaeb20886ae5c03dca8ac497c5b42ce87dd33eaa8bea7bae93dad1761be312df9d68a502daf27c5d7278452eb2dee520adbb22298e5f9fb32c150efadfa5a1b5931dc1f81ad10359c7a15852387a84e67320d187352a0438864e90ef91de0a3db393dd30d28a3f79f08c63caff92f082f788b38c27529084c80dbf1cd89735bf26515f74a923160415c1d05fb02d133c627e30000cdf2de11bda034b5dd70a8213dfb18a47a6724460c905d9f354d45bdc87b0aa8edac295a73ec442c8a671d0a3c6393a551a3a7ff72b6c006f0e1b298c2d9b53534a37e993c06acac00c52effd8d614e7b8856fe026f6b9bcd63d0ec9bf759c30337742508e95dabed1295284bbc908c60f7ad09aa1e6c74b45bdced316d52c247a960912d3f05adf8bf22c3b2dc2dbead6f29e716bfd651cdff25747418ee18c7a9e5752b4ccb98891ce1085c74a2aa09f9b1e270da11fbc05694c98f7f968c2a3eea1829981533472fba3f710c56191d9b2e40ddf7853a34681133a82bb0e8187158c350a94c47db0296af182cb1d2915f864a879f9ad5d23e85fbe8a2a6f23b4915bec809d99cec9d5ba17a5d1b9f0c4da2489659b89641dfd66a766ede7338ce0a51b84022fa2306f35dbf26fc46366c6a8232ae47432953eec67b16c232ba081fc448d491292847442b0e10bc90b8c4c63f8125afa534a3b3571e23b8f967003d5ea24f8df0a26838538fa2c3453a5d9fc9ae46588408d60f67881c2a8ee7bd4a68eb397d193a6fb61c6c647a2d6340db66df99aaa84df4e93ce0897fbae3472f2a4e18cb6a9766a5d0cade470fdc74645f3da70ed8ac06281f4ff31f4503a7d5ecf176deac6254efb5d49993b54c0120fceff7eadecc13b658fde172f7eee423f6fcda1ea642427b13af1cc7e55cf0f9841d11a78057237a2f11dbe0984d06008f98cdf322e037313486ef4968b448d641f17eae87f23f5cecb369d1efc7165601edd6c5e6e33bf95f7f9b8306fb119e7991c566ba476d44d60d14adc5051a0c92227dfcbcf456bbdbc2a7db86da533b75256e36e3feb71a364463dce2ae1d0a8b5f4a006abb915ff1789bbbb2f817947dd60288c8bf25c65483dfc60e6b243834cec63ab8dff3cde9c9008a50fe6491d8cb08c33331be3178f00ed311e4397ed4947810700985ee0bdc5cb02993431ad02e084eeafc8a41eab37a6cb2c063c4b4dce8eb58e04ea89eda +Digest: a598cdcbc02e98ca000e739872235834bc639971465f52cefe54304c0af4cc86f6e60e0292bc9bad2654bfde619eab534202675ef22b3b1c321fef534a5d190a +Test: Verify +Comment: length 12256 +Message: a48a4ae3ffa7acd035454bc8188419fed665629dc37eb21759f3f4b97da1d784049c763876dc37b11233f37612825890302d8c9868cc13140024f304c65516b79954efe32a9c61f50421dca6ca86c9cfc08f287e8dd9774940c9d6e290c26aec689bff0da350f14514f74c7ec9f6326490747d76bb0da65d21cae67d65509acb7b57ecde675eb048489d8c26963c5cf6a8c2d4a979d067f9ab0f68fdcc6770fbd972ff7d003066a7aafce4c7b9be0f2e0e63753f4f8a84c5e780a78a4e6fb2258ad28013f62cda0942fa9b89bbe612b4cc3da85fc5a3c368dc06ea4a72d029f09761b7c7cfbcd6171680fb93231b2f2fea3ab5316483ed8b92877868c0f29d050705ebc21547207931774a0e79c42c476e41e3deb393cad512ec9a0ac03ed60be2a8662b4f3581d698c5d121464bd2a562397c8e3b3921ef631e9859fb1a9bab30316e2b06edc1d65554d8f51017e9f1cd0cc66882debb808d04ba7cf8efb58dfa884ceac1d9a8226e0aa7b1629039d2b8a10a9512eb61319985489b3f26ed584895488f0860fe62eed1857ec11e89f12ae08f3d73c6d9aa8e8b89e0592509b42040a94363ea8a3dda90bc84b729a3f62bb19f862bd9eb9274fdc671cd56d14b8c71b92d5bdf155c3c2f92eacb194d88c3fc809bc48b619254c2477623200fc29310be7677a867671b9550d98656504ffba97ba2c643025135c45418e4ea89c43d05014540ab480580ac3d786e4874f5daa0d8c4b76b95781fea357e971e08f79338cac33d5180de725ba3f00d58801f69cadf28216ae3ae1a1c31d2c42354039c916117f602d69bf98ac868ebec3e77af0dd8f78ba8b49c2f429139f361359161f90d6bf32714e41d21f5098e6e74a5b4520a587e8dcfe965459eddad407349e85617e4bd260060e70972fb8044eb518082be748181fe3ec50b9de67928d5d23b92c7acdb6963b85e28876549d86b221c833c721cec0743557dd97ce08125d5629365ebd55604948b677c6f6f90bcc08f3fcc7bd736b39f1f8399c569b329f9634339c83457ad9a74ae98437cd6a5d4e19cb6b73bc7cafb2b0624ec9c26aae748888b6c7ed3247523e62506f811ef061a84414dcf0714fe7fecc31701426f46194ca2ff3e3232cba0f569e369a862fd43deb6661b5f5951251fbe6f217042bfdc76c7a8f9db9f45f1c5ad005905c66264925d29a835609b25855d1b8316e9fa9bee428f3938338a203d38854f8fe3dc83877ebffdf2f2858508e843af9e2d9e5d9c5bdd85b0b6433544549bd4ae8114aaa7614fa3ffd7b74f8fa6112e6ed6532b685aba66abef1736c4476a6fca67b1e0d94e0220c2d7d88b01e0ab87f0acc30c3a864d6391a7af2da45a19a84b5e5c2e058c00fea5b9903f48de39428a779408fa28bf04cba6b221ccd5d0079a2ebd9a136470c40f4789754be8e4e8a6fe6e27908837d1bfb4c91b2300b9151d9f7b2fec1e7afb68476834f246d300ab0afa72e4eede53d6999c229322f9593d783ff27602482a1782d885253f30120163dff0dea2dc11781cd23e0485bb5b6283b0ed9a57ffd986c07f6ecc1c20a610d1c6a967eb58930e0713775c6f25a4f58677274167ca911cc905facf26cd453f1c57a665137a62fe2009d684295fbb5c4a3ba85178cfd84164132e16a25f76f80b39eec2606c05b2305a6264fb92280197a579b4d336395d5b51148adbfec2a3671589641b530490feae24e42ce6744a355da150c02839d87466b31118d0b0a6f89280358b5ae80254ae22ed068226a1eb0a280f86cd621b78fb1394a000c86a8659da1bfaa6386ff8016665cf8fc66d825417d76f4c3b8c2eb73dfcbcb49257d9119f00ae627c3fb350f836d034dd16c3e57592c1cd4c946043382fb41597d6b863d8cbf0b43dd94d43de46519af20473624a27c57a1e9cd4460c17d04a5e4dedf78c6408c401a78e81227f9ae88d9e5d769e7ec379380a5369c29b587b6f253e74c3b33ebb53103eb3ccc7f247364e48c77a7f03f22247a55461a293d253c77483859fdac1b87c2480e208a3df767cfbfde512cc0e65bc92aef116ca74919957cbdb1223fdba5309916e29f3d7d48e3fc1e81f68f488d0e21f7bde458cb105aef5ccf46298e0feb58d77122b58d9eddcbb8a8e1dce13ea5c5105e24c40 +Digest: 10f9dea4b2b5fba6d63e37612450a26a3ca900804c0d3ab8426d4539a1b89d4da38ed3821232bd9ffb1f27c26418072cf44369e48b86ec8b4015e37cd29ce5f4 +Test: Verify +Comment: length 12840 +Message: b5033dd03db57f3da4ba033569a3e4fd0ff36b4bc630d2fb473a4d0300db4ba9719ef8f4d6e507600636b0d59bd6f4da53992807b6f8b1b8f9640d0923da13fe6eb87b01f0cfa0927ab9853ac16c16c0bb10b1a04c0ee5b9226a7a46de52b10f74f7cce1d49bd13bcaeb8c4a2290d31711010e00d09bf6658af39ca3786bad464b03f57aca7223c3bc76ccee0868b2481b13450d8ac66a23f8a87c083b4c900aba85feb6197c1d9219ff4d0fb91c3bb9a2ef60b1c1b8cb5d3630215e6d1ee2c28a25ed7b0be04710a83118937ed5f6d36d3c66d2bf98a07a0a35938b570829d8838accb3e6c729a633b134649fbb6cfe46a3605aca8f72e23d5cdb794133efb36d5da245f3584cba802aa96864f524a3f3cc55302bc5c8fc974f000e72c6bbbb104578197abc37b65942808915aca6283d5e4d3c2a612a32dfb60a3434ea165834eb5517c31a720084a1c0adf9077bf7ec0251660e8c20ebdf3802d2cdc787f2a0f64127159b8602c9f071be592f2a76c85f6796216d33905d7eefd0868496f11d0f4531ba67fa22f2d79ba37d4b3b0f981e9ab4a92dea872230d915a74acbbd73de671df8a556cac5fd4744ad84372926e6efa8eff3ce39f6f5c88b7840afbe6a0ab1d3187d23610c0b7d893102a52b3860705a3be8660ea075c519418fc95dc93c2b3b6118e74f8da8435a50ec0d7f973324b3d5333a6fea59d7a7495ea1005a1bdc3e1d9e2dfb117da39f546af78c0b08139904fed2c29a49071ed9d6c011e350ccc292377acf5f32a44083a6ecba5c8746f5116eb77079ec5c64391fadf62d8203b00a095832416e4e2526c573715157c4b044ad70e24febde62b160f019005a8af1cb3f4e8c7dd9aa3784f21519b32195b0e5e3857fe4ed950089c112e02480686b1dffe546dc1cbf5ce753591a4a8cc2df3c377eaeff9b8a27086b9ab5609ba5084a71a3c626df967d9510c7ddde41522491d2e4d96a9dc4bd778610ff7d534aaf99bf137523c93583d752e7c837e74d662bdc3f67eb9a4bab1e39fd2544525d48510ebabb9a83a654f54142441c27bc8f537c15c04b3b28da45ade8917a3de9babb89220155b5f1da37045fba57a9a68651daf04c51276231340a59aaeabff3ef1f55d2ad1a061cfbe5c4c690ae1413336d1f5772c70601973277d8d85b7e85cec59d5229b21e31a146a80030ea110b7eef73d39d73820ef6891cee839422a63ff4872bdbe5a637b3a3d99400d347974f1efdeb321f418f357f2222135e545f2af53be42d7a463719447e0a6a305fbe8e43e6279a91eb8f3c5db1fdf081bcb77711e205863ba538bb71c0ebd4cb008923a6550f3d922913f36bf00683c501b60f8da4164dee6c428172c7bea86ad3fef68f732c83e9a32542f008c532f2cb64d8b4a8a0ec5c425d538eba0b4dd67f28f0466805d56000cc113621c266cfc4cabbcd172bca4dd092190fc15b2bd7ad0cf7125b2299bde81148836186882592efa01f183d4f89bee8bb3b0634aa3405b4f43d740c39c905facf20f398febcdddb70f3d460e3d7b368215bae2132b72e27d00ddd4a1b4cfc928e55fd80325c4e971191731bee00571933b6e4a72b26d16d71cbbb64a90e78de6d69a8c78acd8c2a6d411cf6d8cd5303da96ce50fd4a958fc1be39e349d61fe855a61bf470d6409c6b4bf77a09034f2efc4194a310eb2394a7307c4e656d99b72c527f8f4b4112f6f2f62d2eea6df2a382005f28cdd122840a67af2d649c8f53dcb6fb2083d4a93fec8ce69be1d2e569551b57689ac33b67d4acf809ae29a9c54b1ab8308058ae7f4053494757f9d0885bdaa3eae08a1646ec477f68abdc8e1463c5dd46a994c8bed6947fbcb5ab59097e856c3608ee5a283a806dd5c37fe7480a0193eb6852a0059696af8261b02bf3a563d9d578b7b016a69fead55ed85b6a2a1402a62458de5b68a3021fc5d0ec4eb8bd134e9aadbf1718eb1df2e4b19380aa4751ff466f29c93401a01d47d345229edb4129d598303378ad2fb3bdd0369572e2a97e345f2956e2f9b0045180dd7841058cef903faa72ae2e48a051fdedae6a2d31ac57f0870a5ad35b5a4aa05d5788831c27356bd6dda2b38e42080260d57a70121017eaebed84d7c8a99afb6cc85b9c18592be45b7b3d872c204ba636118af27333dd14fc08484d2078a859b3d2a29aa80eda72e35565f148c380b0186b82fc7d9b0f3763628f7c8a50de82d97d45c3f6ccaadd137103380bb111e9ade94ad657d2171bc8033fad +Digest: eed31b1cf35dfa5d2afe01f13448ee3ff01e89b6da29d36c93d9292ba8d142f96945c645a888e6a13e22532b6e3f7f434d4ab47e791bf3b0159a9b70d4753fad +Test: Verify +Comment: length 13424 +Message: 48645a050dcd38634f2edc65bdcf79462f72e06324ef96fb6f1c2a332defc55dfae7037965a701fca1e5b8d17d82899e95fa1848caff5eb9f161fae1c831c8fa2e26b511933fd2c2adaaa7436ce5c9a43123af543bf1c1e86119b21807c7100a4bea19d47fddd13cdc4751c1744062e069b54a905d0de60f290cf9e0d2f8c415b9fbd7ca11c926f296825f567cda7bdaa6779402199bf6b6b0027842110e0da1df2196fb324afa6c442579076dfc3d1b513232b458e218655ec3d745ac4f12382724fe70c8aa75334cf646de2deed02ad0aecfae002b75a59b16bdf28b04fc61f8cbb830bc2fbece18be6fe2a5f85b8f8db311f6fabe34fdcfc5d24f9774f2a5badf6c43f722fec50e449b1bbd6206d3ee09a0962fe37ff66296bf67b6e91d8ad629c1b260cb5ca1985273925e73fb7d5d77259686e27b16bd522c3fd1a9a49ab26e6084de7101e81dae9f4e6e745f1541c748fce60252e846c1c0e1d1fdb05db779f1c15b5d14250521c657d6ad5d2302bfb0d2398c2cf166aa24549c2d695a4d111b71bed8beddb77390b67f661a300828062066c830bb85d600a01c81f619ddfd869def28279a9d6ca77250e7c1c3bac9f1ec55fe87cd0c0efbce37418022cd06db4dd59576e31ed4b09330777865826c1a40ee7658af6118bde4d7b42efe87f4c2875a69d441a27256220960679dc7d728231977cceaeebcefede3232934718fe25565ea683b910f3e26c2e8b8f3f2d3c49ebe4b0b051ac439ee43d6984cf59ee4bedf625b59547313a7435890ef692896b7c5383c884cf642f1df15a4ce7aeb6fcbae17d42351667bae74f81a1a959e4578168788fbee1cb3fd9f287543683c2c82bb52fc22f1b01e413d0f7bfbdefd7ae9998016e767fc331b6b563233265ac3edee5afadd9c18a66b86e7de1bad0cdc11376a0fd41f5f6b522be904241e0ddb142f79f7dcbb68b83137c66900689414f8d68f9a487e0c02aac72712a0b71c1cfd67f51ba8b466ff9d38f54434795dc9a65f35e0cdeccda12b2759852e595130b27c178dc8f1db20b671bc983f462fa424bba508ead168f0de33c684576c72bc3b582776c4d88ec684ca628da739d24d79d0273b2895a696cad4b838a158486b9ee16dfd25d34997102c314af6b80d6bad8802a10da04f3cf7f075c896869be2e501304b7249d23b617d6ff8b32daaa6c9ca8061235a2b896e70465dbe5c33cc189fba8733a2f25b7fa765be67ff6fa8d37de7a4f22c0126363d731fa043d7cf3da351daf145719f73905bc599962516d68b8091017c9bba573d4435c4a451935ef43e6c329c17ae44229834d15a949bd7db9351d8b3bfeeda5a01c8b2e567c1827cc964810eac31fa43663498b383dde055680bff3a366ac67bf1fff370e201b22239eb6303f7cf9edd0bed7409bb84f8e146e8ff77c8d523885d030eab89faf5ced82862e3c13137d7d086f0c40539286777105ed43cd8fa688dfb8b0026555368ec440517d2fecd19fd28914c27a477cf41aaa7b85c1a5205c910f3d67fb9d4d9be66d405f2df698bdafae109e96ced01edde5f8bee443346596acc945ecf810796b75816e97c1115af256764153992e6c2d610b4bbfda5138430a1a4893f61dbbc5f18b27e7cd09fc3d0abc371b56f640ab7419d8beeb154948bf76dc8b07c3d77859d427b88ab115f24368fc7868b640bac7bad26be5ef1cfa25857e5cbdb1610516d2ca647ac53cb498f31dd54eecf0fda454c5316b5d37e9e4bcaa637854ccfec12dac762da4d4f663e0f7bc8a18b5c6c27e2dc9ebce0e8a6592ed59c82c9fc7e14b2a8803de833a3cc936b89ab823a88a9d787fd7d0157e308eb38a4db73df2ef91e104ade0abe29c0247440149af35754941ddc001f117ce36998f59734c0254b85c667c49c3920a2295d95e5bdce00af7f65e24b205f9a6f11bc37bef3e68b914f9380f787ecb0fb0cef2f25d212ab430129b868ee896536496e1359989a8754e33f3d80b11fff5134f2b7dcc1088296832f055f6fd704bf7a74306f0a24411bab924566041a382f092ed41272f8aa326b4072368d91a0920d97380833cce26e0e5441b16724811af36a2fd0cc294e9f2224a7f72efe6038689fd02cfada92d5744cd86ac187029c5a70701db9e5946311a34baa3c676d38f554a2e4479578d94543b398fc89e53ca6063e022172a4089f8506559e14ee1a1b7e56370246bd01ea017a43ff734f833ff54186ea19a716339182023c4d0c6741e4942e143588d6c94ed473b28d6af78e0422b1fd22c513379064b8fe5aefa6d14f03d063aa02df4bf26931fd1e5e22f9fd898b42d52589124b5780cc82be5f32874b25d8ed53a4d8b4e284c870 +Digest: 72db99e7a99975cdf4792f4649e2d08a1beb53bbdb7b6b186f2e7dc03abdd649c43b3b1f43b7cab4da8603eb6327e9595f186188aa798312837e61a4276657a1 +Test: Verify +Comment: length 14008 +Message: 2109959848fbc919af4f76595c42f41e8f61a908f8f1da17288dc06d4611df5503b79385cf80eca04ed6bbff056fedb15a7418c0bbe354b61d324c60a83595d2b0413eabe892a89bd2ea97227a7b8a9a64074877c346bcceeb880214099bc22912efbd94f9f8a51125d43249222e72e0976261b478e1b9647cd80b10d20c0f60100839c86c7b8c0a2edcb3fc654f4e8bd9cc8a00427ef482b7698fdc6950238191d6d9cda7e3058ed54943c3aba8c5a4148febe289e3142f8485b501382fa8937f9fc62d14f8b7a6026509275cff80312ff1ade2b5d9c274cb72a506a571439fc1ac277019814b599d762eafe01d263d123bf8882e28a658747988731add9eac3f45251c204868b08ec5d9e4a0ca60cda5b4f35d5c9867e368e286d1fe3c61c2e1b2e8bb9013b7b1bd9a334c02cdd6ebd0a6c7e8a8f1ae1d8df5c6a7b95634e98f3a97d4d1abe066133d64716ff02f9e7b579bb178fa220fccfa717db3f3bd2a31265af04bd88ad776f593db50f914ef8e109841357c6cc00e38aedc53dba78cafbe5b9666615d0bcf0be8100bb12ce4f119e61f4840333839f8a64a03d59818f14abf4e8a10030a07c78c9a0ae020888cbaacd3170b2080368280512bab38d5df12b1a11fab21dc0471a701b34e97e0473b13e60ca8db9fee1e6579312331cb625e57158dfb628ab05160cb70c23af60be342df8edd0b9d48147d497e0628026075d9343cc86b1af2afe082a806b1d1befc6146047458832babef497a1bc883c2a0608694dae797b1d24fadc2e0a3794acc9aa4d8336c58812ce4018d2cb65571271492fef87c06d703d4d52819b8f7959c138071e3ec2431df83fa20ff9d8054521ce0e0ecd2714b8a97814179995289b3f462374c83ef230cf5bb995e230d5268a0f8a37c92dff5afc13975c7ee920d5b66d29235d7c23ffb61cc620ff00355b3ca63b0716459bdba7a862ccd5ec008da9159ea6790a46df4f0b6e1daad6a4479c0a86e92efe68bf2e9eece5192e264799c7ea7ab579e953eca008089024a0603aa4f44a9dc8e47a037fbc31c32030880afca31c7d4b79f221632a6e296ac8599b1e09c7cd259d90c8b3574f6e528dc37f4c4f183aef773e8fdd5baaf1297a883fde4ddd57a50297e0e2347a6535bc8e590f44da98d66f9d8a67026b61d145708b5e36e7a7c7a203ee84da5f625a3b4d4aee2aeff1b0d1a39398b51c0602a7a710163b9337fe0a493403bf7ac0309884a74177d4ffdf3bc55e0aea39483e1fa060aee25ca2b889ec73e76a39194932c900a1a205fde20c872c16284fc2d41bd0ff80b1a052a7cf7200c85136d814b88ee997301f7649d27d9042e5cbe0653acd4f34300ae21c495e7cff0ad08713985ab49ab86e13771bfd2d29b93a3b71eaf9d221c408bbb666263b240db290d640911414919e400a47aa453309173e8aaafb1ad2040659e6c45dedafc049afdd4fd66aad521c7673f3f99ae75bff640009259bdd7690372dd259e72ac8f21e8914af3abd706531349f5f70cf283f3682742dd7ac8232fe0c2ececa0d8e68777a4d6006dd82f50adca8607943046340827a5850b7bd7af8f2281108c09709351148bd518600686dccbd9116fb6717fc709a5989878eb4c2905cc5260c6950f1ee950b9d3f5f2bc4952d65dc40c6a9d4dd429604b48c9ce5374b5fa4198bdc1882b0cf6c6215bbc9c6a6532bcbb9b56439018234a72d7fdb775244f5906507335e3a9d21a6ba94c7c186eda7f4a6a7151465c2abd7e7fa1fd13019ad098b6ebcd190e96f75b45359166d99b344141b81efddcbdcdf42881cd533423ced658f2f9d32389847a953e845b8ebe032987f153bd8024a15d3966cd3fa5327a499c4f611bd0f5ea4f0231fdff768a1588a4e5978e30a663411c18a8de3d0ffc78ebccacf8fd205063f5d5a35b774992e9005c9379d48c3826385f0438e2027debae2f82739253df3cd4f11f767a41a2d1031eef85541f4a96f5038a567d52252b4b418d9277d6bf64084e185968bc6bca15f252bb98a4c118bbcbe13ff7481bbf2cca725f95f11763fab4370a2700185b9ea164218966c535f280b1fb362c882fb792dce2d2ec0fbf11ea2493a155cf0d06f4cec20dac7c7302eaa4932446930456607122170ed102b4ba86fbbc05b866b5b038a30dbd115d54d1600ea8dd65c570fdd9274da182b34dea064b6257fdf013a049ce72e2aa784efd8d74a93a25fa6c32bdf95aeb4d5b43434b8a7a92c333898baa4a2263704e5936d4ce11a6fc2cb4c5c5a128355881fe8dfec0ecff35b67d38031f07888a66de43dd23c76712e2af7e98269dc6cbade690c6f6a0e678015870fb560899204843ed4f7bb3c58ea4c527df90a3e8cf6863134c337d8fb79c83fb3af50cdd5c7df2fcd2debd0a98fa5e8641e721e18c38dde0377f6d41181064a16907fd9d648c51381055cd7c5a6de2656734fefa29a8bcbd30 +Digest: c69d1e7b32f7300a89291d2fe03c63b4bf50c6746003100ef82cbefd20468ac8536c697ac1cf5340ab21b15e80745665516e708f028bb37728e2d13440d4b384 +Test: Verify +Comment: length 14592 +Message: 97586b625a8aa48ba39ed7e0134446b480871e853d00e6d39b491d32afb51f9f563e491077bf5d4f88642807545e621ffbdbd5483a35c2d2ec6980c4d1cc662b8ff9ebb2f60e0c738818ee0d39cbc5f77377f4145d3776875d6c7cc8dc6957f74970997160de77a2aca2721a4af337e2f143c3102f6eca99f5385a6756f6bcab8c8b9b753c966782fbeafc54103f7f887b278965374388b1bdb662c8c9da5bef603238e512a0a4bb7dd8d4e6121567931c0b903afd1c7676bbcedb14bc7dfc69ce4db9e96b63f6f63a5541f6d8deb5a8d9d71eb80a625e91f9690f72b84769c4ddc466abcd4725db3b478cadeb033271bc737c06e57e06a97f6d440b44a069a6967f8750c3b4f8118798fe32d2eaa696ccc7f24e16d6366753c4c306e8f0c3b8ff676403d2123941262eddae15fdd9bf11bbc7b526d4b8737f54d48c2c9f40a1236245ea84c9ae1221f371483da39293943845659cdf53740b07bec59915a8090759712d6041202d7fcd0429d1439bba5c24b286005ece12fdc3cbd8b6bac39ab53531f5eee3563948a6dc785947badd7169573fdbbbf2f65f7241ee0bf758fa34dccd6ab7151adf8465425e5e16b8a4dced7cb9b45d87c838fb692e213231d18c388db3424032c73cf27e0367185cb6a49a691c13ac552f91468bc17fd414c8c630b8f917cd67987835d88efcb570bcd156658f801023d4713befceae46ca86e8ab9863bf2281fa3e169827a555ba5d6c0bb93a84f1ba5fe0c2dc7e34ef1bb4fd93731ac1a94897987d05f8eb6004427ca0ae46a6b7e377e7c39cf99b36cefa0acf9245a5c984148d526826553e141209fd8adb6fca64c48c2675666a85adff19473d0df4e9fc1c257d09dc6c57b2761c0a9520669305f0d9d3b0ed2a437e6c31e3bc9a3573795569e63040b614a816bbaf193e137890a0d6b294b862d70ae85b8b5613f0cec3676075257abddbbd99f1d45c5dfee2cb7e8aac6bec9aab191c9e2754a0ae62a2fb13132fb30915b8a8c361a7a3b03a8032fda77bb45b2673b0029ffe6bf597deb988a69813202b62ea3b3e423bb0e67564378c0e362bb0df4b8fdb9c9950d53e48c917a6c18c8383086053754b865073bb41446a9a95b126954ec3765544848b51de4fa2e6d587e3a93a8888fcbbde41df22b6d7091e9110384640d4c55b0c8d7bcd35d4a9819e4976d2c6c275d6faa979e2c99fab50b965d97f38fd111cd50c6fa0b083331a2f7e162ff36ddf5f0b71318a6709a7b28fed2302953a620f47d0d45faaf8ab28a44b3259f9cf61de7962ae20775c25cc7c70bbd63dd3e0bdcba053100a7c3a3164767259be3024dcab4499afe0e14f27e9b54c031a10b2adc74694bdb85508bfd7c77d362cda4fe10bdf993c8ce04b4a3c857c9212380167a5883e6d9bcb3c596508fcf82a140b7300fa57d162a041bddfa8f38a0f95f474cb2ff9299d28ff8876ff96a89f25801cf25f7a754a6b5a0938e65af3f86db45ba3036ff8a5b278d27275f44d7556d56349d4ab312c87bdb5b10759d6b50968a493cb45e29cb3d0c2c133beef93ef33d06e22920cf03d9449b0d2973a2db139d8055126ef68712eddcbfe9b96e138c1ecc711d60e7fd5044e9f10bd274aad4f7e605bb828f235bbadf9a1334b4778a83ebd68203fbf97374be58972a5f344d11e0cb2a39422469eb9b1e22f15adf90f4fb9f117a899cb55c8ea055fbd10bfe741711e903be1ee00895c8b37fdfb011fa521726450f5b8854d164c2c768a66bb6ef7662726157309a66362f20a19d9ffca5eb4ae3fbca7f063d12580d94781722d06540f5ca71ee0972c300944efc9d946d97f9e7ed4e0be91835a03ec3058370606aef1e58037aee421bc23b36618d29ff99adc1427ab166094b15eb92d3330825f3d74ca86069a16a9d0e9606410145f25cf0f099c5020576cf339482759852879c94112a3d2cdb42b320352d2f7c70dc7e4df661a1606fe73e83b9f04135f80bc1affc5bee56f4611ab18919916123246a2f6328b47eddd12570dc8aea9e61391f757ecbf85a754c203d0269fb51e550ad1f975d629ff7daf0957cb0b6341685e29f18e8dfb9d67a602d518ce1c13fe7b399337e3056465b4c7c0ae058899088c7974b3128f7a062570cc6f0d9218b601a16a819a22441d8757f07b8362157984ac8963358866baa71460344360550304d3265ae3cac62e9281903a6c37de45ad8dd7a7de30880a94b7376e5acff370ec9570cba643121f3b0f48f1aa501bf36ee30786f5cd097e5421f92539251a8221b0f0dbcbd65178ecc7bfaa24f5f50c3175c00963a8109e4f1a4f61c8aaf1c30bec4d923acbabc20c739e6cc26e94175d0cab370e09c6f3ee6ae12befa8a1ba12102ff8db6a478303d98c406c021f9c5a706f18df37530497d8568a966551ef9fe6401696fa4e4638c2322c0afabe248f69b5b4be7cde59b32e5687a52a2aeb183425f354c5e79015f5373b849e9b3666bf2514941e8f7bab328b29043f5435e7c38997fb113beb013c4572c236db5a4639663f47668ff1e5ad9a789cecf655725b120b752772de645d01 +Digest: 19f109cb86236a5ef1eb3064413da5712989d87ab7eda21313d72471ad577ada2632cf058a554cf2512c821a0638dc343d62744199c2ea2507ab0fa09e740faa +Test: Verify +Comment: length 15176 +Message: b8fc129b4d456a3fa1cc832b81859386066bb9cb556849ca897565f0ee02cdc97098f7c353bd63352418299fefd5d434b24b729512dcece04d1d94e97037fdc7ca8e0f93a0a05a6c222fabbe9ea2ddc4f4a9f24c4a2063bb0036b350e6ce4aadad2581939cb5faed845a3210f6b45941b3cc617764fa55638c06ecaeba8d5e8203a6764bafc6e8bf33e1e61c60d2eeb0d9fde69fca336ae1d7d6658a533dde4eb35915444299cfea160cee6a42c6441b4d84a94be3934b3ccbed466c19a67519a5868705bbf855771422728205560489f7a9d30317e1a07c4f95b8dc748fc9ecc175f31684a9226d176d9ced124bd603bfb48c50cee710aa4a14e363ccc182ceef6e82000374dfd406339232d06c61908decfbb8706b44cca6b3ee88890549c817b85c4aa22334b4c8bd7cd9a6834e38499a49c56536e4ed4aba01d41321c6e1219ca87cc87cc8164753836afe564403db069dff161097121e7146ced3dda021f5628f1fdc4944016a3dcf6e3fafecfa2b7820ede9c005450a1fe2fe2f037f907b5238ba48504f7e19c2876dd054ee242238fa174710d78df60e00ec90590d379cb3cbd5735a92943c2bd3ed1b0df18aa68d520599c6b5f3ca84c6215fa9ef1d3ecf72f8c52eb54bbcc0dc7887a49d32a0c1504045ab467d6eca5c2402b9d04a4aec53aca6965fab7fc9ca957cdf9c26f91a1e4fb5873335ca28eb7de35156c7a95396787e5838bd6e8ec5cd6288936e97e1e1ba4f222323c7e59bb5683b299b414c64e5b53de9887157f4a6a2652d10645dc40a7d43bf4e4b4b9353fb3ef2cefc1ee57ab30d1a14716b7faaa23f101647d8ecc6a6b4afbe3fa0fcdf03215969c11340bfe190726a54138f61cbdde48727988476313b9a7b8c2dfde1e8ad057377719e3ca58d9a9104974c528509526ceee6b2a288a1298e183abfe211aa9ff40881267a68ce3a91673fdd05398901cc830a9ed312ad03fecd0f6a6ae8e0cef55b8b01009319f97367526a024d269bafce4c72903729d0d392f325ffd4163b7c58d756568c377f3eeb1a1dd22ba8c51eb7f453625fdb3a154e30182b3d168e94e7ac4e05bdf075fadadd1cfc39d7291f26496bd0f28de7cdeb0c6c758ba66e42f05411948c0b83b01ee48f08e17b6fbd0394e26258057f0350d04965278f83905b15c68b635250679e779f7e8a5b3ffd361de0a0fa0cabbd65c3d6847798768510389573a98b852742de73e79b403fe9a72c8c133e691305122f3c59e48bef29f804a7d2c67fc9f8f26035cb7ef21a883f090e428de65ee23f5aa26dd72f9585f9c3243322f6c5e396460ab09a3976e2e4fc8fb55049345dd48d3146b64b11a0fcbb341b25b821ef16d91c2057ddfc007f4c37f5ed5b3f7cb910116eeaa80a83ea36fd14378c84255a5e93a21da553e9f9422d89cee42449d72b696ddc0e2934a97aaaa5c03b968b4b2097bf545a23a538269af959ac8ecc142661c9f34416bd23cf6157288e002ccf664efd64c4163d2640a5cef87a230c5948230c961478253e7f4ab0d74a6a0dcf77e3e7b6abd2b8aad7778f12178b118fdbd4bd2f44f875e4d18f3a353a7b38349c7c02b0d7ff1eab3437c40e4c6fe39c259f65259d3db4fc0c557dab25dcb4e41d42d8bb10467813a00ef656df778b6a6faa8be0e7f0ea6e79c7009fd23589c9425cf0401d4fcdc96124ac51984a10df001db7c8eab82022600a4b7a0a2dc0ca53f2d2a5c7c125b5bfa06e6741917ae5222172456d3e5dff0949e6a5956c5fce972e0754d64488bf04aac400a0f3d1631bde42bf3a29a9efbbaa5a863b9b71bf573616b31282ffcf766c37847f191e40347bb29e17220cdabf552d87c462fb84db32872c422091cd5f0b4e5ba4aa6966b520474acdd18fa65e73ea0ff76807056b4be32530c947a105b292eed74fb8bce6f78b2b24dd393cdd2c16859d569c2a4fa8b008a2232733b18789a3e2b0152a0e2505a9e3ef138487a73b537ed3c3dbce73793c61d63c6baab2bde38c74879877d53d2dd4ae2366a30de0e06288830031d1c329358b8b323a5cb6179c4417ee672dbc1dbdc373cb78858e94111ce481c1ec1837e5ea1e6ea7adfaa5dbc7cb14275509e367d50b994f38ccd75238ee46c3ecffce3b9afc093acc13f711a6adf3ff76ace59a8df1ba704e2211ef84aa3782f90156fd442de93be289730588c57136b82e8d1d932f1423ee18aaaea71f3d4539a537f48fbaf8f216e2838116197716421642ba8ecd91b040370a584a553e53d773d9e824aa1ca691a88e4bf8b4eee53dec6b3726d1185e6d069ab5145523f5f9f3a5a1aa053fa17a62fc2cd59bbcecd039725d044590779d0ec08cae26d573c8ae01e6cad34829fa9934ec55d8cb732483bef4d030e341f7d5e5a6bfd03b156b2b56802c1d1f8739d4a053217101c26055b7c4319bf805a4e572ccf05c3c230af20d3877ebac035e9ba729e1714820ad34c594d08db70accc6cdc4e9d1c2e4cf8c8cd45343d7e49276b1353cdd87d733aa502e550e089a95fe60565137b4a1e0803d1c6a2f8874fcee2640dbbfa62d193ec0586726d3fb2a17924cd197f9a2655687da61b6a7f9c58a6f12661e8c6b88797ddbaede0076b199ca6d10f87b2f8797d1d4e3e01cbc14d3f273840323d8a7e1ef7fd43d7753530a7280b76221 +Digest: d1b2db67f3b0539ca9c4cb755343efe7076e0c28625d3e63e98b864c98db3184cebce0f2d4fac97c36920f7c6e29ec3c801986fe9b30e2eecb4b4e9b7707d755 +Test: Verify +Comment: length 15760 +Message: a23675723ccfb3decbe4652fdde21951fd2f660d1f0473803f7fb8cc44f4090d2a85d08f60f29a3e6fb2d55ddd42d77b51bd23a3f7ade8d42620cbb041ffe678db9c11381e8a603f6db1edd248a1d72270278a7b4c1e41bd8c88ca100cde89d4fba4c0d73c3f0ecb0c0b35f7e6a9202ca39624fbe6028625b7df3d536e38fa07d3c466d383bbaac996e835327e00b9833232778c8dffbdf3f04cade12fb53ffbab258a94bba33f20516f76ecda4ead0d65220d9708bdf00f7ff7a12217fe6296cbeeb482aca2d2ba86c97f8ec03c01b4848f6e8220e52660ac09a17eedbb6bc27a486c051d5e6d7e7c1dd87ef971bf5ed6a020b69d1f68d0bfaa355d7b936066015b3b85d87f17547d940a264d96eff5a47ead9c4712bd46ff01e627872f4b6aa84ea86aa3aed924cf569ced8353976036509d9be5672dabb6373b44da3733b5b7493c1c4793bad6bb8a163a654fc187d43f761a41c6c0e52a73bd1c3c52213176767d038cd5c25389590177b9337452c673c28321d57fdda3def21775281cc52dfbf587391cf98181eae30b48a6b9a95313083d4e3f717b6ba0649e4c622c5923002c1118126849eb66475eda519774c547d1b090aa9ea8c9e09b178aa859d6a1aea907ef5d16930ef4b2d837dc169b6239a444aebf0f4a04c61eecf7a1ac22ef2cf4d387a50b4833bdaee126ee3e06730e09617225cb4a657c75835bf62c2655a395dba893504ea2e8c2e1702f189e3ff1886fa284da91342728467e4fe2ca1b3b148919ceec8fa39e7740dd49ab491008aad607864506b9f2bf9b2852d4f7881bfa44a4ffe7f27e07536635e1fff02c7bf6fe69d113903b03c3ec20aa0c93e56ccf730fce4a5e7a4ae0bb40a21d7cdc73f550900d4c190482bca02ffd92877a55198023e21cbde090a6a8c6310cd368182d3243e3f9885a98301f1df46cbc8fff62d2a8e465f6f8002c938e39d4df1891280d4cfa21c5866da9d1b236a4196c9231d1667b2df10ac3fae561607e8634076e4a71fcccb7cf28ae1eb56c428559350fe525507d965e009807074e11b203a1854f7b8e02487ff1c86ef03d4cea9d108376ac0b5ccd3ce08f5f48ac954ace88f786315acc5fddf27d292952cc2f814c15ecc453d37eeb8b6557ec221336dde34c555d0831e4305058b72952c93c4d114daf35d0e991b428a556ba57915e78db0a26c5403ac0c136de80b8e64cf94986b427c72ba6eedfdfd4c37bf41aaae798bb6032a9eed9d8ca99ed9db65c4ebcd4d1bd410c127db4da7c08f7a0b3027141e66b6deb5518bc341064a2690123f0222cd76d1a36277a3e248cf604664e60fe14af3baf7765b79dcb4e8da743602b994edf11fe19d27b3655b740c83a76faf9cc94679d5da90f2d5314271a2bedb661be3bf660c367fde796f19c93386288579682b75c0eca0d0b2f1c3868c0b2d9a10455e4e63dcf497c6fa2d40d66fa5143fae1f59592b2f960e7d088390b97db82a993a33b8ef0a71b6832aedfce279fe38119e7eff2471b530497de361285062b345ffa05beb45eed0a0af3b178cfb85fb29256133573ba0d0dd80406df62a0c42d20b2edd602b819dc906b2a6adbe5e016b409a8631d20b58afdc0527a18f2771d3d939addc1fbc7672dddf3ae346e8e33e8ca57852d9374036ddbc2e98d446a8b2065b5dbdb7021314912b44cc09b9094945fc8a18a5c7201901dfd36abdec5ff30f0e5d9375f4cc44dd3144a69b40fbe2291a2c21ec3d60bce4dac695807b101d5fcd3ddbd1073a89fe6bbb21600323bf8288dedd00fc9aa8f3576887e08561a775026f255cabc63a913528cafc8229180ec332c888a72653b9b049d0429dbd17eb5871de7d74f7fd22481de1b54064b20a539862e7afac43a48fdafd2b268af53f39e685b7d558481dfefb244ec07ee421a4a04ab28884ff4040ac7d0eb273b5cd212da9905f6f8200e450f11d84d044d140cace5dc458fd296d3ece61c3efd021a8c7b8ab7596516772afe6a5fff15a95b2788c5de580b3ac8ff26fc8cd57dad92b35414daa752cbe3478537cb45a7bdb744a03375ea4b9560377dfa841544c603306c20b80748a71944af60624844f3f00bfa18ea23d84c2722fac84c25d9b335aacc9797a2ce12e3c881ce6d3073b2cd23a05a852a39c5e569a44e2c2ec4def0ca7a5fc0a06c74077b05673325bd6317359ae38e28f66a62b384756c588eadfc3880627b28aa354e064214fe4ea86c96e8ee994d4498a265a9a02353cabe8a209be6860f6211bd801140be14d3be3612e5a6660aa7a6d4b8f302412aaddcdc259bb2b5c67728746543084bbedd872953d3ca310c78a86a2138b2b83928700bd4e1eed6e68f77c3c445a1a544948aad205b60e29ce027cb6920b66ec864037ff315a1d1b8d1871067be13b2ee1f4f2b432572600207aa5f5855184d1f891c9f4adfd48e8466dfc41457675c04a65e0982d807958614b98eb57ce03c86be44d5a3e58ef49276084894b8a489cd5340b1a61c28687030dcc04a401422442b0289c4d2d7ed29288803af88d223924c7c89779bdcc107829c5ddd46bee9a2f9de21764cb76192a4e95c2c70fa119bb99afbbcfa2b88943380cd3739e578e850600681fb37361613b2bdd517223b30c3226e3fe41da55f6a117820bf92b75e5711a0ad895e55fb9d6c8d7026558999929d4ac6ffbb01b050d5c75f80cc8e4b377857c29b35a689699e33c64498e31d4d93f61af30c82cf0d5620be269be5f9171e9487dcc2110aa0d0199f1af531061c +Digest: f230ef921cde7b61cfef00b479835a892a7eb41794545a494e141749cc18734d0df36ed0f57e5d1519ffb3845a751ac726c6926551c738ff001ccd040473b197 +Test: Verify +Comment: length 16344 +Message: a1990301c5f0fb63024de2f5b828a00fb2ab0749f066b7d9a9443e1c90be8472574e674f7127a28f1d23f30aa0fd7d69d1c06b38db7fd63c3f47e806185242c8a37d9c68fefcabd3304d48946a6acea58d43c484eb6bbc8a52127a79473359548f0eeb73f4d9e0d645b329ba9fd95d6aeb1c5b58a893316ceb8d3c9ca3c991bd22ea9c98d9250741633ddda4c6b1f061f53478da995dfc8910a07698b67db2ab64f7f7013748e9bb93d3ae7b675a5031b27162324632e78bcc336f9408b583c85e1e43d395aa4eeddc5de2670a3c45832abc6389377bb817242e70b91fdacdb91748ca397cb3fe7e46c3c28f38bf96ff66fec107f59e38d82279c12e85555829975bd25973cbc017d9ed961c784b0d4c6d1dc5d307052f73cdfcaa1cc28cecbee741a45b025a5d609ec3a635534870134703b716f51665932da073ab5ce951200ee08868b1c89e009c2e3903501e88fbfd96dff7483ba1de4b4b6302ddd34ef81422c5a8097d48a0db1499aef7351dad96c0849f87dbadfc2ee6c34acdb2adee02eda54291e126e7645f0c5dd0f5f7d01a67f0353a5d4f96de5adbaab2ed34a9df2b6e5ed15cff7e3ef5db3864c7dd0d927569e2e92b5054648df34b16eeacd2b3c3692652579a0c71c04e683a11980c05d138ce1dac77ddc7695355801cdc10879ddec09b38c03a06a6ac15da3cf1747b63a5205d488eda0fd543ef79df8e0c62a11554356939b004913f66cdb1adeefc13f70132675bf245b80a41889f886e4cb7550ba650cd1573684d849ad7972191c978982371a8ce70fcf17435c493dd4dc7e80c785744125c131f97c91576b6416d6e0eb8ce3b15988840b008b677016eb9148032e5654ec679fdc6e3d5115415e7228a79e7dc70c5443f1c8adefc83b675228f5d61f972b9842e396f7e31a4131fdc35ef225587001835e142a2ea0b2ee35a608035c8253d1bfc19f5789e4d45fee436a1e86d0150ec6c26b86b0840dcec031c23c89a105b26ad8efd2a20f8b36a81b617a2eb87bea82a1475a21fcbca7666eacf8237da1a8e8abf10fe7f4d644cfcdddab698c05134b8d300adf753006accf30acb672c8339dbd5b55b82f3608d9dd2718e3c5511785e8ae1f6588184b17b5f5f0bf1ae9c10e8f775a9f393af13acbe64909fed065d6362a1e30afd6031bc5553aa9e076ffbf84ed75198d45ac871c83c26883139c91182c7ded46e9cd4d6fd701036e004e3550263b9395f6793341980b7c0c8b1a5ae12db4e807d3e8113803da681e061ae453aa14aa0dbe15b3cd8b8aa105c76da833c669bd4d15020b90642d246b09046111e1a6c94f1cd0ad22e6d693e92914fd826ef2c9913d99811b608fd4ff7999101d75588dc4935873e43255b121409ebf5f8fe6b96eae2d363b91690625e82795c8dda04418a20bac83e6be8568ae69821db1bbf95ff72b8f737f4f1488d55e56c67324a8b5d978bb848c478d09b313da5f7cf905cf9912f14572b8ac92b1abc778ee4c08269a1e25588ba7349f0f1c1c973a147b5814720034142c2ace0d7e8c62a78d0ed5746a7e827d4428a312e0ed5771a4a663f9d730d1ec100bb569650a16277e196ce8ec2b94c9b4b5805f00b112dc00237da9a10781631aebc325edc4f5e685a4377821b102095f77e1440a0c5bb1ed7f2fb47e08c501933781f38741a47d3a5bdfa299b35cb4caec20725b53849b9325d49aac993f501f7b7c32a0048454029ccfe8c286f7448d9ee86a832b3001b79426dceb4d32c716240c63f68227f384e372bb1ab08430fdec838d0ff7e07cb16670eb88a951ef2dcddd17c94f01e427cc82aa20d46612b2719c6a505e187516f94d5723121f20bcd548ceb6dfa49e71b45a3673472f6241aa8d72f2a24a836ee93690393bfd1459d6e9e93d98729ae93773d060ad32980213f1477578e9101f92b747397b7e327b4f3b07cc1e1e61f4d26a18976b323c9a3a4258475686b3afa239bca24504f397aab69af0e4ea7c2af1a77f75f580c8608a0b15e6afa5d695844881124d43e03585e7233a6179420221a6659af0b0b40b7fb600e208c90177b56e3507e89d70eb4d372107384d6c00ff016b64d14487e1a7ddc9b7d662ccbcb21538d1ab843e1f7d3124f5cdc952adc62301621bbecc898eeca0d6bd0580eb06c81d2e0a8a9048a26faf74869f8e7f3395c8213481fa69915d56dd1113c6792011526b8a33200d394d1102171287eba3c41000b0208a185bba3c29672015ed9a6b6928aef065c3ce53fa3ce3d4d779b35889bf133d040c5a8dc14a43bcf7bed240c1c3ed54ca02ce0eeb637158e5bfcead858ad219e0cbfa4296be2b4cd473642c0cfbc9d2d550b4e8354444013b14725da4127149b8cdc7732d0382424491dca7ab0ec8fd00240f7a982dd080501e3ac365d4856ef4884e89e4a8ed5fb090882e1c9b6f35e2f35a3064aeab38cd4384793b4f62ec1c820c115e2cc0d7b1060349e210310fe64511a42b3538acfb0aec0994f1ae3399516c8419fdb15cce58ea659c0b92fd92afc2306c500d5f720addef1359dbe8136d0c6c789a1351511f8a1b9afc29816089e88fa89d9dc2ba99d68436e6507be33b48252a807b47f1a08ec66f50493de879f0fc506c7e694d5e62736035c061b152cc68805f5dc318a2551099a6968592d68810f45b03d592bf0e373fb6902be629f5811a754f353e8b6964aa7d85eae855fa5824c7e27a4332463a25e7345cfa5750196960a420fbd2584d02338be0614ed45c42517ed9a76e8716a35641577631589bfdb01118b90d9e3441673d088647a277dd865d7657ba5d3738723bbdd26e9b8337d1fa8efe93a7b4d8870dc5dfc6f14566b4e2c2dcac452665c987f2b7558569b844e4e +Digest: 074228e463f71f74ffc3d270373c247acf7ff36b7796419d917d7ed1b1f9312417410b8d59070f5ccc7a6ccf2a4b3fafa5951107cfca1c01dccf0be9fd422529 +Test: Verify +Comment: length 16928 +Message: 9d0f499d8552ce5d995e158c400d5b033f2324c7dae07f383bd68b8c18f93a7c91f5553d57c4c1b2137f00e00674faa2ec7afe9e27810477196d3545d225ad42ebe67fc5b1def97587f62ab685efa26865b079d1a0de93d7d4ae217369f76b62748cce1edbc8000cbb6a9cf706a3dabd716e9d488d20b4c0334059ff2698fe46f48c4a2e1dab5ee177845c89d1bb2a09d75c73ec366eef9a00cce5d25130ee543391fbdebfaf995a85ec74562e5d1ab4602102a3e2f1cdce01f9cbd332e6c1f6f841ea1708fb3be1ac49eb4565b23326d4655356dad1d5c2ff7015e910e301930c441ebf42b8ccddb343ca3dbde1fcc8fbd26cee673590dfc1d8cbfe354f359238439fbfb30dd2b6638318287f12fe009c0e5751cf45848d11daf3f9e751e65d42e67600a323d7d384b1ddedf46fbf3781c11c695a2b3b35b51e97c16f119b5bf2d4aa695c21629ede752274611dc9d67094c11c520c3d3d764bbe4015b8dcf412b643e12530fc7e3875eea51147a443322e5054fd13100f1c09715d206e329068334a5245782bdb5b5c49684b13d6e88f39d0f8a5653e116f02b700da5a2397bef4c6a305207a1e10d03ba556a9e92c4e5a4af0902d4fad37db981189a53971daa0bfbcad516ead1d79cd447b326576393bc5240691c94a3b3f1c797676fc8784e03d85853291f14a01062d02d6d0301684497c51b9364f44d44c1ee9f6f33f865c49e6d4ec6a52610def4833bcb4c1aedddfe0b8ce1d261a422fe9294da602a7bbeac7e4a6813928488e7e550d9891c9ec8d3882f807368532cdc280a29d39aea62910fb895f0c6957edb5b2f005082f5c5d6cf85e7be74d4c2f92341d614a64c40ca962bd8b34eae514d6908e828ea7d35764622901a139375c3f8ee8799f91be9e7a61698d1a749809ca380f978bfaf98208088021cc129c5cb3d6286d9efd3be46b3fb5ee25ce18d677f29acc67f078e641318c64d0a02238d45408c6b16fe4e86546ca35bcc20e83c70657aa8a51f58bf526755116ab72f78c50ae0b3fb061b14ebcd0ea49162216a1bb6fb85ce51b7a0d30627104fb33a1c21142c4b089594710eaee963393fb99ec5a0a7e46748fba72957b4a03570e3f5ee0ed796bbf74b391184dc0e2014213922b4f85aec5fc530a9dea667c89abd84705d6b3da1d5bfcbb8e15f0be289e8d7a766754fda1084ebf92d44dd557b17467c827f9646ab62a74936dae2fcfb80e8c837a749cd05bb278ba6485788ac91ba57005d4716d2c46a6707d839dc0379eb099af6bf11a9e871d5fbf98cbea9ad6e9479acb69ef6656386e6ef670c1c445ce022ec3664779d595c7100e383ecdac1b930e66b5b80c6512d36890109b070cce042003621e93a5ca3a7d6d255009a6249d892dbb90c5781ce792d7e516a7fa98e8adb44d6895fea3022e3ffce6f7cbeaad32a9e43f39993ef4155558f94d1815f6fc5d8eed26e908664c0b24c93e23560b3161988c11cf60401992cf0ea06d2b7536868f75ef6de1adff5a05c187b650feafdd4041f5236a14c515b31b4901c3af82b8b7c8989216206eb307957a8dc1cfd4a642248c9b44b841666de9efdcc6ea09796eadc8609007c29e920fbeaf8fc7c74308fe7f42d674b60d63403b071a6ff2541cee27e035aa22a30ef5fc24a42cb13cf896751d09904c92ffe7d589a98666ce29515e19ee50b74be310dbf5e646b91a7cb61736c3532a7ea8a8646a59768d71fe9f1513a442a91d792804293f5f0864fb240d94ed077959c54990b214898ec4019ff3d73dc91fa239051ec896bdc5a2dda9fe3f70f260a9c093036ac105924f9b1ba16ca32b4160896ed2dbd2a9195d890d9340325c08f8004e629a4833c09b34d9c7dabcb038e1d22cc868dd6b2c1b6918739e1d8f98cded425848915b412f35a30c2a72a22cad7d08a77a9e4b2567e492466118d239b1ef368b7e83c53c93043f1863ab47444af0c71816fd912cc66242b6920a6c132b6ef4a34308b8da500b75948d51e9a9429534c246e2846bc24bf16937dda64dc3d24249a0077e43edb10f28b14bce831dd3164e11356d07e20867075b78c8100183e9259b695d9ef25dd37bd6813ef96111346380de942baeff6c3903c31a836eeab1de3f149e13e8798b3604db833398b957aa99c641fdaf99c8a739a6e3cf916d611c91f188cc566cfd004341e45a493247ca66d3bca56c3e42f804096d1bf275c3899be865eec49ef2829c9ba896fde4cc6cefee4c4c6e57a4d46dd4fe901a6b9dcb64e27ba4ba77316416d1180e3b37ae383b003b1a3b4ab4e57aefdf5690b5b88af4c51414c15f844dbacb7ceb8b93b4d552efcf365d813bd035425894dcbddc6f547b766660beb1e58f721c547560a8ec3ca551c95c620040a6b6b07287e9d0218beae9c320fc81d59dac3f7282065024010808fabe57cddbd431311918a35e49a1fcb7538881bcc5ec622e6d39ed7426aa023ef20dc76849c79c21b117524c8f9f97263d20b52a5c857d326c237dde9a3f7a39d8d01a9a3387e0c9610d5d639a8ca580aa700192436fe39197c61f5526c65743d590b72b411de37152812e6b13700d0bc101cbbe22b27e9317ac39a0754983a211d408e31a908f61acfb2c2ca153b710ab5a7c74a0573482145d35882dcfe59eb324748a67e8cbe09603bf6eed3e8bd68f037d7d6564efa4b56079d5f7616581e40863e7cf2d7e3738224ff89f3871a7968535a11ae49643233c6f4f7a06eb91cb093dc3fb6892afbbdf44935e4a51c9e7670ba767dc11a5867c7dbd5fc65f1891ae6be692a1ee8e47c30707d27b1385ac316959f356481205a50de94da9a95c5d8053183dde7a1c0355fe1ca4d39f230a6cb67d675923d4c8418699edb8b2a658065e21a4291ea3181d92997c5addeb2b9f59dc6aee8a32f8d75096e7fa603da9c8f4c86e89c269aea32b480119b6253752bc3ea51c6573bdf0d3a8e2789c6b7a4e7ed644074e +Digest: 5f88a84dbc3b2769aad1604365f5aa701340b42867fc44aebba6b0a73f06f0ef6261b0c90ff2884cb78c4569ac3f8a678441263fc3afc1bd9f8a2187a11ff4c5 +Test: Verify +Comment: length 17512 +Message: a8a3016669bcdd9f98deabda37529e4f2db001ed3d00cc9e392075cc7366082475857a9af2b53badfc0e0aec76350db9cd3b214de3c26ffc4c6240babd4b12dfc12bea27ae52edfdd8142af9046ebba720ed0c8a31cc7a608c5c20a849a9ed62f55bfa1687da1b1795b6b509c845cfa18e8e6bac0e65165361d8be9dffcac43577de526e6497ef849cbd5025aa02712f7fe5e5bc64d76b5c339cc1a1c7f5bde1b17c99372ccf8fcb54f0a55392eccbda5bbb23c01a68a0036a72d2bc897100ed09fc7879c9cb237424195c9d684c02298ad8ccc31861ddd06e2099f72d87b6e1e928963d22d3d40876fe1d0b146a41a5740489ca460a4c4ca86ebd599b7f0746b8c69c8a1f2ec90eb1698fa47f8eaed4810702df8caa12fe7e26e7ebbca11aa2de9f3169a8262c0e3c205a708f0071401aa8de09d28a5a6e590ebeb476341880c37bfee1a501229081eb27772d07b371a5b0c65100f34a25a2f0ebbcb2822865cf22aafafe08d51de7949ec242ed9cee8ce861bdfe2b0aaabf92150b59d173db6a5bdebc9c836d3cd6e16658b4f8533f35155858b47ac3851abce5aa516a2169fcef423065ba1176b69c28416d7101ec0a0252270a2a9d3f193802a084955998eda77d5d42f4ea52f08b8b8653a0cd7d7176f834e982bf5f26cd16f5d89a43eea549384c1b7b2058ea77382e50cce07bd438f28637c9526da842c6b137c008f58c9d1a03d995da100d27d6414b3e616e9a11e725de487df20760bcdd8850d0350a6dcc8c628b4003c1650ec82b3f79dc2bc97f1ac4476975aaefa081b392c235887ff5efa0a57cb86ff788c9da15504fef28636cd30d3d7efbb719a39fce077d6c9c3e327a2ab3b77da6eb4f3f080d4e4ef63b23f1e42295617fd04d364cc695208c4f5fd7641089553adf5f4262d962b0faae480812404344116d865f5328060a17cf7da199b8b55d7b0e03cb69db117dfd65e1ffe0be0f0c339757022d555694056795bf12d6c3ff311d42c2673ce61dc708f9be96c58222aef6c608207410251dbeae1917903ca223b7250fa22366f8203e952d7c7c22ec4933de5775aeb924287dd097ef0ea7ad1a82b29b63b91b76d0afbf34da0c7ad3cef6a4d8742adbfbef4b0321e4798c8ade26f34cf1258c009e047ebbf79c0f4003e622736411fd1137d1509f3cf973a0374cf00b969041fc53e5dbaa1c556b99b2ac5f118f8aa8cecbb6bef940b5e557ed9cb0c19822c3d4b7f9dce9915f1547a1f063983bbe639a72a3561738d66917c7bd3b54400299ee92e98c609ee195b3995937f2b1d4b6ddf3401fe16c8388488e5899aed6594bb4ac5cf0f88b037444618fe20539f529ff1734214023e5c9520a14d3b5a24e628ccdfb12979fef3961c33b6cbb1a494568a628641aa724b49e039aef53eb0a65e0bc6ef92623ca6c748505defa9ef7918168c3f1593e67d1924191f86ffbb5dc17425cad8e5fbf95e470943fac0b2896b024aecfe331d6a9978ba2f3f018764f99276e37b59bf33d194c9197b8aa03da5ea49006a2c89bc316ab75eac08b7547ce334b9e851f91eb7be1a3ee06c3b1e7f4ae129f7c4adba77567b1e4c69cdb4c1e2d9beae532bf2872f6734d7e9e5945d80bdca15b01c1de1e88feeaea92d0e4f1df0823bc1ea57b6655a8bb0882247a74839514263372ef77d6060314b77b99af0f3852f4296d6cbfc4eb418cb93a102fdde500c5291962ea186e372c5105f2c086d37f749c3c83e50ce4e6f289c28f70e3766e1f2bdcc0dd18e18e1aa995778c0c82b024bf3d4940f53ab2223be47da15bed651e80e390ba9c0511c60754b17c69edefecd99545384696ad0416ca64290ef5eea972575ae86d82c719b26a27f664bb43b4346f0036c99fe0816499cb70c43410a84760a7cf5301b9f9f4fe6163c694b56416f100a044fe527f6b7c3bde4452d3044825fdd7152aed4f1338e82c57224be4c843cfe0805a0be775993bdb58f83fa3bdcfe7687da46d04584143b7df0a0f1c928ef55c455c14a2c81853cfc6ce5d6eee85eaea511841fe0b41fa6e26f709f5bbfaf87e5aac7497ac220b22577b344d227090c55a2d6f27745f96b8f38f40558dae62ad89f133ad6bdfec3cd3a8cc29a3b86061608c0166dbc49efc107abc264ed3ba5098d35ace4c767d8502fc2ee8b784e2272bdcfea287989aa44361854e479089d150fcf0e1960f4666ac206174a7fc9f7d82c66fc5c102131755eca4b7c00e56977911fdcd92d4d04598bb6db3bb4a1ecc2ef25bb6d12a90bd0ec220470074a90adbbd8a7c88eba28b8f765b8f3a93e77df807ca5dff3999fe358c01e851eb0a923da69dd5bf7c45a159f932ef6e0283f6a5aec5a29357b64294f14f81f99b0297697441c081b03fedbeebfaba9dbc79a1008e526dd4ab70f1f19a13f941ab188125d07b2514ae1ad986f4bcda10ec51e5d0507ca60b5e4e73152e553a7144d5b83a6255ecc19f5dcc78bd7f360fb89429dc9b48358097d930c8561b2bd18dc0a470d1d6fed0ab912e5dee4bb6e148c9d7ed18c0027b7f9791d1ba6fb4a9af61ae8ec5064189f93d66fd2f2842d0c57856cb6eebf6443e12fcfa0158bd40d1403c5ee8ee9e34b2e9de20261fc222572a0e3e46d1f722fbd2da09d4df2edf1ce6b8a6df95fd18fd1efd8e7e371e202565670e487bee5fdf5d94c7da0aefceb8da882f5504477e03622b0edd793e1258b4c9021bf0c441113d90fcbce3e955cca416c1f04162aeec40d06aeceb0b40179c9ce468385f11b9fa3870217202bc80cdc824585638f0df3d546852976bf18ba7487ad65ca916011af3eab2be234afddc081f364ab08c04e320d1b785476fdc5c358d0e63899a0f27283417cf35486b593d7b3226b1c984b99a6cc5bc88003143cbe4b755e6e30ba94114f7ad1efef2ccce00f3f125f187472b03224414edb2e573497a3baa3a1e26a553fa61c8b4b8be257622b3f34a34163b5c7625d57e89c99382ff1cbce77028bcb9c9f219b2e8b7a9a56675031db4ad33416a67b2fadb789558ed0004322836ee0d0c68fb3fa83dc255683e3db12f947978a51392abd378df93edef6a +Digest: b9c0384217f755b7392a0c9adfbea180e16a45f77ac535a42337eb8ddf3c854eb92c69caae0ee2aaf72cbe24f5b6b11dc985d7c8003c8aa0663c8d4f269fa9c2 +Test: Verify +Comment: length 18096 +Message: 993a3df248d8a14607a75122f59986a73c80d6e245760851287c27a36761d5c0dbe6e209ee1f1de10b1c6a6c53c9159692136658714c7637edd1400d07eafb0bbdf1a8ff3ab7e7d34a230e56101c7c40fba92b70f6578577dfdc795a3bf9cd9428a5b65b9267a624aa046569945a63aa608c4db23c5fde1be8e4f8146a58f362024835a560f802dd1506962c484b71deaa02f3a6ac2c282aef33e5c2fbcd147d35234c660b33a5057272ca2892b64fe3bf5445d5ac850caddb0f69ed5821d8eea77e2424fbdd34a4a99028e3db65a5c189ca6cc6a53432ab96c1ac1ce81ce9bc42a1e46a98c15ac3a1a8d9e78c1e1a80efab900100ff412c0790d5d71385ecefecd3b5bd4aa6bd68440204bc0baa5629d841d80f23afe23916c60ca741268c908f5dbfa77953059e79e6d2e8c2d102c42ed26d77780cbcd8abaa7b12dac56fa6128729af8d91db6a289b6bf5175ac657d8a777c165dd7814ae8347a2462b3d395d991c5eee28e7d6396af66b740f49ecbe081d7654ecbdf2079a9bdfee209f5258dbbf3a04e0d0e9959b9bd040b6348ac83c871dacff347c9f379d50386b3cf7eb953bcd38813eab227684aee3182e3ade8dde3ed5df84b95ca1757d8dd6be33fe0eb79ff0d2db25c942d68cc5fde003e8414a61375456b127224cee5627ca0b798f5c36959c4c5e7349bcf34e2df1edcea1f20f3a25526de9004a2cf9270b894460511c90a73c5e06d15c6ae66f0a0078f5ffcf461c1ff4888496bee09e26b447c9bfd947bb512e6c23de79f58cd345ce85982ac3ff664eeef6592c7154c6946b12cef324a033d58b876ba8e34df3c3b998e6a71997ce84019ebaff161091329682a5f48e1d8b5b4d442b80187713821f7811ceb0ac009dabc3e2be369c2f95b1626d64edfc01c998a44588fcd5da8bea6b4027f006a3a1d2aff8f138be49c5a5fa4dc9a8033c2656ede148f72ef1e500ba9b3b426c609960a82520863f87cb58926ead29fbe57a6e6829497249ff984bad4b910ca7df8c3cf791d487e690aeb472f897d7aba3cec85d4312d3efadadb18b78b1b780c7824ee46394a37d0d76a0e212101add1f294c14572c84e8a32b1c9e4924acbcc1837eb6c4e942caa52c0329e49f5a570193e2d48e1debfc881a732ce77152267498b4b7db5acc9701d7c79097ccffe2f01472e70f6f72f305839e7e7a20108589c8d82dd16fa9aac87fd35f531f714694b5e49303a98094c16d84dc29ba50a0a71cd261cdb042cba32c0fde3f21194b967d202192547ca865e00f8d1cc67940779a8a9bf8a6fdc43ae7635484595db99e750ed9e3f7d0f798e426db7cccf32da04ce92379d8435c34b7b70b494fa65753a397021f1ae3490382b10c7154252fcb3ad54079ce7d5a3aa5f349b78c5dee5e11a1e56d461d664dc1996922e7790ea06b373b20111187f3b8ff57f697e84666c715cbf601e6161faac43ab80c5691c6e7f85c952869ab08f8c37d2df8b12714cbdcfae2d6a62021431bc75a4c2482e6b6feeb019beb8e206d280285381e591027dcbb584ac54dfa968657312e4ca7a7e133308bf301f7e420143025de99a301e3ff5580e7ab6553abee34653a34c8b26e7e735cb712affb18704d357289cf90052c128334c130d38839a41df845afae68c6fb9b6f857f0f5d25a2df7d56a364974b3889b96d75233751f081f1e72344d4f51171a4c42dc5f81a77498667e826a04310b9ff18feeac01c60baac83eb1cbcf2fd06dc3681c7f036149b1526657d29fee23c8d2b91d129843bf0b17fd0dd27a50781a24345bd4d63c0feb2fae4123963f63aeb0cf7807c70cb4a89459a301ef6770b7b533f4e1888c49ae64b2b8cd85a93daa225f89ec1c756f1bb3b11bca8cd94cbf1ce3823588c6896388204940ecb024439dd5bd3fe73250dcfcbfc2acd12a7ea8b1df9e41559f41a310535d2e49e8ca1389beac93d5b80c54e5c252195adf88fd2a6473857d6b050573d86ed61bb771928c96b258567ae41bf55524a0986cfe34cd2edc727ebe45e3592c18e8e0b0bd390cea792df7ff9aaaa204c4d3086740e8309b13a8c80d76c506dac5c717492f8f81266b6518ba7289724dbd113932e37ffb45d398f7dd2a33234110015df52afe8fd6f39e67301e20fc9c67eb89647864639b76b37ca1d2a6251b6217f359421e9f78cc4a31f4f019977d7fd29780524e20288798c50002a682a6368b95ca075826883ff9278d9acbe96d4f66e1fb1395b75970a96f5c3cbcd29e27cca3ebed43cb81d91ba64e60c058e86108d7592ec37fcaec75ea2ad3418b4fa07bac236669e4f222323ccc049f6c8b5f49061f26600fe9358eb40078ed13572ae91cf4f5230955a5cd699ad8a19aa294a7eca17cf3de30f6445b519008013131b584f53c17af38de5dab1f6f7f79da9b9609a4a4e7712ea9375eb2bb3aeb6a5f6172988da05cf826537fee3b9170affe93db8d30b35f5ec8f82c885cfe286f0e6d44537c658920285f667bbf80157f1831d0cfa2ffff3ddfd74366f7ba5ebbb94998ba7acfba5d5ed1ed3c8db3eee482f097e07e25d748488541c30df7e4dd0a86de322b5776ec344b72c508b5535cb9407f6414bd8e0aad629611124f514f5c95935ee0953579432ca599c30ce96445b225cf293f7a0178ffbef5a7292a8f39f636954cf17c70f615d42f4f13277792b5f9860e1431a935cd2ad53f0de7191d396679c304c26fd767bcf9ff6084234adc892d35e43b7e6e5b78343c760d8990df7170e5379db261c29e8e768d85e3b89643395327fdfd7d1b159741ea043d1f49061f261265052f97175126f2b3356663b61ed847ffb30c8c9172c1e271b0331682e8f81dbec49b55a5e693287294fec5605227ccc71b77406a6b4ef7cc9f56c87642edc2117d2f9ec8b34da77a8edc4bc087d44edab357a70ec54b828b3704cf6ed17997f39b76d30e4bb8e8018f796755046016a0f71850fd253a2b1433b79bcaf92e17ebabeb82d5245772ce136098ac7c5decc07353bec40fbd4a1e0209ce194e7dca403b082ecbb1cbc026b72c60254410199fa47440e1f92767ff1e55d6e835db17c7a5475730986878a1f7275e5de04925c5070497d5561b2d4e053636a633d898b887437cc22ccfd4d6300bd3c4f54ba9a7078f242ccb0ae27143257dd1ecf8b5b95d670fff03648d2a0e2 +Digest: d9b7d7f2ab02c4229f0cce5a02939b5ecd8364070d1861c72a5590a9825d153fe146f044ba8fee3f26fa3923b0a66d751fc360b19a43e5e3f10b6921b8e4097f +Test: Verify +Comment: length 18680 +Message: b7571241008d792f0e1be9cea346e4aae82967db6aaa119262ad88f1398819204bb69e9deccfa5d3a8b7ceefcf1675ef320991fb2718dcf9d367355ca830423c2c7059acfce1a1481129740d4351086e0b784fa38dc91b45d6aa861862369128e1ee0b173aabb5b5d1d8a3d106dde54ffede677ba5a6169df3de44ce6f834e09f2977c85ae1628426e2b23e21fa454bb90a4a22a7697152ab36b3725d8fec10ae8d2739f5f084419728cbbea998d9dda4b30c85908855f139dba27c6a48e31504a09ba0d556a4f5f6562358e797f07d3b6eba1af64563d813a31dc58db1de806a0a317769825923fcd145778c964dbcf593df4d591f4f79c10391d8486922c5273085382311f55df340cea50912362f5bd8f8b729745d58ba93bb4f2abd4465c499f36da2742e06721b1b5bdd7a4e16e69472c2f7f331e778d9d674955cd7e4dadd2872682757a001d6b8268a5cfa361e5cfa0b450a51c8742c9ff3189641b4d2408100d4a9f6cd2afa217f9028ceff7ba8dafa8128215e4522544545181678338aa973888aaff045fbe3d17f7c30c576feb20b4ceb452b5451bfd57b40ca818701ee54f447d78beb527bc6a8a5c43ab8c4fbd7f8b221b23a111f4e5bbee273454cdc2f98400222a3a465c9bc53fdc189a234cb251b4b856f071efa46c0d2cfd6d1ff5de521b446d7581e552b0541fc820ce96f428527075b9a2b73cd152fe9e427d48a7b5b625b2ee411e36528453e3a6b863ee19e48ca9850c1456f2a5e73d5c4d81fcb6b90e1f2eefd0f0b3b5c290b4497b472b525419db17cd9ad5ef2d0341f869845b0c47dcbcf1c328dbd0b2f8d3e9a5a8678410ee432bacaf841619177be7c8e8ae98181220b1bf85d3be6c438a00abb9d363084f45b0773e0704f3a1928166d0b743c9e9e3958cafa265389862f653217ad584656a0ef7ee649f03cb0c2d0ae27df6a1888c07f14f50af5d1fe233668961c3cb5739adf468a5d190bb73557ec9089ae918a36eb80de6832502921fab989216264e3bf63653d281e4994e60882b6015eac0b132a7906bc8d666fa23ecf714b4dd72f64f8458f197458e26b6f1b18e51e9a93dba8781e768b975a3a5ef4def8738eaf421a71f0cfafcc282bf8002993431facf701f87624a1657140f7d432b767edfbdd5684f2a94515ceae2ffc789a809dcefbb394be5563534d5c75e81d168f978d7d18d90544c8b84e68a34a76694b87726039b7477745d336f375aaee947efdecc7fde8c910af464ff1ce94b39df87f2fbb10eab218cd87c69c5397279faa938244625e8e9b6d221bc01e45a0a73be76f72b5a98ea86ec384bdbc2778b696faf658d284f64396ee6a6a1ee7ddf37a52aa0da47e2da4ae28f9ee0be62267c896b19beb0670b7910d94364ce5cc213833781269d32f9c102a8e83cf6de531b3e93c74085d8e55f00221eb34e9ebaefa2c41f78232f50d193acb4562f91192ed750f87b6f4bfad385eabcf434ebcfb348fa0436a282e663dfc287983423809d9cc933d7366853bee859a79149ed0a48be01b7cae3d2c3602c13eb69cc3d9050d52700bca1d6f706729666f0554972944c00c09aabc8f0aec3c76731be87522fca91e7927a3eee9568ca817b20aa1080391fa810c50c7437ec058459d3a8cd23c33071c187474151151c809871b6eaf4cf88f592f84557e1eef5c847d3490912072b25b1919af724c0b5ecb111150bd95460328a0b1ba29613c0bd6486110fe6dfab8cca5fde18f5b0bc4d2dc970781511d2e45fc7385c3da18eeb18b3a9e68593d82c75bbbcadab2e5a29745f6f3a924e039579f4418dbee186d9cc24b896d96bd990186bdcbd3082b70aee9bb95a36531ecc405ae13d011bd10fe69fe728c8aed73d1d38e5506bf4fa770347f7e0eb6749121cc0be75ed979615d0eddea33ca6f9bdeaea806e44cc4cf91b29d0d298d3acee75ef803c6c9cfe74f0d6440f1c996896e9495420a351d4179e0bed3a25e071e8b3b0d09b667331b3b021c17550d04b53801c0a6d70ccbb59f4b3f51f79d3bd883ec95699c165565a7798ffdcbf93cb79192d495e9385284785e9918a7ef7bb577e02b93e66b896f1ac01a34c532a10921b42bafaf5c4446ab97769821b9390dcdc25a1923db41801b92558cdf3dc4126ee2404497cd13649f924240f38ee679fbef8b89e2ea3051105ccc46887f287bbfa9bd05311f3276cabb76b39be5166298d45a36922cb84aaf8bd8f24f8b409dba66fc6219d743f5c39f9e5099304b501b2d20dfbff76be53fac2620a2c6af00d5c678dba069aa5a009b23b86a04f7daf93679c5dafeada9473a1e5200c5c63da844cce2636ae82c085a914b9cd7ae6bc9acef896186f01f5cb23bf7080d28bc884e6306e13f7fd4513a819a803cc17af2ececaae244f5bff6a10980271138f61c5fd5c9987bf3fb61d75f25d288e3910b62ebaaebad00f39b9301adcc568982daf59f9af794c709b0ad946e0250973689cb76f9dc13c462c1e4beb086619ceb3abc1b0b9d0e8b67d429cbd37e382ee3e4731928323d9275e0228b38e3a6e587b1fff29bd76d93ce22d86006c4944d11a1f64ca69c7f0db59ce901b742bae5f0d74d90bc652672855335fb7873e9645848c17c05695c889a5e84bcac420230af21318ffd94cdca35bbcee8a8eacbf7205f6141c5275ab5ac8ba216a86001382b16284ac004c7ed47e30fc1f8b7a087f24c52185654fdf764caadaa0c0b5c7eed2cbe4bb423a97e445f751218590b9956a6107a3980bad04b9223d167c268777ddb501d3a8fe6dfa3879b53685d61adb5e338d1ff2915d2c95891374c13b9b455b88a49d3881483fe01ef0069234727a88a17da17bc937186a47246198dc4a7fd4ab93c0fca972dbc44fc93ab4920b9970149ed03c9c83edbfc4388607f1dd4ece8897e5fc5f32f56d720a7af3d82b619ff5b7553cf088d61d67178b19629cd9d38677b43f8ccfb561f1796d58ee1bfa9caa91d784af8ff90b9a8817d317cf496a0dfdd4cd1692442a32dfbceabc238bef9df4ff1abfe07e11c555d23ff9bec51c85efeeaee7c3ca509f030fb22a8a3c2134a775080ac38eb74e446664eeb1766f5616a9ebe5aa6e599eaf0cb6219a37b9d974e056768051869e1e784adfef83ede93aae8afa8e59cf99a95e008799a13ff321e90aed5eee051daab3fab5c1151ea423a4960db9b339f7baab9846d0a53bea77372e56a68dbd33b2bc7b566f5489f09834140571a32020aa9c8444876836253e73c998a1583449fc3ed5ac4167b63662060eccff +Digest: a3e6224e7cc986c44ba987f70dd90f08cc77e36ec717cb07f9c831c0770bba22b88e9d4e86e994751718ee0472b2ae7b1c1cc8c832f5118adc896b0f05fb3c14 +Test: Verify +Comment: length 19264 +Message: e78360a670b2c0080307cfee5a2d20eebf117dfc66e7d98eff6f86fe8c76a92f709fea73c96370ac00570cb29fadb4f562fe34649047208d8b310d05a695000a383f2767eff2c79866ad762ff92d8a76d8b3d1565a07837794bd74a92bb78e8366eb7f498766af135c91752c11b48ab948b8be9b6b31e996419c25b2c0e43ae1232c5ae33cc80f670a8c71738e4a9c05db9661fb6dcc3c30bb5586e80f25ec6e968820fbb31fceda9925d2ca19f7a8a4b8d4243d05e1638e2a700112c0818c70e889395a9773d6b531e500fa5ac496dc09fa6e2bdd7746f8b575fdfa7b01033040b70ec88ecd0e40f95364cbf8b84ef6f391a68b9d96cdb584ede266e7ac37f6c799050d40345ec21af764049cdcb939a0203626ed46e00fc060171fac8a110aa4b787f057b0ae85bc59696fed36bdef382f85c47390674c915406ed73a379b30099fd3a7849e6cf0502dcd294d1435ee246fb2dda7b4ab51e531697e400583a03c8cdb34d08efe9207923f638b234d0c7ee0028c810719290e4afe7a6a894e7d4cb61237ef4af1b3346a8a382e3768b0faefc7ee656c42b0e9039a362a317029c2a1f52b3150fac67f2d1a0196bf3d8e10f57f7db552cc7c1dd1c94bffac7d3826e71089374f7e6e30408b7a75291fe6598795b4f158fb0d155c18266b48ea2af1ebe0cc618500fd004b4aed1a03a47c5d1cb72ec9fd72c65808e35fed953b64bc26d27f50a0070557a3c4e415ed5f92642b30457faea84a5e5ec743072fe587de2e821c850f1519bef0a5f9f944a5db3749ad83b2eb200ba0c4408a48576d06d0796c2e6f409fac9eb85a9924881bb91eee9b73e4415e7cc7dfcba011da56644b8dfd1f8fd32b208f415f3c384615beb3806690843fd8302c17e50ef3f72622a7e2b18a57453c280942207da4fd484e7db5bb64233511a855f309218f5c50b46e0e25d96605472585214ab7eb2c27fad5e4e66941cf9f57ddf7c4a214686aac1666c6972c91c0ab9b654a857b3119566494940a507dc5c11cac93eb53b9d87c2983204e2b895d2ca4948c60e5daa0b3a25b30d1efbe49669a67e377adaf3ea72ff9af58e33a612b49259cc4bb5752c5078f495a601f8edaefe05fd182d6e1bf9220d061d4537119e1aef84b5c55a3fd1cd74a0e62000a70857c558383cf7617e89f4fd38f33118b16773b4f594428be4a99af68660e50d9e3b2610820d770629bdb5a386477a6f14034b25b32a1359b296d05e2dc98d67993190ec9dabd4502345bac0b048fb5ef076e19f9690b7f1631b7ea28364e1fd20c26bb6321bf88894a9691c5dfe9c2d6d469cea46cd149b1ec10a883238c9165c741f34e866c9f5a4722c7e36724623b2fde3cd6ce9149f0b0eddd9df4d2efc75d2142f689531e179276ab0e2abdf89e8222011b0ed9e44538c5f5c34acf6f59261b36e59b017923e508a780ab150a7363eba7eb9e099d41ec3f8dbd95c0b4adbab62bb64bd62511976f69f568d82c5c5d819dc30caef95933a111c7665534379378adc31c6fc66322015ed6d465c2bbd78a5f3bcb387d0db7910e9b2d0b827948d949a67d2cc19b2d64f29f8e4c52145a7c68b06a449cc1d085f0835a421405336e6bdaeeabab2c1200c1d9e70a7ee85ebe46bb5a41dd382706441a8e975d4dfb9ea0db015ae788687b48f08f1e9dba6cf675c72bceb2b3238895eb3a89e2c609e0752125b90b42a92af48de6f7330d0d8b726e5f39b1d54e83525fde88390fd6ea4537fc448afd4ca6610c7f32d352a903c91b55115f11108cf602fb10c47deb02bd99d59bfaeadb53fae6b83ff31dd7e5e658bde41ef9021c1d5f00b219b2cec03ac1421dbfcdddda3ec732ad16e102a86690ea3085ffaba724de9ffaad20faa94948d2485e08bcafb9087ed8b32ec1d1a66e7a75088765c4a8fc2948f35ae734659b06ba6a1e002ad634ed615c699de8424bdf203b32d8eb16522d3b80c32ce81c224fd2488030f232d71ec57723ef52a6b398d072846d80f95b1c20e9fc244ad9892e3e9dd1c79c3b69737397d04eb7603037f462feac2cce8186c7735875c32a3a123dbe855c6f7c569c0a4311247ceb3c2d0a61041d55026ffd6dc18a99e78abfac7e4f0d48026248f8e7ed491919c441e891112729804170d0a268e4f92e87844d6eb3fc12eb799b0a9b1afa852477fc1b16e7ea6944e82eb0f3be0a1c1e8d12859d71b455914ed741a230a801037295050a59c044f973141ed0556c8b2e1804e5792cd8888a4e885e8be2d4056d40d766f9db4b55348eab6ac6b37eced3c4b5dd8039cb143cf51881b685f11a986f2d914400ee028c776f25554cd34fb5ffbfee512d2e813fdf228bc0be91b93b59f214a75f2ae547e9d9ef0aa5ec963b458d884a7b6577e96910bd28e13859bc9ddf71624a74761d32662835433d3ada12994c0aa8f230e02f7d965d925784a2a7403823576d2d730dbe5183a9479629038d99e03a6774baaec3b7ed4671b26402cec9591a7773cfc82d0b644c8e309e84b50289b4379bcf437d823672197b974cd5a571e82601a9fe4ca665a193a2a112ba06558ad51e949a25a5f7a9a138b2c1ef7d1c54eb2f881c97c2f64cda64d73a0725d232e285a12f36637f51bb822d1e8680a6f55985f0af98d194a2d4efb76716e19e50c2698b5f3a7b5c0ecad08ccf3580a02dd38d6a23ba62cf4815bbb82683ba08490722a9c6ac2e0c3551bc583076dda682fbae5b1586f714a11f416ff4b82faea0235982d2062c0e79e2adf60ec4f81879347149f198fef3524429355e3ea30fdaa966bd2dc2d5e120e01e0ca69a707495007ecd443afae9b046dbaecf81c49a7cfbe2af268cbc12deec95029481d7594b021f4b8a176b766f79c132c52bf4dcebbd45df48ae5f12186a9b5e44f58d252f9bdb4b3fa8d117c46f7277eb87c455cb4018c420b23f7d41eca99654701266a7405b52e159bc4c739a77d48f3fb3838036d4043b22cda30fe548313f7bf7ac4691f7e8fbb49d92d17d49df3cce32e4af03f005f49a9a21c6e6efc56293bd54820339840b43f57982aa510e808dd2f7ac2a055fe9641587fb5408b96a31d3fdee06a89a7c82446efb8435d8e729044b0c3b7c688639d03431cf3b83b2e0cc06ef3ebdb2ebfa1af1a0ad60c4cd1a574d439addb657664ab4febaf0bad92b061e09fdf153c605d99006885a68cecc3c8ce6da91cfe973f588b6a9b0d5597b2291c2d6ec03874010c8b1978b2b58c934686a7d412b990d613dfe0e0459905ba210ae5bf638cc33410a267d8b82f79bcf8e52f5544ff28d0e33397a53be2a36f4f930efb869f159fae2d98cd40617be7e6d14c553a3926d6d16fd51378993a7abd9df149b2d932e9ed15f57ed3b55abc173347fc7dcd538fe47be3 +Digest: cd4af24388fcf4481291f864142b6cf011bb4dbda0c31668a055f8530c253b9bc14b8784e31a1b32870c9703314308d1a79fa557da734b31fcddd874728b1a48 +Test: Verify +Comment: length 19848 +Message: 687082fce9c342cb8de4fb8dc21633bfdfe6917c6460424e83829a44e0f1ff4596eb03a37a7dd0f3a3f6c91d2a9b6eaf2e9c80771b4766502c7cd03c2f619ab38956f33b792cbe39a1913807c2cfdc46c7b7847605d7d0c4c1f4cb22f2b4cc9d499a9beb6f37d5448e9f9274121b442db11de3a1a879475048d1d51fb2515dabdf9d43dce308ddbd72071d8ba3e5700cf4b8e5218e93929fcbfd345bf6a21584524933365d069e4b55b12275fc96268a996ed41e3f8f7a57515f30fd460ebcd1aa85b2206599e0974085e859a5972f4fa629f6bf42d3c721e3df132e2afd1939ef3809c284296a493a6bb960274f530426d0952d1ec941a4886523152bd7f5652a4c8145411e05084c4bdbb1092559511e4bf7905ed7af8948d9aadbd00518fc63a860d125e1797c7d0d9776d3830bdd9882640f8767db772b23eea7a2ed4aa7a034ee8db7d88e4ed59935d40ed02f519b5d26d223e08b173a2c38a228f8530eebd875a27f6c0b265cd7fdf541738e5430c48402b9aa88117cdacff3ea8efad84b7c3b380505baab1bb03701f4d6f08f5e9fc5c7d22d9a0cfa16fdc4701808aec9088975d20c6186190a2a1faf601da92dd63248f5d088b0bac9083a43fc46376b64a7846de7c95f5ecf1f78fb79dc4ba55113aeaafe1ca6c6d9397feaa4791c3b79dd8b5e00badcf3e55e345f89f61dcff8b0207a1c1c962630d8bbed766c04412d73b32ebefca8df362f7a64f834c6b2b450c7eb935127e0b42d15d5dce6988469b023648856692aa8da72902f5cef566b3ccb87cb8302fe4f7fb6283dae800c16de0488c891c8dd25a6466e94363fc406bd53d62c7acf87e818c671018d63e11a437d22e5756cff94dd1b83908c5f036e19875f1ffd3584663e6c358f4be90c5f27b7bb47cafe98dcc51c598c24f61b899890aa0ad6dcfcb33ad0fe51b0bb94cbd4d9da565825b1e7a66e77eec7ad154184963f56cb6df7b6541b53ae83818148910c087ae78a509cca3c651f3d2cf87d23c0a76ca5907e57d375bd0e8ee2dbbda578cc1b3ed480e378acac884e1acc25bf3769b22bec977e0105c3d99787ab115944aea126ac46a4f7e6d390c2209a209e230d92272a4d1324f4ed786718f92ef599367467baacc79013629e60e5695808ab1b735ff1a5fe8569c351c63ccbfbc19eedfcc9a5b9358b5be11cf11241b447f71cbd9deaa9276c8dcecd7c9b2b60047c5aa1141675d430e5d9713d4e2a1ca23098d7a7bd60772088955450de2045085a06cc0fb4e98dc6dad2050c422d78607e152b4511d2d4eb81a04f0badb292136177e383281c4997615240269551b0ca081d20418e082713a0782475afea2f6eb83750381916eee9a3e38a53f09fad28f7371e62dd0959e10fa43d568dcf056189ce79f630e06505c80c4b5afb1d55c272ec8d6fa6dd509df3ac0076ef6afa33f9c2c88515819733f756eb045dd591dfa2c2d631908df68f7719d79d7bc1f72e329da3ac6f016bbb5847d219bfcf4ac8af435f70442032ffc0722992dcdfe5985ce67434e669c8e414696861c81266c6c0f791f36a9eeb34f93f5e1eb8c9aaba9e26a2e623c098f7534416a321a6cf1ffd65d484a9100b774809de09b88930dc21e49588ce0ec23c3c5e42a971936b1b8f1591e9a97d7910d556101b83255d460da8b5e28f5c2efbf841563961e124049e8f2eeb13ed1d47c9b15e1bc2a81b3f89fb6abe0cb1c47cae75b81c9999e020515c15528f68df634c9f2fd31c175110bd631ce2f0156c068780d21ac0c389b9d103ace6c4f7a7ae85aaec093a7ce702d26a3317e1900ee3abec0afa7e650615460c5d6f5ba15d6e9d59fb86c3dec45bf0981725872b92594141ca867d893f7cd7008fb4fb6fe9ecbc34c5126046d2633e7430d48cede0b17205798462361c38ac65a97e4d67337008c4b274b9bbf864e586e7ec95dfe03365c27ebdd8758590eec61595f9942442ac902b7675451ea40d56a2344d077b2643ff43f9854d62cbc5a83ac1a6fba2a9ce2196de3cec2c6cdc6dca75596f97d433452fff11c69b32589580cafca696ef97fd5c75b8b90b047d52c877641f1d835e1baa9925e8180dd0144f77a59ce95a2eaee6038fb3a1b4168d0202141df67ceb091c8d69bcc2a454ae0f9146e58133bbbc9b5069e3d7c4d0a7e2de117308070397eda484497f3e0de928e08a8a48c168ade223ef4f967bd227cfd204293d6bce4e86a61f9738242350032c1692254e5b0b2546c801c423459531a895457cf273b54d5be1afd69fbd68063d9505ff20bc5dcb7f9d014a02507a6f266bd1ace21b55ab8b73983ff503bb9adbadebc080b42c3c97165511601c5cf3152fd4b784edb409fd7c5a5d6e1ed028cd064d4fb66bffdf56da070087d0c6243c88578420125ccd7aa5fe1654362f16dc4932940a085e1e83921ffebe953d6a651f61fbfeb1d561ca968b54ed7261cdd01ea377c4b3d160e8e5a3f54c934b2d569bfa0465f3a52bb5f609fe83fbedb6712ca7e02b96e10e4b7c9dcc7af177d5d8a62a879f005695036d81fc5cf95b38861c46b788d6158e75fe146b90d849cab3e5fa6cf2ff70057ba5fa36c09334bad99588e4239ef6492e1411bad66f4a75af02719ba71879e5e6437c93f9f1fea63040764f44140ba73d669ba093df013c94a598fd0575fb9c0cf20ffe4e3c446354c517e13360dc116c9bba08114ff78829757578563b7d92b558bc5c069c8b590dcb748037abf1ed815c76d796e8b2c2371b13f5e095882fa91d8a966a385df022fa93159a1dd3a44550d8f66bd1bc50863e775deda9a3dbafea8294c23941905dfc7e89a2dd099f8020e74dd8339d9cde87ab96c39f56fe9167aa3e56c6c0a184763dc298141b45fa73acc42436db0c079eb68aaaa02900153b0c7c6d08618b6013d6aac4e992fd7af22d449901000ac82aa01fecd4a549040eb0375027acb6b97853286d85f431ca4574b37dbd94fdebd4713fd0625141258a9c55484a298b5750bb23dc0fcc48b01389fb19911d4d364332d19d72b5514255dac09b996170014117855ab09faaf5047202b5a62561721febbd9c2e5adf2117725e913ddbce81f36e352d90f7be61c139b2992433a36712a2eb15bcc7558b796a19745e1f0e9d10c81b9dd65beebbf2e6f10c32d07adcc261434f4484194822ccd88a23b6961e3d2e1ff4ab54a2cd3f7fa957f8824e9ad72fac94ef1a9520bca0831db527d0cb24a629783669405d4e0ec1c39fd4886afa15112ae4102fdbecec01733cfa226e6d3b2173a0223134ca9a21964f4b8e12d319575a4cee51405cba3cd4dfb8f6cdc0f2ef2b1007dd1a592cb1182f71c95a0946676c4f3d6219b4111b8ac6e8b3b2c3d57be9afa1acd6a3cb599368cda10c45a129a81484ca2c9bfa86dc1a12c1e321ebadf4a4770732517f014d21e77fee2e348556c44bf042ba7b651103be8828803c6e96181154f40b50918f8348c9ca6d0664bd861b3e22b99f +Digest: aeb8f339811b9309563e11e581d55a869e09ac805e0f3e2dc422b44c598d52a459eeae2a24d18107eb83d061685b0f9662a4b0b5879566164080469b5f86393d +Test: Verify +Comment: length 20432 +Message: cd2e1dd12020c2aa7a9bf756d0cffbace8796673bfb6afd42719f10eb4fbef6cd91255754f464162b6bf01d57f431fc709bf9ac20a237751317378b60a1b2cda2184288a6ae493dfe05ae8fe6d3af7020aa62d37275e16894dd8203c0294a2ddedaa1c783aa5c10b4093323b615d8d463255a639dc0e9463c3707009650b595b84acbba7872ed1cd1e9369f32554e879cbf48d2ff3dbfac6da62f085fa2b5a3d2fb38d7f192ace0cc182148d7fc610851bad6b83326f4f9cdbd728188b99ac6c36e71969b73fbdb27287bc73385b0e506ba6c79c626f9bcc0ef6a12bde0057cfe16fe7cb2b15a8a679cae80c18bce9c4020729e24b86e63ebbe8e224bd06644d77737f0e3b5596d01e7420c0e691a9c82af919bdb45a39da2ad4736dee53dad0421d6a9bb0a79018a9adedf76c81574329a4209566939b88a3e3dd6c3990c13f88932fd951b29d66619cd5197035f91f482fc5d22ada15306d3da78b6865218192fd562fe81fc5a28f6a628ebb559a43cfc291dcc6d7aebad109593141790380a88467073b9510b47b3e1cbf15883f9706870b1c02316e0e17707cc58e756e231250ebc814bd87846d418a124576f20334a3bbf8a8905d14879997b115006b5217886ad9393f31fbad9b34f015c8ba6fa34129d97e9e84b568ac325c9fc301f500546aa472c217ff8273a2c24b26a0c39987de284e00ead704d3d52ef36638f515dd759089ee3f7936f15deeb037aae75f9d614bde619763a134098fdb9018389e4b1205446db3520f3fecde0ca4e2c33dac3aacf667944288f755e71de9aaa7e3c6ca6b6de47b705682d7f8271450407adcf2b160bae85a0145429e821af52a2c75232bcafe9dbd52e5a7a6c830fb44605410c4e3039b955346571cd2cb01aac080a7ab246123204d8de34fb9a0ebb8353d1c4c46eab6dac8211ccad5a3d70de810de5442b514808da5135ac00b288542be9eb152164010a6ff190e524b7e3dec4d4f8eeea379c75b53bf31a61abb91cf001f5acf3041213607d751136bfe20145e82c2eed259dcffbf703b3274abc6242b27b185dfc2f4c062ddfcdeaa60a0a76bff560becbca7c113ade02ec1000b88663c1d3bccc9718c37b3757cb0aba4ef9e4fb40d96ab10e974ff8860abc24745d9e806bb9f6180e1afe226b526e713321df942bc7a2cffbe0ced9b92d8fa64a1adb2d4cbff8f0909f2f17550b41dd7b910856ae0404a5c8903ff818af0b049e50a22f034945df44a2768cc170154d7cca07b9340900a0f9281bda3119ceade5817c1c0bd07d229ed76d092d0b694fbb3f46424a510760021adb067ee84b20b44fd16ad3000f6913908af2f447ae52bb536c887d76b95187eaf5f36eb4f0fb8efe3aa205426d2127805900b3bf6504f1b8b2d239e476f3df1b05279cea50acda2f2037ff0226d95f095f88e7dd2dc4f2e1d1d60c24d0d58c1d812966030a932a552ab33cd9bd003ebde7120d1b5921333141fa60a247652374e26f76995f6d0402a2aa5b33a0142af0b8229004778847598bc5d3f74b2119b3b1602b17ff98dbba2063c69a70a3c8442b411d33199883bcf7aed29e7ca7f35c66b21ff94b9525de4c95fb989f2d7b4ab8d400f1bfa08cce4e4bf9023c5834c18acbb1c7c3e087015fa786989c2fd8670971e7faca5ed71fd7f393cd0ab0429586137d1e090953a6022ee424e819541b65a14ea8da11d7243d5c4f59785ec15af13ffe468b8e304ebc8290c8137872ea85d881766f68217dd6dc982205a225645497a1dbbbdd815de74918fc9edbb956b28e3cfdead03a8f3cfaeac12328e34418b104682a75eb762af8e92cfaa18be2a438eda9dcc876caf84dd3b151518f9cb612925647e5c309fff88df3a7688f00b37ef004c5ef8ac3713bcf7d30ca8eb0d542d840a4bb9c9bcefe73cb359f374368a700993683db0b304b5a7f11e26542ceb84291b165fcae1041372e25c3f93d4c778bc19f43ec04ce02e151a547a7a53af97dc40e5357b38c874496e8655920d736ee28709e324292d9107f4b48ca6a826cc6721c22323e6c2728800e01dbc0818bc4384b01423747645462749441f53da8c9165b4110c167a76f93f707f58ee3dc9a7b9f0b9065240b29a5c188b2f7d534021b5c4e77cee79e662d44064ade66bfdd6cdd1ba16ed1540ca3b2b471c4e174ee0b8f88dbc96462c8c6658b2041929c097695bff986d7c57a06b89622fedb02096175aec143769ae3f9ebe53a5afff7ab4359770d7fafe5fe2953ac2b083a61c0a79f2eacbf96bd642247c2dd8cf7593f3d88cf61aba22c059604751e7377fac0687c6702b03d30b5f9f9a2ae5a114731dfb4277a8d870e2cd75b7f51b32c53750e9e1677a7e29b45cb71e31134e6383fa45c2dcca7a702e067b9298969bff25b14648b50191f63b02151229acfeeb29515f130ec8c9ab0acb1be0219e9bb6ddf14605440865c00719617dfcf6d832ceebf03df4eaeca8dfe5fdaa787c5a71c9d8921efad7211280694268913a05c2db91a14975780bef161dc8f88578ffb8502ed29ec1b5ee710eb961dad0bfad23b6091a3e7bb95009153924d030d9b313dabaad8a80ecf46719d366dba1cff6dbc91b0224edf6e17d4601bb3c61e99d0bcf45ccec1fc25a7b097df873ecb00b747b910204b277e6d3103f324300eee6279897d7cb858049364680bfab99ab12763332c1e5b4848894dab934edf531b5f09b7875309c6de81e38a4658a900834675bc5e8cfda65ee470e38674328fa33ed41b04e224bd360bd48b08f19ba0f98d15a131eca0c6142741384734c819187a6f2060ba97af8d89bdc6ee75ffd08673b98e40cdf32c1a9a351650111e93ddba3174454cd1125793e5ea41564423ac82e7dff591535ce4d5d30a3b9984647546d1630d097f9a26b30341bc13072eee431712eae75fbcd5629180542eb82f71c8b5993280e18b7d5f9c89b92cc736ce2ccdc37b3056d09ec907155451283955b854634043b57acdf1f80ec303f2ffceb8726e30fcf73c93519a3596913336938e447dd0a249ec8b32cc6d544918ce627ebb7fa6bdbf6545c4c16da57f878bbdc2ec354e5d3d65576a8011f76ca7471bd7ff7446e2fdcf387b1329fb6c93cd26fee22623b50e599531998926df3cee6d6cb4f89c1d50feedfd160722f8c66f718a9cbcfb5a1b5dd7009f5f6d214828d995825900bd5758d8b3306196a4bde72ffe92863fad02d68f5ff7f134c3377ae2fade222f535f818b35f8e5d0e0d8c8b4d35a0e6b3e534840b849eb1845a9791bf53ef0727ff7fd681de5e06c3db588a2a169b1f87e6b477da1fba972190c97e72d0b207483bf1101b37e0dc33bc2ab6bd1381d71fdd948a89583b8eccdef5bc70ae95e900ef380ea9f27aa704b8ea582fb4bbd622d1bc0540b78a5e2d4a0394e074ff77f9253b185498962eded780b8a781afe439cb133029c50dcfebdfdc4eeaab5877d8e4e27643b09b3a6a22d41e4e03c6c90cd2835269092da8afa26632b8da07b24835156fa0c2f1934fa0ced24cc1684c42eef4b52b0b52b3209d8a876f8976f0ef1ebc4c905600013659571bc843fe3783274c9f9554e5b6e7d731973a +Digest: c14cfe3edf5d8eb5afccb9860f2570aa9b86acdf9a52b50e8499d76c39f36d6c1565f85aacf900ebe6007ae2e10e8464eabbf0e8737809a4cf4075c412708c2b +Test: Verify +Comment: length 21016 +Message: 57e6278923857f1ecc966658902f2d9273160d738ecb1912aac8705e0d07b7be94c5c7f40286a2479859ace1e65d1876e084a026349779a5db7a8699eeb2cc43bc242662191f3954f99dab7f3dc690efccb62540e680c1bfb57308cc259c6283f68bac9b105a2d8d16eccbf93d737e465f35068a4b8fd9a9603a60c05acd62c46b83c1668e3f643a18cd74198f6bcbc4c088a9c90ccba9ab0357f43d344eb54f4293cd8c3bd5c7a326c90ea5dbb65dae183778c8d03d1a0cc6532e0b5b26416ca44438d6c0243e1069670166c85d1e4f8ecbd94e40eb1216d2b575f1785df062b91d6a09c534b2c8082fb524ff67f5ee4bcb362204df7a0f4f0530b833fca97ba8a6cbf0f10e09142ca993a728dcc9d276bff60dc3213b4065ccc928330953fd9a67c452edb92d3cfd5e01b6eac58444382f81d725b73bf13a90a709218fd831b6e9bbf6603d0488a2d5681bed290d8cb9a43f48d4ab646af9dc3223a4931f5f25b319a5f3a3783f4496319cda104cf220a6982775059df2c835d23e651f10cf0e4d47274ef270ab0a2ac202598229be96bbf43eb3cbcdd2cf25ef210b3a93c89a40ab441832d3121d18851411888c37426dbb533307de533833f1953fed9094f113afc4fa6b8bbda4e8e09cab295da64d43552fa0c0b7bb28e84062a93fef793a4eba6e9ba67ff4c8233d60ce6e8453dec52a9aa0ff4052c9ca4450f03898c09e7a330ba4eb97ffb150032a235de9861e7ca25cdbcb616243636626bde074b0441e8463bc40bb2586f79ac05201758734ef263cfb2c0231be3b0caeb740699354c2143e8cafd3af70a06aea025f0e9d49a71c03a52a0b0861d8a0ae875f60aff8ee4b64bb3fc7e596d4db72db819d12852aee7983ce642f54c488efd445424e562b919df2f87f0f211a551f876e0b2c0f0202663d1ff6eec0872e3947fbf5b696004eb0d9e3e47538fb40b8ab2e3e3410b6c2927b25a78dcda7f8548888632fe1f6ea661707dc5f04fe0406f2ca2071afcf95c5e4e96053a2ae50073ef472035f94cd87556d5014acab09d10149982d15d4e2c620720a8a68249d1b11480c78376260db3a1b29dd598ab7e083b38dae694d135ed8c98b78468f4659ab8b18d892e809296f1b4d02332477fd1e10e93ed4c38f55b4f4cd656579b586b1c57e6997af313b9b75a6cb6100afee7a6993237ebdbe735bfdb69bec69516dcefe26746f3e41d7672f1b7f0ca6c97c40c573a58ec3087f76eb306104e882d5a83ff840411d9fc67b5393685b9f2b6f182d710e2d5dd543acc722fed57db085e78fdc1736d5b5cf7ee8f8cc77723f8fa9a875a482148d85a69873bb86b0434634f7ba3f76edeabc19f731f487a76ba49c3e67b1b66f980e0b660de04009a3e0377e7a0128eda554f3872628b4c7197598f72f7bf0f75ea6843ad7b52a11391b972c04a5745d505eb5a0bfb02659b0cb46dcb54b59324814b91bb9816d4f6bbffc09407383c652a3064ae4d304e5986e4ef4e26819aabc2251119b8e304ba293101e16b37db013eb8f8e7dda76f3382657489c1c57e72396f52465229c8e476078726fac8aa1fbfdf773720da60cfabb09deccad3b6fe6394c5dff86d99fc0eedf0d31a7d02372a3e702abb4b9b745f40ec05b64eecc6bd3ffc352020e067705ebf846ec7abde0a307421017da7d829a0bf62f8998861c2cb55e44dd634cd26d443a94c3aef8adc6fe3b8a7e2fe51775ab8632646023600b1737be6101f83bed93db0574945a41d475f5ff30e0776d4d937a4a3c6f2d9e3acc55a9d41092194f80e48046566d04951379597616bbecea6ed9615bed2c407f7dc1eb7fb7a3d459b25cec8319b95fd181ce7e98f93afc14e2ac5e0701a6ada3d2816eaa1fb2d4d4d24b337108c5b84f66fc58deb07b069297fa2989d3254d6e729f189d7047808787ba3c58481978d86b0ccd8f6406702d37cbaa298c3088a70622d39fd1ea423c7aafef82043d08343805c7f53c64a4ad6728c92e5450c618351386f96a2481b95335343662bace2b74ef2d56611c08dad1176ee2520b6f87a87919f4647ca6c7b951f3bb8a163484c7d2e7fbfab6067b1da3818bafecebbd075c73d6e77b172e540d145aa5dca109dbb7dc2c30bb055af3d1ea729278a282f9c57ee71aa73db6cd707f5bdb917d8055a5f6312bb26d3df9ab91df2439fd9d26ba2171268b8027cc821d0653bf2fb2e0a51c511223a5edda385e198db662d8374644ba33ac4948f84cd4a236ed216722be36d50d9617323c803a6af4773af9d46ecf0b6894fee2fad58d79aba4ba67c3f82d0546942ad3c88c0b188105eec9a43cabacedca09bd792631d1db6b62796c5be729e2a4469a2563bb6c5ee7e41050b7bee5ebd6d0a11e45a6f3eeca8167c5f04d890c4fd34dfb0d30aeb0a586967fe7f1fe8a41bd56913cd6270b497ff775be476dea1c39b5f4935426a2c83b22dad52d3ef19136a37913a7b55a71c5f225cdbe1ca493e19ab6fc0d1c59d76a7e098858ef4951a5527fd003e404c9b91f7c2698df633c31c4e95045d7005a7d70b3085b57b90671294a7dd1fd31dac44823d0bffe4fa092fa3698e3a0bdd9dbc1805e1fbe6a3a02f18321f948082a4f33c1d319c18f466d0645dbcfbfb8ddec391a918b6e8374c071d1c5620db243c0a9ff38906f4cb628aebd21f17c1bed189f26a986ae2d3d1373dd70f69457ad807285060b52ad792dbb4672311e0b92c7bd4faffac5901c63bd4e2a9c241deef856fa4571b0db16e2f48ad777efb25361593aaacefcd3991819cdfb3c072f908f1d06feacd2fd15b1232e57ab3538b84e3c92a2ea9b1f3c9a4d02ecbf83b31bac8e5238a3003cff010eddfbb539c549f62efda036ea9b8e512194040be1d215b97386fb3e82c05b397e3dca7d437f8fc2f623aa9a307016a65f2c4c0969b3081d924a4f659fb0b1c33bf6cceb9b9111185eaecbfeb7c55cffcd71caa1627f7b40b3443d00a0348a060db109e8882157612c43084ac5c3e9c5350c88bc165df78aa01fccf7cd766c6abc168a5a5358ea06298c6b66a39144615da48e40cb760363208105326e9be2570fcc562b455d516d1d31fb3a9959f5390de2e217caf12733fa13ee9acbce7135d07c7541a4591400d0dac0aeee4085b70f6e8e275bf7eb62f77c92152c35a36cc5cdf086b873bc26092ec3abec707b422aef9a5ac5b0d858df64f68cd8f8ff64b768cee0cbd4d04692d50b17d9115f41250d0c965243757d7a7524e818400d866df4173923a3d8ca3178a0dcfe4aba1ec971eec548d94a3a8f55230f34355638b11ad37809095d19afbf8be0a3441340dec347cef099e0f5e8acfbeb74fe61e349820b85c52ee69bd351d30d1027f20f2caa209992acbe174b23b5631fc4b6f0fed3c7489f39fbb867d780498c1adff37acf800e76396d098161575e7faedec598b50da9df5224d831f89b7e6045635491da6f15e3697332520fecc6dae560ccdfd2e790cca3ea63fb5d2b93d5d1059a3a72f69623645af985d579827990c46c9bcf5ce5af51d4c18bad387031e64e2d3b3f1b797c51a9c8e45a087aa4d8930c93577490d0876b5aa991cbfdbcabc5765cebe8a63758e9063547a096a3e5541690103879776b35971fb1ea22c049f2db671b65059ba3a11a41434abebdde8ff15aa2af88ec25bcdeb4b4a0c783e85dc52279997ff257596e +Digest: 1dc71bffc010a485f07f754ef874c25f56ec641f9a2c9a6d64871158ba7eb40e775fafcc921907e291915b2b53c201450f748ef6a9c40c95b0ce2695dde99db1 +Test: Verify +Comment: length 21600 +Message: fc150b1619d5c344d615e86fca1a723f4eeb24fbe21b12facde3615a04744ef54d8a7191a4454357de35df878cb305692278648759681919d1af73c1fb0ff9783678aec838da933db0376e1629fcca3f32913f84bc2ff3ffc3f261d2312f591cff0748259d3cbadc94441d846a9cc8aac55f3c5ad417a992ebd3b4f76d7a77c7ef5ec90f9a14c01ed1847539143c0790250ae37169c942bc907bf39779985a624fa6b9eef90aaee9b11efd9df28390db98b9bc3143ecc663fc11a6191b320ad667069e2980c58b277a3a3d18cb1a6a716794500329293e7175be55e71cf090097fa7022af8ee5fbf7502be1366a89d3cdac4264de428b1cd44aa89684379f3e5dfb16c58282c3399ea9c07f48cd632223871c6783d90275fb1fcc9045a763b51cf4b651bda280e9d2130a125054c300dcbc2b9edf90aa80f03dd9e23278e7134969d74dbd48af8b361e7120c99b19fe4d9e08613e33d3dc584748f2d746a9c787dd02100dff9f9c3f4e8e41310ae888fabf3b551c2d2ed697aea248a07b1c404cc0cf4f2c31d1ab5205c9ea131eaf2f58922cf115d70c1e32e66e5a3a80cf1c0cb78761a489f62712e6bc91dc50ee500ba955bba7dc0bf1be8115bde21232c94c13d2ede3627dadf663cecf194c169978875e1b4ea69f1faf0120da4399d7c68f882a4a7545c88e80ff88f8466ac87a239eae9666c145f668d92835eb723ea24b67061de6be7767272c63b3e0376460a161bfc3acb69104808b94672645c7db0442fece9436fac66d8cf768733c8afb56731a197ce0f0c89a9aedd4a08f13df4eae6cd32a49d30ad873bcbc7bd4ac88c745361e53faf5b0fb89ad04c6b8932d9efbe8d1f56190c2dc831bf666aa39b7784aac38de4f006c47da4a8e254cd65459ddeb31a208a48d0e2d9dccc027c305fe15e4ff5857b138f40f5ec738c64dd213a6ec78acc99ea7d1f5ca9624d7c8d2ad1968d86ecf78d5748b42466dcf8a2560f9852d720edfc1cc5e2ae8e124cbcc29d7a06a8e00d7906de0ad9250a2ebdcb6482db68e52f85941d9274b91b93c50d8d3341c42865e1834a1f9117deb035678154eaa7e2068ecf6f95824c2efaaef5e8e9c6408da6ccb6d41ad7a422261214ad3707fbe11b1eb4031360ad14298161f8c31e86d7794387c42430349c375db93153bbcca8153d2b2033974695c7463803ead0fcce854dde6164262f158c1d3d55cf8d83019df31c0f1dae7e787c03645286640c3973f2a3f40340fe56cd5a8a61d30686b25b496f19fa2dbc87f2c2cc2dbe631de2ea3abec528070724a11c879d89ac3e83f6460c84f29d6a88ce8a58dbba54968f932e171cfc01b34ab06c1c51170a133e17f3dc982c85ef44bb64f0a6a3bfe10916d59741a7b86a8ea35131c4a5a56ea96556c59fd16db3835f567cd4a12c65181a38247b50b495ba22d4ae3f5c07b58e897ab0df08dd1e0c626be4aedb248a83475da7141f7b9a94d4fc7b0a63b752b32a6486a1fa5e98a96da8107c7a2eb814464e09523d97e3e562d1816de33dabe0f11e2d2dce7789202817e986a5d35791bf13307ed290d674735ba6b004222adf85af8fcbadb1593a3abf5513859acfc359b206df05ecdd0bb0a3d31aeded3577901f93c3bf9370bf4ca83d6d420b8972bd3572bfff355f70c1b0f1f4c726366fb776205c2ba5367705db8ada03aeeb6693a35b64e8f2c46c4d8ae686b9559490a4bd20e01a6f142a0e5f22a3f00c5e668205ab17e7ac73c7fc3a9c18ec03b7a2fffc7a95b37a709f0e3cef1032ac4b3c3262492024ead64978c7f9f288b7076d6f3916c41f4db39fae7bd868f11618ae4cc21dc7c83454ba6639e75cb4faecb89d7edcb4857046f29623c4f554d32f85782e0f54fb1255e171994d9d9853ce4d31d2b4af0e6c8f606d3c9dfd846af6885dac070ee40d41873fee12fe5d4a15f2d23e86fbe2c8f8b1dbcf4ac9a963d781a447ed3facac8174784020c72b67297028c83ae1280ce8ac8ae2b3a1ea473836f404a92d7a787b70c5975e402933728edc7bb8a909c1c71a1f80c0cc6f9d8371f6ed232077f89843cefcb4b080355916965ce89bac6efcc345ae599461ed1ff852094462cbb440b43a760a6157f544cefd75b2ff3a9bf16fa276663fe8c07493af60f23a9d34dc8db10e4899d7fc9c80bacdff1cdad00de6dedfcf162b9cea0cb5fb16ef1501d294ddcb57a128d1caf2756cb53bb596b8efa2f17c61530ce92a0de199ca5da28c9263b51dc171fd34edd55bbea4f2745a5496b555688795d9b45f1a61139a9f704eeed48340db06443882a1009fbaf35bdb61324372f0c1227352af5812f781e892243171688d76619d254665743599244dab712cc9b5172c2f8fa7650e9ace5b24add3d07fafd4f2e26653d46a8af11b711e78fab3001f60afbe0a6f51ab1131cd32c286ce6ba961d0eccf34cae280a91160519379f66224bd86e1602153cfd1555b077d9de77c152f60c26fdc64d036f31904e163c167e11f8f331fc7b992a584cfa99b344bd576c769346ce839682be0f297cab889b6009e8208948b07e1142237b0cadac03cec5fb02e133688d0eea0921438c275d8e7020768a7b4624586f63a25f1d86e3adfc1dcb74c0e7a91e9fba38212c7ae540013c55c408cf44563c9810ff8767c56b7b396d8ffb7373283b9caea40105cb2b29965eb4759e5691463b376c6fc1219dcfe8698147ae63b23a1b153a9e5a57b645b8e1ea4645d39ff8c796245b25a0ab76a53ff739faf34337d00c5378db4368022e9fc3ff5833e8d0c7bdc5ce079b1aebea615056ebba61a135f49d152af6b6db61e8d00537fff26aa60ebf3cd9a962ac426e3b02e3219402b74e55f7abfa393dfd4d9d0c87a04332fd198f3c2e34294427c705d293c130d8feaa3ca4e0b645a65b3e9959a9cd61a6475ea42077c3c52014fc4f5a5ff1ee906678bf816bc392a0f65c439120cfc450ef5e9c9e48e0ccec948e85eeba6c13c5793a4d21af9a76ba68f72a278f3fe1af8f89d70a1413b6e610fe3824357856e4b18f640a1eb3885f3dcfcba14786503e9270f2085bc509c934bbd47f43af0e7aa9b892bf5b973e0bbf169672dc4b867a82a46bfd928d3bf25a47f9748798c0f3cc766795c8ce0e4c979c1930dfe7faefea84a36e5ac4c3ee0c430598539e14fc84194141f8c08fae41a0c25fa4f433fb349246ef17144838c50d875f4a5750d18b41be286e07288d37c53053ddf8a848fb6db4e459f43f5f1f37fd2dde2d3b2f2c604cdd8b1a6f85f489e1b1ed5dfe45a9777bd295dcffcd6532e5a881b80a71f1f56bc5f262db05026f34fe459c7c7db9301a5e4d372000518edf43c7605536768199661688e1a6ebd5c89d995cc95db5380edbf2ab36944ebc288431beb1d91495545279e519c80b6e0b143ae75b7227ffc7d028a1aa05c74b7ffe333ba6f676913b0f9f1ffa050b887af6bcf4a9378be7d3df51a300b155ad33f65e6f8b0af715bbf1e891f8da46c5a6b991ed492a5b80c15df037c1336451e31115b2f473208335ae08d39cb457a60cd15c39a1c7016b0ed0a6c872089dfa1bd2ebbe69eb8d7a5698526d6c2fb89a2be26e7259aa28072adbc7ed79bd4cd63cc062da61c0986b8d4567b7dda8d41262415b2fb72039d583d3e61f6eae0ba6c44dfdaf629ecbc74839bb5b67bc54cf6e92b4ba60e5b166d85d83c6c77754cc50f02ea5e2d2a21e25f9cfb090d694f1af3addbaed47292b66dd137bfa95a2b7513b78466908b5e094ea076fff842f5982ce689992e10ba3dde737c79e75900843a45d097bb +Digest: 1aae044fcec39bac6c05cf43d4facb704fb5fb2597a7fe0d9c507ceed29c768dfb3014669daa413801ffe4a201ebb871f34524f0ac392fa54c6b21c25415e494 +Test: Verify +Comment: length 22184 +Message: 52a3ff703c6c52ac2cf3f943fff3d2709615f1c3cf143769b41f26adf37ff3bf8f79ddb4d476becf9061e0ff805111a80968faa628fbac90acf27c39a372117d12babb3ae94b069c354c909e982c17cdf689d64f725112259927f0addc08896b442e40086134549b847cb1282ece0c66c7412ec6935f90b0e3842910888784118d9c15282679cd55e3b8eca6297d17fce358aa11756d4fbaf1d2d06a8e3829f856cee2a21e629b51bbc9e91f73826016b296f13afec277ca2dd88cc4d663a1a7058a4e7c3337e61775784f9bf325103c9cc3ac4918a82f69fe600625485013a6049901c04c3fd530778bc62291ad4ff709a68244aa659f1ecc30e595cc46a87eb9c3a47650c391232bcaf8bd356444cd61081c359c42f0710012d21c4a8f88b68ecfdfa4290b4278f8ff8a73c79018480cb12123d6874aea00cb75c3aa71dad6e9875954be5f0eb845f0274d2f7af2f072693a173f7cd41235267591d435c76734b1bb8df707206a7c667551556afb4cfcf80f18c169b77007ea7b8fb02276f0d616ac58bc4a9e1604291c8922a75be41025472e43951a8ddfde2ec327820ff9377ed5bcf572b1454501c5fd7c7b394018b98b61ae4926ef23cc37371f9bbc0abfb1ddc18ac5807da7b618b44d2cbde97a7d82bae8cd03203d7a3df381b7a3acd6766e6f638c3449920fbcb67b031166a036d540da69d8a893b0e9fd361cec66e4962dcf690ef42e6ed65a0bef485a3ff0af2bfc6c65cd0d8f38e35f2512c0c151dac4e88295e9b6a3d199bc9243c3fdd4af2df487080cd997d9d22135e347448507dbc297673a6899c922cf4b3c7127b3fd8332119bba93155a5e4950d5a877e9e8196691cd10ccb8859c4f017a8f45f462d4bef46602c4708430e15d320ce2e34427db560f936b69cfb0419e4643df01a6c89e16b10af3101ff0f043409a0edce2ac29d075eacc126d06af09e8b57e419108dc61c4faa85df3467fec487b823d8b5159e5473e781d2845a02aa80fa91cea3c80bbe6fb6cbfc7d8953f91d6c66c07be727fccb6f5f0c8151de9cd76e9fa7b0c900e6135c59e64513a2465d463d31e9a7c854d7bcdf515202d2ea114c5430a1e16417bcf3e62935776830a9de0d8988e80df12b48792d70bd8e16a11c55f601d193c7df15c731a925244c958c5e53c418475638aac31d58126ea719571b745afa2e7afc5a939c1acd550ea2d9b61d35c932f8825c339d8282031fec752b1817cb82a5870ac1d524a088db545e8b42586b2f5c8ac5412a8a8cd9f59cfefb6db2d63edc11ded859317f1e472c83745fa68ebaf6d48e8230daa361ac9d6d02f1c6aab1833f2f5da4eb89a3d68de0d7e1aa94545bd2006d6cfd6618b97047e820cda9993f4174b8549d80b81e0adf4c64df2c99f015d3692b5d358db0c808019732634464cb577ec4d1d4b96226073855aeb7da5802600c0884a23f06e735e5a19f6851985f40279212f6166761d13240a3b6b4084a4edc610e2c8b40504a1afc6f092f5e6fb73938fb758d8240c5a09258b9b5653fe840d1544510e1b5cd07f41bf65c0b6f352a15d5d35d37357d29d738213d0365d4dfd5f17c5e5f6a27331530906643e03280d54c80241ad230348bbc9dd9775e9d1feb5042d23dfff132fc4777bc7c6547b3e3ca1c709189b7473c707019258c99779e1b390af1e9b37e05cb0ced3950ed69cdd8f8a13fce4ad845de585a8272628d4a9cbf671fb9d67ace25d076ef558be8ffe3b5547a32936e5460b73c329270a79d6f56851be2d2bfb20252c822c5abd7f694c2f8d549098fc4a20d2caa7f5c7ce30d8ec37ae750c35dcb147f6833d5ad4e46b21cd56415a3330cdaba4e9b7e73d7e1d8d0b149a91c2dfa85fb242291ef6384031eff26504f1c2b9053b3796f02d8a6b50b538c7430bf1b37d9eb1458f4e2d7269db70241e9dc68ce876d9ba6c061a6b3f1d6222a876d97aa8a218ba37428aaad17918a531a105f05d3d164ae22ff7c4612cdad34a6c61a4e8a6beaf9e3b198f70b23111c464478b6a78386fdb12e91fbec8e703b1564fda4592ec4d4aa2a0ca4e6c058f604e53051a0f8550de16b7245fdad3da639a6cc3c84eeabcc5dde8027390da488cc7f30772eb461673a32b7a4b4be47feaa2800878c200239756b9e0e807f964d037ed397cf2c2e822210bca8a01631bced453505ed776aa4673da0cb4b7aa0ab4060a423f0d43ef74f820bb25e698d5959aac448073937b5c9e152ddf8a3562c19c12cbc3250f52f09132f623e1cad6c95b558be87fa0bb613e30eb7267e1957e62cd7b11206f3a1f5209228cd94245f17e14ce9ee4e595dbbaf4f07435f7cb74be03fb30e8abcf87a46ce869b8494b966db2b5a888aa2f547c29e1eddebf2b29197bf228630b38b2f024f0c16525103f8ff7e7105537b153eb9769e54981de27dcfe09027bd79e289cfae19cc81ebb744caa0dde32d344616f052e655e850cf66d54e8c51756286f12b36402c97e75be0c95ce1806c81005703dd8740512db1c364536791ed1ff11b81a20fc508b65a3377ed3c8bb5c3cc75605101b267276239d999b267a904a96f8f6be91458fb4ad352ec4f538d8f02f8a267e61a9eb03930c17c1d512db3284390ee5ca90d089646f6d48a8658456c67268c94e76c6abf2ea884d8ecefadf65e22b3ead19970d4f4b0207e82aa79313779299ea764b95ca9fb4ea57963478c05d157045c92b67f632b7aabd6f8ad29e016e983e8fc1eaa293633e3a52d3261e1194249786d6c0e18d52d92f1c7639f079c26c51aa72d1032e5df13eea1d1006667002ad39de4099c29c3b4719b1f0904557bd2bb0a47374d869ac6b465b5f00c470b18ecb8c0ea53b5d790c4e832006cff534d587a0f77df95117ca4fd43a94935eda422228538d5e5d3a87a436f1db7e63785619ae86a6f9dbd962ebd2ca4b3b0024d228fa36da956327be01118a96b96b32b64c15487840d09a3c039b36ac241e3845c349e0134739e8bb4f5b14bfead30afe0a1f647a36f7045e8078a740b782bda3dd5f79c0dba52486745db6df7864a7353a120335431abdd248b1458d5af35cf45d822869bb7083255a5f997dcbe6b263c4374c2fd0ff6da0458e371d7638bd412bfb15974e62afa2e7a8e4214b21d2908fd668f2436fbdce5d57a678741a87912f1269d1fc424d040582c05360ddb0c585377e06063254667a53b924ba6163ed510e4ca02dda08549b33559c72e1f40a8da1b7f17f10dc6f83cb99abb2d5f85c7939e58b49f085999004ca83e9f645658f5e3b3d18d1faf260076d95c33defe68fd95d1ab84d6fdbce3d48912de44be074b43171383c58f6f94f5e685463ef937b37dbd5e3b96c233c26f64ca673af8222ecc116461b9e8336eb94aecf0da16c259b884530fb2478c207fd3ebc6a1953824d15b3ac3474a1ff2236ee9b04ac78754c8cf108dd41e2482784efd893305c7c2152d0d14f80593c3e6db12010bac054940e61d4256869b6cfb4e660b49da4f9aea3f61d366db2d585607ec6f8704aa8b9361efa9c4316f447b5abbe960833df3e2eabf8b0e1b5b24038ddf58678205b042dafe40a7af0ebd7aec65801171218171b7aca848469bbb61c5615807a4a53bd1b9cf837b5ff81c7c7c098bd75488a8193e8fb7b00d6d93135728eaf1dce7a2c286ea0ea9b4c9f5e2a1fe591c8dd1fc6be7ff35dfa04f2f7aab8c8db0ab6b6997aac43edd4de2ee5fc6ea646b9dabd2dc3c61bf21dfcef51a4b12ccce90af14b3cde480609be14a4683245a4ef464efdca45d9010ec5b9874be3204961d0128b948d19fee2f23be393f529731329b97ffd859654786736e1c6d80d1c1a1201a1aa401d9c068489eaa83eba7bcc8ce6fb820dbbb101eb50a73e185c0bbdd7a6d5a77fbcaa1e7be8 +Digest: afc44faa9e0f3a686ea19317e7b1c1f6d8dba4f6cc7ff2660cbc8e44ce142da55f319d71e7a7eb4759cab1b4fe822a066b5fb3094d6403927cb5e73dac7479af +Test: Verify +Comment: length 22768 +Message: 8cbb1ed01859badc954417a9bc5b6930fb6a1cb4d2fc603c7d70e546d34fe3ba6edd5e1d0ceea80735fb27d71e7558a5ce5914787f0513b9474aaee8f7c2e98e4464b073245561107b018b47f76bf65238c1e3fa35349409db070f01f7e5200e55779d3a2936ede0af7ecb630fe4481f83ca0fa0bb31ed1281ce91f9995f9023eb3facdae438555e199970922d8958f5f59b22d4dba326be80c7ba39a6d941b34ce465bb1a04a071007b013b1b022dbad85da4fd5b3245f4221b1527e5fa3ca7c18d50459642d603ae4c06c89ff6cf5872371b820487549cadf2272c206b88e89262f6e11f9900fb693308a0820e47b50c5211cd9e4a5a9d6a737ab11dd32d5d078cdef57cb125407a588e2b8bf19cbbedd60d45f12360e1a1c7951ca5db34ed683390eb76334dbc29e420d18447d6505fea9852c4b86d4f9a1500d6802ba482fc7e9529d5c78056bdff46fa33bafe5ea8b6395ce1b489cf9c864448766a85030c9674196114c7f680d0890e62f01acc116378cb0ebdbc49f042e8d94f40df57e0a3b521e1c32984b8807075d7913582e219dd08147b0fa5df7074f0d257bb68c0cce1ab1f7bafe9ae3684975b46546863fff179bb9889cbaf3970f7c954201df4397f1ee1e5600baa1b4bddb5b78166dc3e3b87cab933a4a8c46555fae2175ec31317e2f0a944d3f3574fadaf8bc36494fd439a0b881316143adb722da7a7137782315f146e6329d31118700f6a234ad465921b44ad340a39c258b62c4bd82456ad56fd14dcc6f690722c8f9efea700e49eaf703ed09b6961856689be77b27aa9bd0d24ba9c742073a1157024ec596e0ccf2203c1985219d2aa8c53aad33efbb7d9df3ccc567591c4c65b7d69df417d9421743b95ad6004d45a537cb9068390ca2a53ad13b1d22fcb0b841d347d6613c3bb2c7f81b8cd10b1bd416cb3b9892228d8f1df575692e4d0961ab74e6ed019e2c5d2394e61a127affae08b609359971a0a413a60edbd971a8fa5b5805b87783969efd0c44fe530183ab842873dfad9e8e8cc27f51d5c30f21fab7e90ec941610cd0aacab2ba11332a44ff7f25e74ceda9b190ce08e7596a06eb67a46c8feddaf19ab35cb9cdbb846612f13679fd060384bb052e7e913b36ca34d116c98cdb45d765ad3ec4b9d079b98e0ffafa81576491f1a62d3d63b6e9de6f9abc8030982640ca0eed5dfeee87b72e82292204bf75640dea26bfcf7af7d6140b024b2bb310a0204ee4f01d7432c17d1e3d7af7bcda7d6847c79044e5e5239ad88464ceba898800f3b22595e00f7ae23ac48feacdf84089557c39549646599c59bf67a9fcf55b0473d168e8e07245f64e4abb5e61535fe989b1358eea7fea71252fee4e18e8bb8365cf2496c40fb541ef2c97c315701e115af2ff54710658b1b132531b8cd80c0640180310293c4b2d8406af9968d32d994fddf135c87e16e6847320a2d747ef1589286ef57e9c6a41b3555d71c9f0e0d9eeced5a33f5bb788257ee16466bcb729a79cd2a73284a506e3954bccc75dea6bae41f74d6403cd0f0a921fe0d9aaf6cb21c1d8b5f3a98de59b42d51acf8e9cb714d3f064d52a99f3aa792698aea740729e53eba2205f877640ea93dc70e79a54a9013bb9e114d0ce9b80b00c441606a853bf75ec473b24318b0902822a0d45ccd136438d3676f408443526bc389bdbe5185111f4e6b0d69fc00aabcc7974317823ff928f43b566293b231518fa8d12a122d55a7c7d452119967bf9ebdd90efef27c9c3107744b9b9e6c6d5a3188e5d7529a889b3798ca65754e96790c507d3aa43313fb16fc96132ed9d12fb00f40ed983475a6a69eba8a1a1bf8f3bde2d8f320ca272f28ba7ff1ca61247814272c936d63e36e1dce6dab1038adb4d6796650efaba07546964e5efb6c2ddc65b7eff1588f999ba3102aeedd0b7d6562fc707a983c467477784a814862b504aca6d230e12060d6414c387b0bfe30ae66533e99a3e7e1d5c348bc8339ab8498f1de1d78907e00c7fe6ae07b22778d36ec6618d49913383f32eeec8b56af623f3a4618f0ee114115e2526a16a8e05da6fb1d46530127145bcd5322c228d717a191c60bc18242eb68f5ed1e7327a068a59c600f3f638d3dd19b5da64f36896a67fd463d12d477c56a402143bb261f76dcd617bdc047ac7b48a4f5bf5b082e253987aef70c6d1998c1cad723152ec54ff3b12a96fd36ec9669f104b70e272f0ebe35e681d7d4912c159bf804aac6faba913581e31fb8b555db8970d48f1af2ee9f11d7239a9146490fbc6a2fa27626815e6b04eb4d536f814675235f0769e18c842367257e2d9fb7563417ec24c6b16a045a9cf8b09182e254bb039f9d9d63b213727fceaa2f063d930be583583f033e280a2f5070f95740ab65fade7a3ddf26f7060867461fe2a56e4abe3b676884c47584a63cb4135463f37aef62c5d1bfb1d6e7e8387c869ab58ef8895d79c99dc690cfea04a468e213d503c975a7e26a1b591e098972eb98369c1d2e31b5ebb40a24f3e2f0697f6a17f807725d48f7482c27b151a250d643ef3fc294ff4455335ad7f975482be05238068ed162cf98c1ace9abaaca3fcf03aa20eda50f4e8f807c51e88d531114033ea4a1cece654d3d624611fb4b675f402de7a948a8fa2205383bc8115a44a2e6f17c4651e7319f2417e7ed2c6bef0d62413bfb6514709528583da2e8a5ec126218368742f75c15de9373462473ff62d1aec4ede599d97053a2fe7dfc7c2fedde7d7a6c89440d38d39e9325cdabc1e5f63c2b86ae805d3cede02761342738bac4e6eefc0f176d8e6c00ef910e5a5b1e37b318cea91123805ed85f5678ed2d017b1c3d3fbab7a4a10f802e92cfc9f595fdda32cebe9354c40d534f65b018374b6be70d3d736ed9f925e8f830f841b8d3b17a228dd650179164189f95c4ee7d1efc0e07ff2382341c17fef7747208cb5fb95b8f13d78e956dcaf1f6ef9db82805965bd28cb03cde944b8bd065236657c17f452269ab96f5e3a7a4fc7921bd5f85a19416ec04e4ffe92b562e0cf4a584826900839638b0607864fa5a3d39474b2885827d2805c2bea11e29b76fcd0c7929e15359a26823feb667bbb843ce9c1375aaedad479d1d44468bca139897e25f3e4e084d962139f62419afbd91c605e1f4799d4e51b33fb95fdc02eb8f38705d4918e506794d38714ae29d12310bcada2e5859094f2e6e44757899e75a9afe9cd3a6b32d53d36996b12b4f5f2b833328aab0ea8648f8f30d0fc757ae03a3d344636239692d9b148ee05a8b4b851888f3f0ea196c44f8163db53104e9923d397c82b341630e8d81805fd91a7e49b11062896cac634b161efcf01e673f0d4f766cb70191c2fe91f795b70ec4a17f35149efca06b15663a557146f649597ec1d33d8ab5f32f058fc0f56f63505c2d8edccfd1ed20279c4c01c5412172deec7b981783352c522c6f22c70f3e88565da3b01b91ba9144f6346b1f6907aa7760640d212bea07d27a19663420093238165cd8adc37187127adadba84511b9cce1667a84093c4b58f875d363292b17a961a19babef79ca39322798885da5668477682667a694bf8bac6cb37cb20cff52455a433e9e3a22622601ece6392d7a482a535af388582d14a0e44ca94314b2daca6f168d561c57355d521dea620fbebf030d5e5039f25b9adcc6e81065abf7ebf8c85dc1a2873059df0074be5fb5f792097f7aa541c811c666fbcdd99f39972ad84e5f0107e37777b4f43987b885f0684591f61a26441940486a432d7a265b4171e766760f98f236e517b470f6e970eabd2c19d972cc3aaf8afa94347dda08d8cb7cb847410e6a3f78502d9ea0483ec07b362c07acca3bbb3295061530be6996eff69e9d25ada6397886eb3c3e092391879977cf5da5e50d4a22e3f91b384524e43b60a044de70cdeaa337705896e705e73b42570cc5004dd9887107c7b16329b235467725078ea3d88e5962775652c5a506d5c741925423e8b1f968bb928c4e +Digest: 656452f2080cb7c8181386be66efd374312539e4d916769afd8b7da3b213fa97540385316e390b69e5a98eef9bdea356d2d2355a1ca2668827270fc0302a871a +Test: Verify +Comment: length 23352 +Message: 107f40050aaca74433c2f5e9d278528fe862567d6d206f7bddd683e5f3dcd6fdb4b62d85b046348e85401d8ba4df8aa958d6ad63048aad50ac7e4c40b60ec888f261fe9ad999d5d9124cdaab3b3828cfe5328bf1e060e57bbaa8d0af826884f3d168fc6b0c0d54cde3cf76711decf5a8985e394f8b0bdda40f3d5558de51d4e55ab36c21d10a7813ffaf3706d464b9dd7843ffa68df45e72b423246352317e06942a99e3b0f808536ed66692e8073c158dc7241e6c822f8db04485f966714bff87b6cada323fcd34392a4a3cdf3c45f9e0d3f2deb21c1a9e0b86bf42a37703783b3d462ede478f5f67952d2d436d9e317850af0fe62ce54dcdd31c6590ac6e18b9a856063c78157c00fe558d9b010d645e24a4d891195941ff12e28ab678538808e0428ad53b29320d4c0b8370605b3a983919623a4b3e23a92b5adb9b447c7030cc52e430f691299469973749f2505d307556d4692a5c9ad105cc7dc976af763a53ce39d613160aa03c41d2ae1eb3722dc2a257a71e7a4f818a809bc878b5452d5ffdb44df8807d36ad517c274f4e24980747137a8f62e9c0a1bd5b1eb0568311d7287a1f0f972960a40e5c3deae718782c8b2f6de5da119732cde5558859d9eea297b6d3be23b72509c29b775847f9d518b7d40588ab6f0c26f662f56688eecdaa928ef26febce8ec4b3605e01366db8b51229cce09daa2a6381fa84b4a96bb5d6612a0389b817a1be29d4784d7b1c28eae6574956776bf6d2b6d48cd985f7af0e4bb38e74523a68dd6e1f50a5e0b02d9f7985045003597a5bdc19943de43bc23a99511c9781deeb0ac9686b6f2bcecfbc15dc8637071dbde73cf025488edef643942b345c0dab312e81d753142520172a008456744c5ec75c1f82c6624a89530f816a5e2abd4b422fdf968ffd964e0ccf82a4fc6d9ac5a1a4cbf7fff3e1e4e287ab35226a5a6326f72bcaa7914600b694e564018cb8fa52a5897658631c96aa9359b50982ac9ee56cad9e2337fcdd1e616fedec3870a4e249a0275a1ac148b31cd2129adb7ba18878ac388c59828d4b1f6a6745d8886b5a765a338c8198a106085f735edd8f17170272c06a5e9eb945b41cfa95d6c9f9c116fdc276fe6b4aaa414800dbf0b0a698f1455f43ae1909150acecc6299fbf31f10d2fba1fa00eaa7add5e39b7da5f6152f6e3ca1b1ba24c208c7083789e6047c4c210794de202a06364e4126ea37b095a334810bcf4bb3549551d4990e51d2e1b2320ed71093b2cec3fa4502a12e7c2135e1530a70925dd49bb25812900605552a4c37f3fa2129073b2214b9085201c0cdbcdc25fc59cb490133be2977cb46e19cb8aa6f029238ba880ed9d3896ae87a530c44e4db66a4bbaf1c2b672b693d8cf0bf90d392ad86ee9106bad68b40d857af1ab3cf758191338cb5c95214a8915e0ea711a8113bbcab3e52df4c769a7a60ca2e506f32743ab78245c0749b4fea5fdeb85475e70481f9773971bcb141769c8a8f434b7b064652781638552628f298493c82c27bd07ee1240498afa6fd7314d887b5ebb6fe5e09576e587b1ff94e103579c21837675a6a2dfc7bacbc9519ce9d5cced84d2529e605964870ec8ba9cf8cb83dfd8291be9d7a66433b5bd312d4bf57b599a64350f06bd631bcf7a6a9de34411afcc4155280f48d17e4eb7d032e28c093b62b207a2f71753be5a611f644175c829a66bcbd1e81b82030d45c97e2bedf8fb8428350ac00bd8d75639639091b519d61ce4ea87c0a2e86a67f3874fa6bfbd2265535796efef450f495fb1a362a6792d86593baa4783870cf52d9427d155e8388cbff9e7d5563abe8a30940d22be88a8793529c9db11e0631b606aa74a64ecb670ca767e2eb52c7dbf78854e5051aacf7c155f56f9f287256148953e60514d24980f57ba4aa09cb54f840fd78a24621af55626e23299ed9c6d228e7db1af8bfb98fb383cb78cfe0dc0ef9e491e9b31037b942afbf36c766075aac0b5ccd41ba3ca1a726603fee2efaa17ab13bc2aba21853bd5f4eb0ec3ea312dc696f0639ed5c1e9a0d6ae6acdc36198c0b7b1574ffd98d9a26d57e558c226482a91fad267ea06e55e0f155521318dff79a5bca574e02cea3ae5e884a760ab7647371aa519590f99d46fe7427fa29598307e2ca9cb81c7d9e9cf0b61324e5724c6d6fe5025bb5273de7972b75baf0f0f7fa18fb8b64ae04549b94f0f7bf3aff0042204781f79661fb6cc762827af50c1d1a06466c7a40ca8d51511e3f6f92c548988cb61592bc0da17d93019863c116bb10b39386245a3710662f28345b742cee18bc1b0754ad95f5c105f0fd9ddb749a8328cb228885b3a78336f61bac689cb869b75f9f64f35fc0e12417f94fcb90821c6bd488ce48a618506f703f89f67d7033856825eb16d5c984f85ed6a11ad13b838698001f2c782c74e17fe71ba737dc202f20e1109c5dda538aaedabc4f9e8c5f80fed2a3b891ab9894095a8a0232c5d6bc6e1bfc0f61b9f6e1ed4fc8f2613e5962ed4581745a5d6391f7e1fd90d7f2fd34391ad6f6482f1405057bec8c811918334fa2e2e8390a7edf32c49cd78c2d3ea06b27c7da7a0455ffdca751a466e545fb0b31ed9d97799086a14b9061ba3c4107eb8af7425f0063d65c1a1fc2786a87c3093acb1add73428f2bbe01b6cae8ad71a18b8db65febe3926c1e7d6e1f7087923105a3e771c03c01ba64165c22f92ae67572b2bee28c803cf3f99331c3beec706bda9e8dbd2825e43586f8dd2c37626f4f868de350ace0dbdbf48a92cc1d5f659f00e4932773a541836ccfc14f6afa13171047ac1113ab770b578a1aa255887ab5c09c811968661f8e5ec28ef2599ddbb55807a28d898a196b6aba4fad2e0eb69562eee0fad00d863da4f9ce7fcdf1cd11a6f64b2cd624c7e37543bb55709a22272e03363273457e78859d085d8e9ef414423c3257c1238b5bbf4de603e2d3c4546b030e2919b410274ad6c5f4644d55a47300dc74142c6dbb91ff571d4d62a6026316ed468a0243333ccb8cac17a6faaa836ad3ed95ea74eb3381960d79eed01a5c625df38dd82082a0a5e5ed6e50ea0fb8a39e280d02a8d3edfc2b392e2048859f12e598ecdeadfdc18b581f32f42db95bd3c58f431f115c07989f0b34a01829744c0e9b6dbbf48ce6a66eaa2b39cc92b321d08801e7b86cc87c78e9521548f022385e65d917fd18561eaef621c8ce810ab6487d0d02a4ec79d1413d5227dec1f3005f5ef79cce875a1aa16bdc483b6da6bab5d53019ddc562be7f6efa7fe4832dc999ee91f071c33ac2cd7223621b40d0549df832d46cddcb6cbce413c5612019be937e6dbbeeb23e3fbc71c0be77e1d0ac8a4edbda581efc027f0764a15e7fff04d57455a64b3eaeb9f6d279035638eeeb033ff3d4a96f3ca9513fb7b9e28827c6e73a0e58924ed15701fb17d9c12d72399133416968b7d589b9f4d2b8f523d82a5236637acbc9f042675662eabfa8a3bdba928e429ce00dc93f8e7e449f385c589dd21bb4fc9953a2b04921db5891cba009c4a2064dd12d926b758305e9aff9795075fdad2fa5429e623e1e5794d030090331455e83727c0bc611a9a5da70f8b5f386d30e6bd5055e079c1f047c4d1a2132413ff247ab445dd7cbb8c97b64a1330f6f637eb911e30b26cbed8a17f1d3101d5d5769a064cbaf2609771bd2713b1c2b9776a6204126cd483350926ea2a2fd4ceb576c97855b2a3c34af43ea801097d066d32ea84d14cbf43c0fc48749ce10485505a233f63af5a0b528e9c87a66cd854444bd591df62eb24ef4c76ccfa073980129b47c9fb03adaf2aab4764586e6d2998ffb3c9a131d0ad1c544251a604bc4598d497a69071e7355fd4cfbcbb8093fcd7d9258aab5c1852d4be2b81456c355c3f80a363a85cbf245e85a5ff2435e5548d627b5362242aaca4e4a2fa4c900d2a9319eb7fc7469df2a3586aaa4710e9b7362655c27a3c70210962391b1032dc37201af05951a1fc36baa77e5c888419ab4e8f1546380781468ea16e7254a70b08630e229efc016257210d61846d11ed8743276a5d4017e683813cb38e7e7f1224d86e12af0ad768da62e4a490694cedf1c069a58616e0186e9da +Digest: 6831c65aabc24ad3f66e23cd3decb86823a9f9e170c5d4bf2b47515fe336cf7efd3c41d364f8300cbc3b3cbb85364724c8163eedddcccafee579d229f147e97f +Test: Verify +Comment: length 23936 +Message: 9ccae39e86f4e844ba2b0bbfdb5331b409dc9aaeb6435cc1b5dc106e94cecbc72c5f50d376728334a14d210761a0af0c89c3b007dc401b6620910c23752bbaece5bba9823caf215f1af8de9b460e0910453567bd2c00d168b213e487892cf961ef65577180b3a80b4eb3aa4233a6270866b927974d8b641092e9fe6279dc706e71e5c369e98702816406edc3d06ff13c13d8585ee8e9bea6e99bc47cec40085b93c454311f32150985790fe7c47150f3751962daa423c572deb29c9d8b62a76f7f897193cbbccbead9957876b8b42a77b404aed32a3f63bb9ab5f08cfe4936f35abc8455952e0a6e87e191385341690ef721a21121487fcb452c2712ecfd9e2f4fe5f440248fbcdbb8e6c0f43e1ff30166f9a75b324300e8069fa9f7fe87c56b838d291c21e7c87a932a6e742056b2982b13267b053ad05b0597de03dbee95ef213b8bb1333e16934137047ea2ef8c1a6bf785374134d66c6b9c2efd2b3af5024f7882c6039d8e6ee995e8db6cf16bd1512e2e588e3afa62603401af9873ccee35cb7625380b1852b4ca845325643603023f87a6965324870be9bfdfc8a204f9fdbccf947b919c89ca603fad7550d5f9a9b2fae8fe873c219542d05663cf846cccd3f5dc7436025952df80b306be2ffb6c10ede871de2a7925c79cdc1200348fcd9950c5ca02320b74cdb12b7db52e5073e0ca6c9561d6d7e4018c397d3ffca92595481626fd14e65ab439de853eb942e7aaf83d12172982fa7706344b93c404ff5046992f309134291b8094c460b817f0f7df23910909c48eb17396240574e68150b0148ea28f3b0c8bee14e2231418b54de7e5ba3d5fe3c8383c27b29bf498d31ff050ea5bf745298beb28888fb38d5f37784d34bd1428d193c7af9a5f2c621e456c15ec64b298a8a3df965ead7ebe153afa21a8910edbd14a7ef68759058b8a488e2a3cc4a77cb25b32270b845df200e0d52abdbf3744efe6c8c31f90655d3eb2bd598183bd3b6f3c4ca3381c397348b071301c5176ab54ee0ce00a0c361e630a606863aade1c06cd95d28c7ef887143237fb6c4eb25728eab413f1d55e1720d9e1208c40f1669f96767cb0b184778cef8d5256bfd591926327257cf4c7909ea6a749a14ddd62642055684bbdc38bda6edcfe82abc6a1bae0cdde527057d004f91aab4dda8c587bf29b5f06ab9f0a23378dc8971a6dcfc9e90e051c51f8217b5aa20d36ede58f0c95b1298982ff3e92d306753e15b263e7065264819f91c92b52a7390491d051408ffd8e7b4aca6d4cc9b1d01ea27da43bc001c12a6309113b6891f560cb35e43e6ae956840ceae07ca1f5a0e0ccb6dbee9e83e5bea54a41d425c80af2a5fc912faddc484dcf46df48e439ac2b98455027294098e66b3ba11d10b44061260ea03be13e2d7e9bc6b1d819e7bda810124b0fe7a1a14abfc4793fb1be5e55565159898d76cdbf7852a055c8669bfe3b0614ce620cca91a8cd1061904c2e783eae044239eef0b66fd2f2e77a1e0ed62107f28b22ead9642f3eafac36c8766fe50de88d6e0d5e0e872ef0b5b577ded8cbfe2f6fada4976a5aff9e482a98ffe554574e93b23bde6dc94ee2e804d9d2ab40d411a18da0cc4c33f9255cf426918091727e7c90e03a7c3b1b10a7ecacb4f8886fe1494a4840b1c2128c101dd8f4e8a648c06f8d6438e2e77bc11bf7584a66acb9e6916a03ba420e331a8d2c18efc69ac05c943330a147d5573f6cac455d9eb3996a9f773804a71f4518fba94d4bc276c1991409aa3c550c98d0c193dbb447a5f6b39bf951e487fd2ece821cded0834135c117973bd3b29424bd423583190a8bba0aae76b5238ab1d884480e3546b203031ac4664b2c0675e54e1919a3528f6cccb70078cc89594229827807b975f6c513ed44fd4311fab7c2ca6bc8a5287d501402b886fedd9cb80b0f388dd225f88e4d81bfe489483563a27b63c8ef637d3f7a33fe29b3e9fa1b6575b02ae81d606699205ca4879960816fa726a3ebcb3642e691fce753731c741efa0a656326d555df1043c4a4ce23171097dfe0ff2751604065d74b4644aaca20e76bc6ac08ff64079a9dcc47ad252f6d93b408954175a270f7badaf4244b265284fdd6298b879af9069245da000fd06ee2cda214df4b0e5e8fcb1ec6daa78f9c18e81c437615009d9c49b6c48d8803fbce5336e4ca7aaff375329e2230670de6ed54216293509cdba4eba76d1d39cffc9d6e4d6dcaab8a15f018e271ec33a81849686befa8e1789c659fa03d77ca3c5998456e16a786a9ad4aa5731cd7b2691b754c84507e6f9cc6288e2a9c65e252fa0701214928b213a4c900d889b98d57d5b929f4efdda30e4335dfccf2ad291ac732c9ee6e16d8d0e0b65299225a6c7b2f5c2741338d25d8f9d4bb0fa718499ba960c65eeb399fe94b59c23f4e81f5db11a86df583559c02d24d4a7a236ee7dd86db20f82959b065ccf9795174f8d38164e3249749feb192b5e7b395ce77aee948e9fe44903eb24c4adf9e57fe85ac750e5673b0ec510b9289eb1fe811fa43c6d5d388cb89af4ea6af545ad953f129bdf94983c7d413530938a1b5fc52c1517c17e1e8147a762c7ce29ed560db03f1630b037b64690f3000a9519e58fa927e14f45a43a8cc59f3d5cb053673fe85ad6f2ece8410120c4b7ec4430184723672955688c40de8214cba52d3a69b243d04e749f0c6513ad14b8b71bf07092175d60724b190cd3496de325f4e4c5fb5f59fd544b268b24627d92f980cd86e6e165273461ed2701a7f5245dac0514719732540075c93b89fd69d7321739b3bc3e38de0a317b07c01a54ffbab6fdcdbb8803f3179366eedada63e5ef43c79f987a2305625e3527b51d17e5dbaa416a4fbe395af848822d8d85f65f9faaf992f211ce2ddb3cce1f471c98672efa626294866cec20f99d60189c8b94b19132465fb194c7e35188570cb55114333bf35f208cf927203b2b3f126aae35c3ab241237c61164094106576c63fc4d66c356b88a4e78bc8461be12f19cd8a3446d219f20cbbe72cb6fcaa8eca4e49358451ef7282765fcbc11c8743c8f957dc23bcd35913f0674884247b403f494868615bea380c44b6845cfdcdb69df6f15bbbb898e1f9c93f9ee6cf01158ef96875ed9b8363a91839f90005dc0ffe8b02b9f40d9010270b1736c54764941d2652660e58e37ac0bb8f34937ddcd655822ffeb805e2710381961607d2cb465597ae43aedc3105bbf6613dfeadf59409a12233eee6b789f6f2654896b95eb19e162312b46d968d018f571a2add4dcf82b183607ef936e269252cd45844475f616959dd08543a99fa4e18d5fe550f122879f98b4f868803c2e392c037baabd80459f9ab92d944b10efd4d76615c61e263c32dbe4bd5d4746bf43f161a65b5a2f1aeab853a43dd5da5629d033d3c6bc99b55c700592d43beca20dcdee88b8a478e301672e8dc2c262747b186793b564e38f86e5a61d8fd68492f111e8b75554f45a7e37a84ea5a93fc723006fda24afaa274cad24c1c29fa4ee885e0ea6b3c407ddab9a5f6b68e2d8cabc38cb1b96e53419184730042effc4314e12bedb467a49d9241fc2688f17a40bc121f7dc7ebe37e174442669178f78f7bcc087c9aff020f972386fca8ab047e6cc4c74916e932bfcdb1496653ec739ae5ef7d7f632ce33ab1064b615de353af82828cfdec8fc66d7c748fe9ce73f6cc1af195de5815ce86a892543bf0c1ed3cc7f37781920529f1ec351cd54c330a8de17c5581c1e34b5b4370a874a96e5c8b03c08fbd5074e3b1e59bf914135736450435c751e6bde2214b484ff2d0122806fd90dd996d047a172f4e2d8c6b05035c49c6f2340ecc1c4089c1529fadd4d7147f0c67fe33dc788a91f7c0279e65f73a79d7de1383388020c284b86188ddf31c4fdc37d2e8256571d53ebbcbf3a19c475c0f94d78b28972ac1398922a855048836a755ffd506c736c1ca2562b1de7aecb9171b666fc4e7c44d87cec9566390bffc15c76b42a828401e4406d32147178f59967baa7736fa572d168e3eda2f212969cf970076320ff7b35366068b01fd9a0535bd8aeaa3584c2a8fd1697ce23e2e457dcda4bbcd05c34aa04ee33737b473839ce8ed123687090c9a9f3284a4703657c76f4157a1910ca9d2c5526c0fc2849b7204bd351411f89bde0181399c3da9685387be93d53b3a9992d43b73b1b13317601ae19c +Digest: d55658758eed2711fd2dfa025c8546030df60c1711515a2c8512eea513ee99786b37780226861d1c95b3eff2a58507484e8aeb5faf3f2ae6edd4ac043756770d +Test: Verify +Comment: length 24520 +Message: d48554f0eeb2a0d4325d7de835d7c432357741e0fdedb83709d325cdeb8548f8ed336186f83439aeb49d6147f113be3846dd4630f73d04971c0162c40055a770c8dbbf6a55fe3b8d6b8398f01260c45c3cd2de03a9aa3d6e08e7b5b85f8a15faaca6f406cdb7ae589d34a9496068dd86617d93c1d9da6ca613afa611cecd9b7ee3bc8ac127079af793db1cbca2d0119efb07ecd250759926867ebd3716c640e4b34409022d980851959e7aafa243688c5397719ed624cad6a97f8392ff1c0c146566f733a50fff50eaa54a8c2667eb38b156ab8e338f099ec3d77f8a507807f6404cdebb581788dbdc1914baf7e4a18b5c6c21082e5d5d661eb13a88d3813a738e1b45020e56aadab12261a1dd63936b9e005b759036cf1600333af24ee0ac7195feb5708e746d36b2e7b7a99f8cc7c1bd3ae23e21c46596b28509328a3c65d99f1bb56da21ad9d52791a13a0706477602433dc9a9ac29ce7cd02fae4f3e6e94f29acd6110f0f7a05847a4bcdb7a1b70b543f480f09923a7a53c32d0648ece89d6a485b4a19dce7f8c324a97e48f49991e6190cabd315a0777f09cff93d38d9f956166ce1dca665b0d7a1a33eaeedbd885c6980eda1cd6d83815f4a2a2b5b4c076f8f7174c1ec81a21469cf9b53ed814319a94b60d039f0031d2c3235ade4ad3c091c0f8f642fba611be594f0c2849376b040d291f8ebe69aa5090e983f357bfbc564ad7e2dd07e5250cd89eb85435287b2c8acfd8643af9eab6e35ce59fe46eb26d1c1dd998f5c1a455a14f8269a4cfa93b9310ff2e1b9a3b2d44e44788f7c7e9febf33a31bcc21d8c43dc82f109f143d59b0545e936933e3dd3ce973569bb2ab32b97f080d94ec077e33738af02cdf7ead6a03bb3c2dab2bed52d32fb2d5173e30946bd016560c7aae0bb75ab25618b5604885dfd06fec5b860f0a4444afdeeb21d75ec2df1968797a4efb66fd22a72a99d34292f835ddbbcffaf67ab330f0fa2d0bc0a710e5e84b0a83a9777a9a74258191a39b5c896693f19b0098a76033b37bb7f84751c2743a87322855d0c568ee400c0ec4a3726f2a137a8e68ca48905e3463706a48b9f48c19e4e0c8a8ab69ccfdccecd376f9e0c95e200ab0c1efef427f988fd8a0d1508ae71f3998aa556009e157a6917c24a1b8fa14da39375e39a885dcbd58ff13707c1a6e9b8c7dca36eb1337a2c65efd9b3f0ede68cbd29b54d86eba62b40e853daad9566e6eca12d1bbbbf44a3ac38cb4a6c2071a2e3ab02a1a61b7e6b274319d5b4d611a0438361bc0031405b454d8d5343f165a2918a4a2b6865db21bd91f79d99e160717703dfb4411213afeb9e9e732ad938f851480a3f306332cb6e756ba6af3fd9d6e192f588d0da353de99c7d0e83406200ad54b171b09c1bd4d44de4657749f45d3dc151ce42020b71d9c7b7a9efaf87780040de574b690cda698bf07e84b83650c61f62e917222ce836b0ccb9c2af1fbaf48cff5473627c58b8c01e4649d3267e24fda76dc2a3000d7ae82ad29ea77145f4a982fdbb10e0bc2c7adc4159532b11d4fc9dc0d70d3b5e30ce5078f62142a57b2707b7a4ece0913f2cb9141580dad8508cc486b6e91556d2e3ec014bc4fa560275fc16a35ee2648b5613231114ac1e123eaa23f49f5483ebc94c2011db0ee42516ee9f48ff6c927b7798f2de67257fb472cd2d12c84f61e5df0f49eafc06bc5d9a4db60846f5c7aa11a907cff0cd6991d98c0693dc8c8d4b9593e329a0685b0670a7ff63be046071a4d1d6885a0a6844c39554fa448242a79d78807060ba4cda2a6bdfeddd1ef97cb191e37a0b72f847d1477ca8a8c73e64572ba631a5531e233827ebf91cabff15c867b3277d8d86158330f24171d1ed1c433bd8ffe6e92b8c1a6a88280541edf749c1ca1338b0be2849d06a372828bb39f2177d3dbde3117f518258fd1f67427bb64e9ccfb5830d0aa5a4290c44324547e45d176d92b75c777e2db2ead392992dbe5cbfaf8c8adf37173ad3334e9507b07a5b3c21fdfc58fee0cb4a73ca4a5e87927a8755262eb1382ef2ed3ebfb76f2e54b06fdd6818b38039c9741a5bf50f140336a8330ae52f884d6acb91001007fbe3fb070259a2e8b5d9c6b4511129374d510f76dba354b692030112ecc8355eb3b879b6335b1164da5131afba726d43be3c6397b1a7e3c30fe064478470addfd032dad1d2d4eab49820a8bab90827c0c105e16f475128e13c55f2ddfa81d007fbf39d0e836fa54469d88a69df3aef4b004df7822f677aadb1e44b4ad1845263716b1eb0a783b7c0b9d955319f933a3ef6851464bc237f650b0bcc128be09b7efb19fe6cc1a9c88612b397a66ca98f090e4bd68b804dadc3924cf3c9ac3f11b6d370aa97645a2e110ef7d03cd8d65455d1f2ac5b1e2e6c35f21850d494e85ba7a51fb1b5020d7efe09068d6966b23091cc2a0477d84e5138b50e71c7e884efddda77926a2d4c21a99b703dc098b59a3967427d566135e338358fc518098d34a60e08cb1b388ebcb020b55fb6d168f7d93dec857b2b7da8d0fe3cd9599a79c0ac9a43ca5cc65db68e435661c0c334dfedba88ab6aa97e088f99660ce0fdd32a6e19d92e83593195b07dc3e282c0b1c8e357976d896dcf88c081bbfe62b611c847071956336392d0a33a9e60516c583956af992a6beadaa01031af2c3355ce20e3ec84efe177fa0df3043659d128a0b7b43d1e80869337f50b33aff4f75f50dab124bc3a21f8ef940c554c3d667823aa985a980e7e196fedfe024f070325524c2b5a1fe35978ec097bc81089a5fd49b85fb2860296cfdb0175180cd10b6a3afbdf07307a0c7a77e4bdb743dd040a9b3786cf792b853901b60d0f59c16470837038969e4ccf7ffb9c4ebd56a6053280ceb9fbe1e7ade79c923232b676a2eac43fc482a9fa06fc1fc6ab34b9531e07a2d445d240a5954dd42c613cb35f4b3b65b10f75f40037613cca5fd7fc82d2fc69eed6ed1603cffe70cb3687d0f9c1d4f07a75cafcddf561db3dd8f190a3b8735e84c9a6e280a25bcb150eae8fc4ab69ed02941c3501b5508387a32c0644332ef92cba9a368ad0f87b90761b504e6c4cc3dfe6c42d09fbcfce4e4ae1cdc2e761b24d062172a0c056eaa3f948b2f589000d78ea5d55653d3203d83cbd67de29ce126c58e73750f4e990e5f4c13868862632442b624e91fe19dcdc051964c48eb6a2111f55e529e34316cd151f5105e821dae8066d691eb309b1c0107035348adde9d1c5f81c7a1fd5e4dfc6bd8d5c33755fdb17c94569f0641b0afb6c699cb2865204e9483df00f24738486264de9dca33973ec1054123acb71333268726b7a625340f5b0e9fa35b15b51dfd4232d683e0068dfdd2595f6a26cdf31fed03f66d4960c77ec7117380ef4ce3051ad954aa84d208f7a2a73b87b6645969a0376ec5f72ddec3583c56a8fe86024393dc0187468116791e31a04d8e62cccb49ca09f85721bcf36928351d6aeae27c5642c3624f9d1e49ee017402d74fb30f90c5ad4d93c6c9d6a1def9255a01ec7b0b138482c7ae8a30b91fa1efb8b178fb1c2f440bd0a46e33a9658809f651860759582b30d53ac1f627910d5c5a1282589610b57b394111d328c5cc11686419e7e818a0b4a1cb2b63e161a290e4f939eda570e8e5f3271c7fc707ac84d5c20ee4615bcb5654e8303f8f9746d57fef0584f258c59129def5fd2e320fac68f1cbc66c29945e161a3851d939e371537b4ee324cf34c601ec0615044edfcf467bba55b08be3130ee7ab62655160ad87257cd3e4de1dcda3dbb591f26403369ae84258d688a0be65daf13adee6a5d14475f71cda8c68ee38336c389f7a63298abeca998529b3a7427872a1ea019a25b1f42886ade1fd71e87a92d1b49be7ef3e87bcde66750416ce4b975f31a927f1f72975d906e5c49eda3a8e25d8cc77d2dfca7ff021747b5331dac63b5ce6347c3d9c47dc8ca1a6bd37facafcb417fb1895107b975d2e01a592ad68ff13c0a90facd60758e81c89152643ad1def835b0a87e0189ac2ac7c56194de671fd406ef26c5e1b16c15e57efd09c9f5232187ff0dec2bec3f9f5d6acf041a65ac36d6b6da4bceddbc070f6935d8d086125df4f12c13ed5d8aa11f5f03c1112810d5089c87c79e3728d595049f49e51136fdfb4b759ddc5a27d09c369284691b082efae4a1d1c67a2cf214b59bd58e030b9219429ce26f6e918e42661d9678aadca54c33caf2de0322ed1d10ae1421e80aaabd9ae47a2d17526aa081e7afc67418e87b1e65935b6eb5470c9a688e573caeb87698fecd7bc0d4d6350e9318d8f34768e5e90 +Digest: ffdb41d7f33bdb4660ca023cff467d9536c397ececd3963c7015eadf4a2cbbfa58d8b39d3f736432a4cd5df09943d71422fc917220a9579e09d409751088862e +Test: Verify +Comment: length 25104 +Message: 6276f2032ec3330908b7185472d3ee94b162a681e6091e157b9ea3f8c03db33cd699074acd91d11c090442adeae54faeac92b57b8b613a4d2b7c36b138f05339490091710bbf8d149bde028033c2906809d9bcc9742f391f513c66d8a5011709845398603176ef5a86ed62b59691392992e1c553e999a1f2b3863855509887144c3925ff86dd805492da69355b7bd3580d4fd70132c7fc2d1b00b61081de2cc26c5a3e36541dc76b864d1fe6caa7e55f43cefbbb96e2d13a4f55e7f280fa8d7caa5feeede15d4c072ced8db12b3df7a5fc0438695e12a980172bd3e1941533a8d0f03a0c77c698914a63ba7ec5679192ff9996f3d37e0b673d2b83c60657a4b0a4b42c7b5c80326fa956af36e14b3c8e16361d413a4f7f5787fcfe8a1ee76afaef54cb22d8b2a20b116f72bfc7117f010783d63bdeac8db8bf464c1324ee0df078771fe9358471cc4a560d03bfe2e3539b27c8ca06bebef2abb3764b609313f809c631b9b91f26191bb287e911e6efec9acbfbd4f9ad996d14e983191aff067c68e90878aeab495c4d2ce95804442b35cc16784200a0a792c1907b6499596de35e87ac105a4f63fca86b3a3ae1251f94f9b146fd63bf6ec77c51671626cad195b34826670634fb61f4188276f0b05472e8436dec6a3378750bd44e16097ab9fa2fd67d67f98299f3f9dacaf4790e51386275f6f65d244d0537c0384c8a90ad7a9ad6b9f77d60c51a7f5a199cc4669e4c2fefe80583b973ddc8bd2da0f135357dbbf3e3fed8f6083e4d3f775619e1c41817584b00251b7467867536fa8590da6b5bd30266536de9c72c32ec0abfa74a02e25828ce8b72d80a398d5a428fca23ac421e1e1636edf11de4db81a0ffdfb87457998659fde5252da8b0a260570a99a8387d40f6c99da6a83de13d0021b197d53fc06d88c39ce53a9c84143c2579c2c705976eee54a692d0ffed29126d466d8d6278e54324c09f98ddb1bbbf413f29727016b2e61e303dfef1a64bbf2ac6c5048867f7726979dcaf33e09ccff283530f439f14c670622e98dcb5adeda25924a17935aafedbee23e766b9c155826dca0844dd9b769264ed0888c157851b2514cefc8b07cdbf48fca83de3313a372615c33c754fdecc5f02b4bd734f70de551cf3db1114c860aeef5a8107f4645ad6bcaaf21238e7667bf60643739f94330fc576dc6edbd705498565facc13bd32a44723305a5f77a7df4f64e1684fdb617b95c0c84a64e3f541453170db952c09b93f98bcf5cb77d8b4983861fa652cb2c31639664fb5d279bdb826abdb8298253d2c705f8c84d0412156e989d2eb6e6c0cd0498023d88ed9e564ad7275e2ebcf579413e1c793682a4f13df2298e88bd8814a59dc6ed5fd5de2d32c8f51be0c4f2f01e90a4dff29db655682f3f4656a3e470ccf44d9b2094ddc8d0dc8161de3edeefa5aa2c7d0fa9b8ca83ac68c69f3e6899e157d0b7999f0fa18b6e66c0858f1bc08ce70dc0fc2b4ec906f610bfc0e176d899152ad32948f65fe91b1fd8653a2c0b1ad3d35c36b6cac96898d1726a31b1b54ad8a67e3e47245c704f06e9fbc4a23805fd179f4dc0cf542f01258f09a38bc87d0ece09670e1c1f9796d6a5b7b2f0cfa4cf451aafddbee1d0cb87861dbb778aa6142c1522024011e57ee97c37899a4a9dc6e65eeb623c0ae46471c824fe07646ca52b120dc822ebd063c9dde9cd2131478065cc7ef2a927d0486ee59dcfadfe272e559078c45705fee1f25b5cd2180c38686df3e903a8d13af3e96f16b4fda07c1c2610f18b3ee8b775ed74ef4cd133f70b4955a8199d8f7b037bc4fe525903c1fb370406815d1c909c35ab3fa1ff60f9c582723aa8f9db16d39077d30c52909f47e2ea365b240a10c1457ecc55f4ebb743c3ca1f46601ca500c1f823677ccf6a8ec453ff5d4649ce81a75ff3fd546cc5e277ddd45642ec9c077ad66dd82a18ca3c55a1c01c16541059d5df64fc803c9c4e091de87d34c36254459310f30d1524ed1184372c26a19cb65b6d8dc82b03a0d3022aca0f9829ae639caecb3c784d10fd724bb2e1f9baba33929aed04973a7a1dfd5507a1ff97c6d1fa99fb190e18f4fa1298c1f20217ff3e25e7f12667499e8b554d1fb8cd96421bd9d50f1d3111677f5cdbf2c0d241d2429fc538a21dc984a7a47370d8a49da6add4f095ad83ceeed9cb85b3c2dcb0e9fd4ac3320c1d32a2ff5558b975f7167b04566d1d6e6889d1b5e936839c93fd9cbab1525bc9080d9ffef27d480547a925bbe8bb14d4620ad670206ef0a29a8060f78e03446d40c2c2230651ab2b18ce4d31066afa5412aa63b52b8f697952d1dd501b465a6d69fab0080b66514becee481039ed6c71dcf0efe145288c855f6a7840f3ac2c4de5fdf01a7c2be8ec3691acb5fdc2b9b22366f18117baa85b02c2c836a19528833774f8e6c322c0807850e1aebc7b8099a8850f111dc66b6f0f7323cdafa1ddb1f0d840d98aeb86ad34849d7700884facbec3af1dc1dc3435b7e431627852ca3e84a04e8f3dd699c6fdd5268b6469754fe8bb48039e5ca143aeae679186186cad755598545684787236ab137852afa017c8c4606f1dc8111d462a4cd7737333634570a4e56f65a113718efaaa55cb4e78a1878ebccabf223730f037b0aae3cd14777a0a9ee30ab23f20e932bdd83cdf07357d39792fa25305d198de99a6fa88157dea200d4be41a69d752521f7474e037d70de720b702021dba7ca80ee217f30aeb398bad147248080742df4b9523e07f28c21e5ffb6eddf35e141a8d06dcac5921f0b3fad735d9be334340bec49a5e618d2255635749451b3f07aca06fb90284c4a82f730ecf3dd0edcc1d058d78b87386b712e76511b5e9dfcfd4c5972d941245b854a2157ee3048955daac4a2f9d2997e8ed68af58cf03a2c5398917badf8617a9ca04a5f577bdb878f01f952f6af853402b43909eeeed3a9031476bd15354dd1506171aa35a60dd9df3ec0908b0642b557324b354a3fb09b952acfe118e02e8528f55fe0909827b4d5c7df04bfbf192814b78720a7cd19299141668ebfe14dc1adc4dcaa703b703ffa051e559ac252b5c2aab6730d7f567b80c0016d1120f2ab6537b0b0de7632a3d560472b24f73586e875a0d5853daebaea1169251685656bdab4a299e131b307ef41203066470ac00e7f0def15ef6b0e559b665fd6f9ed2a94a47b0d82543d94ce0e730a6798188ebd30c569c87dd39e4bc6c0c35a62d3101a7003b6c8c81671fc3106612fd4a8167bf08feaa3d02f9353fa3ef8a9aa6044f37e0239bb7386c80110a1dec7e10280d327351ab0cec614f69fa9a7cbb7d9efaa384041633ed7be63150e2836a96ef54a3d7da2f660e24aba1dc977c9738938c4058474c9114f7daca614e88412349d6a9a302a7d6fc95d2add6611aac4b748cb4c987af4d5382d632d7ac6ba069b9fbaa716594ee1c474cb45481c7694aa46477742fcec70d8f511110969df6cec23c2caf6d870a01bb727be364135caab5bbeed4ba2bacc78fe3dba897afb2b70530b6c994eeb92164fc5b1fa28f04e02afba167b1365d05f706f90c2a0172d6c551cf6c864c8a1fd642d845a78af08f769c25a99f8f563d77230fb7b8439592b517dce49c20eb4171de8a11fda78e0d2b25f216ff8736f262c06637ece6c97f470b75ee40fc5b2ada37d6e11f555bedab117d3c3bce6db95c77c309125b5cf0ed9510d63f4f585071e7455f7724d8a588f75d85eeb568f6c6b17ca7d311ee9c2b6d3428c18a7146db556bc9af8682c9473fe98082ecb72f33f6199099baece582cc6672924e3472790a90dc330af8cd6863c7c882d4e6e726ce106ff0b6d641865b1e300bfaf067cd8f8af38c1299266efb6eaa88fe66a30191f772528649449891c1eda921539b6b5c80ac255df278bd7f44b2efd9c4f766fa455459b9a4735bf8f807e441cc81b4ea3862891d7318f667f08e31e77038c96f709250b176322309371b67ecc9bf4cc108b341f1b99b8c3de878f9b7f6fbab5a0f98e21e4d15904af5948e82e9b88569881aca7b3484f179932fa1bbc7b48f5288f4785087a22626ca0fd2949ae2115c1d059d0a5259b893970eb4737107d7d16321ade8b45c47251ae9dea26bd053116e00343fb17e64245a82cc7f714a276f249cdd57619895ee6ebf0d2cbb17dd11c1a71a8bd08766a454483420471ff07453e2911d0e0b74bb3c0bd8a4270d11d5de46da6f1df9528c1abb960670ddc599578f63ba18197634193ceb993e4493e60a7bde5a18489a4424596ca27d281936d5ffcfaf2e471ce17cde908c4f32d5cadcc2a0ed4de9a074f7ae1284ca635de525b02f7caf18db4bdd7d71fdf87c49ecdb97cc993d7127971b26421df734262ced4d2d93190323cbc1760a5eb87572d47d87bbde55637212f55e55e +Digest: 8967a2332c882917fcadc333656e0d759639ba46a571137b744a5b65cb0b915ad7f7325003a793a7d4b0b225773b334907a5059d00b8827454d5f85d4f54e2cf +Test: Verify +Comment: length 25688 +Message: 819968e22eca67712250f9927861ca55d2ab21f15945085bffe6ad180855084fc820be22ae91453e81de49b1eaa04ffd3386996a4e4b49a019e5c974e000690323aa4afd9a507c4477e963b6eb715f46eb99ab5234bd86318d16910b4c3179ed1b9fd51cfcef52aa8bd90d4883bc405b844b215214820736e3e0cf8253d07e3637682727db5510994616100fbb693b628603c211f58414d8a4aa4984fdc5c105006b08c5406cfd382e0834b59a609884772b5538dfaaf53e57dec8b753f88a83fd11409e321b63b0cd1840df298a9fe8e12aa36edadcf19284e314c35c5121d7b6c2965bb94a8828abacfe376fcd98b74b68745cef0251f9b321f55121b9cd2bb3e7d4a4dde1b5c94e2e34657412ca183e4d8fa925055e9d6d003309a816d7a47de6c020a7c932bb4004ab1140427e344141befe85cb5da639e89592fb52876c9b2923781ee8472509982be2dc43fc32dcacc703153d993ca041e595225325ab9516c4544b273c2f2f507c804fff8c3b97f6735fdf4359852973e9b92303f988f4176d5a346e58033c966594a15c7677fb878abbebc6e4ac5ce66aa708484b2c3e93e435e3a6e5c6b8d1afc6da44010d8fc7d4be3fac83d7c1022f06d90c62bffef2f28b60b529a3296822bd039e7626db1f1911e5df7e2fe130027f9c368768b99b5f05b1856dc019c5862224521de968f5205be5451ddb43d6a9ba5bae024ff9f8f34ae0fdf8450f4fa39c43473e7fbdb2b24545c8a8036f5eed5e1d5c1b9d45707603f504145b946e41d46a67210f63bf97770f4f66d1ee2e9613eb281a7a266bafd7f684072a2f8a2771a0990ec2e08297984bc1a06b47b06c83ccfa460d2351676fed641ad9680b1e1ceec54cc0be657950ff089ef9024a3754c8bae87fc48b6672e18c9590c75aee7d5ad3243084cf0749350ba8a4a866be2ee75048f7917f7489dbe3c079d5dd5f3befacde3abb280728f4b20693c06bcaba32a4ae9e1396595ce253e2b919fd38ffb236c208ead7429845e5fff0d2c1239fb09e629cd138dc92fec4457b1b224370ad5a17bf9946803f2e8cdce066d091866927ab1853cec7d3371c2fe564b54637e701278a51dc89c5ba8fe68d05ffdc176625d33a22bee0c99644e91f7b1c0afb6811388f980124d3eed6621f36b8cbf9ae82202cc572f01a2224bb52e8c15765397493f6f91d1b11d44a9bbe826327d54924db13c450be6ee4a4eca6340af51d611080e8f998342673d1d8907066b85240f54b1aa8c2146ee2adc642e661abcae8cf468d22db38bbd35460c0882a46199adbba66f82fb8c126258f4f862d4214d7972f0cfb4cee77fdbc7c74521799d15fc06e223cff7310b8f690f49dd683a53552818d0c542003f8ef74d557967823988bb074fd990d039e06115ab2c433220ae7853ade5c9406ccd7900a1e0dadb74c24c884c1674e41e23f5aa84d5e1d365e3e8339f8ca1329825b183b2fe5fe348373fe7b13d0fe738c87b207f60e08873a3fc3b2e20765142162539213873443455f9a81783ce440a2c8639f363cbbbda5d28cce257c526eb1d68a345159178b9bd2e3bd7a13c9512ee9b397944eff81a8df28b44890a2df3b9e054c71c56eb58cb42258a0be754d37d2eb1899ad9c7b4a4edd8ed3aa1c11c5a20c00fc32036821eba07a72a3b0ddc66b5249cbc15a529307f4814f348aa95acae77879089c4d6160a249792b42a9e29c3253b5f201ae8bf2b4b74395b252fffedddd70ae020b54fb73f03cbef258934dd15ddca958393bf8675837355cb2be263757698efd4b02a55a9544c58993e1667990ca4c2898aaff538bb37c52719e2a3e0ded0f54b574449e6117a6d001d5cf701406453976e0f0c27940d25b38a8f237288399d1f0b1c1887b3fcb8c4b7670fe1018fa5379e6b4fa4a659f3eafe2666dcfb4943aa5c105600b449a8818cd316dac89d53e49c3314425ab4bc47d566f272b0768587badf76e3bac7d8b11e0fb0312df3cc18f7f51e732993eb54a0cf3ac64047ef31b7c7ef93101db5cdeb9b40a67a599a6f323fb2d9bb7e0d9c00adb45a1333cd32c36844b15ca1cc4266046c8d66053b31cb6175c858d9af7855a103a0a1d0bbf57e4f0aa1090a78b91db9786849ad2b1b3408cbd1aa4d2d9410479d3c9495480448caa5f4adae679c934918b9cda7e675fca44988283f1459d0efd58033f7dde9a3999b1ea30405573731b2144a9bf9fc95a2635e5b2600440828610e388f0a102f0a7ea181a1de93a9e1c8ea48efd1f99fb1adb6aba86ded467fb448eab139123bbbb51fe21e5fbc3bf7e1be611a0b076b208d33922ca9afec6433c2f305076a6a1bd2dc1cc0154b9dd28102fba101a0889d8667b72960268a64840eca00e1732ab96c78ca4d7bcc20102b5aa12b525f88772d9583351dcba0ff198ed82b43d70df2c678530d0fb8632f4517ca0f899eeb4bf77f7ec62f19b0a268b5b5eacb007476854d4f854d8af78e62ed0ec3f3d9119a58781253309b49dcf625ebd5d38a0eb32d8a284cc1ce2dbc092cc7ff3da8abd0d501d662becadd3d5661d252f9de3d17339175d9e8fc9646ac698e07d3880a9e01bf438b2612db11edcc1218aa6770311c05a0a34f90c1acc125d97431f1ce304302e223031dc41930f7136d61d0589f6b59413f5225306cfbd432daf57067563d7f2ad0d24648a1c4656ee7bc834690860ec0148d2452e5911712928a7e566e458685fb2026a94a2c898d0e16fadad31088b5a97d08a9c5354101315d962bf6efab9c3859399680bde5e6471dc185d58f798a949e5cb58a6cf4774e0b32487eb070d5eef9f960d41d0d03391d61c7f65733c73c6d9b06838ca3fd3f0fed4c642c58bba59ed0c8b2ae618c4aa24611d3fc59f427574e0d6f38d1fb8ad8119855b7d5c5e2946a1ebb0685b9f258f903ed035e89dc07d04aabe5f10ab7f069ccb1e76a7d2c972fd34ba9dc44d68df51ebff0a400d0ebec3ea808a3a35ce5304a073fa959f9f39c96e2fce7855dddc4b2bb48ece19c8fdc6a02354c4dd0232fa0c424f4e4c1563ada1f943a23feb4d2706d707bb495403b4d38e06d72c8368261873bef96191b750d6ff446894f9fc8c8451be2e251b98368ca9e79aa9bac02fcbee8fbf667dfe5b152919f2db71af23ae08fb50368583f4d25c4136dc0d01be2e9b0ac7e4400075645f09699cba2f948be5064803fb8e95ad8f5ad24de5f27a4762773a63428547cd895df5603c448623d0263f14e37fc2252a7c9785ab5d0c202c1d3f69eb5579578f5ebdad5fb5a17fb2a45df2a61f224315edad0bc5081bc1df45ff80a337b20a5951ea0e8b4c8ea671c8c924ad365e0e39f53b679dbb50306537a12fd2f59aefd081a30828cff5a0f7daac325f8c1d8f7cde692299405377a43b4effe055da0dda3511259e077d762a222da523e808ccc7ee61c3235ecb9e86992e7635201a6d60b45cec55bccf2ff4e875046314c6cf036f48d2a2dc60abf298681e391d01154b47abe5b6b693d33c73abd786d600a016a749d77e83bba8cf81257f5516380f8136269927bc706bea0cf8a7f4f75e45eadf895b1e1b849c079c8c1fefd16763ecc9f78f11980efee5fb84fa143f87c8655e33e6ec6c62908131c688711835177348434fdd1016941788765b50752430716e6dfe4f3dfe8b2588fa4241b14a35fdfa3562f1ed303567fbf74f0f63dc86f5555f2daf570095dbe951d3c9644fc47428f24fb7f603eabd9b2e60bacf58d1d85c33fa75830fb68b9bf3c56ffbeccdbf1aa59e95f538ba01b14415b782401904cb0eed0787d3f71de707a09d3cc857c61874d8f5b076ae1b8560f66f443b6760ea1a8fce2bf65f7915b5eabaf18c6a716a87843ef166cdf45fab8c4adcf1c2d4007f6732391df7886d272d2ee0df0ea857072ad87eb01f72874d5eb1140b32485765fe9c77f2c6303682f060d26a4c53281c532b1ffbac7e446df50ab231bfa435f3da72af1dd45abaf1bcba8ed52b5a26ed869f9eef7d01e033d7be7f0a72d0e351851da74629ef3f9a18a3dec7b4a596a34b9cc23599e1a1c88e36433f52b5a9a887062814ced50ea58c8388e8ee1cc3652a8a52750808d054a2d9c6776739ce206694f92fcaf66f3ba0c355e1e1a8f45cacd11756d35cb4fe990ecf5bba459ce0ac2ee4402538a984ddc90d5a952f70b058d9d98101c797effd3f289352c25911e03eafefe78506a7cafe78fa139a8088b60a5f9e9a30bf4f55d397c638964eda8b2b23e319c4ccccf0ca5d6a62d26c0c4fcd7354a77e75452a32e59c72abc364345d08c5c3dd441dd59686528abe7c66aa88db4b2e9b01f903c4dabf0ae700d6633c263cebb7b6bf03c8b9589445f8bb50a5602c3a6eab9468f03dd407344c59a13044f19b3c6add02cabf2787512736c78aca9fd0dfbb3ee121d8867279f11574a12c8bda53a79d580260656bc952fc99a1e14bfad6781ef7bc717a529e353167f7a4b3b1e4b7278fda63bb4894c1384d506dd9bf3b2c5d312ad15baf8a61d6ff9a75 +Digest: 65cf2f85b9a37f980288284795ea6efacb88345105d5ce13785ec4b28c979a3b9867cc0a5bb6e5a398319b791fa95331e2d95f3507d5cd742c095b9c9f2892d2 +Test: Verify +Comment: length 26272 +Message: 34b77a3914ae0f4ba8d43e223a15cdb9ebe4faa703386d4586d46a1308cc4b58c1452e09e47cebec2d0a49fdb96671111baba2b9ac9b276922e486da65a3fbac9e27245090f7fe252b1610e15e85e6332e0ac1a705308dc94c8f138d3b4d70eef0e5c6d6bf27313eca81fd96d17c16674b89bf37b5fe87ad2a5c79f534d39466e2087b621a156d7e31d176e3b953e7f59ab10532650dfe5ce4d321daf63c4d5c9917aabe49c8982f8991e592bf1043244409f95fbc66d81fa37c710429908517409abdb0f3489b97f946b1698abd113d711a04886310ff3e8fe0d23a76d823e0fd191b01c09e5ffeaa7a4231c3613988486a8f7301135901cf86ad46851b0ffff81d2c795ad1cbaec3b400b11105a24df28300e93f78d0af8cf668eefd6131bc5b2d58df66e9c6ee6d7d53b31db036d497edc0b2c5464b92edb96dfb86b2715e4bd207fd8fef3a05d05ca3fd8e6adc645d2e38963a85b1f01b562234ca17b72ff293a1997aea0e3c13d958590d3b7c476fd0cf5d463eec123d55f1636e97eb7578f88e7cd2e22adb5f7cda8d422cffc3f35becce9278e3407c3f414e1d3bf5790589366e3de0762adbce9161d4444b211255f9b3c63b7ec2009b79be7d0abd83bfcf023663eada70b056e69f6c8c49a9f3485dd28a8fa5dff0f1037b360c2bdbd151589eee0b3ef7059c3f0db10ae1a2bfbb80f3847d40e074ca464df14928c86197a16c83488a05032905754cc8fc569d37cae05f0c370db6acaafc56ca9a93982a4669ccaba6e3d184a19de4ce800bb643a360c14572aedb22974f0c966b859d91ad5d713b7ad99935794d2222570a3167733a532eda0b0eb17510bcb581e4995440101a00ee2e80c5f74faece679b372ba237bcd2556c75e3ac050d30c6f8b3fc66496e03eb2cb0bb826a2fda9a05f018981fa436cc18383fa4f7a80e200b141086d2154b5719519f81654d4cd69283b5bdbab5642858804dc6ad34577963e3180a71b8e01c3e8afa5e09b12e0588198a7acf95634f74759678f15a13b849499d59efffcb20e38453801e03870e30d9203528ec3b2bb43ea12389c24bc5056e26db1391134d5067324f6cea60d9d2ecfe578b63f5a35f04f6303e130788df793bf8a717c089cc5a1f33ba0fc04eb679ad49c1a1979ebfee1e05d8f54de91f9264187138dbbea085a394d11aaf5523a9b372924f2c061a25a00c1f1227d00ce32aa33b9d6bd3151145da7ab236d663a49a39c515b9c2b9d004acdb0f9c25ef911401cbed78b071268e6d7b7f5bb9bc91e908249a48bae418d34cd397b4d010c7ab9ae9d10b3dfceb05b69c2b28e6779829467587e0d6e3259456d05078b9b7ab75d75ff12a620089321ba75ba545dbe3e15a81838afefd1ecf319ae2efc82c65fc1ef4f4e007c3289d0562b9d9bf329799ae10374d1a7b2b0d45f9f622e6b61ec8d86f8332148eeecfdd97edcc3ac2dfdaa9ea4b3112a576d4fab53417f99ffe5f6e99452a71a9064f090c9f869fd5e12ab3d6663ecec324afb89543d8ea2d2c4b463ae3cf065c96a5f38a7610d7b1c514349d307d361d6023e762cc6da2a9d114ca1a0429bbefc75a01d81a71c99eb41d940753f533fb50baefe476dc085b14406100514179a9c0f59dc034b15ce6d6cf3cdc74aeaba41cfb38e3ea2f038a1e5972b5711e26d4aafe2e086cd97ad052b192e43eb18861ed6e2a27cf6e7d7f16e767020dc8acb6acfd1c7969ef0aa3504bffe75605b07aeb9c2e77ce9f5d832570a7adcd48f197ef7bcedbd4fef3a8fa26ecac67b20d373d0caa9d8fcc8bdc737e9a7e58a5dfc19a00aef6540b1f2776c9bffc17c185df0c46085fb9fceed22798a83f57e75d7bd612239192207567ecbce29f0e3902bc7fd3ae86f43870af6a4739b67117520ccb3b95763544ddb28588bb5df5226b14bf3a06daea87f8b96311b5ac4f3ca8bda0026c6be6803f4e68b4b4fe7485a830f303762240f16f3a3b8184ea995e46d67eef11394ddb8384bfc833493269a05844b76828a17ebb78191c0e35f685149f8c8beaa8115d929caf4da207d8d63dd4dadd43b2b337c5bc266cbc580ebafa5ff35d607fdb0e52de62ca68000dd466ebdcfd6f891e23754d89f8f4198a04e060daeedc8852f7ac9200c7edfc7a6c03e672a054758b4ab4756b481f42126caee86ac4c4891f1f88ffb0cc99c3c7a5fd0dc64d5a3da2b5687af4e5a6994df94c40ca69814be98ecf6e9b62d41c9b883aa8fd8ce9ab0a6b7aa54b56efe7e4b3a2b024657c96594d6727e91006d19e1ba3ff42e569856c74d33e992364f37ea2997f9d3e1c3117633a72c15f97a87968205abbe142946fd9598d05d56c87c4cf17f75f7ec8e6cad82f974bd6ef6ad4779a009007dca0bca1f6d9b8f36e695e41055e92acea7b1ab52dddb1fd76df564ef73aeadf9f71fad4916cda05d462f3004cfd5d51e9b9b1011e8e185c95cea8f72150f1f2f4ced27b128c9293053a2b15d21ce9f42d6834c4e9f0aa7cb200727afe8accc74180ec9d6082082669b9b08781035e1d1e504e06764c8fe4373e5bdd782fa4e7ef50ef426596654568a7275e40f9e3552438a5d0ade9ef1c8a4e0b2a7689a0d867038472080fd1796acb3ba3f647a022a7eae1297611f1ad15f82b69dfdee9241064523631377349d7ee925d8d36be0f0f2cab1ab90abd1e3e0663a09d77a652513a0295c854743d17d8d494ec0c65a1c4c7abaa5e1d7cf76f3e5ad9979c00eb944c3b98b6affbdd9251aa50fb11bc622e8388e14d9256c10f6ab91bb5951f764063a646e19031b2b121bc9aa28fecd9b527eac76eb172028650276fdfa92a7bbd47eaa7323e3e43da0fb179c9cc1c8ec27d7b65a9c1f9453bb94ddbfd21498372c0b0c39103491876e531f65811750abb4be0c2e70c120f986cd26af745a615c996a0a3e7257abaee69e61837a61fd40a5ac4e60ed8e6ea04336021b55d66b92990614e1aedfab0a86475e74fd341741572cdda086e9d5de7d49c0a20b1b4f7fa789ccc14a3f1820e9d896b86e00473465aa3a5bb165ef1aa18302c1e89b658a514f826bb8f87b987dec8adc5148f5804dcef4f1118512cb3c7c48f982c9463902d1e63f9f9e2dc7aeddab4f5b90babb6be59e1f1bb9f996ba9ff3c77e377a1248ab58bb5282d7351936888fc159ff5c6c98862424870bd3a858a3aa1f68798c9f566a7d7658e0773981a32c47074bc9bc525daee07eb2289250c9100adebd2e834d9bd46f82d1f48c497b93314b18b9d7ad752dc40394fbe4f2e4a7b4fccd7e710b5d8ec29334338df882533487fe734b047d0f43b81cc43cc986cf926512d3051a3fdb040c8fbabb0947fab53065ac82e1d5f1e3fec227e64f1ff6478a35e29bf4a367a8413d0090064ce827e6d6bc1bd00044296a2d8d9dee20ca38ee9f23c21538a323e3d49ba979f1aa211dda3872598c94886ca76ba0412999eb04c6fd0416502c1b66def263dee6bf2547d88822e8eb518588d848b9c2ab13d26f45f4ce529a40d34cc48b6baf9ca5a8e76a41b9f8ad09b54128bb36fd159683708491ad6467aff0082ded0d5673ec209ef7fb8423323b7c182139a45b09b072cb0b6a1dc658c7f61b639de57e1d0120b119fc3dd32b555e904a2a8e66e7e024d162d49be2ee076a191df46090e8732dd038ea2392e8f5e12c1c24519b40a41e25f367a464880ca063a5a72b0976b0bc7eed4bf1ed0b7b885e0fad9a72a48ac33b6599c3a5c7465d9d932c81723848310faf78054c0374d8a8ad2cc59773f2c88411f176311c22d6198edb2055bdb83024e814fa2a5170368e7d386f544f8a728280f548910740ce89d159641e677f4e313fa93d1285dc4691e8470433879065c94b2b9740192e9b41031de946e60bcfc70e8b3a9f01377d3586ef00dfccc326cad8eafeb8a22ab0e1acaf1c6989fc5958ed519f2a64004efbc176f1937f912a09a2d9fb8562e3c3ee367379f0e3bf5f695482c74f1ed52057309563092068d3f8417efa10bbd838c929018e7783c3666acca54f77a214b5da4cc0b1ab5fd8d9392d2096f52d868404fcefc657dab6f2ffbe2f942e8e4d63e78e6f89f47e5f9e2ede853ead286d3a144a74be2c68f8897ab18831ee43edbf217e18387f1c7b875bce137d934cfacf896a56d26fbf068e7e4f45b53163843bfa84516995aaab49428431b051fbbdb8d7050cbf9c3d6f966cdffe7a925d9f4ee5398189e2a96d487599869373c5349a8f82fcb23c64a225e8fc090e8ba2ad7c64264f15f0b94009576678835339edc9156cad66bad53cb1551bfbed77c31d4919a3008a1a3aa2007a739e0c7aba47d8fb3a9559a20fadcd43c85da3f14f8d4958685c72f9ae31d251695d9b74c6e15ec3755ae78c6463ee378994ae82987bd1c2cea95d09944dd37e803dbccbf038aee09554bcd483fd78a2c83789a64e4796cb4e7da4b48d74985480b4ecdac6cc6de523192614ded901181ccca1d6d19eecd4704ff694ea349575c369a83baafaf043972edfc7e5952bf9efbaa38eb2e06890dca6af254b0c6f44c0b27b692d62fa7e79fc365838a03deab987fb58629a7e72dc084ae0107a6a541135e2ddce82d1083407b6503888cb4d22cb15ae714bb2ecf6fb564 +Digest: a9df8ced968a6fe80b4fac0e171f14d5325ed5f3b17a9c254fa381c0444a303a903a94b54a87519c2a7ee1c266b2c8af78646ca0def88b11bcc7576f2b24a776 +Test: Verify +Comment: length 26856 +Message: 030ca2fb111ff69e9497caab0e7f519aed1d06110d6c48fb7fcd47da89f9245eed3a54366edb462691dc455aa1eb9ffaf59007fe76a838445b14dbdf37b2abb3368cd73fa350a7b9ae0163606deb710e20dcbd0cb9915e2b9c6f7610a37459d0656cf2bdb868637f746cec667a680efef569f0e4e01101d9c945df15d42578dd02416f58b309c19f6a86a813d148bff3fda0672ef20f6a756afddf95d2ae4e04967314b99e1d084119b75e107975cc15bee7ec91f872e22807013e39a6f8246ba86aaa88808b818f0768d8047ad57d8bc2a745b5f924af1a29b8c4a857ea413ac08df86c623b74aebeffdc98dd52197e91493b43fd0c1972578a388aed6bef9a6646c80e4b1528c9c6e63374a9d3ea15b13396e30d126a591adf6489716574b323fde0164301e706a583a53fe63f3679accf1e3c2f1ee8f6f91f0e4beabf19ac7e18092b53e7f78de540f9a19c8046d10a849bf76d18dd727cb2ff78606126ad00000bf581afa1870d84f944d47d624651b9d4bbcfe88ff42b01ffb9db33e3e02f1dae1ed7412d1ca6b66bcd961ed2000bd892315c7747a58f72d6b6641c976b96d7ba4b5d85e373374018e7e84bdd26bf489d011cab4cac2f6e4b1602078c76ba97f6261a640bb54889c838d4eccce0f671bdd2176de832935e2781bed9082a25c32b5716c4ec0962f9426861e9e75837bbba4c56a6615f44a832a19f7b54ae5ec52186598fcf980cf85020972a76b30a8e5b18e03c005ac9b6341badd5b82bed03a05aecabfc8aceeeb8087f98c11cf75269debd190d4caaeef59af0cf7bc95be7707bd602bb06304343c7201910b9876fad45f623d05c70ba3cc47152e7af2ed758921f7a5434bb5fb9068396aab2414decf6924490b3a281d34137444206f13d2247d0fd0e3df6abe26caef8d830ae54f19999639778c8aa80ba4a8fd5f529809441ef723349698d86a2ab25e25b54ed83d514672bd46b9f0cd7b319e8a56008772987c0097f9d6e6c4f8207105abd7e69520a3a95ef12c73f3f79ccc33e1d3d92a69dd1d90819b75d1c3985a95671716cb983c31df0458ae09ba48eade7e987af613b8cea0c65ce21b0da86f776f62c54b287ea0a008c50b9923d49f0c84b4e940168d986b20a1d80b56cf440e3d619e9e41f97a646708190cd4ae4d20acbfa0a2f2da0f3228f0a42d0f8b6cdc4999ef2f852b237eb78852ef3d6479cd5f1f3d99391c97a857cff2eab85b4e642c5253995292306162dc55bade65a955046a1c9d49c3d63035a630dee1bd6d385e4158464aad25bf015a7dea3840507a4516da29b56e2f6c3b09ea741c204dbb47dd69c0ddfa87ea1ba94817cb73038f89abd2b8fc8a17bee0618c44a832647f719d04937d08bb650a4f50ae188c37175aafa2d59f96339abe5382cb465245f783f6b528a84644c2559304279fda6fa43088d71a0f10e7923d368a62571e66b5c770f81b0031c884963aff1ed21c11b893cdcbc0db98b837d5a10fc45ae54b3ce4a249c4e5599b2e44ad8dfe4f9fc1c70cf51d94858c39fe20296f4be24577ff43e126c0f83c5121d9415d3078f40441f48538ef8d69d157a52635735dbd516f6dd41b9989387f01dcbcd97feea73ddbe2f49a5c53c002c6cd2dfec55dcb7c1fdaf194b9490c6930c7667f170127f2d770d9de45991d62de10a727dc32ee6c8313b03e9a97f6c44111e4daa05104a7d7069b61459dd0660008385d02ad94973b909655d7f6a604b544ae68a66ebbe14d1cbfcfd7028780df2c47eaf30e6c709bda1a86dbf588af0fe829a583babc23cc3bbd766447b147cde55c7e07d5c4ad4678c35e21152d27b374fd1de2b593d3b6ec2af187dddc2f5edbfc62bba43b91add5173831c5f20332637f3e2dffb195af967ecdcc4576abf4789e55a8fa3fb244778c91a89875c61f4c4682dff9c3de18c33f678c1f0f423133b8b33a385fa3ace89a16dffd26e4dc87e99873241911851ad36b41bb048697a5e1f809ff09da49a0d624627493e3fcbececb720f4fd466d5d125a7a9f4ed9a3790b072aedcca9d28c736ba9f3b57f2596ca8772bc69b50bcbf33088c6efbab614b691ed836f929e8c3ea42cd9b954fd049cbdd0a2bdab51804200ea2c1156ddb788e590ba6fa727972abb580133087bbfc822e1ace171670365904bd99df33eebe9cdba9ab23095349f76d7750ce1c94eb87e4ee4bd4f76dcc6a851d67cda0137410f132c217510ec059f4e3d2a280c39d299be523a8ca694cb12a42a94534f24f8744477a4bebf45c5fc685f77246f09803adafd3e721eb2de95edddcfa5503976c4f5832452cac94556cbe5da1f1745292b4aedb24707be66f8d4f8141a2bfe24c7cd59877a5a00ee741fd63a5f2f753432b52a7f548840cb0400824af809fb68447500b77e977128200d3b812ddd210b18c4bd8be1cac174811a835b8811b9ab0595809aa6a8a45c203c1b96d149d215a41eadc036f5c9cb37c9042e126cbf56d0d4e21a39b521f03d567e61939d0fbaa06b02059a30de37edb60babde4195cf6eda2d1e81e8714e3f006dcabbfe6162d255c44157a38a206d89a3ba33b9c480a750698dc4671bdceee4eeb990964f750482fc5eb37754ee7de9d1435bfcd3cf42de9f514b5aa70412aa0c165b8d615bfc9ab243f7d4c40ae67e9f2e9c314a26092bd6515eea9d2d72faccc9640b1f7d8346ecd86ae163da6ff114633f80b2ecc2e01675453e86bed77a38baf3371241602eb40556c7b8c7e2ea38cb8b12918936a467a54780ea2109d557d25039c1105df911b201ad4c3a0610144cca0f72652d20d2c9add54fbdd0b131f7c33ab453404f0cc7b4bca599a20cafcf429fdae86ffc5ec9c0673ffaf4b7cf1293627470d2daab2cb71c4d4d7f85123d3de8537ac3df148dc55e41403c8e380c09d888d1db3ff8ca52f4ccbf6524437c01156483f271fafe07e2def771de74cb6dc578dc2329fb87cd6ca8561b914c76d64c966bc55b1b02cd199c875b518c390750cdfb713ebb4c6fae6b796b73341106b56f9a01457c825e2e0659c28d873d1ea20e958e26400282df9c921b730437d87a797871d627670347a1d36e3a6dbefbe2c311438a928f4c2ac408f438c3cf93c03c6edcb72397048df75e270147a6e73975d95612badd16b56a43be6b79c180b23fe2099078fca9278f63b48a1cdc28cfab548f65bfd227a816ab41b32ff5e7750a3dc1082f7d3a3df148de7cf44806cbedeab82ca958c92c51a844b9ec52103425e8ccc74e01fef9a6776d7fd7d2cb55c303970e80564269a1a29124b8c242151949f276e0723e813556293dce62bd97b607f6b44db3db869101ee9d9b2dc6406ccafbbdeab742fd264fd95be0e026b64d5e9bc51859dcaba62d24cc9e79e5dea9d2ae4376b8529602c8478416344cdd11714eeae72f8d026a8efb58c88fe41755c8d4b18b5db6734f2b395e7646783288a6d9cbc41d35b0648c3aea22570e12fa1635ae328eb5be98df78910bfef1dd3c66030fb60b1ee01c90ab29b2b9aaf81f2399e37233989c624cccc6da450107b51a935fc6e18eb81b0014be829efff04d57c8f75334a83737dafca5ed01eed879285262fa87ce60e8463e509aec56230b1a8993dd792ab79ef1d2d54b1c017712fa08c15ce626010bc8f188008df7b9e1d4a65f19ea694420f914fffc7c820d08f67c23f4e4ddc30df0f40ebe672ad957ede5020e70ac04445a8bca090bb9c1e1867831c86a3dcd75251189dc6437abf6cd0f25c4f13a22927cffdf79afedbc2711c293e3618c48cbce0ea1606b655845ddec6f44565cc492c838e55452682561ff23f04aaf135b9855b4ff5463fe08cd83438995885a13cda4fd85a2db702518b763f0073e1a2f6221cb4bbf3648e21428dd1abf6e7c36ca7917676c324ee4d3a34a3c20f4e9ebb49a1b2caacb8c0fa43583cbcbef0a5511b04f32ba3f4a891a2aa07ca0bbc7b813286b4b1c0a11b70510fb44c0f54b9a2baf6b8e92eaab3d75b42c578c7afebe093385501ddb2100bd230d2ca667882b9fe03325fe1bbb276da9b776ee19d4241d232fe2b526021556d5832c862c0930f5aa719c05bac07089720981cd7f9213d86032a9edd3fd1c588d24eb672e16d2b674eb9eafaf033f5275ea1f32967fb2c052564fccca5a3e49b5b7125154f73869a86ad105e2ccbd4f1b22f82445e52a5f6262795bf461a2b3b405484c86f38c96adb6dd0e3b631108cc78b5ab740aa23df620d1a1375a711df2d63661ac53f3c5eb976bd3a30f6505f1b6fecf0b3743e07856ffa67c8cd210d7f18397af60977fcad5235a0019decff0a27a99f3b435d24ecdab72ac40ee13cb20d8f7755fa04bb237acad3cc9a6ed3305d21012c99f9be24d7c0eadbeecae3629dd87e79b36b20b87afd43d67e5e720a6ae3d51bea9c19a9e1a81694ef56980d53951ed5b7f3b3d8bd3d5ed3bc246214fb42698da7dcee0872ed3c63831cd11ec955d70e6a66eb00cc1ba328d66909dc68fd5d067404a1bd1600caec3c761513698b15685d1d3ccd1208bf6a4f950fcd4e552dfab1dbbb24457350838e0ada97beb57898029f3faa4994e20c9a20ba5415fa3afef3aab0fa8bc56bcdfa33a7f823557ef1fd555a04bd40d9844894b02d5a4d2277abfa199c53675b100398f3c141fb772aafd81288f78cf465dd7977a585de72e96d526b8636e9cd1e3c93549f95181f968cb00f8382d9d125cb478759131e8 +Digest: 07f11a1f88fd1f56c19088891173510fbd216e85a10b0870cac4d1f5312751852dd7b6ed6b355c1fbab67b8b0095295ee126a1aa1adaed196f2f237bfecf7c12 +Test: Verify +Comment: length 27440 +Message: 513dc380cc13a9d7eb852c02898bb4dde10cdca60851180ebbba9b8f5baf78ff36da076608938a0dc29c10d7890f9ad402947d14cdd707b94f3a6550b5c7c4623568b745975ad938f5dfb3b0bf33e0ec01c26ecfe99888ef841952eac8f215f9d74f9cc7824fde830cb4dd3331e0cd4c67fd7980647be3d8e0bf2a029c19b1eca3f77e92d059e0149085550be9fcaa1dbcac64cf47675f9bed94b5433a25e16422c9254e8962291309b9e4deef70bf868639f863994645613301bb52a9fced89da2b58a4b651ffa9fdb85255492554b04f0bfde562ffdd51396c03daf1881d825586e13b5e0eabfef6ea67170102b1c39e8a3bfcaa7a6f94873e56811bafb9781b4386bd898074397bb7eacd1fee1ee6fc1e7a517a9f4351a5e07cef2e5b0892b2c810cf3f91a4821587a51ea9d3e241f02f818cd956a1b11cb83dcd327353f9a47f461b892882034ac25eb3a99846fd02251954d087d0dc723061c330dfe2d479cef2496e2d55e1a5d0de3326259242ba680a51661a19f932afaf782e87fd4cb71fda01f7896647ab19ed4729620e37a1601c2ca3f7c430e19cf0953753ec89e8d9c7ea2b22fd5be6065297b93701053e76168d8f0619ab0961ecc1502bf6b2936482ac12e16145ddfdd7cade8cb5d31910c21b33305f8f31656ba583f765ef4128d0f0b4aedc2e18674288a04970cabb98e67f965be007e21035e9d79f7f6a798d7c5e1a72b43e20ad5c7b08567b12ab744b61c070e238a3ca1134550b8d48c3fb4c9d4b13329c7c35ed491d9b1ed2710eb967ba58ae4dfcfbc92e0323d6b4a7da0a564f7b9e71b469bd9ae800a03396ccf83c8bf98c6c750b2380ebd0a4d4ae927c302f9040e451b093176f6e4b5ca118cf863b3dc3be9763e8d215f83dd05f8b6bd4f23c5f1eda713967bccb65751a5907eed30b9d6ae969e0cb8784ead1432d9ee9a0664546d7167533d70137a88af6681b5a4a6098f486d2144b5df3ffe0e1df1842f63885d0061023c6f6091b7859bab6d8e455723e2287556969a081c10df409ded381034ea9d2de939423f66ce9c56656c0c41d51a6c835e79239806b1ba6637fe768e7d867820d46c1cc62ee0e51d4dac6f5c4b5785b5ccfbf05236871bdce2a19345af7a8ea57e5674d87873025a76fde2f8df002087329d84d933e7901f4e9512f8332d4d0657a6dee8cbeb70a881af0bca08cab9922fbc459f778993a7ac3779f8b1153fdde0cbbf7991c0cc81fe5e4e22611dad4104f6d71789b3b2f0bc174cd991c8d396ba439b0d828952713d7a2ea4705f983e62cbadd3e31c6a94de92e01d6dceb4bb449cf616f6abbef0df8131c2af26f6c4b9b93e470c2a270e8458e8369d8d3fd60036551866ae6e7b4511dbff85fa458e8a2e0d036d4364c85dd7c9a7b98ae1518dae3c946b17fd8b1e9a91dd8d5000e654c89e7b9f1ec05ccb7e18f34a5e55c83d73111d6c6ec8aabc9a07cf3dbeb58699e777221a02b6264dda3aabb86de9a4a0137715f3197c54bf7e82571f9cdfc9ca290b8966a5c2cf657ac3339c303971461de31097be651397d6b6079b70ec3a75fbd033fd5e52b292be272d5e5bb1a8afd0c98fb2b43f51c630f74339e167532dde799446b2f27a6632fafb8736ded54dfaaef5ec9157a9cafbeabc8354ddae425f4c3ceb4a2e814077a3109f583d6190fa17e59ddc4a9626b5f4b60041cb9663ecec90537a6351c1dab41f1f4649e8193d78d15f0b848169eda9d2294e9dc5f305bf3107ca4d866afa92798f7780d36753664ba89581f605117e9376c1d0978048589170b029799c45e2b258627eaddbda54b6f310ef8e68bfd77c715210959c132d2446d2a3b5d65b195c129d9ff21710b895c6f42995354768ef9155ca4a96f4c17bd29828c5c998aac9369f612a79b5267aacb5acb4db46a77f5f635a11117baa0aac774513b68d1b9c4cde6ec1a42612d81cdbf567cb4bf7be43f16ca38bf64b534cf6754a5da6e047bde1155206f202308fed9028a5b5ee0ee7966e5c772329e83cac35b40f84ad5e122e0146129779068e510971cb22fee3a2b8cbb65350ca2be40ef2fb4c94b741e23b9f387784ebec80bcddcddbf1aeff1ddf214bb12da0b0db75598aa555a28596905b837648df351f6769a728c08293a18ffb87010841f99b95c5dcaa5603bba7a2d2c1bf61c782b3075998621dfe53e621b6e2d37f2278acd6c48bbc043f36ae09717db35e3957d4130a1bf84896b2446aeff9a900d6a087ced1f26aeed999123ad411f2acb916faf117ac5bfec03154920345e22bb323a4c47abb278447456c9d6718edbbab62b047eeb41daf2f539f5dad322f6e5c548c7e3b4082532cee25c7971d052994ad6c7e1bedbdb8288b7d142a48d12746c5b752702cfbd9eed5d6400078e9751969b81a1b93acc8306b865c17148804e6f9bdd7c5cb0496f1aee67d2fc70b0c8e2a0b926a507b4dfb5633ac000fa485d162f874b8b53d08f9dbdef57171da7e8760df7d849e99c7ddee1d7a51a4c7087a93ffbfa585f5ae5bef383f7223e8498990bc41f6f898b45c859c4d987e602b66ff5c2f3887df059c5b8ac1ae37a4dbf94c2a663dd8e891fbdf48ac50f6f05d1b177639ce65498d3f933f028247a0c47af59270c5ca19ff303dab0d07a9082c0b7ed665f398d5c3ba48dda89abe5c81732f8cf82b46ad3a9e332be618ff0806bc98054a348cf44790cedefa540648a1765c9252dad902f29a5243de2173807ba2f57b3cfdcc35776797cb9e5ad9f592f90f1b1760fbcbb5b91dab4badb0f2095309c0e4dbd109d183562bfafb93d3d47fa9bfbc3a1957e28ef79ab51a01ed1e41674ea84b35f1e4887c6896c2be73e47eced8c7d2cc48076062caa0f310c248f2709d1dc8658e3efb6d0a085cc446517ae0feb0d78f0c92f1f193a5c5582217eac834abdfda2f3f30baa8b6064fdb9a0882aa0d94dc262398268e2a0d328cf99ec0ade8fe2e6563ece79d267bbb942c8c266344b73e2527e77422b4374a536c931c413bafbcb15b64768fe0198210978a3ea2ecab1f7a1e446cf9cad00a25ef4c1dc74a611fa3745bd9c9695c4dc159974df16bdd1a957553636bd463fc65003e57886bceb1ac4d27a40228d08936f117e6c758e99a27db890a01677f8ba13dfe5c1d36253d4c544c47a2a502aee1dca06bad1a4d2871bf49d3430a6f525af6e09dee2010fd04185e4723746f29429aa57f1b567440337f3a21b923dfcb02d9a99f73b02e8b5407c2252d0d72a2e9a9bb838a63fb6bcdb9cea7cc4a2d603944adc3667cba62cca11c53f7e6b9863798470b72e94f15a0ed7bc804f3f4bc5ec661bc1edc611dce82c1763c86a06dccd4cc897d4cebe86d98c5f4eba7a229e3dd59ec0555af06ea1b55ee6363c3a419edd08002055e3e842a31c108dbd25389081ad5c28ee0d89fe94e3f05049fc39f51e78199b92282754053beb516f1a38ec5190bcecec2ed605b2eea79ffa166cd9f75f0bcceb57eb149804098df7ca495a2d8e0a2cbb1cfcc0f5c636aab54e83525007fd3cc936de8c45be92c9bffd11e1fdf16b6dc39fa43746b5c3f9e36e266811b61871958fa6c3f5b3ae8d2e7a3889a9ff09396c7e76718e017715ed3cfc2423b584f5b528ebc18e298362ac0b675a1a010c171e831976b3f379853981ae8d6c4c685093c9568ff9693ccfa176465d363e9c904174364e9fd3f2d13104e3abd5c2ec08953c8e341fbbff5d75847c99e600df2b3d1a740238e909823c8f448746613aa725483cb8e766f49291fdb216138d00707a3d7c98687ce71fc1e87928a86f77b5aab4082438b445f95ba98fdda32f25e761a5f51b15d6b3302ad82997e135ceb88c49997ffceb17173c50bcf5802b771958198890293d963ede27fcdadbfb653a32cf98d11a5495769db9e06690cc1d8dc863dd018bfab8d0459d9cfb7c0964c2060eac227a37e49de4ada439bd593fcb1a499b752355406ec702ae01aea6f4d96fcd7e7b04dc2f147bf4b075ed19075cb4946bf5d99556a0cc1dddf5581b3d05d5d6b6e3a08a9c64c856ab220a559bc7000cf488950424efbcb7cede62b166d1a0effb63368b5314359b3d49fb5623946478df363fe8cfe2ff982cc4b3ad97c239e1f502ae257dac288a0ff1a861c84c4aa1d307bf8a8202fd889db0355afa6206734dc8f0a142b40becc922f9c1b17619507904fd3263d51f4fc9a8cfffb438706fabbde447c9b5458913e4d6bc089a394b7934e2289ae5cbb45ab769e3f0cce09bb6ea735e3b373e299340279cf240125a7aa054b350ba6a81f5e2ec4fd4a7bcc117568330bfc05e94f43dd4a799f10c47244e3c1cadda657c44333e8b88506da77609fd037eda0d91dce4c52625348fd9204883acd8cf226eefb148df354f5c16790cca20a00cb3eaf43ce360be9203d716960fa8fa210b1e9e64f293032df0d5cb66d0cf4cdeb865e34d149f8a92d00aad3eca5b3a568756f85525ee197190ae121ff957aad984cb511f4129b4bc5e3a8e4a9b0cc1f8fddca58bc739a0a3a667f7402c02e3847fe3e8bb53486298152e61c16902b68fd7794e0ec1bdbf4c99c921d051161f6812774d283041bdaf5eb0cdac1e8642a17cf59be7fcbf9ff3d19c39d74fdc850ba34d2b6ec25fec889f867a12a1e08db85418331d5f8a6720b6a8e65e109c3ef79c2f2896efe917ab417911fbda58be5bc7aabfb8d165405bb0b4d16b7b9e71b463e3eca6a12668a1ad513a70b136fe133d72e6c13c97522d278aa109782947c8623120a9bf5f05f14ad69c770ec174661e39513f8769c41d83f0ff3def86e8bdffe36ca431dd16237fd0e01bd9 +Digest: 94a68ec55b181ca4acc6c24da70d183cae1ad100a58ad285ba0e62e4ca25e0fccff484fed61f8aac202da11e4c576235e524a04abea578e15a7fa4015eac79d0 +Test: Verify +Comment: length 28024 +Message: c732999e50ab34faf9b932c778ca9a069a0541448783326f49bc53e8883f46d997a78ec9b5caf36e8c3327c2fed3a95921f3eaf1886daf4bc51cb6392b919cf9d907fec1f499df9b33b34973a1c7376e9e41b37e27bc3c3458766ad52f01d5af933c32ad9582bf2af521e203e80e0cf018d7e414edd8a2d20bb2b8e31cf9b8a5cf2d72b620ec5cc2db6538995b10f085989dc5da612aa8cee5b8e88b78e00e8394c206041e3f7f0ceb68935e8335abd5257b9df90b1818d0ee7042f7cd1e9ff0ebe335be17e2eeaf2f103d7ae7e60489c759b698730bb97f2fc30e4ca21b3395da78480d913f7254af467d141089c549861f56e0226c5284af9793b5803e921a6c69871816bdd2a372f39a548488b4bc6bb5c6f99fa1ac8677d61a58eef18326a69e3a082dc4d84380fddd63cd499a8b7d034e0a72148f2e8d66eb5d749cd0619200a9045fbc4adde14e8e6973363e5ec5f1353b242bc224fb314eed9aa53f7537751c35320df1189eccf58dfcb56adb4968c5b63c500f0fc91d8b30e97599079de6dac23020959dbd6159f8f230e4ad134e44a042ea3c98fd14e94de874a5c2cd3c2cd4e15bfe1349f404d2dc0e757a2b8dfb24be611266a1fdb16c200a2d4bce5d5a93cc27f323476c3c4243b7e5eb970b3267391c5922bcbf2cb717a0f74da833ac2679ed3d75c1b34a70ae93fca761b231943b85d97357449f54579ccd6e64a569b67013a4b0beb07685a50a825791683fd14a0359027973556b68687556099adb6a3a03f07d474b07a9b0843ea22d17a546f0fea3762a349525d06ab7ae9ffc486b5e23e983636c47035869f9313fa6ac1db4de7d78726fa6a9190c5d1e2fb2f9e064dd576b1afb7cbc24217babcefd997b1e0cb0b05a0cd120cab52d4dbfa436f2d59801dc74e0effb9d148cb9e304b78ab7ee04c5e9f45eb26cccf1e45aba47c937bbb07f7a03e8e949aaf40385a34d7206ed4060280d958686bb6f8a05dc738c15b02cfc334daeaeb24c7a30bcc2a25b94722e281d40bdc5a0e970e8caf20364f4de3dfaa8a48b716060e8e89049ff6ce7e394c6d276209643bebba6b0e43f785eadab21dff2c55ada5004d50a20accd89a93be14f950422f5a21a6bbf9a6ff1da853d1ae21da593a882979d312ff1a7022deb229a86b29141fd53df00fcdbf6f1cebc8db90e7341526068e80e5f1622d8d66b30bd32720aac372fab7af3cbb029f0f1216aae778f6050415fa7966265950b85b5c0808cb5c0b87677366586460d53a17fffe4f9a35bbce8a906bd1e99c036ff56a95747bb04e9f0ea3a3c55e12260974f7f9740a5cb0b266f33bd93e5e2bea2bd82a1ec44003064ad905e80a9f27d9a38f3b195be36a5c359347c0672820b36925345c3773df69c6840b54fc5041371e26219401526f2870e13e4c2672885837c222b147d42a45ec25027095ee08be5f6d4b789d4225a3a37d8dc0eed5d945024f93b277e97a07363ca9ef89b0f4bbe1c5273b720b345a37b894b312ca7a06732df5d43a1c554a3f4b50162a518bdc4fbe23514245f1b8b83301b744b91118e4ddd79b20e5326b51d1a3890a38348be3c8fe5e605b144baf7d4331f73a04f8e1df977baeec9807385002acabed95376865e6b76ee2e28f87e7e7b7acb5ec22f4b3d3fa469b0c9a3d56fc1581ea048b28259af0c05602f0dc035dbcc7c52d2387fb1b9b8a68f690eb470e481ea638e3bd8879af072cec2c066013b5fad04e873605cce3dceeec87ccb097b8e4ba78dd92ff012695e0047da18ea837987fd6aa69746647d08554eb5c2446fc768f6ad532f9d00c0f17f28247df99b6332c4c29acc7764be7d4d63804029a6746ad7567381954d3e52d2cb633e356b65d5e15617a6f8b749545d6fa6edbf09dd78d3f0ffcde0df28aa819a6202a7dcc698dd90e5cdd04366b60edaf0720e804abb71e3c0ba87a0c92015fbe87255d4d0a43fd7cbea07f25ccbe70c23771ef4025a39977ef1917768dd1558bc36493cc9218f9292a5a6ab75ba706d0aa3f84b4e7eb375011a064b4c080918a7f58bfdfa37562b02a5b355f7ac31666c9fa36f764f68e310dcef06beca79a3715721fdab0c1a09e39339da2bc8b35d10122746c2f4df4a75df538f064bee61e206152624cb6694fd163d2159377dbbbfa58dba7996a013f6cc3ace6cb2f0bac1a76f5fac9abf3418d7c912c92017e94100dcb2e55c34a45c4bacab38280516d8e5358f8ca1af51fb7de495c2ac0a4d5eca1c154c6f22676e03b20eb1d4b7dded6571a00d0abd536fb197928e03dd51deac55cdf7f6f2c2f69d53df20df8d77c9d22a7975fa72a23c1be9f1734c185c884d90c12e1a2d1fbac09806cd700f4c34d269020c9b54a62a62e29abab044d52556d5d939035ae58415876b00b0c6c4f60d35231c15edc8002f8a76aa56e8267d6e2afd5fd8017c1a442bf701c63948d62d96c4eb90c56e8829ea6b8d668cb6583e9915e9c2aa4c44f4899017dbf13e9dd794cdc233620288f90962a90ab8ed7e6d29091fe8debdcccdab1f8c17741013b53826e9264eeac946ef444868f533b7a4e2c1497324377979988da6a14c24006f89b8a892119013b9a5f7b0a8caf0ca8bcd26af8a0522129d58c0aea200e42cad8f69479f315a2efa326529f3c08c80c9f11e995608e660e4f4a2eb4119b75f1653220d7438b2e1b09e74fd715e6fa10757924efeb5eb2bf3731aa7a71e046052dccc443aaefff583f20e72492c02f5ec056b17ab94993a75dd0f28fb9735f80a334d321819a8331d351ad2a4b2ab4321058f3c852e5957103a6bb8660db1efe65e8f1f37031760236f8063a979d3554d5fe805b30a91486c93159d1007e00d8d677855bef3b34740a8286e8108e3f119195db95eb0abd632eff51f200d2a19a855f21bd672e4af1ae9fa3a53e741e02d3dd5a2ada90dc90a57f388bfa7f7ddde31e4b8a707125f5939de11489f57e930d23a06c97c21e99bd2f71e145eaf1fd8023575583aa520a6a1bc3988b78cd6cbe1732ed9b14dfe8e68e92b48b9baa83dd0cf9a129305baa9287cfb3ab7476ea571686206d1fbcf8a21b1f582418040b6a4996ffc9b9bf509d6069f8627f278678a01ea78639225380637c5eb7c6aaeeb857b3b3fd9cd996eb3426d9590f4bdb834260d56ef7ac8401e64e2abf4debc837b5d4802d5046d82c818ad8f7ab5054178bf14c8fd1a8049721e96e9314530278e27dc6e18a93aea1c71a69c6b9d17a95db447f816dc15fb084e27cdb908d37ec7c140ab2922c851b733a1e2ed14bd99ecedee0bc1274e00eaddde80168d6d312d14bce090d9df5da248e68c8782bdb92c52512c8764f4fd20b1032ad03ec6e7c8069735d63447b6e496bdc0c24fe0b025ccb881eff9cf9db0b4def26d82a549a1801bd3829dc70585076ea624e3ee27df416a32814fa785a4ccb60177c0d4febf6b8ee21c7b29f28e82406837a6afc5639bb068c5ce446003e3d57f766219af2bad39892d36332406ee7d2b8301eb33b8c0d24b44de6ed4d6e08193f0cf3d04eb3064f13c36ae44f5356b1a8f5a6918e69a180285e8ec8924ab03656f6f08a409da5742d1e261f9643e525ae31af21df60fc9b610528729f52ca31e7aaa41388c9559a374a416ec59f17c1607aa4eeaef092f8e6e860759524ba8e69ae8b2677d48b33caee393c5df36307484704526d96f90b326ea34c341f05ce4559121dae3dbae360608a12bfbf5b59ce0d69e79bc29354cc0e8d50fcd030541360d5739c63590b9057908c6b71654b7a643238da11e6682c5e7b4e5fb6cec24c2c41c2b2f40a1ec319f903f1a8155ed5b1f9a078f386b7dbc4f97ebd51359b6831f375824e32bf815e2013e2c1f006589d1cc928f5e8b642d8747cc62e0931f00847269b006740536ab226af6d69c48b7c381d4a8780f5fa0f98c2eaabce486c15c9306d891c53a1e60bc6c7f8f73bd6e5c8175e26f3f989e0c2dbab68d92134f1063d6a66d66bf546b97ebd033cbed3504931e45296334ae28f4178d3de6f03106aa8221809fbd60327b90efa8ed0094238177da8fc35e59b5a7ed37b22842efa830b151b3b85ccb1f3003e6d8211d13211127a889a73c261b0fe6bdd6a034125dbc0c3feff8c31b987debbda9af6c3b670cd7b70056f69dc3f4a8268f96eb218c183bf21aa91bdb072cf17a05de16935b392e10da19b546131edb7ac75192a49f0ae5721d118b90d303bc27d3f743a46662d5ba0138a1aa745428c2651a4f23fd5bb2c8e1783cc464cbf5cbfb421af4f14d73bd5bfbe1504f60370551394a270ed34cfb4d2855fe224b436f6407c40d62c3b122d2a99ec00a08af4b73f6ad373a3958134868ffc7754d4f1af88e6977228c37f04d8cff830f15389cb3989ddce9578119bc7f62a6c597c0d49e1e2fb89a70ac2fb3ea2d20c44e7c01f969449d83f36c1490b6a5237af33fa53e01415a3137b8e8ee0c4f1f937d20812dafca0270d6c40cac55f1c6fc277496c17dc5e54ea80422e53a8e09e368cf2537b3579318c82f0af8a46d18b3fb06ae0ddbe4df5b8d38e580bc12651bd82ff4ffbd11d9e49055145cea42a008399ef60b63c5d2bfacfc39a7d902bba595e8f66d15235b3af8e035c07197e661a7e374a35c9145e2cdf62742da8694e867a3336a02b3a183c675720c7f9573270f7e32be106fc12cbad1b63907c8764c1608b4dccdea3428c3bed5285d63cec337163842c588cd053a33ef74a8edec3969be80adbfef9b8fb76365fc532b7f9be7548c19c403f1d514c5d8dc05207b172a6e9fc31eeb5e226a0c2a70a8120f19e9e038295509b504112e7c576687ad4e1fbf1a0832050648a3602d6da64205a40461445cbfc2a2faf916e0ce124a0946115af86245661a682c0775d993e3e9a3ff7fb6984c553f1f94270e2a52921768c7e641bb9d3522eccb +Digest: aa65baf5cad35dc9b91d63bd2a3acef6495b3d5d575b81ae6e83194e16af6823396ea1469790bab4f82e63e79c0793f63c90425eb541683c01349434a356e2a8 +Test: Verify +Comment: length 28608 +Message: 3eee85fa5e97af4d30ff1d537378280cf726b6dc5cb416e11c452b84ccaecd4e9ee26cfe2badf6d86fa6fb3f155f1086f5de7104dc51ea668bfdf74902782a09fe18cdd3c0abc9021068c6a88226946af8ccc9926809ac5fdf45529fc6d707806578f0a4a5f7ee731a2fc4b540377d6005d808ae88442673210486aea1332d5edbea1c9763fb2dd495e23f8fd9f8920f26ea7482c56a1e4b5824d99d1af4654968569ad4811e50cd8a697d5dd5d39d2062ea5733a6e35d8f8c8c9495ba8275e915a4b38487c71d0500acc748ba2f643ac2c0f7ecb417abe6c524febd074525e8e9bcaccffd605e25ff9264781273b1064c559dd3756fcff80cd4613e8ba63febed86d0dc6c50d9d48f059e1464094a2c0a8f90107351936e6884033fce0b899d27eb66d45cff57bbb9edbb453958f75304571acc3626bdf0e21c2ee957ddcda3a1d1b5de53d59f828430043218c882234196812f4457162581842864ae85d1a863220623db3a7bd0f9b7c10489c1b146c9320e60274a66b64da539d75b695e5273c4a1cb7b96b14d1e6a3ae214ab4e61a41509886769754a4e65ab6ae6f33b49dba1cefdbc510aa2fd31b6f542ee1f1fdb25bace8a1b0a8a8dadc447d88a3236a39fd5e124d34e779ef57f649af2ed25744c685b1ac7ef1e1166ce93b99509c1d1a8fda03d844573079cdb58a5207f1e7a705d569fd7eaade2760f790f7e89916fa390628fcdb63f421013f9e9de9fb0f27bdfe89fb2c4df09c7d01f64ac7a4f8477d44ea0146b8357376e6ef0951383e6543739a4c0455e8d3f58ad3f87a4a2190e128dfbc22ae64cfb36e042aea4405de3ad70356934cf76c8f14c2977ce33354f91462540bc102b43b176658f1a8f601088b6db155addcd49e124a9e4c2aae0229ba2a7f5e9aafcf62959e3a23d17f6c312321c2c802e99a9715c473646ae226f76c90a48785cc5fee4b0444ed58127e4910d83166c6ae2d2e91c8bd523e7041e6be2d6a333cd90422ba40efaa974fb5b4e6e953be73ab0ab918efe2a21fe8d18c216916de0a664aa455dcb1082997b10917edc04b8460c1cb0d7279b079bc643c38cc50d488e4a1e7c0202f72898aeeca264dfd7a935fd0d90228e919f65b588b66df9ed332e488616bc3c1763189dd5c849261d80af8c667795bc75af0564d0e2e0b674692e69ca5cb200d8fbc14eb44c553a3f065ec00fae5838ad0022db01900e830ab135b2d3960dd6a2b73dcb7276afa2a303e7a1f17d948aa35a652104081ee817d4eb2d870cf446dd60311cf58e80e6b33ff537f22b713bbd84763dc292396d039bf9e1cf0590d9f1be484727dcef8fd6812e8bfb0216d26548fc3a2276879b37cb07d694cb081646992856efa8252473923aa4f548acd7026ca01d0bfb2ff9192fbc15bca4858644b9795034394a2df43bc28ac6465ad3fbb909f0676a5a10128ec1a530d92faf54e6e43ee0d88532c0426e465844494dbaf7dfbb1d0b2f668bafbd8ed9b12d1bdce71027dacdfebc3f6fe5df918aa0cda6eecc841526d785ea5b59d99e76a8524685a7130a60de52d98cd05d5b5f88db27657655370379f5985a3d8d666ec7daf8884e0b58d94d7df65fd6c99d0d2900a52685356bea3e3cfe7410b21be3b33d5cb8af15ac7f72c4feb2a02a3fdaaac388f7a22d99224ee483717b51a41b9303d8dc723cee9b76af594bd588280f34ad39a17543a9f4d0758e182570e95f90b2d6be3f85067580c66ff21eeb42f3ee451eeca58183a8ec758932b71ad2f6d2d4bd24bcfadc55b992a971235c74d00113a09fdbef0f86cc6edb87d854472a80f0f5d794a25983499a6d8f8be2a6ec949f2784be9436d595e7ecdf31283041c38fe69f6d85634657662413ff86c091d0721c61f778dedf72692402699d7584c238f843f0ace3e80b7f37c6264fab05dd13e5ff2da3f0ea897bebb829bbfe3ba673938dc41ec2af8e6c0c70a9454d90e20aec26091e553f02a5a9c8198bb3ae96c81f4391e3e6e408b50dd92f708f7c07e0989d32f0f326066fc6fbe0147d24bbc0042e010439cea0e3a1c861d9590f761c502e5121b4e6bd62aa19275f42e73ce2aa16ba88a2b77f7d2f06e787949354467e9f0eba7fc94e05bdea9572ec3d42b779c3647708e5cd0b215c6882264ecce689b910c13b15e1e06835d357616ff5c6dafca8da55a1b116de8f8cd3f9890385d9440041d213a07c11c488168bc47c97338a2eb870335325ce6afc81f48b24aad608853f2b0bb160225d5db5508600b2ed369d1941e3dcc059b46094fe9e55dee8cd48c52e453c1401c9fa3e9afba8a071c69d05b0f9746fe7345f150108bea8775af1dac3086a2118d006b8506d9de82602d885a5bc42bbe0b3a20be4128990eb782787d29e620ecd392a2c5a22061273b4f3a008756f2bacf9d17e8f04db1eacef92d3434d4d638ace0da1a0630ca6c2a2995fc16d2248b3ce9376e926dfdb2287dbc6fe5e53a9b655581f0977d72d7a9570c8b8e984985efa90fcdcbfba4eb507aa68ec199b67b897b2af7fa88e2f025520e6d634bda51344711750199700ce39a6c2f3c54e25fa5cc457ea3c5a32c4aa52be0195f4f73b76ded02b7a9c77d3e378dbfcab936ce36b3521307c62c0275cae5a225352143f567e2e562bf13d2ecec8bbf01493c2db8eae153ab0cf609332dbc122b7fe8685adfa39b974bfda45c23d6bb54676b24a8bd73af020c89b70f682fbe70920d57742f9f93c9c2ed482877ff2358a63c1982b57983a1376f7276e4a115b91e2877cdf2477c8ed65b54ce43758562782792e36d73701d300fe1e63dc0a65966a26fb4a23ba43ad8d040aa20da60267fc617274fe202ba68f38be9cdfeeec62e03a5e4c9dca9725cd4a2689a8e32090f901cdad755aa2d54b2c6fe3fcc5da3b6d490cad3bb0aa9d4e0e0761b11798eba0e2a8a8e3ed4ca75b629afedb98166a39dd6d35a473665d37d815f2cf4a52c01a8b692ef1e21366e862a5b6236e88366b7de9ac801bb1acb131b804ab8535578f847a074740de5819b5fad37c5018e92bb2e8d979b175d4e49f585eeccf2bf7265641fb8c0f94c717e2ff1d9045aecaa302d285353b991bf7ac5dc93b311ce9078828d268571ff909711e5c04553220f8f80f785cc405ca13e02f0d40b2ee765ba295538521663718eabe5783888c345519077a9751a1285fc236f2a25a8ae44a2df247887451c86cd646d7b3e7a44ee0ef23538eec557f04dadb400a31d87bfbb0a6761c59c8f62cbd20a43c7962b5c101c9cae89c091529b084be1f40c08597b319a8e7d7b3078125b386c747afb321d762a94d6aa534f7cd9b358a8e2b4845beb3a591f6fa4492986745fc57718e28fa57b6675c112296b8866df223ff0d2e5adc34c3be86f5889da4a882b3928ffdf10ebadb7d35272df9af2e0008261c790efc1f25383d628abdd2780263f8fec944f17c54d2f98de4197c405c4486bd4f637b2c5e6b08d2c17e597d236d8d23b37c67c67865469ae49f576aaddf0938d8e0c1241760d08f546ba27f8edb3745e420d75eef3d02985513a7759be296d43b0d36cef71d7bdf6c091346eab5e0ae83b8ab0d626217cd5ffed32ad05414dba17243f4a7acf20b31e21599e0016fa4b9cc4a9b79dd6b8228e6454ef13d6d9331984e5cce151e5aca7d114218c9cc70aee51cd0dbb5e8fedb5664aca9a688451406c1cf155ee61660626d073914df5a898a897431f2758b9ed3980b9d964d3871440215249131851a1a93b1eceb90a97344f94e229df96f99e749327815a4b671db7bf6a2b5e9f1212ce908d855c7a7939ad42757bc5ef3f619dfeae02b75053c52923a37d3f5a09c20d9d3a65a6c9a121482c7775a8b5fdaf1c2fb7de1a86ef931b1a88cf23ddbb47fc9dcfd0267cb173a6bf62b7c68fb6ff85b2df93e2539d1013f0a491aa9e991cf23e98656a082cb95f87c1b2cdd0eddb51048f94ad4aeeb48a426165321145a9b4ec3e85dff0755ac8f20ee71d2e24cb14a13280e9e15709147c499a68da23868b232cc1f6da1de079aab4d542fbde37272572b9169b5876192ae7d1ad5dc52c0b7fddaa5d0998e2f7fe6dfdbdce8ca82eedcaddc1fd75942ecab68b8e10ad12ac5eeb9f612378caba8964d10c1ab2a69286a54f5a6c30dbbbd8203879974dc2f44cb121a19c301037b863efbc74d2bad86c9c8e6e8c1cc556efcf58fe6619c559c5d8c1acf8514c0627d5ba3d418f4d872c0b2b7cb19be9665e1e6d8ae1b3827356cd0fd1ac5ee69c4424c10d152ae725319ba6e39120a080bf9806bdbe8d92a78c085cbe4cab686089eb84aa7448001919a871519f5d933c80b684f5311a7e8cb20548d14dd95a09859475a3c36930f940cc2b3520a529e05e1498c00ddc9e89755e54a9246b33edb3ba2477a700e23c3361251ce999ed12841c92bc89668b24528df0a464d37e8390c711948391ac688e220f674eae4549bf490339582abcf3b5eebd5183a4a261a935bd88ddbdf7e4ad694aa2c454db0c4c247ac4eebbbc6e3c2b0b4f0541381e699098d339c84d672db1575def1016c0d72969edb17bf1fa41bd7aeb6e4bb8005e6234021c5325366b94b6072372710ddce2412244fe063e53007cc523269ace04250f73f9d107f8f38df72d15fe7249b9c9a0f10da461910cae915ac86468bdd7538bc756e47e1552079b4e1b16a31b1a59f9e890218c98cb12491ac287aa765468496ab7efe012138c02c8b74d8bf86b1dcc6770d7ffbc1ad61483b5f2c88e17edc8ec9175e6859495de4b8f259548288f98fc044a238178648433f7584b4b7e5e7aab77f8f9d671bf7e44e71137a0df19d014defaa07f6038089a1b0abb551434ef45dfeb828b1763732373a31b88fb570250656bef1c6eeb2224a59c9131560b874a4de0192a122c5d85995d996709c1c02d3c0077def0d851721b705546d04ce31726593629de648de9ec9349d186e46a09d77ac33d929a26f0d148802c0f63833b1dd96200f8c694aec206954f0f398084ac1d69bec09b032f8b67aa475ff9d +Digest: 320b0cd2631fab35bafdaf5ad66b9119f286acb988503a87ca465ddd63355429797055311a86971418cdccc77287194c9ccf6ac26149b8be4225f0092dab3fb8 +Test: Verify +Comment: length 29192 +Message: 9a41d8a2073c5decd50c85efa45c9fc6ee4f8edb48b92ab7e490e3185b9da844a977079e79b29577a4549026f488c35b2d97aab04e13d781145694fec02bca7e1aca2117b60a696b76d239c450d0d564516e5516e20204094b4507de75073f00f421703444aaa271536ec7f1409b9f8863bed9358dee7bf7914783e1039bce713f633a1eadfc0830441084d44d52e7706a6e7c34d63f02f2ee43522ff14d417a047ac8fc7966625150a0b696fe5b76c36e66873b465e62a26b22baefc7875fc24a4d62f72e527a7b8006a65edc1f142a788e427463b163b00fca044a0eb0eff219c44f3756271657db2a9c556e06884d8ecef405b8a1ccc4e32477674d2fbab179c7d9e3784dff8c69f4dfa33c799cd3bb0ee616ca976785ed185d6f0c6e88a8733e46231d2cfdc3324db96fcede1665043661d023f9fa9c378ffc89d3d4207e0e11df21cc2cd7a43f1b70e1ad9ebfaa732eab5a4a304eb0c96f9ede2bc94cdc5329ec020db557d697484d2360225f4b0fde0cddc7a52b6aa9a289959bb5d26a486cb5f1682f430242ba985a6fd1beefe02ece8123bf5872e10e05d7ac017bcff7c38114660264cf495b99b16312a33fef07386de5e59f6f799d5ccce4130fb468169a938e9682e6b311984ec24fd8e2434f91ca9581c60a7736d49bce5456c0a24e4697695365ee88c6dc5917ef2381e4f022bfbbfa96eae5c0b76def2c189cad51ce487da2d490d061aefbe75a4dc4dbd03375e0b8d7b7ca254b69d1041cef91097acd55e9987494ca565bbcf71e522fd90b148b23511b2f4cd9b8fb422b62565d914f76917941dce91ca31d305dd4e8f1f4c345a3cbbc1b1da881f5500d9d05345df56a033fa0aea647f8936cd4f10f0234aa95a00f42968002ed48948a47a67824e8b8a6b23814e92184a5144952abf314f20382e356a95d2d247b7869083f102f4fe8e19ab2159af06fdb8e859fc4acdcc317b110a05a9c724d1662748adae4c653821ebeb5b9a1fde1bd43507f6315d4445a955ec7b3251990a1bc71727edc301c0fc4e7ea09e69001d49b719a8e16449e53969474bce06a16a5ed296b34e0b7d1173bddf80c51f1f7a7ffb299509773f88b1d7c4e7cb6ad07aa5d641b03d8a19a20ea6889cbcb67ecbed5d924ae80aa7b8890dcfefb8d298b3674ea2af3ac37a0b43b50424c3a3b08a286afe2b2b9314fd4597d2b414f27c8d39a82410c44c10b5a955ccd9988b672da7bfc7c632a509bf7de277e57e2efe90837f608578887039b6056d2ba9b1d53ee1b8899c9bc4f877789a19e4430c9145db30c26db61d0affd0504f8b55dbbd267cd1ae2ed55753ddec1b535101ffd725b768d44a0b5e6370aea2ee894b4d718ccfb7cffd6de0be2b3ed29e8c499d22a89e84009af6e0fc44a789e4a5f8ab84ca50c74978c4059a17f77c661668591647072ef1e0f72947e44171bc51cc6a7977b68cb521861a7a0c9c6544801ca834a967a602ac8abbd8c80306c01d550ec21d47749da812b3d0719429b449a52ed01856a5cd6e3ffd11686295aa79110cf113ba0b5d4cf8562fff75362fe3b041ab4c5a8abca67581a46df6cad5f59ee988f354ed8eb0b5660b0ec61731eebc85189dc9e15ad5c9dde42125f2dd034d28ec54ce67bc53c887d417fd4944bb386d9a854b26227cbb66632a76ca1a32aa4fad907d1640a6a0202da39148e2d9926fb3ab54e59e2bb8afa3f26fad37f434c24f3ee775c639dac37a5a189296da891ff6785d9c4833403e1911870890d88b2543c8a402a78de6e63c73f9c2cb3e5ad2d564ebb69b53e08654f05388cf500bed2db629598f03430cf6b9bb361a65a63cc30975b101ee282cca173b9a4deb359e5f9ffdc6c73a8dac4b73e388eef0e9c261ce923836627575fb0ec5b9870aa69d7bee77f6fab415488d3af917c36093e8143cb7a8936167066a4f7863254ecd7ee51a4e4693d078663e87628f322543226cdc5c8e936b5b529a51da23832818c73dbbe7522d402599f1e1c63bb5bf6615de15f766c0d0e0eefd9e41773b1726fad83bb9861163bb3839c28ac9b8af7b26ea722eada632964026bd74eab7ac667e67225b7f0abb97e568b226a5c57600ca048958dfbe20c9da8817bada835855e64cf8339953c84a061129204c66938593cec41c79630c1a32a445a9d3189b83b71c35e861971a503ec5a01e4a16987808abaac0175f5505cd0dbfb87101e66e653763d0643f1238d3e8bf771b5fe5569d2db60a15edabfb2e16ee6d10b9d9746520fa821dd650628a1ccfa13cad1abfc5c77e5111a86188ca727a4e5ebae5345b8b7273fad7457bb5b459432a78990216fb5c1b771a363d1682cbc2977f8a3cacb9543c87dc71d2db51f4c3615cf0dc055bd7efd2ad6a66b6da5b60779248ebed5d2832413056068f782aa88dc4b29c154b8a34a0fc9eb41febb1be6b7d91d071c9570bb37d728536995378ec4a4ec0cb5ceb905e624393b6295712dfbc0578ee90790f5b3e57ed653817ab195835e89c0264798788e9941e35d43460b81443b834f6e3b4ed669d9fc6dfc59168f8821bce9d56a8db0113bc7381698afc3ecf734978ff3cf53f244ad8243ef107171baf33eece3ed32ac115750748bb12e58a842047d87ff0320ffaee8d9d94bd0213dab4e136b5fbb6facdbcde487d86b8f37f6c0bf5da68ffbf347c646818f55a1932d40d26aacf364f29bd7eff4eb22998d98f3dddf8c9e8b06c044104da4a8f8a2c13db1489c8492ccde941b3ab3fa7f9070c45f7378d9d921608cc1a751702e54ae6d396df7130122ee2ff3c1f89c482ac55cce8333e7ec2d70c3e0f65f554c903ef7f142854bbadd11cefcf281b0fc42e1e3b2768672cc103814f6a29701593db704612d0ed1c4e3909ac03318dda4c00a8091b4361f82b400a58a13be195d4562bb12975950271eb3bac6ed83cb468b895bf5a50e9815ff109e24b09f48618f87458be92f6eec75c15696898b23ed8da69d65b1d5858ddbaf284de301346b036ec9548958d31acf0498b96df88d9eada86e6a40528df32f276b8b14ab8586895e70f6e19c28b916c2a6b60392b063d3d9f58bba4e594ee3be8e69a966e4b709a162f857c315d23144a815b2213543e77f5b50879191a6debdb96c0bfaf9086b7dc6e25594416b08d2c75fe16cc347d2e3c7410fe3dc030a6c161ea22f6b80973bc43d42d8558f83b32a1bfa3c03757a4d62e7ba0ce26e4e12ca06d6cde227762286908657f8438a31fbd164599dd7c80454c9f1d34cee92f800ac109b0806ee7c316389d9d39105925f09878b3875a452c46f1a02c28cbe67de99b6628224e88ff03fb2268e80dc1f804ccb9a7c55f77dda629f5feb4fbba58c5432eafb8a4da5e9aa6b05d018f7208621984d1381a7cec029e6b3703f6ffa3365eafb193e0304442e1c4041623edd9911566da2019e8d9b4c59c5f864c3b0fb55485d844af4f42a532b9d8a659a9ddfa36dc2d4dbc20296545e5f2cc79f0e0babb2d7e5b506bfc3a001e5532af1aa835f45144e19fd75d6c85f47b46fec5b8cef9233e48823ac369d06df43b72d4aabcd462bbbc3362d8630c346376490e0a5aa4f3728ca3202acd2a255031634c68076d9cfc1df5573cc15f2245eaf75e57f6351ac5a831b0a4cc83e0d3b4ff06629e164c70877418fd0fd54a9d05781b141a2005921bcc60c3f0640d192684771ce9651dc3992e4c9bb73519d35649e8e14efc408267c1b4fac141267b06b2331991e06d6fc392568b5fc51c737dfb3c220d3057f11cb021dbc7b1a973e5f6becb000ed7df873ecb6e522bcf07ccfa8968cd52b8789b163bc96c2c22be44d07eb3bc46c98d64821f9746cfae0ac3c6552817e9ee836372675647171e9493cde7663f3edf13dc0ad7a8a62735f702ed13e2654c66ac16433904b118e9b1634dad44f14d74ed6e476814d8d8f3570aed6a2a4e10cd5d241725575298307f23ee24f29af927849bb6556e874b72953c35bc522add6f010d4cb0c0a41b7f68660df2d164c86373d4d624081a05105c17649f0c93e8d84242727fc31e1922f7aa4b7b740741b525ba356884197c78f64ce866bc11e9a59b5426c6e13927c7c75125335cfaeb9934ac427774fe37f90e1d3fb7e31d563376c2b84aad8dbdda31fb19befeb83c8c0b2b8bf53d40be3cfe38d907141e952e6f1ec55f8a7451d6d2189772cba7ab0a23d880464f798591610052e8b1be4ce2deb8dc9a0a857a4a223a2d036671bd901913be0f4e1114b2b1042bb15e44e3ed60314c7e90599db0acc058c5318eeaba556d93a49b9fe20d78c4c2057c7ad0ca7e08b361de393286cc5b995ccf67c8f55356bf9aca8e840e22c2c4699ea8b9f692bf900826dcef492b5c6d1e9284cebdbd5f80765d656131497e91423756f5fe38b670c60c8d1a84245352af1d6e628fde0884bbc6ad00135768b713c91e2b4dfa9dc42011f24aa451d0d872e2ad3af84fb24adf98cde720c701b472e666b06232c608aac98506463e456cfe64a9ae737d0d215636609ce622e9f7d3f1b92bd79bdfbcca85bdc3c634318ec625ec337e0079c6b431dd87dff5722fbb8d8df41a704b6f03e91509c0fe15cc5ea8fd70945488a97e1dcd4e7ab94a9a9e1c7dbfb75a898deb66235eb2d672942c5045dc4303aa38285c983742e8d3e6f010d0d51ad52aa7f58f51191867c884b3de7ddcf6785ef12770c6f8d4fe9e83561d5fdac15a9f3b96b736ff6e2c980c8985ddf94b2d27630fece2098d751b0e34a45347577567b753903d48209f519a11f90ec7adbc941c564371dff8f6c9c610285391299004a9c08ceca9dc2a95bbf1aa88be9a81157b7ef6eee283ce3b797d1be94ed4350691421fcd8afd68d4f08d1cc4549e353c0f0e89c1b7da95d066d0118ce6c3feddfc7ccb487200e48fc658b25a1035236855697e82c649d8393ccd9ba6ef95481b49b511e5d5830836bbe92db277dbe63add3437baa47dffd659aa0cdfcfb49b1f07af763e4bf04e5a2fc2c155f20ee81404e357c1d8d387284c19f7801dae7279c4b07aba4bd5417ab05a2fbd254ac3947aeb6140b9e708af9271ee404fdf68bc0f6c91d24bbe6c08ec33cb70782be33c8dd0c6bfee24feecbb664388dce3e84626285e2ec1f838951 +Digest: f5481a05f1d06dc3212d8780e5f75734ecc1c3fd7149b5a5302fd700d2fdd120e86f27331a711c397843c8cd389c2eb42bb45d5bfc0b4ab1a36d6b9b73e1d772 +Test: Verify +Comment: length 29776 +Message: c978f3dd3f2cd9614e6b140a8c48fc1846aa685f1496daa5b1b1f64c0a00393195f3e7d3e4a245b87a56090cdd4b0f8cedb44da2730009d1fd5c4954ea798c02c18fb775c7a2526bd004f46c551bfcaec764823523b88e3ec7ce87de8402eee7f4544c0b0db46844f77dbe731b3f2d477dc1f0604b46cfb4b61096320023c7a6d64b8cdde160ef0998c94d66583f081eb6d37d6b143336fb7229609887647f08107b6032692f4f835af18b9033a4f7fd1ba3129da50629daa421cc58414e7ed54aedb054cda8f17ae6fc5f38d5f461aa5338983f2747121bf401c1b955682cd52ba7658936543bb6e3f2b0a565baaeee079bf599c17f588409d02904eb3af2cf5cb3651accb996fefadb68200c7b4591dfd213f39c3563de8c96eb822d4d368d85199a4fb6616b1bd3c06ef1f2c1905b82e7d895dff19bf0245bef78412861d54ddfeb6f1dd420d615a8aa603e13f61499e12ec6b33b68847a281d314f54dc705c0f3fc428981ff5689c04b519fadf83cbc9fcd0409c326035045df480570e265bb080940037ce4076a36437aafdb371c1a62af9ad9b614dfef89708fbbb5ebef2cb9528cc399781e4c5b22f1aa4dba623809f8a23c15d137d0bb3b6e9073602c86766c8b524e17e5d0ad6e59077bdea986045cac9948e7a5945994672c4fdb8868cdbbbe3821300877bb8a135ffc205c84d0303c89e5d4a3bae3100bd791aa9d342dc4b7dda97cf0a1f41ab30c352be5c4fc17b4767304aca4f642bf3aef79d589251beabb5d4b38fff574aaa4bd6defc6e677c6f757043af2f18113becfb5cbd83225d979a3274be21e3c8cb20b42e4fb3de4c675286fe915636f8beb98eada91e3770661119d93e8fce6bbac95673fe250c335886d84019cda729a4a01859c46a783f43a2f1acb851fe7ca0ce2278b0ccda7b6a97d0d4ef9b51ec14260129b76fce1154d622b3d36d5d42a4b882040eb1306ac40fd581bac81e8936d5b2e22a351f30c13414b738edd207ef0edddec0dbf74a8f764e0e225df5473334914fc4c555e2b345307f8ed84411a8589bcf6d521561f252a544d161bd6f33cb07372e265670528fdcd57e379daaf81f239fbd1f74f8162d41eb6cdc60495d237d6110600c22c59c817fb011c41807e9df165a49fa56238e8acb9ed7c51ddac35996107c5d3f35f48846cb6ea1a3fc4136fbe9d891c540fee8ab0c58d433d233049ed9813311c91d57f278571c9500ac901815d5208b9504c354616a75d26cfce741117775deaaa1584b5ed21d343ab4553383478ff14b28838f43129044d0a5694761660befff08f21826ea8ccad3e0ee15de36c63f8af290225b5a0dcf27b6f1777057dc8cf1d88c2377a4519df2b8c186ccabacbd79eb53d55049d4bc99b8e99ae751d2fca89b9032fa0a54f5c0c5374ef5ac2bb3419a3272cae7ce534d32b8786d5dd4894bd8650e56237e1c658eb93403442a68098796bf733de1db6cacc6d9ab82cb790218737f34f7b559089cad019b789225fa3be886f052f69e1dae7b8548c89d15f7e2224d3c8fe2f3d1757c7d675249323c3d8e8dec2ff6e289c13f43ed3733a54fbeda3f15f2ee33e9a38f700fd938d7f615f29d0ddac7f0d76c7add42d875713534031e6828bf6178ae4da23b15475c514c7a7dfb5d531030389419eeb24bc0cfcd05b2dc3a3fc5a51c1ddb920f5f08746990f75fc08089bcacf5c09acd9edc451048c31a2f54a6997769e2bcce662487f49bd1e10938a5a250059aed32540bc0863519c90fe84e7c469880625a46f8b47603d4284262aa0bac2d6e90e8579668b5327b92e3e2037512127d2cbce5cc21762fc8dd72e6e11e49d3062af78dc56427a8b31db22a0eac623ea1c1fb2de8f67c8975a7a2ac9204ae61286468e0dfdd6400871184a8b74abe86b3ca1f04935c1078a22fd99b05e4633d9de642372efaf2a0c01761444577ae517dee3154177bbb64191d1f9d81e7f1d12c578d79f8e45bf226d652e6025abb08c5d63804ba7a04b5a0187c995035df839f60529086c2275c80f75e76341c6c1154293cfcc58174d400c8f978b8f5b5bdbda8986320bddc4898218edc24e44ad5f290462480ba912701d69d200250fce64dd867da0dfd041d34fde9001adbdcbc66b35c64324be6176aea717a756d3b651897c7dd97a926431d3277ca5d29aa2f7a3989a4245cf80d05ab7b6e5b75faa4e68ec15404e9cb221b69402337f53c94f4cbd2cc9f16516f98c2c5e5fa8fc10a7e645c279de77a22f54a4df1ee671b549d1041c4e9a078a6ecd657c59ce419ffaac2a13faac8bbab757ca51ecba9ced83db1dd744a23f51bc99037f8879b89eb3050968273b7162561a8509016e0dd879c55aec40cc75135f6986f6403dd9a37d9b545d93fda14f8827557311737d1c881a5bd9d76b3135b3d9507f35ad2d2496d9ab62c58593c8ca08cc1e716d43005b64811e5cf10c3f76430058cd2a1bc8ab4a6f064045d17498394969c5adf85a501e7b2866005e97034107316b573dd627682fb678c0e2b98f236de372c8155102b2aa96671bb0e2e75dd587b496fbf3a7ad5df1f389303dfb61aa2a0d4e12aadfcb8fd6f495ab999ef41bda2d7bee9788948a4734f15248797e7eabf9a298be63b3ab6873209731969e2a973a687e3866b83534a1bbb18f95d46bc7cc57e0122b257dd9872f0c316ad6824d600f336cae82df48ee2ae669cd0de22bf9f0a13ca27b87989523831f8817c37b32b2a69aec7ee8d26ed1596d7b85823706ef54944630592421a094527aec6e8f270530498d27028fa84193014dc5bc7777b672bf92ee531ab128a880bfced417b17968ff2cf58ccf2eee2bdba059017bc0e8742514f005cac82e4810c329a4a36681c9323875182f67597c531fb9e1a276f7d15b590ff1e2db13eb9931a740a0cab0d9893c20151ee5f60cee0862fd9a1e5722c8bb78a7c16e8c1b6067a2489e3279124aa481041c2f56662316ee85a10b98e103c8d48804f6f9502cf1b51cfa525cec1d0e0275a5a7fd1088b7a73a75e34f84831dae231c08ee12554c5a4e538edeff66d54eea59e45c949567478c8719bd95cd166ff97528dcda5ff3fc4d286c71a4be96a0c29778e75abfb229ec3333958d583f848bbebb3830c37535b9e75fb7849aceb2aeecba4fdb8e04c8ea28a559e3ab15a65a4744928e163c70e52efd030771e9eeffd84cd8af86ebcf06d6036d213c252fd5ad697e7aded6487f4db8f6a5ea84d045d885244f20d396b2a9c251de91ea9b8e6f7e5e6f73cf26e8f20815084b0be1016c17b522e268aa7e3266aa7422d27404fc17b4d47b8396a28a8eb0773a0babc31158fdc341f784d9fe64d97a956933a9d1ba04525c90024c95a18bab3de09b0b56ed80c8d62cb0567c41615a304b651d9ec9ef61ad71144791e4f8fcad47393aab39c08c0554b7642a80c4bba9c592b0a1ebb87ad4a327141dcd7ae42e8c00d19cc24f85562bf49387a785f7587427038984020678a2c53277cf940a384b7c809a0b805d4f0f1255122a2795c2d3ac96b4275ebcfffc79336e7fd6d730f226982199f57c666a7b39688d2c2f8f608deac04a10d6d12cad973032b5c3cf1c79b8c1e2315b32eaa9b0e945061d04b765602c60db1c929ffcce8b9ca3685916e0430988a6721afc284c12f637f6d924ad9767002fd6cae2c159cf22422d759e14c756d1d769a51b616b83f554455354d110feac619dd071a5c97947f49b9b0e71c6486246aa57c50fafaad6cd7129a47a3d51ca12ea49e9148e28824d3b3fe471c03cbe76bcb9856d88f62f1612c2b003ad0efdd644ad9598184b75be74daccaf35c24ad9f920d915780452b09294e3f7c0949c1e2562239b085086cad10203849777ac0318544c920d43d64f8936dce11871494d150e0fa7dee629e4e83c359c85ab3664729a3c6db9334e255f1ef73a252369f58c07a648fc6af3af22ffdf4160fb9e80a08934f2fc611ef49cc3cf7d773992aa02f5a3f8f15d688c09a37d3db9e728ea1a97d2ec474bcd1fcabbc2157f1237cd125e75324e3bfd0e14ed7bcc00dc89f3494c72943a51cd09516d7bbcbd4bedf12288968f739525a7dd347786c66a265ed52db0954611b363d95f58bda2551998bc2a845af1e776dbbafedcf89b1e726f26a1f959eb1a0491bb17e5b2debc3f3657aacb3f59b1653c36c3388bcf4812b6b64fd97ca9c945358f1daf16b2efe35c8d8fe7a71b71752be91806daf3957bc81c9dcd57f2bdd9a1bde71153df6e9a7db650462ca7a62b3d4a73b440a8751205b1f2319666564678dfeab914b4c6c91c7a82733a9ecdfbe2c35ced674e757a123f13c2927521101d5dcf12c3c376f3ab32acfb4b51677baefc3a0eb965f5185fec48ecd69facdb21dfda9adb9c0daebc87165ae97ff10f144da194b18fa2715162281cfd4667ec08aeb3ddd69ee95ec2e074fe9f6af93a95401a1bda1bdc29993927df6119d0d74462d1384f5c989850c74f72d7b2fe92b46c0a00ad9b208599d9dea09c8a76316794b956a04599cfe8a3ec342ce86f8bf439f7efa6ae0e29c5ac930d1a08d66ee4acd29563fa7b79ed2ef1def96bcaaac7327a355f94f38acf5a1b71642560043e23c39114dbac3ae090e6cfd7bdae63cfddf78e33108f3cf94aae89f560a185f69202c64d89aa6765a24183527e793b50a4f636cb712f94e606e293683b2968806ff6a1485504a3eebb8895c3feb9b60c100cdb7367534718074e3a171546107e1635becfee3954ee452263d6eefe5854b791f8d543a8b7f1c447fa9c9fb632423d367b3eb5b71ed6e7b599f5af9596ccf42bfb6b968e5c25e67631633ac8326f4d8f630f3c1c565b1b98a49ab14df5c76e417fa0e072c806c64f9b05671a9577bf9702cbf1c79fcd4971f040a455f9f68e68d21fb2047026ec3a83fdb51bdfde1be3d6ff77474fbff9a81981f96c17bccd08bf227b91e908d0dd78a6955a8614dafc5c142d1a0aa5c4c18cd910eed39ca2b78363bdd9971f0c9f05aa98350cbe85570ea483ce45010344c6b08b5cc208c7ebcb5de91a0efc17f5a7743e59e82da37a7b1b2bc283646da86392e94447a3751bf37b9df1b5025b77da9de837ad04addd0e0285a54a524c72c00a8b23e8df62de88474cef2dd46fac1b82263cdfb60d0553d511d51e3d282a8882118a3a3ef98a163b6660dde4ccf8e6bb98f7d4c46979c91d60d0538799360993fcc59024a1c529e27b0549b5fbf4c8b480f +Digest: 2762ffc07d5ff88648b22c8c6abb35772443be6ab11a2efdb15ec22994ef929a5eb2b33c2cbdc0affb7ba3350b760d7b850048b2e355e39af8ec52b26d26ee45 +Test: Verify +Comment: length 30360 +Message: 8d6da0429b03e2affb2ebf410ede348d607dd766d07f1909f23bc898b1f9d8ca394c62e014a2eddb9219edec6f94892cb00fa18dce2f1010161d2e39509599c19f3a368aa82d72d8f6ddcebd9d219ad51e8400348bdf459dec2e4cf4e09c5cf688e02228a0ccfa0def236a9ce2aceff17484fd4350b841163a1329b2ab35a6d3bbe531a244a90ce44593ca72845d11e978b99fa265e28be5c977cd59f78901bf02f368e0dce930c4bfd4f525cc5d8723f3c8ee3a1284ab70610041d30dc0f42223afd1cbb0b7ee15278ff39f02d4d909ac5cf2f19fc72a21c9568c0635010865e7c373490839cf40436bcdc66eea90026d1bb4b053d28f5fcb22b6dcb774c3ee16d756432b975aabdc118a8458c53375fcad3b6078ce62912d0cc83cda42b026789283a262fa18bfb92832c007904acc22bb8fe754e22c21b8bbc90de7935475d49d014cf58a8fe4a459ce62c4715e6ea7edb92f2f37737634d8c139268e3944f49fd82b2c6e4983634c6451d790f6c353eac01e53f4c2f8690ab9a7df5ce6f99e4111264ecfce02bfa8ff7788169a33ee5bac9e07429e0f1ffab73f5a24e3fe9b2bb324a5d4a4cb8016a4bb1f2bd2263fe78696924991231d50c6e9de0fb9b9b304c60f77a655446e3d5d05e3f627040f3755ed3d30229c2cb3eb8db545ef94ad7553ce0d6c69d750c6313d1da0203526f2218d5020dae214cb301325ed0df553256049af4f66ebf058294c155046214cc1f25d13403f5d9d419c6377309b466bbdf868a577d6e7149c4b18132f1f31494cd145cdb9db768ebd3766f33522eebee42013360b40358539a18a5f6535cbe43ac52dc8b23693b1e60a02e0252a551443e232ab332d3c0bd8338a40191059e634d7fd4a54d61ecc651c20882739e3358145ad4c1924646d2107010074364118e10e9d9cc6457da8e176a93164d900e847516c61e2ad1575bb27d5e59d31ed3fea72f606310b1a0d031e8324039114f63d0f5732b950b7e94f9bf038bc89c326f60beecfbdae5bc3731e98a92de987280a865707c496b29284693840fbc42d94aee26e4191b8aa91d87ece070a6ac14457bf52272b066f38039b9747806c9150b9fe5fa2d6b16e40db440f88c19b2b12cbc031db172954a37439f49373085923c167a73bb31f0e98237a42727b052b5c0f93dd6bb085ca9a7d49366dfd21ecd56b263054518cf46159274f0e5f2e2ae8ca403d1f1da43ae7c9d5471d463eb22e6142e035d87f876324541da496a0917fa5cd383e870e0a50fee40eeb75e713f64bc3a1256f812f662d08967c47e3c6e94844b8121549a49ec57f731fb2a577f4d0b25a6e3e1954311b4ba1dd9b7d33ee5aaca4e1f0df6e99c5ad5e0027fe46f19916f3566ecf5e8d97252611baf83e56840ee3f43f58d208a776b7d7f97ce8b54ef75326272bb642499f0e5ecbdc51e86d715f932b3a36b412e266ec53a7c608965d642590b6c218d8c03f0df6afd36dbdddff06dc0f0466affa54875b0646b219510d9dd2f7ebd7ed91a26565fb2cae1e5bab94795ea3e426c567f03921d17a80da36d4147699462f181fb03d47c37036f14b862ab07bf61e4b886e1680d0297301c7137fbc352e475f9f34a91c027eadaac824198cf4663f95a04b1aaca98799cda9a23b502557dc6e083bcf01509f2c8b08b66b7a76fb32aa95cd6c2cc65c9b46c2c96fbad389974b440bd77e159a5b9ef4844b02697c9f93513d35888d702074fbd04483a58c200039ecea1bba38e1ea74d6dfad35b22d56bae39c49688bd1603dfee13205271e95d1283061a541677771f34f02426585fdba06caf6be7456116e9d6e4f5a243910f206d0d73f7d944ed124c48af95c4f8f38efe617f6f4568f77f315630c491a7b86cdf206f0b311767eb166cbc06132151be719347ad37ae34149fcf5835f69dd74c6c07421ad85f75ee25c4f003ad6964d348bd6b1d96914b3e64b8d262dcd3fa4395fab383199da5bfecf9e22b0e41ab51e638403cdcb2ab4142bb35f7defa8fe6dfa339f08f5265c4fe63e8c8b04aa3befcac7d8794a2e2e19c4f0961577206aacb792bcfa40e3481bcab9a893dd4cc7ede72698a38c27083e3dcb31be0cb0d03cbe52f9ce221909aba297dd90180a4162e329ab14391d2acbbecd9940565e186638fabd4e45d18647975e92495cec9194e5587a94fa187c08717c3663ff342a724d136f404e13a737d198318752f9a0cc163c6beb7721e53c7c6370efac3aeea82424796de8e554c277cc2112a23954519d5ce7e0573f50b10707b0ab07774d50e6b5429db9517531b183cab2f3b4966da340573c427ba2ad3bf25c60b8f32db1ba4f3297695ef2cca944942fed734f66507121c7e2dcc4793fabded667b67814c979b125a114b3db8497e750397d6585cb76af49dc6a9e5d3cba9cd5bbc914c13bbb270d097ca1a66d042bde7fdac2123dd7678adb2d18a05aa800255c33eb00379dfc18489da2758a14c8a266934c55cd1db351852e1b8cc0fb708df3fce319e5a8980e07809f8f034e266197afed95a4cffa6882748d67973e56d7282de6536e6364b7ed2b813d013bade6ba368c1ce975a3957b07587a06f619c9a2ccdbf8fa56c6dba3a82ec7ac61c6f876311030c59818a118f0620d36ad212c0ae4a94eb00a2741d0ff90752b4ad75e73a7631a60bfc054003695684fead6c7077a3a9eb906f0b21d368e8ea77e4ae15aa06c22e1720375dce1d7d27836a0644298752f3dd287f631570f5c47838549d324138f713949ce53fa1295d918e7c96245424b63f756d5b669fd2534e3f25e853c40ab379dfa250e872df79b1813bf108a893853fcc31751753f329526f7e719efdbbc5c257e43b4931041e6be8c0ef46e323f36693883ac82bdcb93d2feae3646cc0b075a3ef0ee23a3bae193ba7eb5f926a834c71ce26f985f3856716e798547fbe061c2a0f36441ceacb51e06d7fc334bbb749dd7fc42bf0dc0058aaf11aefc518392e70d16bdf4795d89e7d6e070258ac01f73d199cb00afacc8a6293e586db43bc151ee1fa2458c1686779362bad6ccfe5cd27181b5622d44c94c44c72ba10d511686a9d7ba3aef1fd455a626814ef7be5440217ba6ee6fd02d046876d1a0450dba10a806aede8ac09a0975f16e96f4482e47495146ab5d981f57fd11ef7242b7d577517425364541011c6a8e29b5ace4136f4fc93fa1e0e4c5cb6b613020ee978e410ee8c84c09e93015ecc359b306da2b3f9cac36d8defb47ea1a2e39b030f50ef8462c3f27bc024f7c625aa699e9719d3f98c1d6594026ce3c7240b52def187d23600631cf48d288da3619ba6e3ff292f7abd2c42befad8248dc5e4a9c1549024bc63f464d93a201b6cfc93a3aefa531f03ea5ab56d2d88a96be52a00789d0c5f7df9f27a887b9e2989532d105e1d2a3b1b70431e3d0ee0eae81e2607533f5efaf13ed7ce80b615408f01b25d8fdc10fc280b5fed9d33938198ed732effb00a8fccaf3ec1606e07f8f484ddeba2bba9eacff80bb40c2ff2e5e4cf8bd7cc93817646c772038627f8ab40591a5b4530478f69e2f102084891805220faa2485e665716142c05906869d008fad22cd5de8c428c488a482031f1f967ae2a0ef1752b9ab121c737eda3de2fa4f69fc0d31aeabcbd855206d26096b9abb3b48e667c43c99e5cce1b1c6eb7e2aab8fdb7cb79e5466445c2bead58e23994ce04a105e8416c3431cb3f9b2da9c180ce56923d8ffe7816f666e00f8f76f1997994d76e2d96eb195d2915f8650624ddb354b097a1b8ea4c13a91b7788c78a40330f91edc0d6cec41b722e92a96f8507e452c3686386f58a2a23b173b9566c1f86bf81235663afbb1930fa186f487a95fddb2b3e59fb2247a6414292a5a61f9de14ef5ad32dfd664b2eff8f83b137e1e4c785877d988091b149c5f42d2390d21ef189fca0a9e0b6794f9bba07172f7f77ca4eba386a0126af19f6802d371bd61ecb6c0283240872a2c08b2afb6c980b7fadb555fd5f5c6bdd9c4ed610df2b8d4769407363e4a0222d4776e748f9990d6439615fb3bdbae8a19976fdc063e87e0195ae582a32ce4e84ad05fad4065b0e8d36fbe044cd422664da16fd230b7931b5155db8bf56ba7f0eb9df6a89db0696646c2ae197d71dac8f25d5df231e062ec9b2f79b0a988e3c3335ac3f4ebfc12b50a297689423720288435baaa7e6b9fea734210af3406f0e5be716810afcb457b9a2ea8023f86ab1b9fc516696a9b828b563850b6295877cee99c339a7d808a10732ca2e2ca02d4088175f1cdab02b345d07cba93fe0fe0e54115b6f0c9ce591a31bdf7c9761e2375f5e2cd35a433baa06e79be97269fc4cf6188729218f72b0f324d2714c84b11fa5976193feaa0f1317cc9bd5e378a8bf3a75ef71cefbd88560174b153450c37ec28ba564ae2cd1f7fa7e76747b552aee89f23a4efb263e9953bbf171350f40df1e02a14f5212a6dc16c5d2ce2048ab614c5510c99059cd7232d76d8c380750c721c4fd5bd2a5b84cd36958ecbb9853a1e9671be875dcad9a6634666f268219c033986091162a2fce9931afd5358e4935caf000b593f70599589a8520e5c6c651bc4772f707ec33ebd0e67f917472b6a555b86a38d0f2fdf56fd072a95f1b7d03249adc988b32ea29e0507229628cc17af486ff781514bf3812a0d4117acb665cd35646798b437f1332372ea4e623933b0e23677d4ba770e9abd05461201dabe6314657a4f068182e2c635b0ae78053700a584b4f58f13b91a12999a038587129a731b820a0e9de04379ca2644fec2aa252eb53f7263b46b75c734cd6aac5e3ac9bde11f5850ef81cbca9abb905ad40584da4267c9bccb9e34476140c5eac26f77616092c861f8efe21531d11f10bbc1a634d6de6a1eebd9ec1f99a493b556592a1a148cb8a63ca33d062a074fb50c670fcaccf3d1fe77a6e3bc685952b07c606824777dd7b23d2422f9edeeb0bc288e3808bf58afc0017de1aa37ef8160b71d983d03e6740a7ceb3a8ce7c7d09ab27fa57b086d52281bc73c6592d7be2aa8f960b034473c137e70fa1bc2533dd51ce3eeae32b2478b293b7a7b03925782948c281a93208e61b44dc842e7f136ffda3359fee8c81e6dac131256f4bffc0d3c3e74f8aaf2f979a0fa5b8ed3228a7f6ce69df9850f354437169a9600a0fa2ef298cdc6e64efbcfd6defa5c1e7776e86786213a82083aa33c9e899491f5f07c4a13a901df8503d8d8844b371460aaaf3c9a6a1e7a337d0f3f1355ff331f7d59b5478d35e145a028f882b4ac7f6e84586e8bff31d8219afcb12d86126e9ddf6bc6ace0dfb6016f34e952dd289a0192587fe356f116431 +Digest: 8ed0fa05761788d42e6623f0212818caee848e2c04ee9bc36239981e08cefe0b1d7b260ad6f456ca74509b00b3384426ce64a7bfab22228e85fdbdfdc7fd5df1 +Test: Verify +Comment: length 30944 +Message: f28634dcfebacfa510740de8973be90087fd29eef45390b6df07560650d4d519a56c85db29c02a4ee87b4c2cc2cfe8cebf75654ca2efc9e6c1112da213bf6f378bf8262aa414db373e4976f2a874f6aefe16659eb59d0b3a74e6e3e425ff4bcc4d31ff11983e4829b9e7718270b17b69ece9122c54e6bf7ba18e5e14ae1cd3a09220f9d72dc6dbeb015c2724430fdfc732f5523da8514b71ef12887ad59c6d7a03cbfac68a35fb47bfb07e2049158a9078430e1ad96618e40779475ec3098323473ceb24d8130f039bec60bda94be58c65d92f0c0ead8e9c90cb8507a0ea7c64077bb53a3ee681e83c17b4448c395683a2c19b596faf1560331029be93c8c003eb8e3e50e538b8be4b3962fd1968463cd7033c4925f316fa98511bcbc42ab7c89a7f70aef5901c4d6f5b5130795f1e80aba5f8265801f730669643765c98c97dbd56329b9577155c51836b25d3a64417c6b1b9362f6222cb45e58907839a5ee8fb196b61ed740bb598bc972450c622c9d12e66c3d39dfd93df48d5c560b9ded3fdd20546260f661eed0bbd7418461e5e7425e7136c3af24fd9c60ff91c7cb1046b88e79368d08e60f87ac65e52aea29d569d246e21c268c9de671febde6c3f43ec44f98fda40ec436010982a2787154f209e041e1abcc7c79434ede3cf0ff05a280d2384a5e6e68eced51c20be57df3c7931726a80b07612a334612917f02d0fc8eb4db8f04ae50be9d23a8740a9682c0a5c53997b26df72b4706404dd945c2c74e65f74e4f552805a0edba9d40217e77b2990f432a769ae6feedcbe4985e777d3074100a96e93b6c891e5cca3ec563473a011c3ceba7c907bb8b39d854a34b98e55dca4663d1275dc644239d4ee8ddd9ac8be4e76e880de81d6cfeab66badb94cd816a844eb35843e8ed838909122a899a97fdc53b8dd61284e1aec0770b841b699d8536aff66ad95179110ff5b7e5e184b3db68db2fce1192a7aed9ee2bf17749f0bef00010cb68908530b48d609c7beb7de254b5e4326fb72d933a34929042df395c2307a8e68c468086f948a2baa34f44c6fb5451bf7772c1e073f2b5ed0899b601520f1568beb3f97850afe4dd0220a6ddcf4eeed1d356231b19912c64332a1522ff8eecbe7a996e895d3bad5022e022bb630e11f61dc1bfa79db85c925cd0c555ae1f95543a374e3e716462d0603e36d4390a71b89146060a72a0dcf3d05e550dc039b5c6984e170c2fc2bbba447b51acd3dc7475d87384e82b13140547f332afe855b481ff2e57770adf0e9a6a3801c9a5fc90da7dbaba95395798432e6fecd088fc2822e9589e037501d1ed2be4d5af21d36d42db8c15a62016d039fe04f20424b57705e17d493600d3ac1f24123bc1f9f9503b8c78349f71b962563152d0bf3dfa27b761dcf78320dd03cccd30b2a680e6e0410aff85e5a0b7b53452fa07665732b0b40528078f77866f6291d0c8c14924a3efd192882d2faa4f30fd3b049de307b89825bf179f5768557d0c62eca6c52af1947ad1c9ba9109a6f87ab666ca73d195b05e32a64762db4c78b7779cdb87728fdb512db922574e42d765fc9c808c38deb91903122c0c87bae20d8f67b40283a5211f16d508f4f0a97a397e14348ea60a0ee0a109a1b6d62745890acbd4b8e6f8021f1dbbc2fc89513d8fab7c6b1d919e1e3facfb3d145f281fb48a47c22d04eefaebb2cbd4c080c0bdb30523a89b94018390874572977b23ed1a7e49e0e185f087ff6683d2f36f7e675e2bb8519b15dacb8db096d6a2b2b11a156760c558b2b315e4b9823217bdf0c6eb8f891a9eaf905281c95dcdd8be36335fc61af3f5339d31162c35768ff4ae58e591344818c9b8b5172218ecabc649d5342ae6e1698115761e2f1c04ce9c3d99d6e1388e8becca6fb86b46a79e93625c4d0643020813c2316742a481761cf50629e014428a813beed0056583138df65504d8bdfa73741a1f8bf77d60f91f8b2a692e4608773f83bf0870f403bd1e9c3be622c62f1e2a838ce6cdf537e9fc56731f1c4c34e470385ccc3e80adfdddca9d8b64ea146a8fa4f62226ba5aab3bed7cb64aa57c44bbd04495de89f65843e7e64f2f984f0b4be507a8a22b5dcf66c6a3c939c0333a8ad202efd18e515ed99aa2bbd35f3362c7ca2df4b0c6b5b8f56894b25a5afe1855c42454a7ec537417495f5c00bd65f39bdad590e31af71a7059ac2c3ca43170b50d054ed242712a758a78aa28215b40207d9b07b9a6a6466ff07671415a81d621334248d12f4ef48cc48b10ca3987db0e58eab394e827df3ce3603c18dc43bb12dd47dd34f12164c58e034a67547026adc3413f155e10477f9915d713a80b920241a2767e36bcfda84d7d917000b8a597633b04ab86d4119097e3fcd25c5ded9826de9f0d6e6621ad99569084cca5ea43af34aed7e107b0285676f7c5579f401ce348c17306a1635de82ab20626ec775b0dda981afb1fc59f5b3b627d28541c391d9d983fae135531c06690849dd0bf1615794af54380a47e2cadc76a5d20e4552c395dc3c32059b198a696709017242d4cad51f738ceef4d314a910d547a2af995a8bccfc45cf365f7474e6abc04690919f32781797f08750f9e59e6acb472aef0682f94402da4c762e522d3504cd02213c746345405729e1e157c76d4843deda2f410b1b517004e41ecbe3b2b451c10b0b6387076f6d010f34c834e5a5dff2e43d91ab8a1ad78633aea7b027b818f4d772c68d640c7838615a008ddaca638e95983a81974558fbea45ad3e9ef86ac40edb661c6500c1f560bbc779559f17dc74a804344dba3b8b924aa6321e5b915937ad0cdd1031906192bfe5a05c0b420109d6b76db161c85db2275b37b0cbd4dada507e776f882da481cf21abfaf92e28dc881ad3cd22479ad24391f35b307a70802c85938aeddfe5b5514442344e21777627f60fa8e6ff697b06130e2770cc42b0a9e8d96749ef4cb5af160c14f364165e1c13c84a9339f333d8a8311c741279f22f71f01082a502094f5fb2a1d03f2e1cce39a7bc133d5f852117044324943cce26e6818d82492f399be7dbe3cdf9e739a43053054c53d6f649292ea36899b4cdf61033e42f23facdf97630e3d3dc683c08bf752d28c38010b8a65844296b087607b7af1f737b8c4ed3d359a8c82edaad61b0b53d8ed4845ad756292f4d506151c1a39d4635980d4490c7fd3a9638641516c9ba3c65cf0b5c0c004a6bbe91e7e78d9ba35f5dc3a435981ac4a223422ffa91d32d3297fc3c9fc06e62006275c1bfd1686c74d24479ab539458e7599463e73995b5270ba340aa5c661af723461862f6d29e8c7e63b52d29fc5e111e75276176d9fb24a90c3e0546b11a57e84a135665a1e2b048688044821c81295c2fa3f2b065a730597f5f39e817092898cbdb25859ddfe7189a0176c6ba6736fa0800214f0260540343cbcda95f8f731d0f9756bd8e3e39d642614e5d9fb840e0496676bb78ce978fa1a949f053553f5e5f7072773ba6ae6aa8c751af931d50f639fc7a5d8f9a01e5e1213627b9039443028e001a6dc04fbd145c09245e3d6c2422ebb49b0f6c9aee4b5d1bb55a417ab44218880eec3423b5ce48fd25c7c29f524a5aaddebfeb6b9026828002feb5fa99653793ba80a9323b1db2b5189751ee68fa72eb8f68c07bb4bcbbed766c0a1bdab412a888f1c785384bc2ba679695634e7a5bf814d293d243532eeb796ee6e66077d24fdf063723929ea293788c3305ec123c5cd7c50b792334030173caf26111f69e102788a114335f77c8b541d6dc2a0a3d9d3e09d0773ea763b8cc49d596d6789f74c940ac6101d56ce2857d24f1f1a98845b3658bd47af37697ecb3378d9847fc022bf30111e64aa6684f07c54b273942dc9da3e499c16263263bd0c24d3da9de43b66c482cc90450e27da862f2b60096e8648982cdfa3a53ed22681cdeaee76dbdd27228bb914c90d87628a3ef8447aaf36fe00e780dc46d750742ed48d448d0fae8cc49c5286a8ed3a24f2f497b55a684286f2fa2e148da455327de93961630825e43545275a6745b69e4af088274b324f6008e54600ec1e56fdf96c8db97b4db9e9ff16b604867f633b1ca3580eaf9594159d296715d4bdec132beef8d15858f0ea8c716d197912e687c29d75f009fae7243a46efc7f9fb7b3e8fe0e93d6ca2618257f5db0dc1a8a700e73f606fecda8ef86ace6eabae7f8acc8fd2fd523ac2623e0c048e5602a92b32f519a5d2cadd121ea91052157482a149b64593b435319969f33de5968e7cf9aa66bcc4cd164b07037fcd38a9decd45229da95ad80e686db2b8027f23f7cc88b3d6893bb371dcd453494590dd6fb7ed03a08ea13208ef6594c4e2b992c0f05efbaf1f892a4feb106aa029e93489cb0f5969660556c72f078c945f33776c90f2fe6ad02b9612fe31d62edaa023df8f329042bff5bacbbfca06c0e86b266d16db18945b918b6d9ebf021fe8644fb37ced44e6fd00d2890a239fb51ecf44450a7df6b602598ea2452e9b2dd393fca80ca5e3a0cda54271a6bab3fb52ee3586d462053a74f1f47379f6edc31cbddf4fb6d3091a72516f380de5f00e35369e951d1db0bc13e96133b5ae966a24504c0d242b01aebba3dd2eb84bb0683636d4023d07a5958fae697570cc119daae9e752ace479f7da0af0d83e328183c67d6a60ccc6406118cf51bb43c5ebd7e0e925c2e9b5de608df56eb6f850f00b6658e61344c01da96fbade77972281a396ec8bd03305bb9328018b6d8f2d6849a687cb9c2d8b99c8f4ff542cf3687f7b0d528e0d415a7dea38adfb4e5b0e76d907588f8def8f416a391b476de11e31d8e4b9a0cc7d3ab1d0405922fbf49a8823f969a64b2351a0e7bc8d4c9cd8aa45579d8068a04f1ce40fdfa196d8d45838d50d29a476316934dbffc3c84c52a3265198554a3b4f7770d35705cb7782adf546a3270e71c24c79b1635d4eeed77f51518596c9cff6d104e556f4254a88223a136bc058d03e51fbf287c84516efb562f1b5d36c00cdc00c904ffb58e44d4b93a5c7a3f8040e301839ed834f36f3ebb79cd979b5604ccaf47eb299dab75a908e78374070afca6d6ad2052cc1e19c78dbdd31181a50ec3858fb2f4e0f46288787253b146715fb4070655f13418941e35c1d8d3d2f6534bea6b006967b134f971a17639e2fe9097fa56e6bd552907cb194e82e37491fbeb46a17d8e1a2a12845b3e9114c5f9b8d719657abe159b9a56a32b794b51be2d2c01fad26de1a625b29e0f4f4bd5aafefacbfabafd5db477483a2266134fc51194833ea70ea56f940aa2dd55e4fc588b8a77df4e8116bec32945f9f14158edd0ad3435a3774ccb8815d06f4eea204d860f87dadd5226ffa97f2e79c1df538092ff7da66fb2c00329598e8fe0622bcf180f62b40f7977c04fd45c6a7ff427c47e10c45bb3c7e75e9e604503b3560427 +Digest: 245aa878fc3a4cdeeccd328a726f4112fbd4aa60097842ed8c936f66e1fa8348e335d7d71643a690249b3311c73ca975f603604260d35e44e26206a1892789c1 +Test: Verify +Comment: length 31528 +Message: 0938764b4c385936129961e5f75628d5937728eb4e922e1175920c208eb78e02e9deb01878030ed9e0049cbcd0a7975892dfbccae04bb758f800de54f3881f42522a373dda6c2596a2d7dfbf6afa43672eb250e7fba896dd021aeb16ebdf60b26ba57482197e87b57d9b91b46a56134a8e764e0848afb4e8b9699c301ec339995dd6cdb1dd3e1a7e9bd719647bc4ef48dcb61df66e6af7c048745768353c92414f46ab90d0b6c7382413e197434bbfab3df7257916e148afd5c38588d85253f06a7b77e998ed772d40d750146af36bb9dbc3ce58e81b90fb89df8f56ae0e65efd6ff9782ddeb10a315accea599c4dcbbdea1805d8b20b5ed8b4fdb9b6077ae86ba5a752348b97be3ce19c31078c7f8f86e1aa34ea8f8a1cd049bd31e959517fc3e127796805ea13591a7971eae03a8bab1b59ff4e6ac3ae31b4cdea9f671889b8cb107a22ee269e086dcb397e480d547d2fadc17ee426a76f9e963022b12eaa9c9bf8c0efa4eba2ed7437d43c14765e9f771c37f67c517d0c5faccf2db81236f20c26ea38ba97e65a9615eeaee5f42e549a3baf3fa3a2b37a8088041aec41d35b74414298afb9cce27c0bf5312d05286ef172a3d4fab8df4ca9ae7b74ee5be43b6cce8689e4cfcb176e70647d6a37f1311557c230d1f254f5238691c60ebf0e046e3512770a58656c15e9d8ee2dfafd3d9e6166edd9fdb8f686a6e378fdf9a558f0fb730a80d22042eaeeaf0dd8ccc0f6d5162e6663297fe36b95ed180c8a4ebb8db8249ed8db805e55e57356fb3bd10f51ec65251e041e2e1aca1b2deaef5e7e9cc1b3be72c309f0ff64a24415b6a1b9ad6ac7b45b1c18494cc9fa24f9a77944c6ce8cd3ff2721bd4fe2d86fb8cbb7b83007b2aebaeff2c759fc1697b921139064252c99de766c15bff6723454e9876da249b25ebdee422acaf6dce0ca1ab1d42d6c2f5a814f5d8cd8160c3c5aae956c4ca7434ec4a56ad62840c9ba7cc2e8926b19e1b098005aa510a802e26a796616b7b6e2196f83e16bfa40796f61d80c5da5a4f0168337f7d10242f2b0e4e87e0f7bef1b392f285a6ea99c488a19b8a1987593e706b364c9a3256d58426a6a51a901c65b1884011a20cebad38504e34cd5537d22fbd905249de28daff15b7d6595c1c32e41fe8cc554c202970aa3f67286b7b720804497bd13c23a665838903e38646c01400f49d06d3c29ff657750973f2ad88c1e96aae7c75cea17d1a25150234227708d36b6bfcc859799300f803f711567b2313fad390b1b234117f92f2fb8f39c08a3f562080546b1e0f4dd13ef9f1fdb3f62b01d1561755c5e75dd88419be120160ecbca3da9f82f632e507a1c4b92a9802d8889216d041bec95a00b1a3e935a35383a5dc52d02569c471a2139f9265920ec395fd1803fe857d1e1063e03a2b0f2bac1ab33010dddf8c98ab7ed1a43709e49333faa3d91284cb52138119d77bacb00e2110bb8630c0530329c9a31627654af16771007a07217d9e0ef397e8ade1aa52c5db3c5ba874e15924dc5d11be0e09853b4a780d65c659a90ba19f964a18e01f0bfcfbb6cd63fe43a59f47bc826ce9f6b66d51bbb2da291c11737c08d9b81b1efd5b40c026f67269b2faa840fde7b1ede0c3d3ab78c5b39e29517468e22923f7a2e153a03b93047256d5cac4b7e82b11c23248063eeec0d85a23d1dbedd2c05102747b7f94a47e079618f37137d51d0b63a3f6f38dbf1772acd1d98b831dbad426fd0285ba8fa6cf7cab6c6f05185082ccff269bec9f82132743d5a02b71d82915652ed934be45730f767de5a9178c1f032c2125e3f6c763d4610c426e36e3f8d79248a48a97229a57616dfbab3c988a12142cbafa2daf0cba14c897d3d5a4e8756e970d458407ed5d5586db94ee3e6a009d9282baaa02b3e1424fcae2b4e0a2f6e0653decebba1328380eaaec944467d6b199a4aad6880352d4eb01233c62ce62cff85c073604b5c0f44e933998732a9b378b49531908a114b3e1641fd5f113c2259a911eccad7b2e6f8ebc0561935b5717ae983bdc4c382fc57c1d5de854191dc99004ba157d0c7993164dd7576ca213394bbaec851a6eacf4035165db54897ba325de62793c11a9462d6f38e2c5a5d685a9d6ee7e3beb9227bd2bc018b90be49ba0479f60b131c7721c49af6a680fa8e31215c72d7758e946f3d0f5054b4661994866f832a515dafe2c05c4571b86913bcc9f01fc955dba38ee6b8c0cd1e3f9856764f557e065ead2a2c8ff11a7b29a75209b23525fa10ce7f3220e941589b54743681e382ac800d6c9bde900d43dca795631b6969bcde73a4d1d0204dde19bc7249bfc3b4be622f2e809098d69cc2a2fb68b4132128853194285f0c6f293b6ee542516c90a685b0e46d7e71e300ac07f88ce4c8d8c7b596c1c8260411c460ba21a2df44b30f6b0122c4d0c1def9c96521325600fd14e001b213bdbdd22a2a4ccbddb1f2785372be6e293fff06f2db48ea0b60420a8a8510f9ad9e802ce51885586581ec7d1d4d372b0d248017863201d77a9c028da31522ece831018e6f8bf23bdcc7991dc74b09fde3270b6d2e6e4e5e0271c8f30920d610762da8733425220aa5fb9ef6ec0cb53b3dafe79445f08d02358a1bd6f738a918b9eceb87dd44832943765484e602b7778f37ab1977692c58763d61b627bd0a4a45e74118c59a943c57f050345fbd8f476a46dc593d28cab5570430fd053e78497ca55fb27777d3a835d228a1b39dbb0f2165e1f001cfd6cd6a9710280a3d717af0cf8df18d6cdff17f9434498c43b953770d526a6fbeeef4f34e75d3b12a8473349e523251fa07ac97cf0998341008a8cdb5a424d18661c0b392d86c94863fa6aaca53117faff93e00eb1f1a65b3376387f76dbbc1a6ddb51e1cce7f2ee101a9d5abf6fb50ef132a6d60fb4c7b8db438483b059bcaa0b1468534be67eacb58e157ebb47c9047e3f61fd914aaf0000d8b8109125157049af99b832ed34295c3e173e22201983aea25aaac01c26dcaa1d1c4da0a58f132e942c380a63dd0e0c12eec27b616f348a43d9062290f4f4e2faf7636542f13cc3ac69fa5ab04102cef2e1334e7491bf190a2539410fe0efaf579379686405920fdd9727aa3b28aea9c637b924c047cb64e0886aa502b3751a1c36b8327491be1a1000e6836e5ab9a576397b83ad5b0071ab48c2d4cf35302a3129484ad85e67ec2eea606bb09ecccaea2fa2f6a393084a55ae6858e02ec5e77eb45038fa34368e1d9ebdec6abe8f210b6155020ab988f7c40284b99b66df59ec1ef88541dbd307c764248e0280a9b1bf16bd314a932b7ee28c407d6aa5248961b16ab8141ae55f1283bdd8e1adc382ef97020acbea96e99593c22eb4b23c7ec6b3cb59ddba149ee845b1526f0d849d842d4b15f6857440c7613253e056d040046d46f003840acd30f0288414679509641ec0db312e6b895f3cb975585988d801270006ee3d6cf4d2cd49f739849dce79b28be3e5ab23ce456d7f1b83830b4da729242205b0e519b5243d32442d45f5a933d1b57bc54616613cabcdc99b02a7ddbad8cdb2a41b46c33d2cbd9f283585dee7bdda5944796a9bf06514926b14ef8a23448e5de0b682e35f3d21b03d1486ff1874d9e9f066d1dbd3d77646b9ea2c98ad92ed6c2d5fd6fdd498e5e1368b01f40c213a9291b553092b267d4d4e2b66ee9de7724853be48fae2669199da41fca50bea86bbee0ef80d417db110f280a5743e6ea6591a7ae3c0d2cfae3ff0df82fa5ff744ced017c9cf5d0299f56c91f212d74c10074a3bac38ecfac33d410c98db4f71fc32ff7bcd37c7ddbd65860554b0afac39bbaaabad4a771058fa957148302280374f43e00c2ec637a5c90685d4360fb4a7db0370eddfbd38f5deb3b599e1214b7b8d64ef8f9aa338da87b5b8798c3f8ce4d11d3274dd049b2351658194d694fb5354294f5d65a707e3095b474b9b875d7803c09a4b2e956069bb717d3ff7c3b7440c5ba87e7517cd48b5c0d952492f4fe9dbb44f79b8b8b05084a050a42df5a8d81dc2a4fbb43eb192f5ab17977f7e89c1bfc0fa0665b4b35f14baa3cb5e73f696ef26e9db0863dc4830e6a82126bd348719ae43fb1bd3901ed4871dba7386c806ea4f1f265bcd75f2cd3736f8243577c45044d15fc45b70152acf677b557446b17705efe594c5a51836676625632b7bffcc4b4d3a47957acd7f592816ea859a1efc0f011f9b939443d23ee2afc9ea67c0f58a5e948cc9d7cd3cee09911c03e9d5e336fcdc587f69fa0983529e40b9649033cbad767b3fae9dc756b2f6d2345e5f92428824b3d14dc643005dfbafdf9af5eed4e2e7fc3e28c68a59ca4df4621e4373fb4e0094d0672ee87baccdfda530798e6ea4f0f70f6dcfebbefa9c69d35409ec28f677e3c5e0ba60bde71c14534fa47b619b9854fba440544fe9ed1bcf263a6793289288f8dff2148eb5f0db311efd1d7570e7fb48f6a22cd23f47f1a0bc5d4b028b586bb18d5f6ab5be523a86c60cdd72cbe5d43e8a7bdb10a6b3d38d3ffa003ec7d174381188cbfcab49199c6e59211f539bc8278956c9d1c437a9ddd79aee0f85058cd494f5a02924de60b93f6d5245b110bd491ab85edd41de5bd9abc47d3c6dfd99cf3e2f4f05d018f72661cfd9ac8d4c9cee662b02fbc6add2c9e400158f26c0846f36bd425858ffc72bfb071c1c8d584e5c94361df5fbaef4f5a9d61ece595636fda527dfea639bb60f359e855d5c3bbadbcd62179187e8aaa423cf00c2adc896c0b2f690829af5ad1c381b7b36a0fdc7b5393558981363dd1f7a722333cb1d8b0286b1bceaa51495982c06657102a75f30ff3948d1462873afd547efe95a5dff0948e0cae82b0054cc39e8add42940699648f64f06c93e569a5cd7cdab0390d91f210c2445d4c2d4008547ba28bed0cc2d3bf3d6fd43ad6c2839a923426ebf018a39bc31c84a61fb7c3baef4346860723e01b8437f5d7e9fa391465a7742f25e92b778593b32e5b38781a2c3c2d0f64210c1cd0054bfb8d5518f34db10272fda81c4c804643757e36a7fad8f989d9d24eda4bb73441063f87c58fd0dd5c7805c9d87359a0dffbe736e5f56c07f785a001bd2090617f888ef6a17285790c7eccd30294683fc32224ad84625be3f0937bee3723f2094212da263f23e2307d27b1380d18428fa798b52f35ea3f2a0f73b478dace52885305df9b111c6d8038e3617d6a875efce7c027206cf57c26aeb6e8161aa8488b0d01ddc9b9d48dd4ca324c179d6a34142e28e9258c1ca97648cd955a791a3a7dda7773368be4d9caaba4efab38296871c53389a325b82da588383aba68ccbedd65d72e6619b5c7ce57bbaa8cad4d42725790773dcc509f10c77756ca7c083c2629b16ddce5dfde5c48d72b407f5e78b25f903039e28e7464811b57ef258538e48096c01f72bb83f11997e07b20d5719e47e3433c0aca23fd6f94dcbcf7ac3b9514e7b38232e16f39246e4881343aa3b29aea3ec8978c4467dd6443a864f5cab45124c6b9b8e9e67103dae1e71c06a58bd31571443b5d5c20450 +Digest: fde762fdc4ca5d5314c9327ba459053f2451000a59823a2f0f29512e7c7bd4b3f84e9b066deedca820ee5f870ea57731bc21e42081a26e0a7390668bc65b9f6c +Test: Verify +Comment: length 32112 +Message: d0ef0db46744fd576bb47ab9f83c9c67f27b939c3d1784c1315d94304827423d1a03f9778c91e52b442d072a60ce84cc672e43357f2cb6d7e16ef8388b4a19f634e7b608859fcc4686a8cd2c57f4f4db2055d6604ae53b39f0a52b1590644cdc07e36befbc3658b11b6df7464574949b053877a6070bb8ef444a554fc13d82f7793e40b5971e3173e9c4ab0192170b14ff1f4c8e1c66d8ffc7a59d6c859c645073425ee1801e0094daf511e3a6a5024ef4517da0f2be40735ffd2cf6434b99eede35edfbde006d1dd5475376e9e62052ce173364f1db9b52f69c2a756510cadaa060148c198a1f15c1049642c4a20e2773b9966381858fa573c8be6f52b49f1aa30bfc1b9985bf84887205ce9da073d5cd7fcd240b83c473beca106e72ffbfb8cd7ecd30c5b8f47311d9c5a2dda9f865c2b0012ff59ee4c4bfea49f92db8d3bb0800ae5307ed67e844830146ed8545de3c96590da99e94a15e6f9199eba9822c3bdac70dc6eac0ee09b7df4333fc01482277fe458d4b7e1083a30fd4149875124e5541e56b78a68a48bc871f19d5d4ab5c9c175f0b6c4a1c16ccec35104e547528b744645c5fc1c6e9db226506da6810d14dcde48acba0caff334f414793c65eb348f7100267baa9d45cd89a62d1627e6bd2485b722e262426206182222e73d3d6528374c558393bf287d04894836dfe1172af4c2a5e873173da4a7f07e904df791b10150ef9e58529a333f606b82f97ab762a3f1c2369f9cfab31c05f8a218784ecc57d4313678e62fa282d1f3850512226e3bdaf44758520d93ece93da71d5e00dca33ce6e665f86d2d87447ca79345ccaff4d4b8b52dc50ad9b3009a19dd073c648bf15d28bfe7b746b53e638524942aaa97858bea806456f6d6e2ba74c80265f67aa82077e752b28085264488297bc0e07c53ea6210ce967df1160b327eee21f4e7a7bd4e6cc7c36d7fa2ac3b226b33d41bc660b63f522dd16a00f8fd6218d5026ba6a036c0958e501d29e7089ff0d8080e536b516c9da183da3a2010021103816efb65ab736a67eae632919b029b41fecc9176be391f8617aa280d24df7541f47a3c7a2705a4e4905333484ceac8e62acef72f772546400f52611ca67aa404fe05d05a23e7e378e2fcc257a8c918590e9dfad1f6a1a063dd8b6bdb0f342bb0f0aa6d824caa94b9554b665c392df80f3ca2232ac73ebc65f48dbec4e9cc8afa6ed05a8eebbe371a59a775d27879e66d1783f676537d08cb06f1c066a0743035db002ddcaba3491082c99746e13d721731abeb6145bd04076750173cddfbb9f7c7c25df7e6fa5940430a4115fdf919821d928867f8af4cafa82129b3fca396b4b78f716d2813d60e2cf1e9ec493d4b323dd043e6f6a431284bcd8e78770c34f11cdffeb909905deea30918263d7a85ac04dda48aca3c5005c4edabd6f7b643318a2c5c47e5e03f6637c8425045116754151330bfede827dc95ea086bd9021ffa620d20a6679419197da80ef71ac25ecee1395ef2dc3836f1415b3ab3a59049b046ead260e91c795cc730c48718edea70fb88b5c00f9cfc0869a9a92ae7e14ef7ab6de7e3e4f9bec4b6eb098cba0478fec6b9aba41296e566516dda5e1a759e34f1dee7cc05bc77c5cf4f44748896b8acd524c71b6fa691bf9b0054b9a7bdc60cdcd64875b5c532f462d61bdb0f14f81f99528e92815c7f58c9199eba3a2a44c3aeec806d6fa45eb53407e62cb82fd5db95db68b5e2190ce64e021efc2c5b991dfa7a363fadea79ac956d39f60e27c0455d27fbd22c7cc8dcac626bec08c241504217c058fb08023f196e9da39b9d460151b0ae83aaf841a066b2fc0649eecc2f184db545d17d96e1329477c1cb00e584061df756f80c05d60f6c45d78a4197eedf748b82bbcb963773676eed26e30d320cb87ca89e2863e208f6dfdc245b43341a24c99c24728ea64e6fc97239c45bbfb828951507fe0a58d60b3080c2ac4c836ae6e5feb5f2feb246163ded6e252f71aad6d718cfcd57af08e1de61cfa5125124337726cacd44efdce322db5e7616fc575bc9104046da5914434ffba5e64321d882e3b0dd821fb3855f2eb8654790b4402fd1b813db10eb8a87ebcb0fe03d7a1a6db2098881eda1c202a7f12d0a3b3de7bb876cb4fa89dade28583c58139fce4c5c68ad366d2d4f35462532104e64fdc08760aaae35b3bb71bd1bdc0900b892f0b78e2881a45cf031c23ce7b984ac786d3bd3fe6a1d0ce207be8d36ad28366caa3788e7d4c7fb4969ef358e733d7032401187d4630113f2e29542b8bf0a87bfdb34ef87ba3896cf2025d592e7d96ebfebd0c2c933926772a4e9d2feb9182b01064838649c76ade5f71e63918208e685c2d23b49563155d5c114946515e1aee4add9ea2b1612af1271318616dc1c7608579e47d1457e8d80b9be2d786fe771bf54727b37919d28f910f7a37f50b4abdc2cad7efd8bca7d28013f04c531aa12157c9a6216a96689fe48d942478a31e655b488573a83b583204a2f90c7e5aa1e6b88ca4534c81f70869b7ef91bd344b42981a756f4e7c05e0dd70877fcf657e5462b7a9b3e78184b468b312e48d64da3ac0692f4d9026b5c353a4210d10e440529c733ba8023f198a28a98587b0dbd2371d5c3c7337e171c5b067501e077ef0c7ade8e49a6762bd72f3c2d1e0ee423b20f51c234b0b5740cd3ae09a1a7ddc959dde3d2bf1dc9379540f257d590f411edd91d06c3bd32d2ac43b388a693ba637bb779b98162a7a5418c5fc1158da7f825539a1a0ad590e3790f996a5730683de09c029b46f19be56a75d6c164718a56f7235b7460863a0701abd2375a1a91b936f00100665700887e71f9f138d915aed1bcc39e6b4ba8bdc4ace068159ea175dd581771761f9fff0c153bd90920d470538474f09192678830976685104931f452389876dc97a4c981d40ed15be5414beb2ee23369f6e0f6e3dfb716e0b6ada524161679206bc9687e42f582b792d68216f09daf5ae5cf7a4cfa6485fd438f18c1751410e818786c6fc6826592b62eb3458e09fceaeb6d92da8bf16acc9c40bfb8ea03a67a1a2c45c4f337e283cb9460155bb984a07455c12ae8e02de51d8d1a88c987c27cdd7f751c4d8881f14fb21904fe1edf021d1295acb5a357cd33aeb9afa7f2fd56fecc7ae429e6ec61bf023e72c9bc7486422e70de66dd70eb9b300d9c19e7afaeeaade7ab3cf55a5ba5ff510d6314edb39ff3f34e70d0f1c6a0bb86ec73d861db2d9e1bdfeb1674557113f1333eba9300631d9d6b583052f4e0abd60f6a47bc623417b7f0b8dcc2d5ccfa8f62d1001d034815cfb3a17e2cecd78b4b7351a807ea9a952c9c2aaace52f5fd8c3abea7d412cb471ab5d10ce824f1c487c6be8bdcbacdb0ea20b522ef63a89788294bf460d5595bfef06b8f0d23cbf1fb682575b38949d5813cecb7ae7e3173039d2d883bb16ebefce1d557146fc29e16d61ad824ac9b8d823f35eb94094cfa7f24c7d5dd4d97da8518b307866f72237a9f032598bb3f435da6253138ab47b86b4eaf6fcdf0514937f36912ebb9672c97317300982ba18174003f2af4babe17488948a87640278576007bfbbcc3fe03ed2beedb9b747ee285ebe82b60ee0ca1a74328226ec37719dfce60446215b363ecfcdb292b3c03c0d3b7c4d4f58bdfd1f83ac2603fe0ec70d5cbca6f743533a73712cc7bcfd8fcb71df2399a3b3a9442dbaeabe4322ee414e876feef7b98db582c0c4745e1d1a63fa539dafdaa60c65e923d59211e03fa90985e9246e0b736e16c47b01a19ccbcb509ed0d71bba4f29fdc553ea93c16ac5e55f109084c26c2fd5863ab5ac0109cd1cc8a6598e75d85811a84d0df14cd55e8b1cce7a5f65dfbe670deadaa8d43b2f06da067c5c6210baccd5ac44540ae93ba2c40a292a7c36e4756171b6bc9ecbbab5dbd789ad065f16d75356d7e4810e26d360ace60b90d869a78bb99111e52036d2d303c8a8eb2e36d92a350ec83bade5c6f69bf92a282d15a492a8b5ce34a26b04cb71817698e3e07b63303029c02c412291c1aab0cc9db0157e28691c10b921f4c909fc3e95e8dd65052e872e96f50290360541c5049001a15820f42303cd1f4ad8b380296ba3f53e18195900476ef0b7ef4f0590596ed1f127779f0a94462eadfd57575fa17eefafa5d8efc65b01d240c3873f3a529fe8acf317b2fa4c8c16c542ddc707bfdf955fb25391a9581572d2bb9637ea788b0e7bc4e7751ab1079f3bae2d194a4d30adf74a7287d1c8119616dd6235c9519b0b06a3cf2f934d2090b74930954fd4d8001e721d1865325f07b333d481ff6735a6f497b72a8ca83db3e01ccc823fdc3f567d343c8d8d1f668d52c5d462b342c3a8eea987ac2e48c8ce5f2eea2a41ebcd77bb97b72e73168eef9b994b220e68abda9be027fea0b727aadb8873d37e8bea2a81a376433c9f3ff735b91f0737635701a44480680b7dc40ffd304dc61d43fe38776161141342e16bc92d3a5a56bb2de8b0dd7831972005c56d30624b479b716a44d861e91e88dc14fefb826295f6975668b4f8a36b2a5493d29098a9241cab8691115c0985f899ba7d2de1691a9efb1273d0e904b0231842d556d92adb4d155405123bbd711b7e25eecb3eb50d3ac3e57b39319d8d91b89a1d8c0c1495b7159e49e5e74d0a77f41cf7db808f9753569725f8bab62bfe9e63533919b079e0142a04924701779664694367913fe0701cf01b146a97b2f131651e66e746b0527bc1df1f4220e10034d27876580d0f197db805952b8749f3d968271a601e6195b02b8296c2f46f3bce203f11bd414cd7e1b68a84e4d0188bfe33155d6b7fb52f1d3094feaec34ad1981b3f3fa822c130b0b353e87db84841088f9137f0b3d4aa2898be60edd6994afc8a210801f993ae527708c9dd88019d604443b1d800e58e3b2aa7c36975852c60368c74b00eedd930ca502fee876a286c1ad2d209af1061bdaff72f09e836012ee8298c9ea9f538b074d32397ffac6995d9e7a36c077fad16f058adb576d350cd66a057b112d3533b3c3aacc036eee84348292ae95257f9adb27043556884a2a57898ddd290b0b23aeb2dd35175592edf30417169d6c3ceecc0e7fcd206737e1ee8b927ea6db4de1349539f330415c2cf59d680d2dde9b33ae166dd1298c56ca07dac3cdfef065e301e55184c2b492c7d8b915d0eadf130ffdc95f0fe66a5f493fe19259b5fcfbaf732da4685321ef54f8e1a12038e04cda47a1b3c7eb8399f5f34a7e80405367bd24d8b32c760bba4af2918a79bca4a138f83a1c97bd5a9f46ce7ff8f04286428283610e3f8ff48c104263322bca8ea8929bfcea0db061e7c23dec9218211804960b610610155efd5b64b148d506f0cb8daf54bc88893c0bdeae3aca76509b366e49534b5cbabd6672d6163ef3e68da260befbf4968c4b6412abc5028975625081b9b23e63d4825ffd02fc7516edb795d2273d32c65e029904c325eacff40fdb66d8f85fc3e760525097fe9bac80f14e5894a2f7866314030b60d7e3c851164f9423b0400b87b9e6240177132344ed144a63c7a3552fd24abd21557de110f8158026546f992a0173ddbc006c29aded804e3105c6b138dfc890712929c8b847d5b15d6f3efb42d983f43425070e20852aca790 +Digest: cd5a6c8fcd32f7d6a2f34f87f156225c812cf5c80e00745123a34b4d6b2907cd176d2071e4ea4171893aca2c229f8e99800ad4614b00ec60659e3aeb330eba5f +Test: Verify +Comment: length 32696 +Message: 456d397c6c654d8aa1e1c2b0e82dc631fe583744d7deb8cf4b8304720c8282c7dbe71ae8fb3a4832e65d6e4940b76f5c099379ab16c22246c288b717e1b6d022f513280ca500acda6a5cd2fc8ca62c8a4d613dcd63bd8b01ac73f5591ef14744fdb70cef5001a40b95a696d0b4402742328d2bb3a7151b89720d6841ab7c0fb4599c6e99e583554ccf0261cea0ce850c20ddea64c813f9657a1eb6d6709f4ffa738af4134dcfea25803adbfc389771707f1b23e8b0ff4e1d2e6e872155a1309fb14949646e2d891e1014ad6465e511f7b70d7d484521413af5c4842843ccd92a7da0139432e45bc0e8597f0e0dfe8d28307ca18b71c0fb4336ea54f5206672233e58fbac803e87926ed1f800192b0e8c522f36b91b26a3c05ba6a090d6b825135b39a8b33f81351d0b43c14472b4bca986f0e5db2b996239cbc110ff4b0a18813e0bc3b159f68fe7277882e2fee1be0a328556f788626037ee034b4c69a473f54e96f3afb5e5ba7a2b39e2e0a7fa3d34c0b730181cc9c4412c33fa7f16cd5ff7f3a2e1b33b96e15e7d4c8948544660b1964e1b43ce15b7e0ed1bc49e3cce041095f634c8d3502a1987792022ed0e50071e12c1828690609b998152b3c2ef89c79c5b95f3655dbd35b08a4f74599a34c1becbc7dc2c80e8fa982e4bc5907816a57199ac3ed903c33a5f45bd4882323564e040d85aa92e768552ea58dd8eb1d5317a7820b0178b64aefe7413a54f1e7b7aeb3a9a02e3e233c5307c2102a4e2ecf320c09a51083dc71bf4ddf894a8a52d8b4781b5dec3e4464198ae4d3cba528373cb38c12a92601508a949151b7511731d5bddd2f6317bd881f3468593b84ac33ae4a93e429e3e75fe857f12459ea876ba9116995016f0110eaa0d70108612d3cfd1dbb8a2151d1084f04996170cb35ee950f3b1f6588b186f23cbb7ba0cf2dcbafc96d850dd460e22526d499ba5795333013dc3f0e194162cc848019a33320684cba24656e001966013b4d4d852447c1e0abc7644975332ce004bf7b6e11978b4a8c6a9bc0495d0c79be6dfd6fc5a0134d43873fc641095dc329e4118fff05bd2facba988334ce5de52cb119e89040bfdc77961202f1266dec80786c876ffd666297aefc4546cfd2da12a1337e38ac2004b46e9b6e0a2ce5d294f6ecc2c8e12f99d9923774f3e3f3deecd8ca9f0344dc5c969b3c85e08f5e0bd3ea32e0be53712bdf0edaa0c0ad495a27a25fd9a4ad4d4a7a8665d938c02efec9bcaf6fa4c6c3af349f3647218e4be26fa863ac71381b64fccaa7e66761e121e308e2ae00ad9f8a76ae0ad6baf963ee115566861d87af2279d2932bf0d70d2bbc394d4a768a7d43f1c5a8ddf18129f3a923e904fe1e71099e28881869a21b62b1d87fb36aefe562427090db49c81689b3be5b87976f1980c657273a3655847d6060da875240507be539734d3810b226bd6f4ebc7dfc013e8ec8d11ffb63e0b2545cee24c11e56e7568a90b240fd754112c122e21637b099440816280d5fb8c7ea474b1a3bfc514b22dea988f900e86f705e88b6f4c4a007a29f76e0f09b6524ae9a41d6274ce7fdb6bffe5fd4ad74184291d0999e05682016e973e959c97e3f2dd082f717928395aea93fa54865b0b205f5ab08768c71691d908d9f8d4c7c9dc4848eeb816faca95724cdd7e8cc16f33704789222bc5459230f34722fa6e8c72f20c6320926cb8f6cbd29861a432f225258b9b507377956c3cff91f955b3b21ba2fb948f37a88de3bcce33e716d61e5f44cfeffa86059088c5d5be672fbfc53e22bd8bee4bd3d0c60fe8b4f729d47a4795ba8b09ad98be4c931cd653ceba4d4538fb502617180a068ac7257827558e46e2f579633058a6216d7de2a47bcbd097ad5de91de39dc20bf6148d545680e3c5f127c1f2576cd0701ca0e9447e1ad89c488a60bdf78a803d1a76f572ff7e002a8bf9699c6afcc49f692cf31a1fd0ecbcd32bbded9a08cd04c09664ba69766dde78137b4bb0320b1819ca090ea615955f14e70694153f2fc8ae1be214de91b34a801cfee672342c41f72131085a1059edd567459cb05630f1adae7868a4f759d56bbdfb55f82aaf84cada75f085eac3cedc5281ecb37558e785f72c9e04cfe7e6009d79808a3d1d48599cddae6dca586af151c36c66c62e12fe9d089e4641e6e70865804f7094fcf46d10702b5ad9a22ade0c1204116e3adbe0491450b277dd3f4cbc19aaf159d7f2cedd364d963f28746a2a769cfb9804a8f2a2579d90965456914b4a7957b133a944ac37fd682372b15c54f71c6d6a15e2fd51d96b27c9d394a2b91da4e8c69a8197257c2417ad094a7d319e6caf0cf4f2c9fda2a4c036e36146af9a13edc093e28eef0ca8ec0774a5956a727509a7293e1e4fbb2ea3050b2544d5c8aeadc7a734f3b3ef732f563b2c6ca67b1dc3633d30c4ef2bf3185fd44865d2af5e72015cdf8c182e6b28c5e746c98ec24d2467b72f8284fad9676cc532714f570982993d4b22c7d07a1e79ff5a75c94eee75dc1fa222b630cad753664b30f3c99826b5cfe17c67dd875b9d0bd2390028e6ffe9fef36a2fd6adb13d3ffc69670cf4a67e9c0764a15e7925579315dbdb561f07b7da892394f4693e51d9abe65228034a1b2b26a01d5a3ac5cf208b2301e27fd86e3ecc159090e8c3b8bbc26d5d26af5ab404a7f982d9b1832f399cdb1bd3f0b935af2407c9b4118b996da7c7300ddf1d73b0f03779e3c6a69c67b0c9d03259f134b7f9c2e767ccdd1d78c4bc72e57bdc7eb66b22a981617840312fb7c906a1c994ddb30f93b201006b637f13cbb66adffd9e7f81bbba6a3f431f816bae57b2897da9bab4759b983dadb64296e589966e19f1931e5697c944cdb90ead262e737916a47779342d7adc08fa740b6565e6d1f93511bf231e67cf04883f47d992cce088555028786d8d25a6b67c3bf653424fc7f5602dc9592a2713137aff708ba508fa45ae87eb65ba5faf72c4ee3e5a9232a8b6e830f150fb9620e2289f9321e63795fafa60331cead44bb6b3ebe582bec0c602118f430ac362547eb2ede95d78b681fe9a79f89a03caa00bb1fc94d3af4249604314668f68d4d66e7eb21b4641cde5d9f89ae3e8ee8ad9f826e7f3564bff5959e68503e7d434cf3af6b5d0e42ac3e9117a8d9b0d945c1c067a75a9127b411c7462abc11bedca666b81c0b1401be2b7308a19c911dc8791bb166e5f0f284ebd391f4e49319dddc48886996661fd7074be8f0515fdad5562a2609abc563870623086364234cab710196f099650b6b64b41f11a26d8f10cb440c1c169ee95ec34e2fd2a55295e9e73a7a3d8e91330fc62431720a5aa8ff5b21fa2aa0ddf250d5ad6edf42a1a40db15b98ace09b4518ae14b6bdf397b6f5881c6691e5132d21afc94bf5a680e58b61dd78cb39b3a03a7f1e2541e8b54797d4cbd80e5ddee825a44a5d925b80e8e76b389114e4aae2d9cba8e3aa7433c95ab398d4dc7581b1f165890a51dc121ca6501588168bb17b7b263da8540083cab2c70bd3a8c6ac2909760dd89092c4ff4c92ccb44c9997d882e144b9eb2825ba3461ad5adfbbceabd228515efb2a0a0f4eb5f6bc2398ae98a5bf76bebc45aa165425f5d10ddf69b8e02eebf3ee1c61db213c0be64803661a48031c1d5403816d96866decafac0ddeb7dc563de5c46cd1789774e906547f0bee4edd5c5ecc3c3e8ff58e0431ac0b9bcdd2f8937ebc7b90994ada3afb2629bc1d051302192a4af78515ce9e305a136e96856bab158f1e7717d8a432a2d316c938c855952f883e272a49b831282095d5a67627db46a6d61388d35b8679f5c6a1d60b2d8c1e70665bf413d35385ba135f8217b5ba8e8e32f4409d78ad0cf8b9d47940036d526d83f45706987bd5610c6a9e0c7dbf59bfa577f3c973fcc87650efa6f96faf57f9f78ee784702093cfe1856ea7185034b5be3d06d9e61c28d92c41c3a9dac8bb80419a1a3002d84d41534e8899fe13abfaeda1ee313781caabbc7963e3cd5fe9aae294637bc9197e8fa2145027a7803c19a4553e71f0a41a6882051c09cfcb6ed46b0c47da2b4a83e58e757a029d1c417c72b56c1eaa19949a0d6340be4a91b7973b705bddb2021a0d58f04aad474e68ade940fb99bc48c5bacf126663d649505de44f03f8e5d68d4191f3667a5ead2e2878966175bfc82a3537a1118cfb68c5b2e626d4ae4f1e7a2cda2d420c2baefe76910432251cfe3ea3e78dc6ac12668410c166427056604d4991dc61e536ca4612d348e23a6c717f814f36fa43c3d9180206abd1f18442930249af4a681895b177afa2f62816c86957ef4b20e67816fe0116560784611bd801720460373987bd2f96c0e270b45998924818def6b7c6a28880f367ab657288a19b8a47b53216c5a529114ba6bdab69bada5e8916fb6eb222c71256f919dd117d369f65846ac95772c712762cab34795c265ab3a9cb65894a692169dfe6c22eeed3b24e076c260f12f1530695059b23d0acbbe331a041b479d7bf24d264b82d90e36165c0bea348f048418152453615c2ede09c410289a03ba329fc830c2599ede63b4132dad791a53c6c5af6f29bab9d5a67434a6aa3f8fa5c107534559100607c9e74f0292985bc3e4217e5864271ea82ce8cd061371b5052f10398d990dd92e709556b521f717fde513cc088b0e514e774bd555eb973b8285a4c02f09b9dffe61a7726ce2ff19a9d182dfa726d91b708f8795beb81beac5caaa3254327cdf1ca306e84f5e18286eb158015cbdef44b67d82556704648a76060ad5239abfa3333e9803881cab0bf48c7c774fd9b894c748265d7856dae33d42acf2c5cbe8f1e93b470a3ca41e8be46ad68ca9019cd34cf859f41a37e5bcc08578d0614d6192e6a1fa44967fdb70e6534e8792be03c8ec960563742eeddfaad756b920a6904ed37899fabb344882a150ccaf3197553c502911f3b0c35a12a1402ef32a60dfec58c90b75d64bcf88be68384eaf14faf720b965e9f37e941e4dc9e8c7a602b5361c9b3afa0d4dd74ce4a47aaa33bd5bc1034fe99068e803cb58796c7dbc1579f2c8f60dd488c1c794bc0a7a0be61bde62a1f1852f348810e06759a25d962095e903e26c49702f0929eea521bbf0b5eca1a3aa210d82e62127256f72af59ab70e376683fa3ed1f04d3217a55017813ee47b17fa573788ba06637c5c5ba303f72a8c98f6e28261a2059fd93ff24a6be4a1c727af9a93efef366486381c7416303ffa360e22144a7c5852cf7086da33d6ae88fa205f7fdc784effe4f901eb49f8bb1ace181d56e4f5b1d53ae56249718b473afffb2a5dd6fb9c90193d807b27b72878d1c348ecd994aea1dc1d391aad892857b9ae6fa057dfcbbfa3743ca63802046ee19e492890dfbb42f3765fb02046be59b7a8a3f9e79b48e9141b8aeee35feb976df772bc933d4433418f6acca24a65cb6a787bdcfec480a6dbb1efc7b2272a7ce76d79eb5943e5ed26c6dea28c1adb2742ac3b9c15d22f737ac5ffd34d0e5d79ee6ea3677b7a2cfb13cb2fe4462e7af7f0a287e9b54a91d961d62f63fc6c0128d379a3a3424665c7a8fad30478fbc1a7c4f9d538659454433150f32c48c69204372cdf11764f4ced56e46c759d094bd1602097faaf55e33b59c4ef8ecab4ac9699f6da445feb2ec69e0650da1aed75ef32a564b2eaf5cb3c5ba078fdeaac9d5a7c4619ce97a0a80dfedf24848b0edc6bbcf6bff3b10a88c0b782240c311500ba4eb911e29616350de9dd5c175 +Digest: 70848163e754f864efb986ed9fade0cce56011421e307cf9ae04eb06bf935273ba5f0ff868d6d1015e0ab5f854865e85f88934a7c6148f947ef0ca5e5fd9a865 +Test: Verify +Comment: length 33280 +Message: 05ef6eab767f537fb2e12f2748b62eefe5458cf0ca1eacd87dfc64eebff09b50bfbc177f8d7d901ed18e09f7bda8603f404e231b7d68a5637b2e51a51e473f6d563205c396e6d0f688b5b398ff763eca2de353ba16403569443ee2b2bc1ea3883219e17f79003a8d3d20d412f468f11712cec4d37cee847440f4be1c83bdef29bb3952b91e14f76d5995156e86c6a1ae58d51f7199bab90bd71a8eeb5a6b4cd8595a017b6d692e1e45dd1eb39cd7751868c10c9954ebfcb77176f9272872e21e744395cc4e49082668c096e91de496dca859325595cb77fe76d2a8d9d718d88274bdb7b5a9faad0f29052519f3352c8282673aac44a04f6b4ef442094ea6568dc1900f3c66c54461f276744a05125e935db1cba74ab3af8361a470bd756386c5c384446c6df2f5a22ad92b843bc35496a1018e4c8d4cbdd018acdaff34998eb4e260ff4aa6c9ea5c38f7f2cf7d8f3713b51d2ba5f6b3a1d9d9d327d6738e96e287eee7e0f992481686986f34b3c02f9203cd49ba6d2f84260de0004b1a8cc7d618f4a5354f943a597b834dbac59c639cf2db9091db098e401d9c0c6411d94818ff3be0518e18e6ac7f82326a9b6cfcb8ea0daa34268ae6ae6fcff42b40bd4230a28b413da0667497fa5bc74a1e77216f532d3cab38f7b5f86d405fa89082dda76bac70006bc60da254d7b3653407fb489601f1fcf79b22a77eb9f6e2e76e4003c16514a2d980d956f6be9ec0c662b2cb19526e314dbd5642090061e12fcb94cf0b7fd52cd1dbff3a46d83265bdd16d8045e75e5221a4785178df47ad4edf0090b3c35da53a20a7d7aded145bff9c54f0828a67655a99b15c321b504f2ef3add020f65115fe98fbb394c4efaa760b90a239013174e2e429ec9f7f25ceb54ec316bae35c84048820586126695b0866491ed0156586a0cd078827d26e32cd3a69ebe95124fb343b414e7edb2a749ff4a6edb18eaba47c9c74b932dbd2835dfdc7d61507518176f8841b51abdb0022fed0964234aad55e9897062863faca4ce0065fa6ce8c1fb2061149445e240479ccefa1edcf0b212e0a99f771328e0f842b4e0e046e7ddcd0ae1160bdbbac8a8ca62a9719267590d43aa11475103558ec26c66c97afcbc0b838ace6268b1c9943d4a9ff2d02912b3970d8e69dc597af6c199700c8591ed353ec0965e6961b3a869d9561932b07f943f465f44f185d1bec4be852fd33201e8711516465a452743d4b1645b2697e02db0d71c6f4d32fa55405e2eb9f0677a83df1ab6c0b7d694f50245334f2849f4fea0524e5f5bcb4538c8fad52179acb795ed2400440e807d3a77175b6bb4311e75622a5d8b89c952f7d31700fccb7c59ad0fd38b46cafd4092a79a351756f7cd309ad1d27a73a7a410d3354ab25250c127dbaba04f7987af8c286068f88d08a19e9edb35b2960099025dc80ad8cab49e94b51ee7d496c9ea855dec6f75d2ee1c3e02c90fba5d4ed24ae751c9d681324282409fda6caf2eb22ccca0a115a5129d8d5b0db8f855fcc058e465204202344d6ef2b0f07e3f4066d1092fa66e8010b61afc3bda030c94f3caf9748691ea452fb94ff4b29fa389a91087ebf7d70052e6558ab5eb50eda1dcff7b02654c95df5a0facdda9379884d979bd681de58263cecb7b0e556875adfc950d8154d8918d6cb0bdde4cdc6aac786b3e16712092cdaffb41c7b0b03103c2fa1593dddc69b9d87ae7690604b66b16637e89aa0ecdfb2a43735475deac5dd0bd279c58be8aff1d9cbe206d36e86b3400e33421068066ce5284572d3a4416964ca81d5e0571c7acb4b676fae99d0741b220a85ebe46bb0ca6f9223f6994c894373b997637caae164144ef37a330e9dff5ab58eb8cad4245af565834c32aee5afb468319cbd21ceac0fdfb9bea406d5f49e7b83ff810a739da005ba5fd52e24b075d7cb138348e8ac2461ea025381c503d6a68d4971d5439b59bcefb7eb96ee4e9e4f8e5137e8d86b3c1eadcfaa461533ea7cd31c02fc3d5d09d04adaddaced921816a1dd3fc945f13d5c2bab101f6c8dc3467e039c4908ea968af4521139c683c9742d3f05b3d84711648b21edd27217474bb583a7824c4aea3215a7f104242a9ab35a00ef6e39749e7ef6b6aa28d0db5fd5a1268b70b386eb10d45fe4d7ad8d731a4fa767c10f80cef194f4ade92ee1f42a6973b0dbe3a5836b5a04517809b63df035bcd476037487078c625fdd332fec9337f27f8b84af998dcf1da2b0e1adde7e33c79e53bc57b306078828cb88cf3158302c5e473fad14bc5a333e47dd78400c72512c21e33139372cef717dd5c9a9c17ea8b6d8bca6de4123cd8d05a42149e11ae1e8a71f0b01e2241ea0b9c1233e1649eef007a2a2de645373f7b2dfb0e347520039af19ecf34f169d1f48f4e7d79eb887729a99a9fc6c12aee415352bf584423587ff78dcf7c52bf554f2171d5ba2f4faa6594bc420a38704bcf74f9c67e113083b61e5e3f58e8bada97ed2cbb46a25cff30e5dfa324fdbffe720d40a21a6ed01bb9a080ad5f05d4d84b6ccfbc93e718fc07f7a541ab93527cd586d7e0a1bf7a9707588587f34ca5e4f60aeb4826603c1777548d8c029be03d767c2ff0c885a87c2b90ed6dba1f96771451fffc72901ed7fb86f900de69e1b6b147a950e343d241a2d418ad28112f0522dc8e380d1949c40109884e73afcf7f3283e48f968c906de9bca7e4a1a3f815ae0506895a4e35422456bbb386b0020d56cb521b36c26b778c950ba2cb6a6a3f1256196eeeb17a08d1e8f3de6c2d41d7ba5882725887bbf4e7f7c44619b6fdd7fc5a07674ed5705e965ad12da879d764b9e5e633704f0a4ca87f626d011c3b86c89b70f0df4cc0d9ee06c43fd0286b4af1ee0dbd227aff052a865686062cabb20364e69a2469d3f145875d6367bb45e0eecb699dc3add2a50a97110fbd4ab6e04970c8d1c2cf323b3946fd66c3952fccfd187a53f85a5db2b53c32888b18f597e739a8261eef642e45e0348898586165c95fb05e1502d8a4b6e03b7ee3f9d05f7919f505bd4cd230d7cd93674a778351c00bbc3ace39dbf18c2d9c617c7fef9d8bac400f026a14f98b798a715e752e077d96fe786851e03fa16eb5cea90d9bd87b6b1990a2b994cebd7e8a4548c39a0d5eabf775980d8dc5933e4814fe457da6e4d0d23902cdea470a4733419e057fc9ef9517d0c1af2d59de26a3d2e09a0d7f34781a76a7197de8de6de5f4c29d47c3acfd000879c94732ee925996f48db3c806bb42b8042ed83ac64d42dd5b0d8a81234e209b24ee8407410bf9cfbe930927c824fbabae7081a34e7fba79cbd8a098cf02f9f757713c3d821dd4fb834c85f4f54f95900a70f2b8d37fbd48a98122611ca60cab8604084c0e22ab88f71cb2e60a95b123acc2b3f1e1c7dbd858899870a8b1d926352950c951d4be168e7618419491cec509c83dd515e296876d647b5ddfb0d005e933ae2c098ebd22cdfb0ebe1fce5f02a60408d8dc4a6df46cb4337f4e2d91b916b588ea71cb092c1a1e3ea20895e24b05f89d73b179d2adbadb695b50829ece4241799b47042281175200a3fb92e92cbe38744c11fb54f1fc4c7588a35a37940059e8a4e5e4a9f03a38fd1a454fe426132615b88a49758f95a9f07da30f2cc8b5516e9dcac70fc7e725ac9b822753a5b9540a4f86eea4c50b5652a0cc2bcedaf5da63fc8235b496c2ca67ae3ea3c84a2544ca8794457340e1e424a8ab3aae292657712798bb48eb4179e6b8e76fa281db7acee74f086171add5eeebbcb63b51eb4b1ed57ac22d13e7b67241f8c582cb30689ff4f381efd5c3ae09e07d1906e39947b55ca4d4e1cf2a22c2d00f5fe9a4e880a6174e5c8efbc7df0e2d68fd813cd4bfdd43a38df76b8d3130f97799379d586589e49bf2bf322edb84390cbe4aec12260f10f337ee8785544514edfc0d22f489a3e388df01476d35d489d4e5b46fd61cc35b107d3781a71e87b8cf12cac4616f9c7a819be57a0770a7a66e0e6e469506826897c8530866f2715b8757f0f01389dc301293ec68821e55f51482d8fed375d4efd593d18a49728a83c34630448f5adb9aa86176817191681c750d74f715dd2357668a2375d3014bb7ff67e91039752320df8f24533a6c66831be8d2cdd0bf0615d6f5d95978412d7e98278c11a64b3b591467766c5121d9af55bf62f1989df5c1837153a3bd94b83e2a2fa9976a5f9ca9e3a4dd2b6a342a17defbb5f0d1fc6ae1188732f3278e747d21cac23fda14bf99c9a1d91eca25e052f4283c5a215cdddae291f7b62a90dab21b9356698a2d2cbf32f8eac5157984c751bf767beb21e7359e4c026b5b4e53837413e6a30eeb5c70cc1492acc091900b644be4f4a3fdef8797ffe3912e098757d7c6e38abce1d764d18f513440108a8598381852f0438f275c383bb60764eeb59326ed7f38a325e1ffb3b70a3888ecdc8a1e80f534952ebb778f4b489be2e20342ae54fee6a1b09eb33c348d0e4d3f66a669af7a056546aa666fc2c7400619e772d7ca986b601ff178934a3b35dfeaba7994045fd7267f8aa54412c09840fed8803dbeca2b50bc60dc23789343d3875e70481ff51e7b31c2b0c6bbb30915e93d174a92029b062e833a973033bcaa8da926d062f86fb5f5e915423e2d171791ab8488e4d05ef2dedf3059118b04e7764109d77dc83f7934645f511a8d46a860aa746347c1dba955bb49d38d17b0fcc9bca5c7b0f3023795dadb7dc1521c5aee9053740b55959c2bcdd3a11348456d0062671bacf75c6362a32612c31a1ca18413ae35dfea113db97d8a4c34cb46aaa2d8da6dd243a29f5353cbdab053ac0ed99ae123161dd3209750ca3f71ef195839868c18c166795dc073491ff98d5f1547ac98c64e5f5fc73dde1ff55b4241d83d01d8b6eaee450132780a6d0f25ba3766bf3189f92d1ba4257bf7f8415364bd15c16cc2cf399a2c31d8ac4c71cb21f7af494808a715ab39d6b0eed2d490d6796c4b94c6dee6fd51472b9b28b1dc4ad899d148acc897631ada2360ff75993b9f99170d2daa54c302dad743ac5fd7794cbefdbff0de30e7a99839fad8b4cae88234aa2281b221afa375625221dc5b51e677151a6f7850bd78a97b291902a481e3c77b614d76dbf7c59f633333a7c659186acde4930795390a864d582affb48c16ba0165fb68c25febc140635c52a6f364f26ebae60c7d0ed1a74714790c896bad84e29d1628932c7873806f065d7ba55eb69de9e30756836094fefa9da981a51ac085731806bd021e3ea9b2cc38c303681fd21e1478d05b29c7bb5703674bccd0f570849bb3be652f8b32db08751b8203a681a3f4f168eaafc822d644b63647828c2a4dfb8005ba3ed1a2445582c3a5d3e343380ed19eb6650ecbe4cc26dfa9820d193bc22c2195ceba8e8b3de279f33b4e8d36bcb9d042ec13fcff2429a66761e0c3ea89f8a07c519e3e1c2c249cdebc40d61ca91aac14a7705ca1c74f3905a4bfc0b6ad75f0d26a0557739ac9aadcc982a4763e7480a0199c51693ff7f608bcf2863cc744913c6a78613e24323272055c7ecfe7380c79d50081b1f8d47bf53d118af941b5001ee57fd1b8330eb242d266db865e059e064c3554187c35193f87955558b767dbfe6d842f9e51bfa8a3d31a2135fd4dc3d9f1b34f0954ba7c6c3f066bf792dd736f651dd13d0aa5943969ef165b3f710c6957f2d900fcd513efc5ed35326e8664c66ea57d30c880f358096df162af3fd649018c989bef055e5ebeb257b594e33ea7dcd36a0605b244a4541f68e8c6dabfdd60d8f436a5dbda1d8bde39edc0745f9841f05e195cca1682cc6bd36a110237ab0870827dbbc915c0aff952375bca55fc30b49 +Digest: ae1c6b26050b11061fa4d014b61ed1c3ddf4ce072a7fd0e1a622ed9405cb327ca23098e80b79eca5c7a920efae47d43a55a0c7a0c4ad5f8cc40abc6fb6d5e839 +Test: Verify +Comment: length 33864 +Message: 90a28c1b7a66f7fbba48aff69977f9d3150f52a63eeaf947e0baad026254b890ee4f2c46d3ce6d8d279aef92b074413f05a94b69f0e6d44b174e4733dbcab67b81a01fbb8f48ee3d797bc4b17d8c7722ccfb5a29ea48be615705b81a6f2f25528fbeece1797b83f3fa12b5bbca68a266b32e074ef5b7bf71ea068a21e62c0efd61d11b1f58103397f0884a185dafcaf2026ada40d9dbe063167a44af076878633f0035dff3ae0711a4040b31fe0af7ae01d65c685e5d281f24896f2b9b8c6b6e7073c18813fe05495eaf816c77213282f79b142c4ce5a08d5c5a92ff6a3fef053e53478280a7372866b033328f9b82562ee08af56a1a4e96051635923c2a0d10efc84f340252a5940330a9ec0d21f012ecce472c81a53c2068e4e14cd9f4cc78ccf9620861a756767e576c00ba5a839e7a8dd237592d7214ceed1c95094635231d0f0765644d52b71f4c03d85eef43e22044b380ba5bf65b7d5971d593c84efa2a31c7b3d5eda13d2e38f6dac18738c7251c736d6cd7d2dbbe4f6574402121e53a88295b7a2e4cf2f342ce70aacb6b33d33c996836480e7ed8f782dad8fab6cd973cb5c31bb959bdb6931201e262e30f70ccadd8e257b02b157a4f7023fa13988774f3548235d385be524af432f6a84445f6382536abc2cabb00549ce8ca423053586c76764bbf3454a8ffb3602cc3b99ae0c1b6fbed4b4213b01ac7f1114b7b4311a792bea327b1c0bdb7a534ae3b55b7b2d0f5f8c4547d65b3285a047834639ec72c0e23e412e44ab8fd3278241802e395ed49f7d9e462f93106bbeaa707cfaea184546db789b53ac256c2f23563a767b1a11abed303d916513d546b45cca6b9c836ca64c3930cd7024cbd6b8a232b8b2d73d1175bb9ca053b548c4efa89d20864cadacfb138d16aa1668caccb60789731ecd4c8190f1d0f18d3ca5d70483ae39cc9eb782880ec3bc62d957a9f2275d3e7928c99b40cba7a1043785e4c10c69198ba6425d17445929a2741a0ae720a8775f06154d5b98a8e4a2bfd1a39ea5e5c8125af9f541bc5b745def8e4a1571ffa038bbcbf231c7395ef13c159dddcea8a7f9233ae587e52f1eeda231020da9c75baed03a447405ed526832ce2e0f15264b98a581985a3d58abda128ead2026940c19da0c9e82a34971804a67feb2e7e32589486aa849437c8dbbd713b60d76fa34123f9f6afe4db23ec1d97f6a69d573c83392527fd595ef470b664ca716194e6620878f543753dc1cb576710b845c3c963009d5997f83455a3126b61aea9c1504bd3838d4ee541b9dd397e95ca2eab2320715708fb7ba0359d5bedc6bfb6df2a250c8485753cce52494b444d8361f890e114b9fcd1e989da861852c24b90d4bc173be2a66283ced6381522008ce59059ce722cfcc04bd98d85d2011dfa408a4e4ae905b8bdc2288bd1207e758cc25dc6101219d270a87796c210649f76cde728e69d55832dffc4ba3df3c1752c01461ecf7ce6448a084b3d665ae210643fd59212e03ace5b448aaaa31654c814a932ab3239fd1bb6743dca9938e3376f9f3bd3f6391c63ef9862a52c129d36ebc20bb362d0c41e9bf235848233cfdd3df40034bb306308900434f1006e06875955b87f87c9a517e28d1bb54ad20fca76460efd894d7786e68ee8d746b2f68208682157c8ad06cc324ad7a3189e09c6c39d4c768719c0a49a41669f2767d5f09d062e824d03510734335196151e2699cc02a2e6de1ba72c54229691ca140a99c334c74a3f53ed8e904f72d869dace0a387cf897b5db92e4bb3b60f55841ff4520fcd4f5c6264229eda620b03b5a6ae3af1436cf35e2ea967893ad12f8761bbc5c653dcc0902b8a2f3414465b32760eadbd145d786b7180833326331d33cc6c52077ea173172b7c04b27c740fbc81ae861bb0bf7cfe3820393216c9a101a682a143bc31e65fba74a9d608f8938c5fea4ecda717639ec924e4067ae95d89969b1dfb8b128ce27f00990f5868895a776e822375f9eeb5cafb3e30c136a533f322329f79a7f937dfac5cded938438f4e97aabd9beb50dba40f824198260a89729479cfe6869de852e45fc509dc74937bf2330c87404c98fafe6aa95e2c00026b7e7ded7012fd4c8f253c4278e97f1f55fab590d6bd3456263451e881dd2827644c9978a4f199fcdafb5cd794d3d57b833dacdaf896aa9bbc4dd27fa1ade570e39b6701d386e671cce34c04ec201a507a27835b6b8101e223a756ef4c12ca676fc76109aa678533eb59845aed52a006b144c382bdf0ecc202dd79a7dfa049837f7d12108807d8cbacea903a26e02926bf11f7f15e6acda3c05c9549eadad55d8918f4870aec63a18802fa33175cf838fa2b9b17cb43270ff2a14445ec27004e131772fd9179b83e132f1cc64d2dafb5f8de2776833e8b8f0058011c52195cdda41537e4ba543929c4eb827426d6b21641b6279e24a16d797fcd464dbb364d94c28e9ddcf3f088dd13b4c5cd32ec91d25b4005ef1e103f87c78dae4a95e2450bf4e01f26bcd309d096175121ffe3e182ac185cf9ee1f84128e2583a360b1f5ab91b6568293804e9ca28fbf12fc3103afca8ba73f0303dda22a0170d8aa39b1dc4f7dce51166cc9a9ff8a5a30a6788aa22d364f3efb71aecf21cdf06ae0ce1c4674a2d112a40d0d70d393ccdb8d0ee9124a84ef6a35ed79f21bc77cda93039752b7c21967cae57c99e53891a42e88a168b913f25150ebb1a36eaa90983f5ea5896f580190f99ab97d9ae512faf95a362def5fe284cad0f86b90d3b6245453e97321d1245ece7126a46b25fb707c1839ca53c54a650241b0a328cf682f6077b57875d9ebf1a82d56a6ec87a58525370ed69cd09472a5c27cf2ad1a20e9e23eac31b1bee32a1503cbed85669ba9933b37db012e5b4e13c7bfd294307b14580d30079c0c8448a3b8e8f0cc6f586e44994730572b0957dab5fbbb54aec11f4087e3926b5f59ddc2a1504937ee664397d5af7ed55319107931a31584e1bd6b3a23294ab613de69f041746f4e804fba2b74f33f223315186dbf58899b75aa988363939912b67c7dbb3dd7cb76a16f426dfb94c9b45787d026b38e800ee72327dadd951607d3de7991eafcf656ee6f6cddde16d7021cebc832b2b7816592b1899ed5b049ebe85efe12dd467855b3aaaa0990fbcfa20fbb61203156162614c03e4df0779d5550886b9c8966b9f99dbb8a6fb8b61c0aac614b6db40ca6d6e9f9d676b24d98cac8e552bd73b043c9091c7e8ec9c854b28f87e789bf2dcbde9ea8b297afc4b4c2adf043e420c59e3a8237f6c528b502100599b5e2b74bfdc38f67832f2d5f89c37c23afaf151931c495b8a3c17a1e9cc9cb11473730e9a52c58b0a8bbdf808043b009f68cd52d96fdbff8d60212379d462c890bc5b0795a5f770e93bc1ada20c9e61dc8fbc565465c6d833de5a5c27bfbc66b843cca9da5f356fbe4ae83bee3dc9ad9978a7a72b8572ae21c0a8931c171152340fac3a8e07e94e31c118ec151e22ac7d29778b87574749020ef50f7f63c955ab28e503dc267ad6e9a73b063f38122631ac124b9064ae707cce2819792c4c37c6975d4cea4350cf8f0438d2931102e25d09622f6d330ded370a29f932f901c02c63fe5de0e6d301cae1f7983a3358a9a8464e7e474dcd86dcc9e0f7d15252b78594ae7de7986b34434560a05c267e43ba6dbd82453857041314355b7fbfa6e67b3357f527df802fa2385b311f70da783c859981907e122e83f2106c63c96613b446e00ec7467abb8ec2d094ae9bd610d697c9c44fa665ced56b5973a6f7f807d8d8310def52c1a0afeca7122f2fd8d22faa3593ab39baaab187f8b86fd2c58a90ee323dc98dbda6aebdc8f1cbb24a87f0c6c536ccbe788cbd4fd583e7e135648492cbe57a7ed694333e1b79a9ae93f7c0f361f4d9bd063aa4cad81c35acb15c5bcbe44c2dad7534e57589f4f2aa1bea483af116fbbfce7c0c00eaca83bb9f3bbda265bb08a3004c6d6cf8a8cd2f4a2830a25de4594b371c9efaf1d7f69768c9541d367a33e7e1a5722b51de63c488781f348da61ce9a9e001bfd689b8c775cec5473fd1d7017e079db87ddedbf13da4bdf769a46b218c92dd578229f1d32d12bb2569081c7a413a961d63f05e3ed172b3f3da266f7c49f8dccbdcfec844f75cdcc19a6629d991050462ea5c1434acaba930c6734f8146dba422cb5266a03d76d022bb3427a6d531908dfc69245a361746b717d434b9ec02dd64396bf37266264050b5bb3d6a7786e1a88061b738d87d338fb39146aaa337309a0d92963fda35d4546e4094abdecca0ba5d8af457f8a618c084f2acded44044cb2f0f7791006b3335d00e53f472cb74cc7d2d043e005b9b53703e8fdde5e6c3ff862abfef428f06fbc26ca3ca9b4b06e5c7910e755662674f61bf162d40f1523efc2b96e2076bf4ae2ba1acb7c113fd0d23003b85648322bc3ebb6a584b299b91785923f1b8c5a657f5f695424cec024c79c0b3f5908875a2ef7bb2e6705646ffe3fe8fa4bb66c3fe07b387f4a49ebdabb11a9d4d4437070a5b47175d163ffb91236001837916f4a94920a95331f1d531b4562116e75a81fb6c67c147a4ad614e21c7a2175a9ce162a38424e95cadf3e768bc69d7e1b78a7e0922d72b8468203ec57d9ae7c7c23130fd291f3e8b99bed3b6949a189917cb9a1ac182921d38e169f8c9107b264e8d1c3f55c3d8277edfff8625df627941eb57888ce903d7e54cd8a0f22c5ce0099c2c515138419924fd73c1b85e3be8ff93bd39cb35061a360892a64118115ebb076a1b65a5014853c1364d953f2e4e176bd516c68d234ef4be9ff3fef922072c75de86d8329e9bd3d24f1404abc014521aa607c51ae3dbe715086e71fa1842238f8f78f409a2fc6bdac9fd4dca7ba0784938f50f03cd2ad7b6d4fee1407a796afd85daff4f95d2e57ea9efb7c3e65b519f94c6ed716aa18c480b8d98f6d013c766c895422ffd840768f9d48bbf89ada4c5c164a78c40a9cd74b602dc42a3780372618f05cf647c9a40c19312e5edff3b62c7b5857bd9ab64e2db44f64c790fe6ca57b29057512165ad0714915e99b7dc1fafa3ce67bd0d1739853d2e3ddd423716b2e52af04ddb3258d53f5351153f50a48015cc777239af21b9d4cb3d5478c0fd7a0f1cc2df12c7e932fc9fe7eafd5f9842f2c5d48295f44481f11773681a4728b81aaff48f2eed072733bc479f5bd0a4fe2402a5758bad47e47c5808a08e953f74ed28aee5976c5abaccf39bbcbf6d6fbb92cb13d181a4d5eb5ed724843d72e9b470d21a6ab60c8bf5af8c08ca93fca28124684620e19f949c7ddced9d8fa5ce828bf45da5f19542e0c4cfb8503e46e458c22065e912672c01c2ae8e72edf897e526d5a21eb1ce2682f403d3d62813de49543c99b57cc4462215972d8cbd31ece629be0f5e5f80e0e3257280e4b92b375bc204090b877d8a055fddf3716819748b7cf7ccec6173180b4062e80359559897f4c0de739b5c9fb486c907ab5778d8de08c80250216f75032e1c33ba705ba903d3b83f7520272e3774a391c2f116c0e7b379d913053c9fd2d5e88892660311aa4534559a7ea7de940fb3bb3c9dbad2ad665178bc77a13f801f0d0f12a3167991337b47691da458d54140aba3c52eb9380a9908d3de68fd16f3d5f2c28f5b88c286d63e6b66e64302f194897ed0381b90859ab0e1a257809b3886562a939ce744248d6226bf34482107f57e5626a1a1bec199996d2a377117d86965d3159f3d1ff7e8da2491570f3c6aacb2b22f30f2c9a4e1eaffe0cf7792bac647447f2d335be62ecfed45183f5a04014c1a52afb7b918b9cc1f2be93b15c6e52405370e7101d8a96807413d8084bc3b7416fae4979604686756734b64a7e40d239fa70a9e19b79fcefcef8e7cc17aa4542f8c993b694f37e22b21be9b51fc886c9935e962a96a592854b6d5d8192682 +Digest: d75043d6153f9d26de85499a009646cd22ea2d35e1d7e1cbbeddde33efb7bba5f3ac5de36f1752920faf7b5d5c4a2bc9fb4c428a79a982a80410933e2edeeca0 +Test: Verify +Comment: length 34448 +Message: 445531669de300ca3de49d56b0850e465577d271b5f2ce7114fa8a0446e19db2c40d66b0fffbfd05f48469eb015f1478f7e87c7d701f2aaf63f4e804f5c22f609219df713dc032d724faf3897809eb747bf19d65db7e33283e88b7f21e7686fcd7010271fe3b888af5cfa2f7bc8a7d820a1a9def9d16cf26ce3f5f9468068cceba4e3977eb72e5658e8addff76eab0e9ccece4e45ef0e7ef3aa048b27c79271d6487eb4dac6f33af18b30e674e326ef3e8eeda0bc81264ccab34db1601d74133fd347fb9e83a58b1bad39cf8eb699ee687a9e72e81862c0549817e87a028c156acdd5f8447d93eb39d71ef7af697280bd0a37413315429e23b119acc01758fcf990bf2767356cbfce8156fb516c4f3aaec66e783818241abaa6c98aecbc593e6ed45a05611b8e9d6c4478471f4f9e90b027aaa46181a5ea7bd18def5a721b5e2d014d1eecc087f8759909675383ef1753b652324a023671f9d9fd6693c90dd0d69ffed04494d7458ce770d8a8999f332bfb1bce5bea6445b7189e7d1331af3ade18e5c61338fb2914c8551788f14d888b5e5dc501caadda3625c78f733c7df0b5f4987cd30d7207afa40ca07f3b686c0458aea2f62371a3f98a2f3a1e5a0896f0cb9d40fe82ca65b0132e0fe5d87e621992750483855e3763ae2bf98f0acd9201065acf105962c7b88e3fc277490e0f5d6447563440d209271a544a4fef4b86892d578392c1d9a23b8da8448e1d85d82276ac14a3166b9d96472ea8cb47e0c8dba929eb007cad89bb99fe22a4c674312b21f9cc4a56996943cd1191abc54bfd8b123881e3ea4cf2bb2ba7c955b467ceb9fee6e98481d9f0a204a3914be7eb7919f109c4b79b3651bcbb4bc51b97cee55175c9f8fc48abd853966b2436102de00ace244fe5f0083b22e1309250c11839a42f39771beb8d64baeacec6f4eea1a6dfe20e701989212390062cadafd0e2101473abf06e1b0d3a5a8a550602d3e551fc052ec1acd72f8f86c266938337ab2d14eb97d15d2799ddb4fd744dda504765f1801bd12a6a61f3797e94d07575d1d5381f93a683c1b1a35cacc31b05e4665752eb4c1b0ca386d3eac32de0f10c04acf06815fc5c59f34fb420c809f010b0aa92bf360bee22fcc54d18a841807aa218c05d952f5150cd274de1d9773365c4d4237460202959423c32e78a7e9e3238ad4a78a7dc0d56adce9c789e0f3a440168a79360f468c6e59d1ed84af4b4d336ded131b47edadc139a224d8c1e9f4bf4dc71a4aef506ec558c733360406ede3b22072141746441ad3e71e90a41bcde1da42410b0be8e4a207ed2b170ee26a3a41b5ecfe5791437c9100dd3bf053d8afa54317ffc9d8960c4e8afaae36a76d4002f4a8606e9751f05b3488600d57bd309612c4b092e72b0b15e7cb83e21c9dfede25cfc2c420177d19cd488863ef236c96f66fa6cfdc4ca7444dc41f7b0aa37bbb8f88acc1f43d2bb311443a5ae5b26c8b394167e680a0e9c4020d096a3926c0837bfca7cdda6a021249a5fe5a0013375f21617d419bd0d87b4ecfc91671cfd31c31533a509b460b1cbc925ccb07eed5f8f7f77046f5837c527b32e8e67a46be70f9b4eeb2ff7a4dbab434dd15c3ea4f40022dc65f5562de31d05ded441b3289651b474a5bceaed0d577b208a0fcb0ac1d8c2909f384140501947960971e3b3ae5de36d6b3d0899d534e3566d479e8f479db13c0694b42f9a810adca46490adbd78ca61a23cdb4bb1e81e57d1a0439303b3814742b7094c3108c22b2bb654773226bc19f118cd7321c58e9d8d8634b674beb54aca0bbb16a1f4fffa05d399a0bb0c4afece6d6990b371b6afc775fc7a1913cfaf030f642f6bfa36d1c948fa9aa68de98890b73a24d55118f7360c055e6f4732ec843e7ee70d7ce94afc82d1f583203a3ffe62b9b00608381c4fa4e9c3f5fd71abd41585edf4f199be061dca21df679f8d5e1c62c2d3fb96777acd145b3b7b1e356930f3a4b0fccab38c764da029c89c093630bfcdbdafb6a14e010f74be549b41c9fd429bdfe2feb3e638d710e0d7b23c2d3c3b4121991b224fdd45b0ed1e7b396ce71d33b068a847a9b1f0c4a2f9748e99bb6fbdae4c2662f6be5190463d3084c88ace1d00e249d74d8e156bceb25589022ac7a3c23d8afbb910bd8358454dcc6364ffb81ff465fb5839cf46e2a6c7a3fd06dd93fbe19b452d90e40aa1ab4578d3e20c858bf38f2c402189168d2b5d77f0dc0bfec9dce9e7baab5fa6a0e39a0280ae8f15c37427d29bf1dd3b0cc4896d7416fd449a93e94bf6cc9ae7d492ce01f006e1d954fac286d20736250016de1d0d440c161c8b3bfa4881303ecb2d53efb8a7cf50cf0bd1d178fe1e750586cddf02ffc2e39e37346b46458a2be307be3420fd821c800be81af73310ab6b88cb4c2b86bc2dbe3c75277696333fbad67f67ff74b48d168f77fbd3429728c0b168ecbd854264eaef70b74fffb5dab10e2a037a99d123011b03cca3a92c8da38529295f780029a2e4b98338fe7c8d7413209f48f9629ece231e35dec33b3a62788e9a77eb8fdc8490b223c7ff01d87279f583d10fe320dc2c19affb4d6dcfac000ba89d3c2bfdee97ed01839de04c1ac73b69b949cd89c9baa8937f941eaddeb012ec46066f1e7f5edcb4e2379248fb7f44a958339c0a05432da8d243d865890d56ddf8c6e3be855a03a66a78826f8316c3db3469d9521d5a2b2899b92587197c29e62bea044ebf1df46e82cd5b1050021b67d4390fd2806423cb4c7080732e811ead560c6b5f7b1f2175d1a266ebc0d5cde7ce3daa0bbcf599d9510673ca36b0a78c1d9a635157d20d44dd84405274064dc378e4228e5183100b5df769ecb09f471ae91096d4c3db3a63ed0f71d4e8183d936ad923aabc9108b9a9afed6b2a819fc22f0b604a4d9f1b4ba69065e37b9fffd02a6908117ca3f66ceabc78b6031bf42a75e77a325392327480b3b72ecce216f22e305a2300306bad9789966de8d2f6ac44312f2d8459026711e5cfe75aa31581ecab848fe5cacaf416b3c0f33a2b19d02075098c4e682dabb0a32add83377df7fc573198abe7b6c90ea772d675a8c03e712f93ef1023f6ab03885241f533a2dcc3bfcbddb0fb91a4d5f1468839c0ac3fdccd58b688210ffd80e1d0e52f1c4698d941cddf939afe00131d96a8d4f7106cc9eab28304f3dc1baf5c11177f55bbc4b379b21ed22a5e733c88fd8905d0af3dbee45bc514f0ed7de563bd59846484e8c8e4130beb4e2566b8cfe5d91ad1db3b22569f0d46ccb6acc975103bcced346db00d6b374d5b05632e5ed9f9a27f26dd9ace06cc08dbba10d22cc43ec7443cdbdf52151186f550f0e3b2546b2b3d04ad9e972d71d9a27a5285d733c2f20e20abcd5ebb3b1691aa88af66ffbe23901723846e6daf47a579da5b210978dbaf6265f09fc8047ab474a2b7e916631a1cb0c812a061c4c1793b20d8869fb0e2bc8482ef71c61e31d241c7b3b532ea7d3774039fd98462d58230ce6464811bb59a099b20813fe8ba7f94701967ffb4cb84c38ea2665ff9f254ed2bb5673819b2dc64172a4a8fe4a310df245f5db77293694191b0f35f0ab665e2d111fb2f2b68f8167f734a50a25a3a946d0c131484536950e551fd0c0580399447209cf0d15681a33c71ed0c926e5156b29634716a8a1993c1fbefd18afe54840657c9079bf9ed9ce6cccf1e454df9988d841e58a5b5de6ce015486a0b6f2b24873e0bfdebc1b06606ea4d202b77a7dc566c5d54b6554c4ea834931ff77132185229d22e615c5e91053103acc589c084b5a56de02ce6c7db92e06c7defa31db1efd1b8237d186ca07a577f0e93e2e83423c5bc7579f8f586289f10fe44532293c89c3a679f845f06deb41bd02711936d2953e59f1dfa49c0d1d73d3ba6200530750fb585593eaa469aed569bffa436921eb665c79969392e470f5d9075981a1a6d92c5e72a95c2e23759dbcc7e096645ac93b9896cc44820c0cddea74309f5b42acbf817a4285d6c4c8007ec32bf96ea3b425d4f18a9eb3b07994cea9f140c802521a8912664ce4742f66765ae453d124368cda32d78b6ff63d834d4da44e310f52a73ee41e999f5a33376d35128ed307d6d87000bcf3fc06e2112f084fb0de9034cd68987154509f5bdc2bfcbd91bd711d715f0340bca309f0a53b84fc4e17ae81f3ced668663f6a30bb7856ed44d78c91c06ee46bcfac27eda93a66b2102491c08339450ab5b4e4393d1cebab8f6880bc2b674b45145f876384f5597ade4c6079e4718d5f2af735fecade64fe5aba75261b10dfd7730452d99e31035ba0d944347e3e576fad4f8407cb8769ef8d139255f9334928d5e2afd85fb90c5d3e11647ab9684b432706f9dda6dfa18510bcffd32b9631402042c7e72f541d88a03de9d2fdb610e27e62be07c5aeb5c8cbfde5281b023d283e6cc28e76c9dee5afa4fac5b2f14f549cacf80d8ebc4cc0a71d6cda2f3e18e715a8c7559ce1f67b5190c0da40e1afa2672bd2786bd10f768a66bb73d11468858f3efec509640e526f4762990f4ed9d3c92972cec3b4a6f15e1efb7b684ad60b93759065251acd73f212098a870074efa9ec009afe2eb839098e53785ca909800897a5bd59cadce5c039dd3611be29ffeebda5618307ed5775feecf414f9aaecd8ea64560b3ee2b0c30405241352a00982e488adbc07ef5288b5ed76fa026058eab7f6b7a53c88dde1bbaadcf78280184ca9d30510f563322cfd7f87758bd4cb264583688d8d767304a5f3e7231771313454abf2e79bf400481ccaaeed5ead4d74de32f22df9537a130b09cc01d91d5e222c3afbaabf48c3c35bf573ca4194e6bcc82bdceb47c7fbf6351313f78f29a6fe7aa8a8bf2a07838702295e75fd319fe64c97ae31417cfc956b3a456f034012b0861d818fa4da487b598df8545a2b7fdab29ef166ad1788d8f5a6e9d0fb08a82198c00f82f5691b87a84ac8d01f2b8e8142672cf15443a4a71a7e878240297237f8b9d901e45b03933687565216d8d5c1441be73cfea65aea24eba7ed9a4c78dbee3167723a5809874c6d2b4005db5b83ffe1abae72e8b1895914d279d019c1f6c150423ebf0a344b3224ce03b5db29b0bce2feaf7ab2b26c02228f8eac37556eba3df1ce3b168cc830d3c704ee81452ec3456ba7dcac637b663c6794f44f3c2d2121fc89762719e48ea29faa7775b9e75c3377fe617dce9fcf8be1f371087e193e23ecd637e3e48893badd5c1a5e8dc1cfd4ac1dd1cdfbbe83368513eb0b241c586c481f48f2f49d884309849de4c7a6634f916af446f0c1cb66db5c2aff361db82398cb6ffd5109b564ac89c9b0717d61cdae4e928eb791ef436c37f58dba03a771654275ac04b662464dd3666a922e11758c32724d581437f4bf0a155dbab86b7e35eb22a6148ad71174ca3cba33a0bb70b27c5d2cd934eba25c3e53163d234c7193303d94896f5beca9d612465bbda7e5a8961bd244d85274cc3c75604c2c94720478901d6c4c38ff755fb2b9126c1dfdf7e674e9a0e8b593966b43e5eebb89ab122ce1eac408b4735fcde2b9609564e026d63016f64b5c264232874a2bb8754144b2f9a2998d1870f0886bee4e20c5b5bdcc16034deb8f5659fb073a0b0b9e5f2273a0eef3c2ac1daef81502e3f688a44532ef58adaf964b622d8c5b979d4d2b35d79d76db8fb7a32385a79a28fdf5d7456f83bc1f7fb82ce52fde55d654c9cd0447bae158dc832ad798eb61231e537345eb9ad8a9433f216a6bc5d1d1195c6e1829bdd8739156d95197a7fcde42eca3cd0efc5456e371547a4809778ed54c36f7e66f02339779d819eca416614f068d664070d72b4897ea9c2e71ee176ee24c2be79808a0d43450b7fdaa55b22fea5997e9c0093258f80e5985c7df74ce66d93c930091c231ce69b3348161dbc8e030e971b29472fcdee638b6d1f1abdb2004b0516e46a296914a96f8f0e3e4042f3ae3400f1df31d8f9ac12758cdc67f57f6118bacce47ecc31ce8b0c083d3c9219e0dbe9e4fbea154537c41231acca055d6e6a880d3b919ad062fc6b9e8b201fc85ef +Digest: f2e2c16cd3b8422f13b3ee018c3155d31bd2cd92ff4032ac9dea523e356bf20f7ee0abd80d8909456ee70368a58ee259dcc6e7a199e6c4a193c2f6f106a136a5 +Test: Verify +Comment: length 35032 +Message: 29c708a3ab3910b72eb4d40c8fb0bfee3bfb36c34d50d741f62bfede22dc8e8858daee97e25b51002f213bcb759741c79a1c107c559fb061916c0a4f1245a8365ab5bd0fcea1651115202d28c18dd6a331da562cb52620fef492a5528b511b1af7ff7df2b534d354a758b30bbab908eac6da12bdb60fae80e846d8cfd7286e9ef761362ae03b232faf72d45ca9445e0422c74b169e7fe34f3530aaae3cf129292182f19e97dfde0cf3159903d65560590d470a1fb5a045d3a3f723d703d5d5223e0bb63622488b523dea08e8891597514f0256c0459a5e75f9444b3373fbf9f316a38bdac89db26953992cf40aab8a55afa237e19495b69b01be2ba8d68b1d0371f37a72d207dbb9fdc90a0da040c2cbf6ccb56aebb8d3af810eca1f72afc9ba17a28ae688ad8faa0522ac1c95fcc51dec2ad943922b3f1742db3081918d8680d059c31e32b855a4324e190a2f061db15964aa55d117823d0cce66b4794ddbbd63c02e03184fb60f4bf259bdb78751f105223086f0a42287a78f73a2721851d9997ed27b829b395319b9751f74a6ea44b80b74bf36f9a95fdac55f31c6166f3c3a3cb86fb7c366d864487417b08c6f1139c77de9ed3f9f2c6e18334bbb6ebd4f0ea1e6c800f0c506f34a5e8cb16068c251ff54ea5b9d8a552c32f6d79b49c378dc56666ca54adf4690653b68c14b5ebec85bffacc83cf444d9b8b0bdacce0a206e024045eef83bfe014114922675d86d668288157e436460405569e5372619b08a4e7a3a222361980f87f0f228055e37f21df60fc4db631128af2a378378788ef9e21e328bf2da7a82dfd8701124788436d35281e12c78bf586efa9bdaedb024826533176f8e2d0e22f0d3f427f9afbcf84da3521e5d2bd2993be2f982ad48d9ef80c2d0171ee2bab763e966b4ad8a470132f16cc39704b2b3bee939c4dfc81407dad245cbcb82e808df22aefe67928d192b45b618018cc86e9e1743e8abb83f911c6b5ed3bd94ffde0d87b44e504df707e0a61864c44a7a928374ff363aa1c156ed9503761ba06701951f61eb9045eb95f81c7af107c631e6170955f6b40b021ef6591cfd0d2e87391ef39b1f4e02d2891cafc405f3895633ffdd2e6f417c6ab0debe91b0bdc7c94e50094b30b20a15acf368dee9b01a4f41e6f870ea077e61d64ecd4ad750f29407d56b5a67e5e71ac6264eb1e5650186d8726305af31984f56ee8d2fbaf138512d5221ae0c0f214b9f5c6923403ac761c04b25d306e5539cf9650629a1c620668872313167573e0ffe3ec21d4458f34ac01a46c4374b35b0875c401ed3f7323ce0daa5c9bfe6c8cdad73608837e70da8a287cfbf898dc8f3c87a44f899adf63bfd3584605ee447ef72a44c4a620e9ee32c39c7ab46d094ce8468199d3b10f5cba729d7dd8a7841dc16798c4d0df62d6327d93672b43f20a782cdc7f70147b655a55ea5288cca40fc61992a7780c7428f5a0e25fb1bfff4e78b5257ec327bc13fc07ef629ac03cbb71aad2db202a865d18f819a2ec53b98f7679fd06618d39ff3c02ed3c8314b6b750b5c9ee5dcc11f908cdaa0f3f919953dde5b3a4cf978d7d76d1842ed65c9a69efa4f84f8573bf7351ac03c32fec17123b72e9d861e91f1558ee44e808ea6079ab02ee7d2b93e762601db78d31d5cb710bcc202fbcf4776d4ed3afc69f50913d1f5a0d05d4af122cc09d45bbe9e12ec6cb3bc709554c2edbc50c05690e21b54ac904d4580547d868ffa53eddcc90a9a9e65c7f03bf429de74802163dd9c0451914bde51231d0a27d89bff3713e56d48109a8989d5f8a4d16645032b396deb92e9ecfbf92eeebf8f0db581404c3c627f291aaa434ca85d4ff9660fb78a9bf8a01d3c4b478a0fc44598108011701412c651acd326864c79df95adec0eba6f5502930377421dc842d1df74a5b065b6a5a5f01aac3b6c2c230aa2e04238af312740b50926f2d06161bc4ca99827156a42a46e2adc89e690815788c8bb3e532999e3ea1501608c21488c4576007e6678114c34a50c18ddbfbb4eb02dfd278c9fd07299f1b093375220cc34a586bb42273b24a852e3f13702fa7780d7b0fb44daf7752c63da93ba3a100180fcd1e890c0e8b533fb0a1bdea1665b618d7dc3622334740a342769fe2141b591448a0c388b3f853e66289eb8e42681bc190c86cec2aff89b2c411cea51da6fcf44583021d0691e2f5ce683af126371f741044c70ff92884712cdb4651104b8a2c6e45b35d78e086fa5ecd1aa7544b47cce0d1d302102ad76b0763a59a8e7177290d5955be7d4c96709e1909053f2d1b187d102f67229ee90cce1b5ad5faa14a76cd4e67b4a66eb7e506dc94bf594500036f502aa382fd3fd2fb92d497e7637a92089577e466af61b413983c2a353bad0a1242634bc3ce425a1a4ab154d7209e0749bef4a240970a8a6edc6dda55796889104757c4676aa71e94a35f913c711b532b3b7c82c6ae38c45319a8442c76c92ce3df76a1e08ac47d155d6dd1a9cd78e2078b5e0a5b6d62fe6ab089fc3cbc5552078b4e78b1872101f6a93a9a81ae4d40893f37bd914d2f953061716708d27394f5db5d9d6cf85359c3376450668bff0b0ab797f0ead5e5253e8d0d191321da62293012a48546c1c105886997cb0f048e0694dd68da802a2adfa39b96ee52c0463c3a0c027d0af2f4381cb8d51170046627579669e2e46512ae35db44fccdebbd8949b85bb6ad7d5fc554e0acfc77651fd7605198867b3c7924b41ab7b0fba334aaff95f4e4b6b75057c16f63ce8dad07814f7d5957ad06caddcef873bd748d580bbc238269af379249f2b3be1a1b52d9cf859840b9025a9423c6e2ed74c11074461fef78c80f848226696bf061b8ecf31ca320d33d03be41b13c68a97959c325c49b684c825014ac6785e6cf37eed1eff318b5855639986fe0a0082c2db71bf911af2c722b096e7da7e8b28eff15a82cdd66b4db970c8f8b4c822fda2451914ab7cb8a8e2493f87241f26dd439c5e636461dad4a6204ea105f637e57dfc1b9b7219120f4f1a85926e04367238a880298d79e1d5669bb5e8b83c44219c27ffbbae9607e4b248ef707ed4c3cf143d493c0ec686383f0884379741539947ef4edb269e9f0f53fe06891c38d6dc1f824005aff2d3e57a8f44f568ae6b35c67c8f65a3d7e3787a62504612d87581a3a0edea3aa2d0c45e5a7c89f42a95dd60f54ac0ede9da076f9c570d275baba6e6bfd854758084be358eb45d035ed8795e820854cc7d8da579d5a347226a7d3331058aac2a34f7b9455675d85df23cf1084d4f89083b0238e235ba5dccacf510cc9d8a581f66319ed8d84562c98dc92da67baac768ca43a9f0e326b5edca1a25ffad60c21dbd3b56343caf6310d7881580379e76b5d358e1ec086fb94d6bf45a125e9550ebe11cc8a1ab3843fa7a8092dea7b5feb7fd47c71ecb1bd0b3388c984cd7b06c537bdcdb694d6a6b4f1bb98a07f376c736f11a42cd55b461e8d8e9c5f741397d1b338479d349cc41d7653ce744446939fa56d93c42cdc2d6b5f413cb59c3b8eb0cb01a8926c7e62e5afd108fddc217bdcad58a9cc65ccb96e0341390ba86b61dee9ba9f2abf1419b9f8e3d6c1a9407b97016374a9f2a5909313ff0fe64b1bb7d899b369eaaed64ee6fbecc6442e3c197b2c0e72d155ef39772beb2fc9e6d4d72a459cb746ae3d7919235c4619fd6cebd597ba32f722122a869586271afe2f664097c6f5c35fc23ead09c2d4a7796b5952df17237fc9a6ca4dfb60747e0373dbb7ead2b3e515fcf63f19b1007134afe85f5c75c2efdf25cf39d80a9657995aae0cc94060207366362bcd9747fbb1b32f77ba869fabb5077fd685d50b3c223c639bbd808919fa66851faff619cb731d852853aa2847fdd472b0bf50519020a182f122239d161d9659773b4df454eb378fedc250eb490c053e34cf1cf7f8371292b9b19a2ab95f7e29cefa1f762c9c99b634812b5733822238ef5f9b7cd8b817f931c664a07822767c8366eb0dc709dc8e990a9a0a7bd2b4095ccb4c4eb6361a4d05eb039ce71927d830fc213998b5487f87e91d6396802315e9acbfec1533b204b29a078e6aa60ab3544452682621960f8d8735f1281d07e5326e56d38a234796b44de0e3975b87a469ba0f37f3d12dc5167f6441850bcb0db3aab1a369a763997791103ae1ac2711edd7b82796367826bf3c38c351cef4e5d9cc50ca48129e7398ee1602ce0a81825d27dd9561d41daae44813f502f91e04315da4b6ba0740cb84cf82c9d118ff7c4414f0200b3c86d8321d96651cfc9eef46d92e0713f802f7c7bfb6fe8f3a19761f399055d6d23c2505373081f45bf01d86c97d2a0a675d8ede39531f5cf067f66b102e857927b627ea3f62da4d99ca057da8e29df1c7a90734b6c7bacece637394132b5d56cf7d376d60bddc7d28854d97e22ee15eab7dd767d2854f5946848446bd274be41c09f9fb75921707aaaa4c621f9282c59554a5e3f72c5b80db439edf98a2bfc5afd4d600d890087172b18868bbbdf0baf7c5c935af2d5dda0f3929eb101e476ffd766239f4283f5f232388184111b9a34539d7d964f8c4c954ddcbe5de0a6147876714f362db1a053e88d20d4a3e5c132039484ba31f2ed34e99db5c3ce7abe0c01f64c9af1927181759ec942184468efb3c911904210a8c4f060eaac74665c04a07e8193372e50c600f3e598184177b48cc58ade27ed668f89aac7df7975d6a87d9058e9a78e2668b115dd9c4de3d6c9b60f596d8b910ddbdd05b32687ac1440bdb43863e8b9d9b0b18b17175c326e76582fe405140587f114f816474315ff148b7289cba3b753e628ddfdd0f03625039bae956d6a50ba19550c590b57b77d6c0d53b4e77f917a523e94f691aff8e4b7a613d36f367a909bc8c7e23a6b9a778f6bde1f80254e383c19376920417f94dca2e605d1208cf0be96b41a9c26c7d6c6ce9c335d3cf674ebe44ec0464fd31bb8b6b0955ccf8dc1cbe75869f8314580595e1358486d9216a8c56262cb81fd63930bf7ead8ec85ed0ae23d3818331c5f9042cdf707602805bbe4fab7777e0452b7c8466c0d1e7d5bc3b0eaedc2d5555ab2a3527663bcc32b6c6a9e2712eff0d26b162283c30e7bf33e78e7f2bfbff75809a8283f242a686f037fd61a637bcacaf61d1597c1648a9dc263bdadd7980a43db7ad9b8125121b9c74a2bf833cb9921a104a610d0c7af419999f388d10997027140ed4bf4daf5f101f424294a8665c1b4f45e56b8dff4c7094111e977b9a47d1323ea5f946ced00f9a44a15705536917714c3d1415560175b849f3a8f513c9c094b5a5bb8b00fccf78323256de01579318d5fea32d1fb1ad78926e2e27864479adfc4a9294d653e43b939bf08ce09612c86ba0755faceb6c4792e4938d726660f07b1b0afecf73e246d144d0ac81b31ae285a927079e0d46c7b3dd7591589e1b0eda8d81135cbb5e4c83a353c7552d1009ac9f14cf53a5d15b8ddf40cdb95a0c5b6318919cfeb89c9f135e1637eb62a6a058f8eb117e237085795081ad1538b968dd42b8d635fa41c108db74a8a4f22339132cf6787e24c8d81ed7b4c9eca8b6b981a2636982dec244fc821b84226a2a5653c1e35ec4282eb5e6eb568eb03868bff8ae3dc175f4b2bd47085744d429306aa35e2e4ef08c36c159f1f365f04653febadc84788fda877c70c4d4755abdb9f87a3823c373ef656cf091f80a3d711cf84093e3e910dea515125e0f9ff6a64b8251068056deb03f2b3321e0c5e847183f128ae8bdd99fb019a42a652f5861499ac03fb073818d188eaa485a339116ca25b927ef412a8c2cfc9eb071adf07d5894305a30a41cc4a609be7ba0ddc88ec76e9cd1842d943270306a96b1864f68ed2129dc8d52f0f55c1ef812712eef0d845c463e23dd97112e47b023a152d5a27ba4253d231abe9daf50efc327a1852175813dc46acbb3a6bbb4d80dcd9e23b878afbaf2ae65d63c2421fe0450c01b593f7ffbeaa5826a61ad0a7abba2c2aa19889643a36bcec84f3f14ab3c7915121336ab093780ac3be086baf0a3ad6ad954101a67b5f7b01555649b9ff20d2b29fdff84de217883a891bd48d25c59e141e6a38e8fa0dea43dcd394914bb794ca357feafe34ef9a320f3c526a84c44d0745fb775340a9d25b23 +Digest: 8d0da554b22491352b9baf334025cc02dda86b8772a5a0e6716c5424f856038c79554be8b18a0ee040fdf75cb25f9cdaa4b7b5c50fdc20728098a051b82793a5 +Test: Verify +Comment: length 35616 +Message: f512ed3489fd79ed86ceef13c252f77a4ea946d4a8a4732f327206bfe37cd3de3d8d86517f367ecd1b71dfb96a84e2369f28705dfaebf0c73ed35d5364449b2391230be8463c5d60d6e1a51d1ed4b18770689a24d0e29a1763251de7248f1b82d91ea48246d7bdaea0686ac4440c0c76a9afedb293531a268ab271048b24fa02fdc47ba6e6ce46c05f4c563846f29a093246918eac0417fd9cc07f3101cde1ace55eb5dc91eba19dfdd690008a4f044af375ad4081bd3aa27f986ff6ee5078867a337dacacf4764d604e41a47aeaf141d5836a517c482b1f1d826adbba76669ba28df99fa0b26cd972fc90ac7c8d0af5bebaef48046c917c5cc59869cd0754f046b2513cd5ed2c481927a6a1fafef76e976065ad80f014bf26ab202790cbe98f4febae0bb36d5ea23f19aa0b5b065fb449bef3095a9d5df2627a2a9d698ace7fa3803895a3f9a9f0cb18c570076debd0bb1cc2e2f93b141cf87be054c10baac82cb916610b5bb539a56d1f5a66fb42c9d4c2f9c3c592e146cff668d301172673d0de71f854592b85b560df50e0780ca77ef7c13126696a77d133eaa28f76ea86793670e0e7bcb3dce3382edbddabf372a00442b684895ab7e5798f4ad5f09d0c0e0a3ca32a4bf447173f3382c55d9d332131a3d947bb570ef3127e52394ce70a77a2fcc887d097cd39bb17cd0056b2f2ebc60d23d7c50985e444e0422554728a9c46d9d86511437731f50144f65edbb5e50ba71a9d6f1a239e58dda300cee393653efb5a2cd8a14ce7351a700f3dc086f7489a48ff832ff10a969cfc3283e52ebad189d643eb595443c389d8b4ba086c09c40d3566c7f3f5104546d5233b1e628349abd5141212972ee677044b9f5b7003c829673b050b3999ae02b63bbe3637a8ec8bde0617741e8ee70c7d3eb26398cd9c1568e40322c58b1af928e2d3d6b511034e7981c129f04d0e6fcaf3bcc5ee5088fac0cb8ade9fd0cf53b28044a6e5a6d51f2eedd7d61551a3c973d4842c7a72d400f55661e7d14e1637dd7dd74dce50ac2486b322269684ee410147d43e431cc74e91ef52e663ef36cd3041557478f5ce8508396abe7acc3700fbb672a35137aa0d1cfd23835b99793e333485c2ec7e846b3de87649c913c52ee9882704aca9c5641ce89d65c33625b26ebe31e031d416feab28106d8b40e1f25325bb095d5c607c1b178835a2ad83506a481f754fddcc65dc62fed2c93bd374c2f5f6596b36c37da0f4ac9a01e6db41ae38182a4f83eec958fc09218bece3ddbe60a09dde21368e34e6d03de7c975adc2f8e4a738adc351a560f902d73b5955cdce807cbe0400d75e55bec55c3e98bb2fee4b93124394264df4961cb7107c0379a75f9f14c66a81a6a93cdb692d8d937c841596e62ca96fd822a81832539510495305ade751bcb4944b1327147e9d5e31210959bb524a55cc51f69d50ececa3c53a3a4f408c3e97b1a10b5067190d44d72cf184999cbf00b3e849541ac3c9e576c4c62d265f37538414ebff6ae6286cf50f93bf88f24f97145169e597c074fee35a70eea1b2f10f950d7ddb24ce35ff1331b7b0913c444278f31ef7d0cc34159562013bb96db2f46df2878d9db77b24b9fa2702bb62e42b66363032cbcd5352124642bb7779c32a932cd2bcdd8b430470d2aa5b0f4d78776682664092ad17dee46cf817e2bc6cd88f242611ed30d5c6bf21076493e34751003f89c62d52c9e1923eeef6031ff427ea414a34d49079942f4f07c4510d9bdfbdd5616fa2a6b082a522eb01e08aa53e2bea08cc9a91779347c4722351b4ba4924adb6e0fb8f16eaa482b6e083e6c546da892681481d16ed8fe9102b9abeedb8be2d50c440f7414117c5183af4199d6680856dfde41ba0ca8f24a88233157c5411bef7c177c57aae8753d9b7390d75c7a446a5e579725b51d0de04d0279faf44a7c9727faae109597b94c1005ca89590ce3496e40c0c90abd980eabe7b46ceb108b48aa7e032366b7bf097bd65d444ea86b707a0a7d086ff327023f339f020c2bae807e122a2490c0fcf25955a78cbfd5537c2c151a68776641877186987eea047ceb1d477188963c0993131457c72f0c21c8df01376d938f6dfadd511f2807237cd4f29e77d409915b684392dc781eb56ce31d5f428c56c702c8fd13b191e61104cab887ab7b4d5978ee6541b43401897b57617fca5933b5b69e3b5eee410955cb58b9739af2d40cc891f2a16d7f79d0f39235e33d38bcc3dfd7228333b9d35a26fb8012b4df5023e10f664266beda246c30254a29bf548a15004d311060f696be2fa6c587a5342758934aa53e86b50c3b9d99f50e518d60cca615e902dac5b3e761881c91c8e28f85ea1a3a634b9ce0e8571e7459a3d9f08d35070b898bd30a393dce7851cefde4ff505f826381f45af8d92d58aa0acca1cd39ab19230891322a10c469463be8902b82851dcdce5dd2e3b031026e1ad80d13207cb25db5a2a44087148ffd84354990dd254ce0952bd14f68e41214488e9ad585f637982769d9030d393cd62c5659d5ecaac06a5af0ee925f91084b0842c3aad6a24970e26958f82facf06eb8ee49612d9ff8c9944f733320d24560fea72009af0b38665b23ac764ada5b35ae4fa0a91c7f666ce59a17c8492269f4802e28685b8bb4e7162b3c23fb6bcdb9710cf83435c389e2b36344b8350bd674314a554d78be2f8187e29087cdbbe8689598a88905f6e3c9723d729970f92b7e868e2f2f931d08b444dc31f81e550bc1a0953a2e09a3f46fc67b29d28964d961f46c2e951722e0fdc18aa91b89b1c86316754579bd354c6414bee2f9eae950dd0f56dbf4916a48dc82705e687c7caebb6bab23229d354c34e17b367611f1223e3be0aff48e4d90bf0c2fda4582f02f4924b98b8f262e8460b1328ced9b16de040e9c12eb5a576943c31ba55929c6ba8ab622c735f47b856608676eb6f2b4e4ccfbebcd6fa21222d94bb63809dd7ad0fea4696ead64c6bfb35bac44689575c707984207e7e2086e0e0aa20aee1a571313741ffa5c037a93d72f53b6891fb4053248518afa96a4ab408441b66c6d15f177b998f2d86d11c25ff8003d8ede0a2fdb907c9f0e3c615b2f4d27930b4211ec89c976d098ee26abac4a3431e07ce287721535ec994fe8fe08c9b6594135f574c8483c2c142323b05a9a524c3458d7dc842b1fdc224d86148b9e9051b4b51b1ac19a5b5de0988380c97d0cd4e11e447f80668cf64fc1d33f26102814cc4c0d5ef45446fe74aae08d9746a6647d29c2f1054c2fb368295ace46d2f02b0e6736a1defaa17646f6a54742abc1937ef7ddc171305a9c11f077528c6b8b0cd1a34193fff1dd6dddf85c4e39f0e0ca5d24ff7152d7a038b3b3c36c652e5b22ec6c98a5b5ce6d4db02c7ff30bda86719e2da271389692e1e3ffd96c4fbfe315854fb647cf04d38e540f7ae636ad1531b87e615170f1a550291103d2ca84a54d52a924fa7a2992b8401df788290d2f834293a682ca7d49ebd9b3dd4064112442bb256f5e65a14d43fad45069716f37deb309fc95739e131d9c44e0358ad9e28e5520ffb4000045c9eacf2ffa9e47c0ac905dde0a2ad8737de7309712cd636298874840cbe7db2ea2966ae0cc1e2b5c9550ebc5414eb0fd8521238c789a3226f9e7f7ece66b766a7694440d5e6f8e6e017b404ceb5dcc13bbf08a1ac78fca921afdbc5e9429768bae5ac7201200e5677975f7cf58e66e489acbd0dc9ffc9156741ef21065a05ff4c25070a39770c4eb75e78ed72a672c2e9a29943c629f2ac6ade255acdb4ea7485b2bed124f4da16c7f3651fec06e9a18428040d4afb60b7520de437e55a2c0f8c13378f6b9e60f6d0de90da0cb4b1ca82c66631fd7ff97d47579581f754b5188ad0dc0cb57e8736faa85fe67abab4850a04277888bca64870429e00aaa86bd7a672140fab9a351d6cd83c0add20d819446bafaa93ba505ef558687ca760389409804662f5fc53f44ff68e0fddec07d05982668fc582dd08ff215bbd95840396da82dccb3aacca03ca8abdbe232828f071d1b5eec71b378eb624df8a1d1ab42642013d1322b08092061d31dd57db23c2b3e10291408d443841e95dade72c328c6984d10257125fe92b365134210ee08e4839b63ed9e1ee4ec8f83bec9ac167107693005f7eda4e50605e878d27c8469c58623abe3a1e1b1775dae310dee23afa92b632f4420e340ecd1c3bae14113f330ae2f5d90a4cb5dc6e16bbe15d969391e476cf8748b8fb6c9bf8d3608ef1b39c86434e56f274a3e5db342d26bce55a1e955a3fe13bdf8ab2f27ab86b3d718820f50cafff999ccd7ae5bca0a9a6d777e9ccebeacac18cc928f92b5297cb98a7057fc67f9aa8cf1be3b4377c30c175d33ab2af390982c6a015d99209acdd6ff8934bf825f0c61275676f2d2884b5c654596f3092682895f7c3b93846711efc6314822a0bc99c6fc3503e240e6d2bd2e38d2af65ead5801b678c2a36faf3349d1ce4be598edd1edede44aa695b2cba269200b8706a1bc13c57d1c5dee2ec75e280acfaf34230e94db6cbb3a251d3c3dcc583b6df00cfcd20c1aeeee29b68041521035134734fb6d762fb969267427abf67ee23086b6c047749660dc8a0f06fc3528a69639e93f7fa4776bb9008033f5cdd927562f66af78e33b9cb177000297bb9a4ac2730883d34e8af9b41c0909223bb3336952e6716f424fc7f45a531c18cbad481e5b596e6f5db18ce2e0d7503a27522ef159fcaf347a1b0c2e9acefb894cabc9325aa6a95db7344ccab5b1b14678ff3f74ab7111cd71e791e69f3a48f128daf487d9b5dba5465b60f40460d44d18028e7cb00c3e4411fb7ea4d15eaa594683f2a43e4fad4df06ef0e833ad6057eea34490d097dfa1419efcf19804cac88eedea11f23cc75f9fb4262fac5dfe6de22a893973d89beae81933535cf24f46e86205575e44d0e23a762850d53b5595dcde84fd01991b29f0b44a5485f1e2dc3c286bfde92f71dfa9fc1ed3180e0ed9c4095e67e2a0066540b7697c7bc92b907288438bfac4515dd48e3141dc9dd04182f13efc7eb505a7c06aba52a642d16c72cab58afbcc1964a374882088b144d4ffde4d463ea2c0f65815625e6f247d782436eb81531070fdfef54dfb8612119a211ab3cc882ede5af0ff8c283c36d6bb71140af86a55ff2ecd5ba5573d88e09bd1ec9716c52008db70715e397641853d3fab3d77a8666d01f8ecbabe15db59e0f89b21ad5e41e582c0b30018860d31067844aa87750a637e67f1b4b776d223707c707b18b9591e56c90d9b4dd262831f022779af390889ac02b1bbcbc837e75347b3cadf40305a5f71c75761c408238fc79cd3785c298693b276f58073d04c923fac398b5a8d42a6a1285bdbc3c6b85eadebe0694635033b5d868d61df66fb344ea2eda36e397d324279d0433666ea949e5bc70a5ff4a7adec2aa9f375c09b415bdf11afe6fdb40c3a03dd2287ae633a8135b1e3102d1bf048aa72c09ba8d5c24da9cb37299f8f3a730babfe1d67c8583dc2c57dbfaa060c574e0f4fbae451be0e4943c49fe7b5c6d3dc62626059c4f4bc472c5fd631110a035ea8283b3db63d8507a3ddb09fcfb744bd29d3b84bfd18e50f0d11bb8be4f1332167d4847bad479a2a100bc48d8416adf528db8d061bcba061911cd88026c9cfe072daff66dde535fcb4d5437b7deaf5cd88014753c716d584df0793d77f9abee3f1c213c5ef1e3ec3b7c3952f623b068d71cd4ef8a9ff6cc1215a565a996dea720d1527628afb9dc8415d2271da12c77d0ac80bbd68914e607c9e88cf19493ad5ed59a50357823b53782c530b8d7620e47c79e46cacd161a91a5a90ffaa379653bb19f471fdbdfeab87b78ec3246ff90cee6942cb1fc98ee32316d8b2f23ee6369cda7c7425b4cf1a94863c6347053a3b891e8ea46780be58bf5ac7af996612c4ba26a5d3776e97e6c822c6b19d41ccba75222ebd2cfed74e14afc5c048b703463d84d7589af33c584a129276cf2a95d1d9fd8cde174cc20e4d9c3aaba73a9f034d7d7ac9374ba8b843de0a7984c87ec7dd350ed1cf7168e090aa8e395df6cf451098f6eff57fc14eda0f958465246fe6ab541e5dfd75b00b055f2a3213f37c52b15db3927d957161382c9a5d1a45517468e22349496181d9d646745e703a8c7456541a7a76989e3b84bd83cd4a340aba3f65855e5a3cc59028e4d5851dd2e9f02806916e898d3222e74bb79c9df784005667ab64d90e637926c3b66ec1c379114efa +Digest: 52c76731d4db66a6e9098b1f3398d202a33300f49f0ce6f5203fc4d77dd111a9d32547c2c31a08a008b0d59e97d5fbd40d9fc8fee7deeac0593818afa8d30e27 +Test: Verify +Comment: length 36200 +Message: 03e1384bf7b8da331617c78eea31fbb182a71cffc497680d05d5ec04d778f6472299ce567757a1f3a01ebe837c2a05b60a469b6ac3dae3cd2d24aac2adc6a2879c8112949e40cbc62f585ebc7f0e8c82805afe6c3dea37456d6ac6a94803c0b099216dcd157a42f5eb4c0f039ce57a5b0d69accddbd04abdee2ea7815137380b400248c8830decc7fb823a1e7bb8b68ad9fd0d554493067dd7f8b5126f6af2e0baab094e9102b386888245d6c38e28560b9d89cc203b51cc515158244ba5d5772fa41a27e7607e78b9d59af31c70b809cbd288f919d115f484bff87e8cefcb17c676e11b2c2f34e7b7029f3d30654eea432272a5d55b393b97ccfde9db51bc09a7a8c8f20877bf19a991be7ca475d2409818af98fce4a5eab300cf2de0d28e96fbc2357325410657b80a5e7723a82c54f539a79a37714148ffe2d612427a2a04ea4d92672894f1e80cf6e6f75307446e800fc3732e0cf59fa4fa7b60aa51789b9bd04696bc796816ccddc0c4dc9902d5612169ea88bca935c9d024debf6060a537d3b9c887f75327214553a667674fd3c1f702c9ed8a455497ed3b552aaecb68e5de53c531169a6432b807659c7711aec81af7d6077cb14236d8268d92439f2dce7a7c5463de261528bd44c822d332af9d11aeda7b9dd547cd194f4ea028c63c192e9c3fc558dd822add7298a283981e6964919cf4f299ad84391c60fc6426ddef831b4cfe8ba8f2619ef99dc38d2d43539c07e61885e6ba84bff78a4dffa95878006144b78070aff48b429f2efbd7658440777e8f5da2b8f53347953b0236f4db2dd6ee973d1bff0c29b3668ad580ce23d84b2d0282b7edff1e734a7074b4fb4192e31447cc922bd102b5b980210fc459eceabb19fd0ba2c806e56e915d0db3d1b8ee7c6e35be7a6a9db162b8e96c904e05bcf07bd5881e7b7604cc49c62865b42661efb57e863600820d27d9347f7a29aa2994d11215ab3ef3382b3db6ed581164a235c4b1d1a5ba3a33d18c0b30c91364996ec2bd998f3907e952183544d611fb1b1642d58911c14c8928787567c733ba7447f7dcfe1396397f0a804b1525dc72325ad7f395c03c4079f3467a0cbab23422e7177a2b7f7a11621b1d01488e995151c82c12ddfb549f69fc9d2207ebb75a0b16cb9c081b0f18fb4d995ec5597121df2ae93a490931efc309267640a26bb5989cbb4c7d2e7dd5b068996a74ce8b684446b673c134fabbeee3887d9f27f5cc2f408e917202ecd1ea33c82e3e3510b1e7e439c62dc2d88852526c3f0dc17e273acbed74cfdd83921277cbb109d5278132ce1d3a75fcf2e0571d7ac570b92e4f1f067ffb7c086aa28efc4dfcbff7f9628ccb08d8812a714a650e5916b2572ccb48b6ed3061cbca89c88af41546e3addb5da2a3a739947c4fe4ebb23ab9e3a1231ba6de1b676dcbcd26e9680688e16c750e1c95af86813c753c7d2c3a6fa5b4e0029dfbc3743894f812e052d76b395eb6050186f84e3bd847d58c701dbae58e896462ec3071724e92f3395a8ed932aa28ab19208b7b08794a18e025eb84ea56a6a8be586a4764202131ba2735b9157953682b086ff33147086b40f4adb4fd35c03879e77adc56332f342c62d3f22af2bea501e9aca0fd69083775856a3266535e7b5b42671a90ae436356b2716eb93ef1c861694b68b608d2e5487f2ae66dd708d92c1139e859bae62802c016140a84743b14305335a24befdb7e8bf5b85aea46bab3fbf82dfb7f9eeaf634cacc65edd064e2e7ccee0b5be683e250d49074b3a186b9a9add3bc24f612fbb5957e11a18cad9236be7b375f3f443b77ce56045ba0a506c360c1e5d27306d9eb801257c7307deec432c46f80838550a7ecf25209cc8062f017dfbdb09f2f587f92717f87443bbc3a2fb0fae639b0ea89354ca6e6ab7d95d8dc158ee701f54019d481d10a5151c53fbe2922b8e92cd1c4b14c481ac7056624b64b9e9e21c158604c2b9478df26d17ce6172d1f1b61cd0168db7fcca8819e7cae6937fe88f969fd045812f97422a899af60644258b7a6e863df9524d4570587ca579f2fbd073b9704ee91b39aad113d21ed0f4a27962320a941d04bd5f163ee14fd1e58485196d752d75ad1d82fd51045a6765e11660e5242ea796933b580589444fea1b2414265f8f9b579b610bcbc2273e0a79d8f2d2537c1d7a5740d246e51128533823d06e8fe3ee9d4bdb88ee6c03d974c537949428fad3428226016d85351fd3640afac096a8c40097490133828eae176bb8c29505298d61ac4151f3da2e7acd175fefa6f46cd004064fe135a6164074d5e3197f8886906a2e396074647bedb2da892b9c29ae872a3136b55f4739150f8c3ce59e23a080ce8064a969a49bcd17261d3b0ac6cc5de570b40a2ad675b06a072cd38b5705c3015b59993e2b0cbd8c72829a9d3c64c8c87d4e3c22d44a96f6cf494fc1a304fba5179ebc8c584d2365486fc6adfaf65c359f4be7d1d1262d585d08d6db884c8f1c3d8a8fbecceb8344202b4bd7930f8cdf5f5379b25da707e128e1e523873b01f945c38f5fe96671ab925b968494fedf0845fb8e3eca3bab33cb7b1754105ed8aeb8d047ea4e2c630e0757333f6162c752eb8a81e1b7528bb2bd2ad9c7c43687af1f2725e86bcbdbde07c4be8298d9da41a8a6f145958a2e006677a9090340939ce13eb5c4b2b340be1c2a74d89bb29c4715c758d4f551068f6fe801926e1b90ea978d8419b3813600acef02cbfa8b61f5ab72151a5735a9c222026fee6505e40aaaa9fd520e9420583288f4b725c2dfbfe22dd2702bb69c4b354d609778be118fb30aae07f48aa427558ea724be077a1852511d90e332328d023f800829a2bdec1925f2a635d315e08e66b6bf13b7a591648232d72e5710fa214f2acae8323da2759287a722fc0a3635b79fd0e75206ad9147cecd6d93cc350af2dd5a450b053520c6c9a54c64057af3f7bef4797501ef71084dee1166a8a037c11430c09bc936d339250b22a97c31318db0a46a7f2bb98c5a3ca3ca4e4ade30407bd8db42ee09e5604653464af2fb8700016b3b0ed8ae3b942798f8b937317ce750dcf5bee830dfe29a1817a6ee3c5ce52db35b72bd30176c7b481d35e26c862c4f97b05e3c4e4b269cb4277be2663bb392075c693de1a849c41ba852c0c1d495d4a39bbf7ea48fb2cad1e608642babe1daf1be40df2556927e8e3a9e76f3f0aa6c7b084113f6360da0dbe3fae7df15f664ece1a8158daafd273a4457695552d093a896819095d69dbb4c91b1d2031267cc6366fd759d2dd04a8a463c1c7883bed696b6ff8915e9e986ae8fdbd72a19cc8defcebf73b657c24518c0ab04c00bbba1effa2941f8d8877f6c3ec75bd6a48b060c896ca46ba139c3403432b6ee435d71fed08d6fa12aee12201f02d47b3b29d12417936c4fa2ad31ab2151a735c31ae34dca9a66c16983fb44b11cd5aa563f8be109b24fb4c4a31ca408865a49238a627748eedbbc1cff77548583e3c68e2272add047d34d9f91e0e56a4f449abd127bf5ebe91303ada732da1cc663523b7941f4fbd27b7c8c202ac9c72afaad28599c342417c13aa4119a4fd762e8ffe6ba5640ecd0ccc422a456db9f97f0e2ddb65fcc72094ac388d53a1055c7e902285c4c3c33c13bb6fbb4f1956414abfe45bf1329662c3420d4588ee61883f82b78d5802161323cb76fc89781a53fa03208da62c570ff01f50f11f51b80257abe40cc9eaae59264680755951ae36752309faecb4b13003892a1a8293b2d0b054d2897e4334160372b4af286eb9f2a566c6292c904ccce3c9c347187cf8fc31c4a98ce1d54f52a2983b315f95e490701680a2cc89d1eb7a27420049d3328ec145909d5967a816ebff3c83648fd717c0795eee3667e895afeacfcd7d62088c4a1daf454ec3e669c6f1e02ea124398f7cd98994d0f238d36a5c94371cef2000b3952f0b28afb2541bb44fb97c1bb3018c7c281c04f26aac93c3b6c58e4325f1e4f5387850f4b4ded291b0ac5f3eec74d8ab640f392e2529136860003c26bd68c485f1132c5a930fd3d02b90b1538df047ad65f4d66f1251d093b86e8c5f906c3d8d836425a8f8ef06b9eaecda233d7dc3cc5253457dd92cb38ce699e7b84705365416f3a4a88a87539412484276a524344e53b5ed2021c2a49a1309b6f78a3b9823d0490f20f2dea3a8ce2c51146cec807c92a03620921c8c0667445fe500174942dcedcfd9d7fcdc3e44216fc43bde909e349f8844d541511909d44c4a52a032f960674d9be2eae89e9cae044fba004cfc64374b559239dd182241e3ee28df3b908540f02dbbafad10ff5c787e905c9cdd48f2e71c700d164ed9118e9828da4d4e72ff1f59095315dc95b2331766fa698b0857c55e18c4e60257ceb412fd9b4e7c502c44e574df074985389de2e3e0994ccdee4be63266347bc3ffbc224d2a2862464fc69aa65a6aa0f8761ea9b0181669bf40e27b65fce702462d1091c18dc1487df10d4044cc282a15f51f3274aac62a05d4f2e4598ce9df08df172600ce03761c99819ff93e282c053c0646d89c93d6c832e4eab721215a309d39abb3f5d4334cd08a7e6ab652f1efd33dad84f864b72fe31e5527c077bbe7f0dee681081ec9351d90a7423f8ec0fc432a2f1fc62013636e0aed5073d349545e6ea11311c87efe08fbe027dec4e053133794510cb1338b5b0f79db411d4da07151a21017ba9bd01933f2c29ddc9a1ecbcba3c4d4fe5fd03394c36f333d0ff2b1f0b22123dc67d2d9a0a5ba83be3682f44d251d25efde5a7d0391b54f1cd773a5b198ee3c162c2dcfaac0b79853fca91527e307086cfa50c1c3ac559fa0ed4ad5fd1e1e6a50300884ba0d63e58133bbb6c0a228835df9da883cdcf62bb298a1c93d0a59b572bd8c7e365263713125df5f802d28a1aa242258d6e840f93b229d0ad72549266419e047885862454c183e99cf4bb0673cc34dbcf99add1421d1681f353794c40e8c2e6716e70667b85500eb15c368dff91e86390db872814eee2a90bd08e29858609b644ac7f7e15f244cdeba5ef710ca7cf3597a0baa49a8c00ae6d95fdca82bdb51c88bbfdebb27cc4af926e406029727bca3a85b2a75199131a8f00529fe6d47781a409863fbfa9724c4c21d3cbe49650a9f00709d0d88a7c75e69c372a208ea37e3d31a2dabbfcbffc7f4d0424bc67f05d6e811a917dc4cf390ae5f5f9ae20db7aaab0de5d25eb1068b25c7bfb1f8bdd4cfc908f69dffc5ddc726a197f0e5f720f730393279be915e97bec85cf9c666a0120c1b2da6d85dae8a3953c3acf8f29953ca66bda7c9b33273259cc12a17c490281713f63b4f5b8e624f3b8ad402444a44e15b2e64665ea8a8c40b954cd51dcd9854b7f8634c06a4d6d0239572ed365c54dde12cb87ddce8bd02dc8068e7ba7eea29d1dc26b7a8196e24d18c8da010f70b26c05facf7731b3a46d92c8435e3cca70027498c788714b2b40d152e031a42f024c07047ba6c69a8fac83eaba7dfdf564083e89e78ebbe2be6a1db5cfe9c668b40a80792af0ff98d857261e225f8de7f51ab61639d1e3f602353841f79dd8b64e042cb93bea3f4744f9f3b339774f1ab9b675be3d067bed9d4edb97f5c26d7046e546554d07281e2c01674a5e59c426086817f27fa0d631f5f3521858fbf75f250a77cddcbc2c96140a1b540f7b8f6297abf7436015958b92ef46538faf08bb6f003b93499dcf4783706a60db510388bdfebe219cf93c22fa7f12ca1860142d9b430c463200829b00d0eee1308eb2e101dcb73d64a03cc0a34f61fc61939c1e206f544724a8d908f2a81355bd693003f9c28cd775cf09bd13cc9e6b19ce131594d1be267fdb5529ff62725eb094ed7a0c4c99803eca45a0c2733286af841b9c6f06b454c23c69768dac864cd8765dbbcfe787d83e1652f445cfc8df713a182b259aa1528a30986713c2b9a093a20331ab0fb23fe257c42ff45ecbf62d749b3a5efa3fc0465c64842851970a508c60843441b347c9f31bcc849cb63b32b8075251a1da0e7514504631e5a8dabdba181bd20a0550637cbc524d06024f0f690f0bc42dfa9d94fcde35d6db69b229af7c712ae5230a2d594849d4274a72322bf4bf1cfb2c0e347a70db6dcf53f132d1101c954f96d5b61d222ba08cf97539656af4c295e8d0b211ca9f9d2de23857b37586b7c5cb436c3cec70388399a893a9c4356b9abb75bc572e0abb73aef806eb0f47f8d44ab3de4d099012b7a58ccf6db3096e561e7db1bf1d956f2d14b0dedc6fc8def79fd77aa1fc33b59597b24b2599d951647c4920ce3bd81ed6bdd32e1bf981e09c350ecfe056b3a7ba0a8995660b3d9b526f7887e8eb3b50fd050f930e4f2b945ea4d +Digest: 21c2d63349286a4924387aa391993e9c9d9b1e6ce137b047ade88466eadcea14ed869c7eaa09bf968c729fb3e7470a31b62b50fdee2d580525978995d7032bd5 +Test: Verify +Comment: length 36784 +Message: 460d93600e2e01e263e30a961f6c79688cbb0c6e783427cc8cb1cad6d9c9c175b4521accc424dc1b5920f6e3ff71764b5412fbc216906de68012eba4d79605a1407d2cd9d44a6687f6a74744e4a91c728d5469dba3629696f040e52bed5aa7f69198b0d1672808ede37fe301f69ad3a7e08a3d02462f0aa584449eb0449b0e3c50aa8dfaa4472816c8b0b4625cce04b0f4bb5f7f278130dbe325007e03e4a23b24bcad9db42e30cb4b43a0ae3fcd155673efb69a6fdf72ffb6ebf2dc53bacbbbb6d5f701be6586d2173f912fc61d7061022e2c9b46d237dba49e5b115ca7f183adfd5370eb7594f3d2ac6e2b1a487b994b81a8c9d3e1e8355647256645327c5cb23ca93063e5c0f825921feb62d6a0c6f6ef136e3f94ebd673ee372337e4d40e6d9be18a4d3d74a7b7fa8bb7c74d46afab8153d0b173a986a4997990594361618521e4c6d10617ca31eb9cd77137d41d113e513752078a0c9152d3f4d4d98c1da3d7982c19c711273a6e3992871bb4d8d02ef5ed4ad7f732e1202d99cf2ebb096ec3e6044a08c9877b8a4a3132824da891592839c06b56be3d0c6fc573c857ee8fefb6958f52a9b19b47b8fc99f30755fcc8d062dc4c10794c1c81c1e831c994ad63f1280e2b186f43ad693be5f64aa6b882d6b1c8018e2bb75a4bd555f178c371267d05ef1e7e871bc546363d137e646e8f236ea912379c25ceb648e28ecb43823f44745bb044c2ca963735cad30b57c5f89ee1aa0872933f7fa864b9922cdb8ab92dbd7a6bd0e8f928257fb3bd5a4766c42e51f06aa9daad750a6fff8502552e991f2773d68bc14f84f65d215ad1fcf8fbbd08a6c0433716b8c5b2dfedb47718e904fb6f79dd1475b194173c30d93d24a6324cf293a8732251bf757f54ac0af0b1c38295dd2fab12b7e5f52bc9dbd492cb7466fc693f567a47e200074151d55df744010e89e74ccf9fd33e17ad3d87e9756d9eedcd72a7c6a2159aa03d0ba208c56fc301056fc05470453c2762691fd1a9043bed44a830ad6a3f8c72cf423799222c0f97da2dcf483222358472c564f471218723584ab7d8a84a1fa47f5e5db717632cf78f8b4054ee54725565bb1df7d4acc8b890be05ef641d985ed5c7dc0aaafc634bacefdd1fabc23bc3c1b11485db8e47d4746de299a4a042ca5ae67c3be5dffcb8bac36c527154d8f610110f448cad4c9d8dbf157e72bb640d952105f2d0f43f68406eb69448f29015d942d7dcf1f21e3e621d6847d55645520ee13ed672247383c658838e3984ac49a5ac34f6124507dd7ceda19cd6592ebf4e8ff090d355e230d4e99be74bf274b9fbb7ed3af58f4da3619889247bac677cdc91e3c8fb70d298f389c5488724308e63cbcc4fa4b639b79b87e888ce3838b24051df25f35e8ce3aaa0cb59f30328ef655097de27a41341b2218670d7e3e9890335ac4fc2055838829673c19a75a4058aae178e843f236b2ccd2a829d96c128aca711ef704f7dbf02d386298163ebf7594d1408c571b05b93f59e69283a09b8c30ed8ad062345a2b2bfcb38b2b646ee5b9656f3f22104396e00a8cb80b50a60d1d2c7308b68f6061ac30c973454fd1216efa4f81137652e46561151aef109495d5aa7210708d915c3450fed0f27588a14c1c7bf2c9a1c62a25fa0a2b9d4519aef103f2782ea36f734af9de34b169e7fdd7588ef4a3471fc0a821f67a948297c0f5b59eb05f655d4f5677e21f1081918f771ad3074ecab24062a54478634d81746a3bb1497147dd38fd77a4e09e70f7eec1ffe2cb1aa14041fbc09eb597fa7921b512e4b412cf81c89655912999ac9d844e645880956f2c1dca104fa2a13de1617cb7a380a260cd86b7be217ab098f4f852d48ef84d98e86c6410e1dffd7c5cac07a6782faea022fbe80de02461ca90b395ed0072b1930796304eefce2b3a3d7a1c6bdd21961224808dc167e73bb5e33e7e0a57805ff20c23e536e3eda8fc2643f1843cf7071b34cd4f64f3139cef7f0181b8feb1a73a58adc94548bef53689a24d6c2220603ff62a73854c3a03dbc6953775608735e08f9c731698d2ae8dea1d76a0372e3004cb30b09ecddb0f0f5c7205cc17617a69236869075e992346ca0e03acb68104ee36787d1de2772cfea3107329ade0e35886aa11b404a302059bfc8b0e5ac94d70ca5a4f9f348edc3e3d09161a7e761f135bca03891560a94ef28153218e577810e95e8e7f3e929b227cb4551b13a17c4e0550c5131b52b797400522a2bbbc2363360dd04a6b12f86ff4bac6a7f7e3895d05c6dcde91098b5317204ffe7d87cddc12e0bb8d3490625b3784c15db5ccd4b4efa49147f0f5a326ea3b51914e1ad5e0126f96c4458b6798b79b0b88b7cddd0a2572a8ebb597ad673beece07a815da13b712f86bf874868ce775dbd5885700b149a97a36797008b87e932bce05e958db73635700d7ec3dcc699dd8a0a208ee4ecec19bb4970f238f34c0e150f205c0cbc9e9490f6e42fbcb908b68969f440437174373e2b8d5ac500110853d070bb0693d1d350416195f0f0eb73203caa8d10ec5b7994d3953f19f35da8dee9f6b96185f67a17b89ffc5fb36b99b94de97e33a5c867250931aa1e175b771e22595e06d836114c21436cf34ab0b2bb625a1a95e4e48a599709a2bbb330fc7c4541b2ddd4b8215945f8ed93fce1468e44a4691cf1d6699944c42fd80e07bf5e1858becec3a531a5ec6488271227db9abb7073b113c78c4bd70b595e7106492d654389c2eb24ca98dd2f4498d4a9fb468f66413d94df7cd91985293324552152f2ad1b9f965e739ae2022acc8a902dfc872ddaa6ba45c0a9d2dba6406f1dcf33873c7d4f0a7ab413c18540ac7c03fa246c6e46d6ce22e025c9b4d96d9a86dc3aee98b6b88fa1156b435f9020f22be82406d08eb3179d65b3c8b9c8a3ecb7cfceee6acec46ffb1f0a30382211332f81651dfcb927dfdfd6bd95927dc8aed930564e5ace5af0af595950bafc6588384d4f7999cf196c10bbaaf9e600c52913883cd70fbd615ce64cbe6b8b2806396ed34be150d97008569de2bc5d5783a28e5ee75132a3c3f9c77ea24853aeda8ef89bbf1fc9dd16f9dc02cda6a08ce964713abf846a8967107b796eb0bb94cbceff2d14f9abe6f287c875d37f57a7deb6e5a42c37607635e829c5886b6ae4c043aa12b3389ff9ecfc437b5c0e2aae4cdf12259634bc7215cbfae85a410aa6a03322d102a44c20ec9e749ed01cbfab1a281f4465412585efff166c4afa40e055e78ef26b045b62dab784659771c1a530d9358a012743b8abcda4d9c25db69cc6a717fd552173c89e8d9a5819d5d6a5763a7b7ed3adbf12317dccb5293314e1dbbbe57b28c43d582168df00be10a6b2d4921aa8419d419b6957b88ae74401b87c6a1ff44bb3601c49927be4efe9dad4322b3990b4be705c3ca38ddf6458262791fdeeee28b7851cff52958d122a1a13784b01bf95d7f55c90a8763d07372b3902bc79f32697545f2cef558191990d788e3b9abc4ab177a44faf992b3aa8b7f3b7efe98aad1d74edb6b2e44ad2ff5c0a5c432b0f3d149f3a5f001e316575725f99de653c250f8ece87e36a703f23afd2caaadc41d4c71528aae32ed7ee6406848ed1168ff636490b85ca0e793ecfacd6c1bad7d97994807616a0f1a63e3e186a7f0f230d895a4eaa9aaef9ef39c9fe2027b9415f9341892a8d7e8e25bdca531a55e1b53e444344b6add9535997da4bb8e6f0455b8a97d74ef6c62dddd3d25c9bf68ff4a990b8d434a5914340c0ca3ca4e4a70856c55e13e938c1f854e91cdef54c6107d6d682a62e6c1ff12b1c6178ee0b26b5d8ae5ee4043db4151465727f313e9e174d7c6961abe9cb86a21367a89e41b47267ac5ef3a6eceaaca5b19ae756b3904b97ec35aeb404dc2a2d0da373ba709a678d2728e7d72daae68d335cbf6c957dcc3b8cae3450a59c045572de824c7f21bed18782699fe83bea565582af7ccbaec1c1c69c9c87b4513da1aae07c5b568e9cbb3535210705e6e1877ed25e8c3d6b53b201c68d611944fc9a1d710af0dd2c2bd49709b6166df3f3a9151675a7d3fcaa94a4f5b0e7bcbd6ac63359d412fc4293a316c5d1d506aa474384149bd275a8edf219f1ad208603afaf555f81c99b17fcb11b33194ab95206dd329579170bb84551c7822b155d60f2dde94db91da2f48d840c19377f6f3557008760b77d7d74d93b1670d2cc2b1a5bd759e92617f9216ea65240d27c0e996332eb3ffc0cb324d2376e824b4fd67a14250bfc6ebe88e6c89f567093477fc752fec6f8f0cd951057ce37813ea647c8424f694d391b388bc3f57f7021eaab074be980543cc70c809186d93652d7674c10ddd9a63034ef578632340a266d79a1767d811b8803febba7eabc6630ec1d4ea458c5cdfa1396933adddf0447d6d0dcfc4132157b87550ac27f49dc80ec50152648948b40c01688067fe7272e2f9a0105bdf909be5df7b50acfe65fe9e0eaeabf33aea8aa41557b139fb43b8380be58b87a3fc1f98dce04a661fcb613cfd21596a37becdfa03db788c5ae08edcf24293eff6d03d31dc03ebfbdf4aaa7c1f0ded51f631f88e5b5838e7a3d551526b4bcbfd4e998f417b7ad7c6c34034dbf2c8ca130ce084c16a4264d44c9eca38c565862821d4805829a9706f52689accf6e69255c2470d43df4e9ecaeba933e0af2474f906fdaae67514584e031036dfc9ebb862ecd1fc8618c14943d78138ea670cfaf86491896cdc3ff1fb6bc3b374ba4cbef2b31ddcf8b54ef6c7b6b343c6ab839aaed12c866bcda0dfffd31f7b3c668e186ddb87291c234c19deffbbdf05eb2cd674c32b3c53d7db64b40f7008974d34573cbcba5b70e14d44e219178518947d20f2b11a15c5694432c04761e605dcb3edf7dd03fe977dc6ea89a932b08f35d92c912175ad31108fcc9d31618e08a3915f27c3109ce0674d8d3e16b9fbda4dd53be8aaca5d176bf294b343fb8b2020613d34f54c80fc2c45af67e7f9c17a5b05e151a384bfe8ca212d9b059c47ecd187dab7ea34753b4b53b39fa39eabefdbcfbf74b2315035b99ff9ccecc05ebf4599ea192844d43e22dc5c5dc00505bb4eb718ca4d5c888eb8d37bb160043a27eb0bdde1261a18756153ec2ac3b9796d3240afbadb62f344564035f105e464b7304218986a10cc61856ef58f3548716604e0c6dee2f11b07008abb0454cd58ddc3f13cb76ac56a82ed620ad37b2e8846653c009f0a635a3745f77d53c33ba10c048dbcc6bea47d7a27f19ec03bd8287ea1a6ef83a8464b65a53aef77d7cbb7d2707c1b3edc3a6f87c38213bdcdd1dc8f68b5e615432669129cb9a3d918da17c19640da9829f3db6c2e881c24c7a80ee918ed76dc71603dbe9ae81d0ffd033b49f4706d5b4e6d2b67e7982abdafc74a2c40b23441a9a033da2e6acd74fab3bcec098f5600a002ea3b7d26a1b0fcbc18c96ea880dd5252d5e5d5a637b0a887f71853f22710c55192376db813c714f2f530f134ff1811e4ae722f2eee4b7cec946f424d531434d5bdec27c11368af185a0376fbf17a5ef227ff7969439dee5dff5183056c73651bb7ea39d6031e2178d1a17e422a7c9ff7dcfe62e9ea307358925f649ec5c6ec702a82126b754ff2b0d6ab65bbecb75b6237ef6a25449bb26917e9858e1187119f80645ff5ec76b93ce371cbddda9327cdc352fdafe548120beaa05467b22c9ad654016119db3aeb9982a52f0c56987b96f9c9abfe4ebe28bd74e45f903a3fded11fe9c42bc404e0333eb5fdebe34fdd5a55a3e374e3765cfa515615bc0c29640c4e7e07b0295d5db66214b6d12321b384618242b835f9254f0a46053fca81b0d45a3e9a5b9dbcba8fa741f87078a694b1a7d5284cc8cf1827fa64ac8fd7c14be5ddbc0a62739b6d1b88ee213e7656f74e832d22871e60bc21cc127a40d670abad4376b6894d820c065149cf9f8eab61c7adeac01ba94677a8d9d00ce72918469725ef4d14adf90dcccb155218342c5ac962ae6f6eebf8d149be3dc2e74210a33fef962cb90778f8db40b1673cf94248a05be8aee578e06f60e3bc4ac5d40248042afbe3dadc8a43be4cae6d726095c208e419fd33b2a598aae4cbf3073155bb804290f0eeaf9574e2597ce35cec9f4d5fb5c2e8ce3ba0e3643bfd5a200c936430d0e5d288f33302e3f1ad57510fb741013b63e019767ae64943b0eea4a833e892507b172e49db844fafa037f34c7643b9df8d71a9f59c07b6a6973f09a6cf9f313bc12d4306076f61edf603b82564dbd62c901bf42b7cce38df10b9d37acf1e7a1d48836bda3f2ad7273f59142d0b7fe2ad2c5d8c9a95a03c57adfd76b6aaece95f81b80d18fb5d2bf5bc96abb5d2866bcba2a4d7c59f345daacf5877cceb611b8cfd49ab54c46cbcd42e4ac36232a5de22a3906a3ec1e1093315796b3019316d202ba6db1012d0264ce4f41fb4d444b62caf9eb868d64cdb9ae0dea582bcd +Digest: c89c166c62c53e7740f091dcde7b58c8800e8977ddb515350302270bed6b666df6e029a801f05ad48d700b7e839b7dd93e2f42c20a9859fdf6f0e71943115c5b +Test: Verify +Comment: length 37368 +Message: 0f34fa7e1dade7e6947b26744f5b897be1ea4e1985c5ab7554efaa46bb7337952b4a77c3127e5ccd0b9077cf51180dc77aab6c9c62017f5f6557a1d0d113af249aa7610550b7dadb4f7e7d4a366e03fb9a16caa0fb497032f67da17dbd712ddfc5135e4dbea08896c80de1ece4a693a0a8f5102d38e5a6787127535667d5da4f125516a244818f88de044bbd4407e73d0e0ee64b011c48b83d1e5e62b786defbea37330ccaa11639fa2d62c63edb245a3329f2033e387f7bc22a6caa96ce606bb67f5a9338494630824ecf0ebb6875807f10df5cd77f724868122234eaf38828dcf6354076c147f5e0303a9da1f800355a8a535fb43a4aa797a02a0a9d3e7fb9c6646c1a6d5140107a9b497cdad1ed042c5ef613bdb02e20b79a2c3495f76da6da91a7290341590aba57a7b24c3b65725d557280db2b473c30c9cfb8bc667a7882448d7621d8bc69072bfa47e180900955376caef4f1bc826af5bca0f8d3ccb62547c608b05f8eb8c8e0eb447fe795507dcc8fa6f14bb67bcee69bf433858ee82a60fbe8961efa7c673e21b010b79ccf3bdb806fbb815dadc26313ba54c5e697fb58d41cbd5d253f4b0d45937b39cf0ff82eea1138dbd8a2af36ccfc43dbfc4afff6f8ae0b643a88dc15fef6a8b554971d8b739552a150e2fe256fc1e80ff9899e0410a56a7a5fe0821ef5e07f7253ef10bbc302f01aecf315f9a4122ba805dc4048c30ac1e9bccea5efd159e8baf5a03b868360fa8fd55f5e7912f6f4f047cc4d8cbae4f7f77bdaad513b69cbd3613105b35bb7574832ae3f6f62752b2de8e02d969c3bf6edc18c020cdb191006c02ad50cf210f18d2c6622a13b97b8a80fa1492e1218a513b96d0ce858709f9b3a141557f172afa6eb116ed9466583a9e595071ec482ecb0880434ad5b7660daf6762c5dffe679da96368bdd2be674789246d02d5981b30d59d9e0228b343c0b1dd882e6c5733773565ee1759122745c3d3c0d227a1de2735275791091b11975d6c27fbaeb21d1b75210d86b2022699f0ffd24c6ce5f62289b5f683f14f6e1614abd8ba018f830efb3d4d88681ed3d872f137fe1fe4e19745d1f1477bd097a17a1500e61f4013a62a032498d5c8bd65dc506843bb1f2f0a1c03ee48034f4cedf020470c52843d85a42b3934958051e68fb5c9d9b9054cff6eb43422120bfc301956019945cc6f31dc0de1e821e62fbf2f79f31ca427b9fba07b69524297043c484ec7196379371f4433c52ff56aa5741e156a791706f46363b20444ff8113572f430e19362b13c27f353988aa7e6199ee20a69b6c239aeb2b008b96b35a980510fb5cf5285283afef7ae56e9b91d29512242de01dfe0bd758df65b3f88410eaafd02a49c470155c178d2f5e535576fa2c8866e3c706c5dc9fb72929597e0c6c4e69fc939504373b79d49de46c39cd2d9fc5e812d1ce675f42205c6330d8e90e9f115a4f149f67e298f9a78d40af53d3de8537f9e8c55ed3f29365fe29053545f46eb9f8cda235d5f754d2a57b3699517b1ecd15568c1adf2398ec56ac838fa6f0ea921d1aad1f8a178ea5e966501c3af82b2dd1a57339c55799461935f446b6171d8918962083737c0fa7b5ac9c4af4d812c0cb701b1a4b012d09925fa808d7d96ff597ca9d002687405e96b87ba4139d6e2c6f20f46ac4a2bcad6e744f2490ba6a6e0722832417ebd910f9146eb62baaa5c749529f79d6ced0b81a2e2a48852c8558e338735dcbfc2285794ae60f81a25237c66f6ce5d5e801a001e7f9e309b2595cb866de2bb74ac51283b6820ec9f6ebe482e1fd2d5680b7fbd23c1e62a2ee4edff35823fc7e4a295ea4f1c332792aeb53eb44b0bedd2b6c31e7950865f532fe692066f57e659cd7a069971a2903b0c91c8c223828ee3ab6d8de7d586b6522b06edc2dc2f0119548ae2de10740ee1b1d84d1e4f3e9ee40f057137f8ec167202d8763170d1016d604de7e9a1b18bcdc41535917647061d0d13322f60c269fcdce1961ad444cc9d194a7d81cb61ee486ecde7e340a6afd6ca203898b6109638e0abb546b0904cf1a6090d6d368d1f98d78acddc5762805771b3ea39a1dc856e37bd3c7eabbe67b13012fd768b3d050526d34e44608360e72855b2dcca301ee6089f91886dd40724deeeb76472778ad98431d2e2061239d0178df747d81349e77cda1e2c9fdd1393d924a1ff9245955a182bc17fee16f25868e32243748eeebbbbf54a34e9de7346483c250e94ae0fd20b4984e3c39773c840df999846a7f5a8ec787c66f2e10f8554beaa5b1fbbde87841381d62b9ea468ca0ac50ef56846f738eb1e8c63edcf98253398acdc72ebc2ac122120ce316d7f2beb0e6d2ad9c9f0c6d7976ce30b9bc6e22356ca73dd1ecaaacdcc88565bb6578e0bdd7c8c0167dabfc44fcf1b425b59b4144e7d8b045fe9a7ccebd86821673619f09804c4e806ff4a38ae7cb29af797c290e78ccced9765cb98e4d6af8d6865f424a9cd79968fa590bd1c3d511b57c9351e89c1e0a2ac873db8214bd0a6a12c482f769f5414eb15b8da01d8a0ce633634479ce26c2b889726b408fe7674fad23d976942fd690097eb18c51646ba0428e89188b81b8e11ddad1503b947005ca1fae6e87d1b9db87251fdd0bfece720e57886b60b92d531a0fb627942eb51addfa8a35d1a56b9faf011138a9b395ea0b60dae8ca37c08cf2a3723d2620b6fd7d56e572fdf58c3ad5754e25c71d6266de3cf9073477f2dd3c18ae175e14f63c0cb7589c695c6c6bbf041f1ac0b6a476db4e5b4d4c1434e24ae1c22cc875e345208e4c18a044bc70b0301c8e32f9eca8a7178a215d77172ac3914713e1ce1ea73d6e488e3f38dd085d8bbef6aa61ab6ab61afe3a052b1a252a99b5333677f8e0d7b9d64392b34e811b698efa7388513b8cdb3fedbf9aae5fe48d8521331e127074036e0f475e91897e7c04e04ac88ea98fdab7b30960543985cf4f54742aebd496dd8817c975467ffb15a97e8ccca423539c0e306ef69c4092e16c435628f59bb4aaad139591cdd315d8e4fbb5ef42376c91abcc4ce7f713706674846592c01451fd5579485e98216328600e42bad9543f4e091d4f9ef510b2c0f08e2ee2cc0cf33809bf3e1655f947a6731cdfb9ea184043be79d38606c6de7358d72eb389b41cfd426bf37367b947b5c6bdd966e4e213f524887557bcb4680015d5c16f79c833bf97f614d04deff7f8a357cc3c6a503ee4e3bfa16e7757c3f9c020a3712ca7dbf162e3feb7891bbcc1c17124c4eac105856495e454c72f96c2e04e218302d18a353bcc3db399bb2aa389907f7ad6d31c793f81ba854cba34fdee94e80face3a2ed9b054e4f004ca630744c48d8cf04f812cd39908a5876430d53bb53617b4cca9d09259cd45d5ed3eb09fafd5923b50cf4a5f412ce7ae23563b817f0330e7b75c60eb3c5fdf1502825b33319968581ef9152679dec349c80a374413afed70e18faf41646267ccf1783286b39fb54f9f47b4afaae4e05f3a94f10bdb02f556348ae81f399e8402a2685a229bb02226bd0150823d07e8f8633c925e3ec4f1a19794310a23dadfc0fc99fe8f529457e75e6e1028980f801c2a4a42c5a4bc885af1f7b28c8ae0200de95544534113fb9a6cd71d2825c452d4770528c975b363882cf9952cd676eef251e254f8cff5b645ce849e0a4bee062732b66df11a712a332fe3ff736f65f1761a895706630132f26cbdbc577154441e44a538c6f9be8463e2fd1ae7be74d2a12d927503670014a82eca9f9601bfb3c0931ab2cf7b6219212d8e0e12296d397b7245d57942bb0770fcf26e4f62f7fb15085d039408249274f8e0037c1916cd0dd1eaa0ef5cf7b151be7f520afcc4c5258bb5529d09cd97652b3920abf739375e33c8fdee1d7fba535cb7725037eeb9f9056cc773e425cffbaee28d29299c1f767e2815fded1acb7ebee3f7a87b3c7e985cc88c9d03f4e33e6923737e19082b5e9c5210a4348f8cdbcd4a089b3077bd0a7a12c6a3cc027a364543fa302d44061d738e156b5aa7a4716f36ceb0be671d584591a00ea9173dec288c49c9cf1a56bbed244cdbc72abc488ded706f8dd44789a78f406401fad467fc4489d16650c441f15bde7be3e07b6910b817600586e2a58752ce303c74e6afa7b4e1ce5aaff7b6667df3d317908adbdedfeb0c8f4497b5cc2373f7c14d1bcd13247a4a12ff982236d0b26cc90490a6e1aa13fa91d80ebf604a5643fa4d1dc826db7bccf8084e8e489d44cd630236d3ff61b8b27508eece2a0fa19b4e3b91a8ca230ddd7391c201842bd17e4b532469224b01bda19ddfe712ba798825e12276e6425804eb649b83d2c48008ebbf017031b117a27f5f8b1400920891e8057639618183c9c847821c1aae79f2a90d75f114db21e97515975cdce0763efd7035f92528b7b473031fd54432e5c4ef072af2b311481bed89aec88eeceb17cdea08be197f1b4e526019b53898ec072473c57ef69bb4bf4e81765efffe8ea5c03b979125ced81ece2519c4df28b542af1af19ac5c08c5d00c69728155e876f3f2a8979315c15ac501cc60b1f2a69fdfac4545008caf97d6b20ba2eb954fffdb080867f2572fb813e0bc991e1e52fc16c3896a7a7ff22a8f7568777d4271ed87c0538aae958b22401bbc95f0ea230146d4060a88aa830650c32a50b4c200b870c8144026656611d02f46f7b8ca9938165a25a59990c4a3d127abdf20b87ef92c7bc558f82b430f5a87d63ef4542818dbc272bc4bd7599b771f77634f7a4f182147d115a26b948335a204cc31fb522c2db977bf1dc29445b917179dafabe3ade5d8e206a3baed15f82a3d2fd04499da728baf4e6df7174b1dab06decfb1ef12e09b52bc7a7dbf20287cf9ea7db471bc40c583cadaf955142b57bfb70e10d3ffb80bbda7a5488d4a3d16c58c88cf7c3a2f038fb4e32dd0295889bcb7096d14ccb2968d48a28fd9fcac842a869fea1bec83a23dacf5291b032bcd984f301b23f296e83c2ff0d817affd41834911b8d33be54e1803af6f882a2bafbce020afa409ab6d64be2ea5e8dcb5db8a748ca034b0da43a9796065ba16ce9c953a499ef79a86a27183aa6da01b5cbe8a796f34a2e3c94f6c4ec69023418b00db8e196db0fdaf03fd00f2b3efe468671dc847eab03d38adcb1430935642f798da8c1e9042db8b1e61c6960d2ab04f61bf019546ef25bf0b506a3cd3c5938ab12c94d7bb3f9cb15e3a4512ddd317983ad885e5bdb255b2d496a159d5e3abbad64c38c322f9b9a85000fce7aa9b82d96f14f597c39c15ba960869f61e52f40e94b3f87f7c23cae670306e92f7c67a795adea14a0d2f1e3ccc2024c01176250c68fe544b3b2048d24b530a9359f666feaaa0497adecdb7cfe368521663df872acf75ccd4c481ac125de3616725ade0dfbb043e88dd0a7ada786b728769e1c2f034d4d2aaccca7d2d146bf38cff4f70932874f1126c67eff2f7842681a84f40e34575f61b986d2468fb4741834b7d8ecf6f6d11a621588f9fed5cbe93b35a897a5de3b7c5dbdc4a7c9f2fcbd8ae9aa3eaec671092707ec237c64fdb4bffa6152bfa988827ebba47ce6c6012fb7d39485c4bfd6e85fe2d30512ef7dd0901b47c8ea82ef7c06c69b4e4ef92877a5bdbf4b9fa9a9bef1ef6428263cf64594e081808f2f1871dc27d1a468531b9c3aee5217a74c9194c576c81322150e1cb59138021479aa69e8266d069e9b82a660b0767244703771c3bf264e6c406d5cd97593d7e3284e6d120a98fc579b049efe4953e3dedc425dd311a7626e85bc0dead5bb866204ab83421d790ffc194a8bfc0210f2dd595b61ddb673d68eaea337cff9d797fbd46ab660a539c6f3defc754123d627a9af2a83c9f4b1323681c9e3702910931562320b54ebffaaa5b2c164b7f4cc0baaa656cd7f1489ffcdc8d719b5ad8e011774ac8c0637f4427a5c416145bd1b2549058847e75d24c3bb4974df86cc78696bd37f405fd13f16dba62573d3c5eafdec9667f8ea19aa0967cd493fcbd0f6537847542f45000aae2e5615a34a55621cfd1f9ce86e8e43563b1bfe406cff3248a698d362a10d7a93dc35b8f890b5ab09e269ce1f5c0615349efd3aea51a251cf5d8da3e05c40b94c4e0bb77a8e2dec4c053ca6a69dc74b2af839a54663007e7105ef6db15ce1ef61eba0b9312c054d6ecc60cc8417190bc1b298e85b8863dfb50686d8de8b38435a1abb67265384f7f6a19ce7c1b4467d7f32e2ab32a9119c23c91a8d6ed08ddec045266960e9f3126cebb99f665b95cbefe1df95d1af53de43b47333691227e81bd3a766e7d79ac55911809e79f44d1a9627564f428071cd9e305873d83b4f88f12c0707c406c139447db6890566b795fe6d11818d06b390bba693f5c2324de6ccb80df3fe5db096b596260b0f9b1b61ae19d6d2b8276150227cea602fdf692b33de83d29dc3ae0334c497caa17ac1a92e956eeacdcdc2345c1c265d272aeb7faf092f4eaa2205a84a6fd06ec2ebf0930747a172d3df1f65f0ec0f93b3fb1a09c79edb0d2b61fbae7eff9aa07bd6f147c0993612d345c00a66566cabda3a3ff2 +Digest: 608ba7ca3bcd069a632aa9901b1626ee501570cd73e5370c05929063ab4060efabd2e096175eab8a29c71b3ecbdd39d443b4cfd500a54695e8d118e1fc51f9e1 +Test: Verify +Comment: length 37952 +Message: 0d7f84d2848e412431dc9c86f415a1a35be85833ce66997d09ab211ad0c1e6fbddc1a8ae1e3bc9dc1dd85e17c03e86d23234fbb12107e6042a2cf88e9126b68a36ab14f0c40246f42cafd3cf5252ebc305cdfa5935a57dee60ab156d4edbd95efe84f120e0a9617245a722391319777dbdf97eb472080543956fa0426ea6f87f1f9566c6d9f9c1604f0a74da6b5bd3084001af4841f7270bb0c1c2925950bbf67f269c6b17ba0ec5341ef03cc3dfa66c782db4a0083b8b4f99e9a2e776a1c9ca087ebb9602b4f2aadb2cbfe6816e99b14cc4b641309cd817382f6ac82f60cb03a0e7ead002ae13162c7b08600fd054e0a310dcb522e2b76975da3fbeeb5768aa31a751a07f7219110f55f433d3cd7e0167574f8345d5cf4f38344b50134c49c6a207198ee1c6ada46c00abe6372cbf1a7fe23633003dc9d06983b6060d08165fdb4f6a22907377d52bc55401a1b7c135d3f9ba4dbde14cf4f010a8684253767ec4c76be5f4411eae34ec170c7b3429594be3035ae38a01c4b52348ff1af4112945b7455e75f74b376fbd1d902c6ca28fcfea38e2da008f47a004be52feb5906b46661f167c5fa577c5808e151c27d2de4754816b090ba0869afa33e9545c9b49af1d22936f3fd5761c7c9221b32d614e9b6a077fda73d987894ecf4d85b2d9cd6824765fb860823c5efa4f3e5945f8e7b374f2a5b4ffe4545749b905fa7ff3fe59c34202bd8a55d27142f0f376393fb277ba6a66ff7969f5ea301a991a8b90e46b42ae02e884f53f3f9c9bc872cfddb6d083964824a70f702c4e19924c9d598884e8e4e9a0180c8bae507946b5d07bfba4199ed589517fcf03eadf77fa7ff6f18dfe093e4c0c3fbfa8a5b1f4a703c08addc2ab959741611a594b93d08bf70e276fcc488a562938e114e46b5bb132556a61c7e50fb63e5c5715ba5e2667ce4933109ac75425379ffcd956d1013923e1a31a7073cb4f0f18901f7f68fff6cc511c5ab0ae2421fe1b15e1400870a99f0d3eee047d51c87d3ecc5fe2d8e69fb8cbea34552682b245553613ed3b30676e8142c7cd2d2a8b507614bd2bd660cd5b62a685d357f740d6f56657a490c7dd58e4b78c11a9ddfe50676f21a18cf7e57ebc573770680a3377a2ae95ac2fbf7125dea6251919f28b44bae5738d203250e7810531758144f3f10414b54e41a08d9c1916792da6f199f6167e9b37ba99765f5ab85b2acc2ce80cc4a3a0d2eef098873a0f729478638f2c244381e783b5bfadef799dd66e4a7b8f8a603c805d39faacec99f798b6d0d7af8c3b0de5a20d949be74fdfc292261244fd55729fb7021ad3d5bdf17f88bed847f56e2878402a5befea4309375e4917f1c6892b7923d462c69d82469217b7fabb07e5b8ea85927e72a25c037bfa3af05f8d044d54ca36394cedf1df198b42a5d56ba7a68198cf63ecb4a2b5d68f810756f9cfc179d4b0072c6d10a45c0ce8415bc9bcdb86a2697425cb1d089245a7c29eb2f1703068ca352fc4e97da2c02f3616c82d3e40cae617e48dd6e2f643338bfe617241c1ae0d291d9a845335d2a2edce1101b6f939d0b6f3a2d42d49b2adc93fae5b1b73cf004cbe99e70c5b68c6cc4b4c402df716aeb818b31fcfd4b99de32940b3e88ff32c06d9671c925dab253c5420f38a848a09851c68c0b2df818c4384c0828f5d4117c038ac2bcb83c246a6b33521b5e6bd6885c668bebcb132025018d5d0f825e24be0a1111aa114d5b1702e34d29565d65320e05c21d794f38572ad28a60b2ffe50d0dd3df3fb5a0eef048ec50e144bfe52be30ebf2eaceec9f110a600bb0c2bcacf6b4dabec09b9387c89a8fde19de5ceec780be38dca846d795f82608cf2844e9bced8d81da208c01261c3b498d6819aea3967cfb976a29b5673f22a450a7bf8e89520046303122e685da7058562f5c1bba3ace43025cbcc2eda7fbe71b885524c4a9db14aa157cbc4c9ed7125d7c4ebb74365c1905c6288590f85ad918132d32d7bbc5f43016c40ee52e187f8a9616193a51cd8488ef9487b8f9e683308f7040295067ecaa7a1f61b752daa7c6c7deba7252ca8d7320294ece7348ec494645d722306907008ab73f2ad4c593f755cb288602fa3baea10f64382e271c4c7ed57e2a22724a1b8eb42fa67b824a068907eadc29069622ba6d5160f22c1c228047bda9ef2abfe1ce3eba930eb9d4dcabba88de8f95a6b5b36b9bac87fff3b194c41c075f3b6d3b917b665956113a5f030b8af2fb507450d333cc86b447a9e3017424ac3a4a5c112196be601b338379d823798236de07dc63ea6b5542ac479f117e5c014802954cc4b5471124c7b711742addf509e9673fabbb0181fad8d4cc0a0b4c6c51081fd2c3018bd23b74df0f1d473cb339169d63f3cc1572a170585435427d561c07028d66a1110c26e2015a1ca22024910fb02e83452f8f021fdc1eda4c762872a54764f4bd6128aeba28dcb96410b0d87ca88aa24fd842e48b66124150bf481b8af53eb77f048c9ba4597c3bb595bfd5048e5e9a1296f30e5c0118b177e120df5f1405f50d81a2b5479e22ecbc36b951506992b1b5f408493bb21874e9631686ccada0f78f60d1c44cfeb612a27b061408410d306077ea5dd083fad0cdcd94d778c6f7052e2a808f5a8221f68eec0ee6d31eb95f3da90112c27ba60e4ba8019b0c6af266116619df1a3049e0a912398f59097d857111b530b9a205758d7bc59a2f9e7964629c037c341217171b74f0d6430941eb27376f7e5f01fd4fb8ce489c8a6c74454654a62e4f3073e50b9a99853927edda85a495c5599f77e2f72af169c5dbcb52e7176abd13904690a10d9e62e26a6a98b3df91cd52855c7870152ac887f366d36d6cb7f02a3c766107546536e7da9e6dda70c95ef0b992574b195b8378bd2d1000dcf590393ceda062f758c8ef7f72a322e0a740db4503c7b1beea6041400950c6ee8c65eb969195dd7fdde2a362ce81b2b6913abc309512ca8b40288a85e0ddea2ae437e5544c889d735e4aab8a9b4eb37af1163b83327fbd08c5a2fa929cfd921865ced27e05c0cd5b42c9aeffbf534cb52e9aff45c155b3bde1983a7123f9e74178f2581aa48693c0f12755ca24d8a6eeb08fb17e2addd333fdd0f22a5f19102c836a1f3210221728d32c47f2b024e8addfbcf837555f46f17f14c9c336a43561f0ffd0cd33dc821e50a02c7f4d813b7a23eb7d772a22337fd12a674692e48069257913f4f4fbfc27d04aae7ae235c7dee4e2e8469170c36659da75ba5a1f17cb8ca08fae3bc9accdbbf373ea5789b3608a6ae0ac728f1d2d81ee9b28769e220f8b3bed03f08cbb97796323d794c528897d4b0db2b5c86b5cb02c8097cda9cabe8c14d4fbfc8d510d7262674980314ddf254d185f4263d27c4d5ecd0f4987365ff6f1ed9f451494b80eb8e74905154beceb38a9bc01a87c14c24a2999d182907a319be0f6b469af1fb62c4ade0ab8493835d367cfdadf91ac76b93d3b4ee0fd97a5da540831d3c8cbd0883811786370496ce7fba2b64f38ccd172b1ffa6eaa73fba75f2dea59b0842c6925be9355ee8a9f93c0c3d7b419afd3b3f2cedc2e8b6f9d836617ff60a960efe13586e2af1d8e0429a43a613fddfc61ce6560c8a22524e67e349f30e669bb6e2d2daa83f646874b1c948e764cb2eb0dc30d864e6dfa1c5cf455443d3f73ec3d89987a05dfec2efad90c20858f3af42e3e55afdbf69cee6782428762f07a8bc4a2e075d6a080bd99db95a0fd6bc8c049acd83e0fb06ff39ca486d9409dc00299f5a03e74fca6eb8eb0ab706c570ea7e67affc1484ff5d472e78cca648bf6f933fe52347f58c1116fe4c82f40f55f439b3556ca1409c0f970a7eecb3d6f81d8192970e8443961c7a3e4662e29bb3cfbce7857c9019243db1c72077c39acf317b00386da6202fb86d13c200d751d4a68f6908d4e8f6e1111ece2712df7c8cd309f18fe7b676a10d76e58603db19ff9f3ba3a61bb1be19b165865a670d64762db4cd6525ba2c32421d1c5c14f6db7be247fb26faf35b15450e56831e573ad66403fc82cebd2a2b7fea200adb317f91983bdb5218b7b41df6a2a868dfc5e6f4a37fe6ae8bc458d4ee665a58ff93ed89e9a0aaf01e04b178eba8e3d3515e511810aef3b104d99e74b418301029250eabfcfcd0c9b3e33a704ea86e8a1c2a618ad31a8c52e003e454fc880bf800eec83efadab5a5805b374b442ab355e931ff91154b175ac84b12bdec3f54da2df6048c0abfc14c2c749052f7b719fe607c1477fec8fe9263b710f5acc4717c5745abdb55355c8560362ecd8fd6084b28128682b519a7bf5a52c644659fcca627e4a37403c3ee19c4aaf7043310e806eafb3ffb63c67cac54211cf43f59cb2244dad69f3bf2dfd1ffd7d43e0cec22f54d40252a2f57e320fa2efb4c6179d8b7582f2aa425489773bac6adc542f21ce1fae82256425546e2f4804993f4875a2c08eb89caea4f7ec79c7d6bdffcaa3f9198fb1dc8c3480cbbe91ff0121f0cb94afe17da5ab28ffc974e06f4d5629df3cfd082fdc9dbb69d738114d6110b8f5cd9e2bb059ca48f7aa9776932ef9e52a1614a83ac9fb22961d26566e5d7df98ada15bddf1d8e9d75ec6c0ac0c74d551af10ad0911926f28c0a03d1d03aec4af136912878856a8ef12b6d1d969ae322387a4a11914ec3b3c22a4b0421adce25df6fbafc0b15d0a60fc4151f733e3da4f8fe5d0bd9df33debefa767db11aa6029be1dd991543737b0862fe90f515cf85d319bdffc94f19ec08f710af3d060679cd49838005a2a566a17474028ab61b2d6d48d79dfe12c85406aca408f3f461e3c9e337518a97f90131652ff4a29393041df84446c6ded1bf5e87ab1b946a4ae9485b838de2a7e0c35ed19cd7db32e9b26bc48e8ad1e7b876672480678cdc13e29f2ed285cc56ef357036153ca31861b0dd2a10eaadd20f21b6efde7d5bce6f7854b9cee9963996c02c0f538388b8ad77f89575e6a9322849d4661fbd6fb5b012ff98b329dea45a0bd8c9c25d0a982f80349317ff526ca6473603ceb86726883af65839b7144bbb610cf1dc29973b6a5227af81a538060bb2526565eea0a55a58ef64bd11c5743d783f141b69bd26d07638474d68d872cb03cfe77fd0ca969915313ad7da60d242b9f5ad0aadeacf1464ed06d5ca925756c3f526670f338ed6c86266f47184ca8d9eb7392456beb88896bc4ab53b2418517b689ec5ea7a02961af965ad679fe150af0a24e3049757bf843c9f564adc2a2d8290bd17031c7659557cb36d3d10ab4e53450ce12803412bd5d481537a49215d72140dd4d9897e933052dcbe52858cd9341e6d894190e94fd41a7d1739e98263d2690d79de4f7fc614224e0b587d0a83b9fca355e1bed4be37850f2c0a4bc1c32be63890a1dcee84795183feaf55a8c06d466ad178eb87d9489a940c8bde641dd7321b93a4c06f30f8671ae2d7bdec31c6a2107677a57733bfc1c8230f1fedb67cc3230d5798666de9d97f626204493a4e9620df8e8b175fe5a0f82a348ec33f751feb684aa3689df63f2df7cec7445c6d793856fdfb0ca052aec06c7cb9891b68bee13efe9fea3375fea30d8e75620acbe1b3877683bbc79f41ad74481eb3ccc01680ebd3dc6fe111ae8b3e11ad36e7b2562eeb68a3a91824101bdc373cb7e603bd57096af76e0931a522e408cd1755e95d06ed44d96924797097feca7219d9ac29e012445f692e5e9926a9c45397f7b95cd827ab93507f1819ae76627d6e2a31d29890c092e5c300f0e2f9e4ef4d2faadc1f050d70038a7841cbbdafbd095a3d4e0d0f90307859c123044eeaee9b604651481fdaedf6c922af7c4ef29f9fec1702a9d913a6757507c5f73336dff75c1462efd2a46bbeddafa93ca4ebb386526786eba7cb6381875d402821594205658d7772c7ea87a01a67c59959eb87411fa7416ed637f601132a3833a3e2a33a0f1a058d6a2db06f11e39afec8829974b64ed89ffee9ec98ab070496353371f9cb62a37c23de745056cb8fe98b415885b8c6a2fb8c41a59ca16c3bcc5ffc4ce92cdfc7db9f8d52184b581af62c9842f899b7370df8efbfa1b8d244427e8d727c95e9f93837bac81b8241d280f707f741db990b43ef34993c33d1c4953b67b128b9299dfe86d744ce7de13d36a500c3f5e0d4a639b9c0d0b0b4d32330f12b5771e9074cbb076366c5a0eeb173a12367895c028e5bf304f4c3be6ef6a24a48f3ecb81b7bea23ff9c859da2e5b465d02070af9b3a27258153d9b2fda565a131050da8deb208770c5482b6a630957da7ad405e171037bbc69c673517b607807409393db975827b1a2d41ae712883530a5c8cea0ec6ea40352cf0a735aee482a28f03e9443d04aa899546c79c440a8088bc9ac5dac4cb3d6d940a9be006a9021cf4f22df78efb800b1b06a47ff99780a35c0e941370671dc0401985af43a19973e9988e5bc1d385ff3d05c7a4efb6cddaa96cb731702a6beddfb1f6ebec8ab327bb4b8ce9ac2946e659d8a3936ce4e2af2319b1bd4aa1a236c148622e77a0e9a908afac1974692d411fd3bad417ae498167ba063f46594b4b835149ff6ba0978840296e63d12fb39ffd9b9fef667f7d01d5b2471019ade19c947120d73ef65746003d366138c9647361a4a53ddfd4e790fb86d6d83b3bef9a730c894e680ea352b +Digest: 0c146db51e9b72a00fbcb83be0eea5ac730829f73551c39ced2ce000eef7e2a95d3cc28076d275b897b0370007c94ad1d2d6ed18ae48ea3428d35fbb6e4c8fcc +Test: Verify +Comment: length 38536 +Message: 20cfbc71906d5a762cd6a251bc08ae8e2a8eeab07ea4b3750c9b245cec7f2c65abf8e418406e20c84270451958575ac0f026618a34b5e7a0390fda097a189b7086735428f5a28c6da06ff8ed128b94873976f352619ed3e164cbf5c51aba2c541708b3a99653c3ecb09b65d4d2ee86696d44490fefa8a1c0f3981e99b4af0798c881aaa40bc7f0cdd9bc34d680c655f0f4590ac9c51876c54f3efd8b313d55c400a5e01f3c46399982990dfb045c2ca4377ddf88cb397d79e08539a677ad3e61263bfe25111ac6d715fb964c46f8310c9c777055e952db630e357aef6f47e9f6a40cabbb728ac00ff9aa7ad02ee28cb08c11643707aabb0c42156a7001527f0be1e090eb47dd4fca966e5f8fa5616618701164370d8a43fae2eeaf3016182728457e54bc785c9a8e540fee9291bee7cdae40175ce33a9bb75888f13794df0ad638b0a037ed4fcae69b54cee0dc423656b06626ae7202eccb0aabd98e65f04f9c223c1c628efe0657d306a7816c327c3bdc4b3835a02a5ebc621f0e3c6f931f036beb6f4744b0776b64ed237e2bd9e0059cb6f6fa56f91814c6ab39499c0fa2927b8542eef5ae45a9b6d1e8deff7e8b3b577107047db8435aa01902bed2aeffd1bbd23c5d8a419799317a9ea9d268a4657442155bfbb00617572f10a2fbb65f48919a069eecaf95c43eb0eee88be0540b5df2c508ba268ad253b60cfdfe70e98066a447b9014069b1433a80a2122ec3b67949c112a065f613fc759dd7c324c600a3b9a8b4b33e38e8aae1fbdf4f9a18ed300eb18197b47363ba366c39321a1d50aea1d199e9ef2df2d96d07a72a6c7c39ea0b3c5e865a2948f5bf212a339917f9f12469708b9d6d563aa64d038beb16210f060bb054a03f4c15d963b3aeeadc82d209193f808e239c335375fa5a600f2d07c8c67febcedef7824cdadb8b569373bb1a8810b20a754d2e3e27957f138ee53b1914d3322c2dd0a4e02faab2236555131d5eea085b8bf0922d0adbe24cbcd211c09db51101555fe45d0a280b9979ae42db45d66ac88e0dc7e9c6d46b53c07bf2870a2c70977d2ca88a125e7f02f809b01ce3dac098a62d353a0488036fc368473403413734cec05930f053f4a409ebc5a8e001f214fad744e76c0090eaed2276902ffb4e2170a260174c0f53c9d5dee946e550e984b3935cbaa543fb0a6530e96337629ea68a5a2307cc9b85b7836984c09ad18b30f8e9e57958592d18541a0675c27e0d0a44710cc81bfe71b63c15fedca68bc15ff26247ed2c4b0d5be169378d79588497c76e8221df40fe102868bf63b286745ac985eadeca20821d35a4e37504f7ec933bd9ecdcc16a160b6eec2f1c65cb8a6aa4da3614d9e076a4775371f30a632b47c83bb4bf6883a0f13729b6d16861edd5abea94560293d03ad0ff4bd033a52bfb941a41937d938308aaa6bd48625083e3083c6a6ded427825682fd8d329c4d2f7ca01fb1fa7a3a999f0ebaa4afca136dee059212241f555ad666b80c691c80a8290754a2d8fb9f9eb3080e79fde5bec0c5ec7223ba6b2511cf33bab6f16babae50e009683dce05b4893eeda0faf868fb7a710d480c68353b83628c1985ea1ca696e2947ea371db7f641bced62172b0625e6bb9ebb466f44cb58b92a0711852153d578c52a487af53e6172875fc050399e4151eab2d17e0a9b80774f85d86ea9ee6d76790bb6fefe681b980fd04f00106ce0591f2e0db98e71d7e896d95b6549815eaac9552ab1b8bc99b7ef7b6f4073d6ec5ba4f7a227b894859668cd4171e953d09d1ecf4b9c0c8200568e28c61a4a238de0e3d539d1714eb1092e27329b71adead5e143c2c6e2017bfe54a1fc957d9cea6f43907abd9fe583c74eb0d8eacad7d4dc7877363823822f36a9adbab9f4892c902cef0cf52ba2245a3230d866da19b73a4d3350f8b54d4786f513a88f98327acb06bc9881fecdbc4a406fdd178abbbb75c641b81082aae976a09c6d1e4fdefda93abdc567ffae721de2348d06c30407174d68158771e13e8f1210b16f02d6ddb12ebb3cb1158c6f5d7f48903a6b3ec4a8496f0f6669396d58b4371e889a63416c4b7da4672ab1db917e748fbb6baf19ae221f4fb454fb9e5aecd85a73fdcb5160f9cda68f2563dd42497e3292ac9f2fb33f407d791970fb1b23bd0d3815563717a171ea33edeb9df7472e20c615582d3e0a9a41bea0dda925c2ace0ddc84e1819a932175a6c914438e04e025f8d213cd8eaf4418ad18dd3002f6e7a6c00f91fec7bd8d50d899cfa8e7ca47f66fe418407471728e594c79f32d4cb85eca4a1711a7d2bce532c56e67f83fa40e24f012c568acc9cd7d1d23545188aa6669c8c392b19f3a7343d0531955d16ecdb68a95d4a19d9456970f7bec1627587e1d0029da5b6f70bb8a5f2025873c02c5931813e6d5d06cda2597e622c1c52d065284dc512bb00a0e84a65824f2bc2a86592d0f846be1dd98b74af4810adea29fb8cb4daf992d60ecb15a5d902eee3070673e0b25da5e4142aaad199f47d0538a9e47e04e3a241fe69eefc2ef925eaf245bcf7953b78252389e12e7c61f46ba87918f46a57530918cbbeb0a9bd36a01028555ec967a0a6b1b0020c1ade7ae31f73105e35dd0df503f86b0a74d58bcd0aba265d7569863064a5f6b49bf37736459eb4048cfd38ce68f8df52b4c98a398700173bc1ca918ae472a36e2628532cc402ed2d98403c5ceed400d094229dab30041142d611287eda1ff382e306768d41a7a122812d82673e93b8cc3a672becadcdfab8dcc6b5d2eeb2cd37fb1448216796b92c6e4d70b7ff3dee8dce209cc5a563bce6fa729f4fc73518d696da32b0dbd61e9187266f13dadb8a5c79d557fbc0cf3d14599c4ebd0eafbea7dbe19a01486fb699f642e84577747381620fc659a718678a21cc2ae46a29a6f2f3b0e9dd546a6b8ee02941137d109344b35550a60246208f798a9b8b84aab8ff06d0880ca7ce24b67061e44695b7d1ec91305da97862526c895f097c033adc153bc7dd56eaa3c95bcb7437a6667215c32627552bb272e46a7ad2dc7d90e1fa7eba1f5283c5f141c31ceaa4fa9948470f9ac2a1f45881becf746c7c57d3a8fa80ac5f4e5adfc176368949910cd54250191589a7cc1194c8e39eb351d27396c464391039a4e11a4ffe3a1b68a2c3671629be05d07b85b5eaf02131c4b519b4417288b97a297205b46258e790850abf8287bdbd84c85deb0c3c256e3bca6c0957f1c2e27bb13b898da90b36717d53527c7a3b392c7d413f1610d1f11fd7159def2b0e14a304e4aec21c7a8f73514629ed4b60022e60d8b7f0b44d42d9a5bb78f26695d55ae9147c3c03ce7afecb8a4bbb43539ff43acb5e8270c2e9cffc07a346eb7eb0082a73fce1a62e7f7ab1c8c0d0a83d98e4d2c139b58c586e6ba3a125d502f22a158daa359a4cc3274fcca79112c2457668f263526f4f365a1464300685f219cdeadb612f503eb5f9e5e4d0c56bdb94c0e76059b09903853531055c4e40051a20eddb3ff3e9c52b7ea5c1ea64c23951fec9e54a5b1cee6c852c4fcf06ed811eab8757ed884f274d3cf52a9e77fe25a5b97549df5cde5814d46c0a2e3674af4cf7201513f668ac44bd3ee8940409e7b8775554bfbac98ba4a959fe24e4bdd7cd8b21df58461e9e3889e9c47316cac7b1c3d0ce927dc4ce458d5bf2571aaf41c8eff07b647f574350265c83e4b2290db8224e7e02aeb6681f07dab06fdf343466acf7b1e0a9fde5b51e01f08ee20e00f71e372db55389a2599f3efe153c33facf499d4b74cdf7ca8ff93fd21aad61e9933ef4a3537724c41cddefa5f13795d92a4e490fc7f22d3a053d7df02f1c0a10b70aeba8851f6f168f4a566daadb401a9f4465c78220877f3f7425137635f2bd890b8504f35552dfdb6dd91de82d1d0458b258394c5fede066259e039602ff3831c82a7e4420b56927cee17f553714e17a208a2eceb847a4a2d95088388b1ac8d8ca43e0208980fa9cf6d75997000ef73016636db0327d141a17a36a04d72cb7a69736f031969bdb626c21745690f190a01d4bc099d67778f767ff70a1ee1b4bc2b96d771c51ee54a0b829983bf0a7f2f2bcaaed31ab1e186051cc64b8d8d1cd55b84e3c8cc262ac7e63558ced2716654f7ce8bd21b9583b7e5e720cf09d3484861a430927f0dd2d25f40f1a153d2833dfe46df811080e2a79155930f2462eba7e69b3a495e3481dbdf3be085b3bc3a2c97ca166a8a1292e78ffe99a66dba6b5642c06d67fa38cc56de9c91f6628d1fc36ccedce8f8b8f8da3a28b11f26283bf61eca3678d398f6d5e5d9a27df0c39874d5db7fa6ece2a8f2388a55c41e5af1e9d30f41f66ac3b5db8d798e86defe38c37b668b0ec73e07e2039a144f96b111a3f8060c6b30477dca2df2b2ab9dab7521b5f69b9b1809ba0c13ce591c3fd91fd70644f231b492a3344febbb46bd49d2322e121dd6600423f2f18db0b46a2170d576529ff47843eabc7bbb04f2ae67d4573c3f7e3b3f8bda19258e9792b628b941d0a5722debd9a8a539f73c39e173f01388d55953f72f40e118179a51945d5d8e9dc3f5489fa26180f316ad8706fcb9f96c8a2b9b375cfd0d41df255b954de22e4624a5df045ca9f24f9fe5548f60967b7fb4518b60a362e04b3bc52b3968cb93524e004baa56e65ba7f9704cdb5e2a1c3aea87af138116fc9cc3f64ae14c8e706aa6a129023fab3f74c9eaba8b33c94e16932a70b0748dc4aefe25252d47bf27c7d4e5019c556d106e7791381f801893ab54b66ad7fc3bdb0a410e648e08b23c124f683fe956b070dd89204fe8d17c8f6195b807fa96a5a22742ee63840e2c2fd27c876e69b1f9d35a85046ca7968993c1ecabe288c26fac9e5a51bc9fa6617570f2ef07ade5bdaa5de1aa08bc4da44344a01e65130dde6cd81dd4da4180169f8628fb86266080886025adbea775710082866c0a19e786755d03e4471a19a0208ab5397453b0c6dff9c77bf8e99c647dd3d6216c1dde0c3895931c7d79e1828ae6fe155cb6651513935d91420320e2fde135eae58f5fb4292a41ca07e1665241238a3ba9deebdfe5b54e8a2474b19103031c0510fefb32e983968950f11683e5d8d008d63db3abb8e820c31aceace34fe1ff1c78ed2efcdc2a17e6f329809bdb7f76098c435afcffa46ad88f61a15e26e665ad87ca697693963c4f58eb130eb47fd2ba169050383c6283370cee0d661a88d624c827492482507a4f1cc67c50e3627ca71fa53201f1bb006b1dc46f9fad51c70ea4743cab2ad15852993bfb06fabfda3d01e25edeb20678e13c75367f51d9bee7b741b26f1f916cf678cc3d956cf081f867d85522efed4335e380f069aa79343c7b0048e4c3292e9715f7a290acacfa65ac07a3732dc805e59d683bf309c8cd796a407ea0a800f3d0fb3ec86d5c3daa1158f0c843de3f175cd4ab67b01230c12b0f72b22740a17320b3022d9fde2b2767f914421983ab1e2823bb02053659d5cdd52791fd2f931302c7f230bcb51de8f606f29f78b0b480b40527a976f8ac61de45df7c76c74e69f3948f7028735e65280d1c4ec5d7b3c5acf371bc99db910bd8ebfaf0389a4bce8fb32a7a879b95329a75d1be958b41735f6919b9d251a01a4a321a9bc72b13d713ae63ae4e902ac7b9cbe39d7c2de60067e0803fa4ed6233aeb2aecd870c2f1a3bd0cb89d1e3b79b0289a239ce420a03430455aca6115fee82d838041c9ff5fe64e4b2abd618a4330139ae32206a35e27d2f0a8f4a6fe181433d36dddc5910fa3b34b972bfa17906225657f4f708f22472cb1f66065bafb28c3c3bb96aea08940b5b507cf310bebb025a4020d690b75fc082e4bf6e6702f8aa6fb7352ca5356271c3182914d8ed981ddfe71433a3fddae2c12af9e70493aa4a4229dfb63d3fdbeb066115998c7e43e131cd6d92c54e4c561032a404d6da6dc84e03f78bf48066f39fdbb0f58df934d90a538b6857212a96fa9c5c4c303fb9c10df63b126d9faa17e9d899bd6fe6e171c42a0c48dc0eec21eae87121b34bf4b0ec4108ee2ae5fbb48ef81e55a4afe047e9b15ea8e67007936b779129d277c50473a4ff73af0c0275f9baed62ceeca7d80579f10ce8fd0347e6fa1ad9005b91583e727d475c7a24c8b48155493105be8e81e461e965ee75cbf7b09c93ef5ff018973a00ddc5a8f92949ec048d9d937ae7f9a13fd2effcc5ac186b94fed20d57c2387c28ab7d20e614147b69b4470e8380d710d93de9807944c36b728e6adc3ee17cb96344e56a8215be8ff331dfdf6ed5a4b3dc9ee52217428330d3a71c551bf2ee623f1e80fe33aaa2ca4faabaae7342dd1a988a554a1611c26c36fd5900858308171aace254a15f6b8acd7389d457750aa5bb64dc70fc3f2b7dfae5c356f1fe543894849bf621807371fb10afe971d897f5b3c2cd2f401708d6bde4cdd0f7d15d572b19f05b5aca54f05726af6668ea1f8af038a9ed6855f516ee9eeaf6edb87de34cf1820ca3a97a86701a0ad393160bc61f2b15240b686aaf1b68ad4169f0407d888fe382928a6eb4c46f44a98708d7479f0e817b7fcaf41fb2d68738f3354f865c697745bdf9ac0bd29aef50bb2f2c7fde77615c5bfa0bd9436cfb55ffd3f58e3702dfde7c83bcec19215d81b60555ef7bea473f16722c8c4b909c210678dcf5b6e06fb554a50be606972184fe07fe06e5dba5ac35cfd07949e5cc12ad70507d4a86a952ecca337a2960de0309b38f66bac00f1c407f9240bcd11da33b770a55605a3f3f8b8fae290012e5645f9 +Digest: b8e7ba92ae9fbf04422e0e1c1d3316324bab091204b75481dc0634c702b691c72febb769dd91eef1fab234b6ff4f2891d7617802c09730e0d2dabd5bf720ee30 +Test: Verify +Comment: length 39120 +Message: 6723435b5e6164a6ac2835fc8e18e993f3ad1c667864667d96202f6e1acbc524d640abdf9769357c57a451f7b36ca82e9f35e6e7589755159aafb15714c338c2192400e098598df84e79a3903ad9593151e76f6a7456e1179f7cbce463f8310c9697e867497997a3fa6fd2d10ba82524738d60f6b4e9320c0d4df91bf0b3d98bb6610b7a92107804c34e87c20e2133906ced609400976f7c4beb1006a33b57c6e14913245b685ba412dd696a2c8bacfda4d0184b40aac1edc31ea8ad64dad4458019a56a8cc766094de521d14b30b7f183fd2f235c684fe9dcad69161cd67891f9976c560d76c1bdde2e56ff54567df6713e4e243c1a42f7fe62fd4bb1786a31b68c0defc6bd95482b80b1fd30462593d6591d57c807c1a0910309540d08d3ad1dbf333d9fe30a309ea3dad2c548d8511a1743c3e979f56afd59383716ceda8e98fa8449813247ff9d5e7886fda3beb6a540697085b605dfab2c2ffeb611a85b8e03a81a52f0753c927b3322bfa1fe4cdf9c366785071a87014499b1d41b649c67a348b8fc66bb70e4c0b5acf288c19b31f253afd2b45ce968681c56583237da8aa20c2c65dc4222fbf6a32f80a12e2a010c67505205f28d496260f7299f499b61c89b7d779931da3fe5a8b050346e81b8b01b53ef4205fb0af80e9b31aac16a53dd9eb318e7b12118546a394a89a828bfa717bf90b2bcbc15f3ce4b579ac8ccc8a8bcd7320cea7dee0c91d156e705a87cb9029c1d9e4057d01a470e83b9854b28f29ef0ac51037929d6c6815c98ad8759ad85f37d4eb854a53722ec9d4d216edc83eb066efe259a3178b15044e2c750bd4d47cb9a0a4d3cfb1006ed8e9fc3bd4a234c22605b776a6ebaf946f60e7b88105ff12c5b1a2795396f9c1a3cf794c1db9a694a6ab022704966466b5b63f3b9b9ac2a1ea8c56deac91a8c7a909dbc01f7afe98974444d34284242c8592b546a22fc9baa695548c012d97d1572d86206072c75e46660213f74189364d9acc924b217ebd78610dfa17c7618f4cbf1ae5671d7b465284cc61896aee147c430776ed1c4c3aee83f5b146fb7041e8130c97b9f784f13a2506347f4ccd57a00fd89d0e7cdcb357529e3a25366e99b7edddbfdf7d9edf6bdb42055f83c1604775b25d25cf8aa761618a0d190497174a8400b62e3c137175fbf26c909c54ded0f9474fd990e0979b452b92c8e2942b0e9a18234caf7d47d71ba9d2b8e2e223eb2ef9dd804d68f4435205738b6cd0457284768fa14446d30dcedad04f1403cfe47b3c8ec061ae5e183caa27f6eff60724d7be43d2870aa3986a07cda99c34435b6291fbf08a0b2588498c1881f85fd083f851e847043329f591b3538ee7fe1ebe799c7db70319faf22d2dddb32288521e8ad3f575385ae6a3ca5fea3583bbc29c14aebc8a79554f043bf1d010db09dc52f3b6f3e39fdc5a31688ffa53fc17df62e86b10c16947823d1a8aa811ae5effdfc76d5c28a742051d10a62c50bd7cb5b1693413124f6b34eb3d5abe3c08f23d037a79a6aafb2677c54744c8c24464e5f5fbac4bf3882af7bd18e49b06675e147c916e5bf0e7f412c870ee780f3d5af0af243623cbc0111b1131bac6f7660d069980bdf4810a3566a521f5b2bde4e9664b7764232173c84f961c3fba85718983e8dceb08d1de54f3d9df1d0154e77aa76969b8d28b1f8ae5aa3d05fe37165e2ce90a67f169e0ed4ae50ca6dc4ac1a944778f96aa7f20037dcc188ffa92c0f56228add746cf9e68cc453f35ac25efdfcdf43d90236421bc887a3340481f0dd9b4161b9b916983520878eb4c097cee98847e1837d5d09100964321b95f425985a33ff83739ce1c337ffea54c7c962a5e386383f02a4afa8a17a5487db8933083a014a82cd873e587a354d1d96e284fbb3a43255b9949cab39d1f2befdc882f5e4b22c00ed5d16bb9130a155566a9bb1a1aab60ccbb438e17872f50924397a27ff4e8c43fba9d1b523f8cc452ee70f90549fabae608cec11076443b07865846534de519420f0d60ed896b83547e34760758bfb819fa51e058dafc6fb20d306792b68653b83bc8f8e5a114b6cc8e5ade9ab778dceb1863883b35c6432450b6a298bf7af804e9463fc4e716f34da76a8f29f6a49dcbeb7a0542172079c0e96163efc9017aba601ba225fbf0bd3a51da045f86c17f5edc1c0407ef99682a4fb7480283d8503b58afdc6330206925062fda85f85df5f662bfe0e72faf92c2ec2eab6b405e1d1a3b792b172424ab904cd28e47cbe8963527dc488a77b18e2d574e2aa4bf1135d9810e2abc587be90e8e787c1f61efd49d9407974c287dbecc198c322930704efbb1e557cd4da4a5f2537830676ad245922fb849b6e232a9119b6f5e734519acf346854eb4642d66de245857da374e4db56364fc55159ed1b0656e0c1d7d7be452c7645c1c3c84a03489af3ec267a26169c7a41b913300cd0af01ec7724a05998cbd191c6f5738e697fbd361ca6c8d3531d4dc2415db16ff93d3e81d3c2b451113800a1c2814b8be7ae36b7d5cc64d1da003a3a23d7e2feddd796079b5a1b90f89c8bdc7d125827c5fd8eddde40580af36ec6112828cda2c6a690e69893ddfc951efba9be4ea34b4a954c0f01a9ac64e68f7bb018f87a41fad1b4869216037f2fe7d7724fdd33e0bf9ef8b704af66c9fa8ae07dbbf1efc4c2818a4f518a95000f1ea79ef66810cc6c3f1b3cb0fb902078887de1d9b9361466de9baa9c9899667eecf4957c9743f999a13c06cd353151a8b0db4539f857172e0f6efd3ce8199bc27944bea911d34d8eece37d23055243d22b810fa45758b7623d8bb1fa211c8623ec2283447fc8b2924798097911fae03e20f7a9e27d43db498f7b2f9cebab0feb6d134b17882b0fefdae4129904310f34b8c679bb141f6b2c2ec5deeaf0cd1e6026a17fe8d5034bebce4e004984ffb8fb1b75e9f7c1f54e5341f125aed58a9bcc3c5385800d5850cf4b5f3b52396dc3dc708c5f5d2ecc6e06f1886eae45ea6e75dab1c6a7d93205e3789d2b7ccd82191fdf9445b603acb28d661120b3e6f680a42644aa24e19a526e7e92388ee547a00c921402cae79e022fc714a28560b5b7a048939ac1cc971fba85c6cb522cc241eaae94fe6183a846363c195eec5c30fcb36927fc444332540db4c04a8e47fde5035e9ca1437fd566e8efa9bbb0826d3823b1863976ed72dab033081f0be100729dc8b55337822a4b8e054b219879765139473aba1f735f97eb2b26b091a0d1d20114667c0734b1db6fa988f86eea53313d54cbe6077c017405c4a267e82c7aeb776b3884793f71ffd501e7a9f87c0abe77ffbf24f5b16159482505abd72e03a746f5b2d3564872a00635f09affd8a5e22e71a0deb3b9862ffa77d7e3274e72ecb8d95cd165fabda44b6e2b344aa52b83acd1f57b073e78dc64e19e79a033d1a41340bee770fa59f5ecd421dfa38ca58b37484763bae5404ace8ce4d40a8627b6a051617b3df34e79318e5904d0351ae118fe1dfd9458e55f7f9f305c2dee7d0aa735ccf7968ba51a62c55b099a47926d971affb35c3f6f05c1430b79d114da88701387c1416a65bec6a0b058c96b1617fbc575ecdc41e723daa0fc93bd9f461842141b430639964fa648df572548acc78e260811da0754a113dd8b12ba38caa267600fe3afa040b44ae4707075875f6596663f881f39be66b423405e90876c0e251eeb0b02466cd5fa9dec0a83cf34d95caca3ba737e2d5c0599a4df07333644c5763822c9d4229afe9bda8c15c9350b2821bb0f9d7eaa6a4e683efee6e5302c8e917c90caf168eb9d05c260f41c69e442ec0ff067e23c78d6b79621f74461afca9742bcce4648b021032cede871d84af13727c39752ec6fe6af35b200f9d1b3bfb00f109c7bc9d1d0bfa19bb9708b267e278cf1f675c135c678a217caab8821b7026df3fe37f336f35ea8d22ec0896131e6c5e34cf4c3b3be3965ba1d038fe2f8b8e3cdba22cfc8d10bcafa100adae1529c5a006176fad1161a0701c1a9eddccaf8fa0799e5646db4ec8e7b27f587902970d3affca46f7815440f567d44aaf977ea38076328bb0ee2297cbe3b2a9755fe8bb95ae726298e04df05201a7ccf2046b82836e092da94a4eb1c291450121718159468e8a330fc2b1272c661fb62397e874ffcd7cccbe5425af725791001c0c035ea41c8c48dabd206ddb217666e2b688237c2127e96eb049d941b34126b373e13454d4e30478241e3ce4b0768f8e04cce67ee574f418c32dd7b710bfd5864dad82cf3448f6668bfd0cdf9f8a70a3f729667ea6fe7d6b213413591c77ad02fdcac289e708bf34796f56324b1cbab302100c01c22ef5c44f0f249e13030dc808bb6c0b39ccaf4060c7b1734fb7de49ba234f9ee370fdc2a11173fcb0dc8833f301f7c9b8ef4748d6a8a72919e65bc683e5b9ac778ee5d4cbed9a0b528e9ce54130ee4be0fb278c4f849fba4622a3b803a9d2b0eab35e7923f60f309473cc3a77cac8184e6ac0a93fde13ad30f7469c9e121352d998b82e4dbd3c02e33686d21b321da56dd8931e2c37ab7876ced4f2c7a10408b0a99372adc5a908cb416d1a8ff94779abaf1f699903afb29423bf4914c91d290c6070d4c881fe98b91eef925aa2de1ba468e5fa0ad4c8d1f590660e1a0cd75a4947c0d32284756939497ec81fa169f1c490577df62d6f5d379f79c02beecb02f3da03ec403fd5c0c83bab2a23874392a8b01433ef601bcab6ab5afdeee150b998a1ca8eb6367855e27fe5472ab72384ad328cda6b3f46911f3e9a15c78700f4a4098538d8ead58f1480cd9d89d3523e6ea221cfddfd8846cde3b7b63a32643ab2abb4893cdf85d2eae8b49bb54e882659998382dc3d49524f15244ddb95f30220f2e8ee668701d7b2024ac0519b1de2fa6322a1ca71125a1f5d704b100425c18b6992d6ca73c1f41677f0b9d34b8bdacd997f9b4d2b6bb4ab171c3c7c1f851f6e8a22e0fd285ebe94b436d6bed26aa44fc70addb8eece089efc98a0743a897226df498b630720ad99419db578c232a5fd5644f7b21db1bc575876059d07bb4060d3573490a2c037b0aa85c4958d6c7652e1ce57bd4aaf4670c524ea5ae993208900ec7afa8da5e367599f8299a6808becd3f7ac3ef82f3d57cd25bd326299992bd269dd252a5a4719c93b7df9b0175d27a76133bba8aa1788db08fcb80546f0b5d26fc9950b55c96483fa253a0c79709ff69bacb7deb85b80794f27504413edb38b5edece9310e0c4144c06ef4e5f5cc23bf765b7fcc28feb1258db9fa198d69167c77b36741433b4f4c1a16de811881ad2150d3095610b0540c6780a903e51fbf22a2d6100f818b3afcb634a5c4869266364e1b63b0c738b8f188b05a28cd64fa50763e2dc05364c9fe9eb192d5c96516a77b1bd504d5fca57af93355afcda091aefcd1057f3e2ec6fada73eddc6964851bdcbca777c066e352c1efe2c16d3c4ae33b78e272cc51f7977064fe03ecf57a3b7be4203312dc391fe8ce4986369eee983b1c0ac18435247e6a6b0c70dc82beaf5f7c896052c8718a77b7d125af2f457405a3c695ee421757cf6f614bc0721a1e906d2a250991513a7591c3c761571620a0f75e1693e197c9a85a43bd212d5330179d4babbe9fa2d8ea466793d27f2b4314fe1a6bfa786b7cfc13fbee861b348efbf6341af95a2b0bdfbd05b28c0d4a866aa242bdac715c19d382d00577a484e0445f2d99432ab67c5adee54b176b3c91a9c91d332f323248368f0c2a7c300acdfabf7d50227709d266914f87f9ffc80bd95df4f60d25b5b02b22f5871e278ffe26006d6820a9eeb608be8a8ebc33b89d03450f2dcdb0acfabd23d541e4f1db1bd0094509c5282ad04a4ddf87e76ed3ee2e69b601f83de1cdf17af28357f6b6cbfec24d5a985c88c73326969a0317e0a762b1319a15331ad2d10f9573fd9ee8b6ba13cc8421aecf44cb32f7f19798a86fa705c71facfa20b164ca0539615238850be40caee884c6ee1b5749b12b58f3ef064dc2b846fabb11b2948cfe087870e0fa1d53017647376e2a7ed60548bf88ce8671688f6a9ab29ac45370ea7c7a566e8da6eaa55260e86b0190e413753531b5305902c9a045cff5a1f1fa2444beb3d8ce6719c10435a18ea673bc033a22b44c0aeed7917060d8ca515472d5e8ae4ec5c549277e15302c7f2311a6fe1feeda3a1f16310d635496c0dd662024f0b0f1de79325e030cb850e58050e92cad016b2874ba56650089d1804c0d4b3ae52e62cbf20b04797134d468c31acfb46bc42fbd13c38fc2cf6751b2a6333d3e4f8f6a3338bd6207cd0e81b1f6569ebee19deea20317244c5957ddfdf4bf3c59b43bd1bf542fc0d6a6ad1f6820ec9f7498f56f7e4ca05d2a25bf3f093d9991b39e9a5f164d48660d877976354ac31afc17357bfaf7448285bc083d7f89a984739414dce02bf29bd5f5da4dbe7bc5577ee6c3dabe0aedda84a49ba007e0d75cc21f110fc7f614a8567a386daebbd99d238e0954719082ae5067de2f484b0b63c7c6f9c171b795d5b79dfb9fab12e73612966db0bb8eeb46108c3bb4ebd12ddfab1134ba86765f6a21e78ba95d89d868748659b8460e10eaed9c19f5977b251995882ac2af3959afbbde51536e27927c71e73432b717d9e20f1ee0bcf550db59aeb443a1940a6becae0cb36783f5feba304066e7b9b22e759d9af7cfad5837e71d1ce81edcf07d6821f91aab47f90469da19579ff2e6f7edbf99c8f6669b220a0b487f032ff4776c3d2befe95f3d8dd296fa6f220abb1c909fa2bafbc822820ba0c17216371c4140292c98e776c97f3e8d6c1637aa3985a7623d35a57df44132030e27209972c42c0e847f6e32a3c4f3e7f6b4a87a691a7933f2a1bb +Digest: 1cf9a4abef7250b53b978099b008f90ad25742882ea04ea4a3e44a65815f7e6a4c5cd55b28a746c2f027c3459f0dcb58fc472eac23af1e6f675be632d2498e2b +Test: Verify +Comment: length 39704 +Message: 5f2611c1cc063547a6762bd3f4efd5d04d3e20889935e4821ca10b0eb07cf61e51631c57df4af468206e169b058b9da92e4fcfd3af0f002e15bab33fa40b03c7e30241e05b94df499ba28cff7f28a10db2b7bca47225aa6e93838b20c74f304f1cebc884c64ebc921ffad727ec2daaa2e25c2f2469ddacea9fe4dadaa0b0475b0506f96aaadf54ebb55e3e3cd3048010c5276f7b1ca0cd4940c5ea94b7970e96a43c1bbb8eaf6ffa63b60866bd14eb006300c6d013d7d4347f0e0177956a4fa50373789efb26d56a33ea7ecc31c5b31ac5d07a4bd7e88a5262a768abc192d0332a94563c78ac4de12de2e897b77f9f05f27dd416ef3db74cf4786757c3785ae61f88febd8da9a00758868eeed7aa786af2f11c56e33c23c93a6945a32483b466ec35b848c2859686bcbfb7fa1aae06f0ce129a363c4f95723e634cb86b1aa85c9985cc05a0a8f7036173ace307f411408dca96dc81ddd6ef074cc2be20a7fc702c5f811dae7a8b29508bb6d027e26101370057703a4eafe79d0ef0dccc917949afaa20b874641a9d90f01be900e1bddcd59c261bef09e502098f1e3bf640e7902950f1fd7bcc6b0a298823581c5aef796e854b04297843e952b99403261c0eeca3383c154a1b4716243d184203b3bd7f0aa50e556f0290448072995be48db506244a49286aba766988f640d23b56f097b1e3b6334a0f93ba9ca4766bb9fba685b46e5f5d610fc0ac5d9be52d4ea950686c278dc8410715f4ac36745c2ccea7125b8cc8dcb984ed87ab134d7ec416a49b4259d93cdc53de9abb10d956c66e8155228ccacef980c4a17b48c0eb2303b6d73c62e3b7a359b653ce1aed800d43fcf51056ae5baa6b0ea3d421889cf5da4cc56128f3601f8265c7ef3cfa038bb6df9b2ed3bcaa53ac9334bf86ecbac1022f0cb994515fd736b29f255e4607c82df4ee83e93be47cad1bfd435f336d10e327554c8e44dd53de678379681ab34b11019717817530aed56ea66894a6dc69e5fb4823ff15021ce04a1af142be2f9ccbcf3df284b0b76f8c53d6360e8d305470758c45cd0df5b9a6240d98d47aa443c126891dd835a04a3a9435b6b3309059ec5bcabae272dfb296bc037307963ac85dcd239f674c14c447f76cef6cd62501c176a98b248ce7901adca58cc15918b4068eb280173c3b671c4523e922c817d3578ed2bf7da536da994a9beaeb0d678f232fdec8d24f3cba1f4501adbb4f8d58176bec5ed403f3187bcf8c956ef84edf1e7951807fcb4045b9c1af4221b1af1667d4a07110ef47d3273321963062f62e5e34b0b006f96e91527fd5b03a36a697b09296fe1bb15a91073e01f41b9586034b28a65e4f21ef2553491a00f0289a635b6e7510dc9153dd82b8d4b716d827e74d1cd994418bea8922e5263929cdb200ce2de6ac3bd75a3c006844e808720161ccdaf159c67e8846291ba263cf6f17f8739a90dc20ca9938e917f78ddbac3bf9302897b6c544f1e3cfb53687c954f1d3b17c1ca773b33558a68d95b176cefe37e1cf73b127234ce87b7989acffc46717ef9a31161cda59249d92c759c12071a448972c55d264c1de973144da5909a14e97bd782f04872b2537ee358fa4e9bdc7cb476aa7af4e7a4c8aa30e19bf6ac8ff10ad98fc1102d3e2dc68865a07730928d3a9d7b1a62b9cbabc989072192e04b3c2323a852c927ae4f5ca62c3d2047e50c983197aa04152b095d772ec4f9e7cf1151406d13e8148b1e8da73d0ede544c6139ed80a83dac2b77d2a5b9049025941711aa3e82d1564d31f615e8b405e82121bc2bd6a393c1456dc57f365f0a2c22b3e0ebad2e397f7d20026cefcb4b660bd47b66fa1a8af71161a27e3732ac5e038e4b6f297464e2834f5f3692a2f37074e014497b7ba7d017e9f62d3c2e0b4dbefcbdaf44040842083658ed71d9a279f4db032ddb555eceb16d3d06a5bfbb8dad95b4468d5b87f0646b8c0c1dddecf4f43bb49e8a2634658661f3851456117057cfdbbf45c958903065551cf73e17740b78c516186cbd16ff7e9643088fc198562170643dfc1e83f4aa609a8e68d679a318a12ef6975d659509a1aae2db208821313eefb6523e4e19a12b0f53ec9e684391d543b54499c3df99b23733a6d2a2316573bc5f7a3c7127e010d5d837c3d2658addeed4e2f6d447b534728ba14c991f24db5489c29d7f97fdbe989be90b5a915a279ac600f8f955d294d75b28f2bf4325b232d5c9d5ebf24090c20f7ec9435f965ed2091d14b5a2787ff012cc698735beb4f1b3fe7a28bf6f13ecb347822f18b5c02f2e95de9b862d423752fa15a36f764ffbb4ef0ec867cfc47327f1ca90653f07fca709bb1d995778278c408b8668d2efcb5909e83d73e92eefcdfc06f9cd9892e4f2f74ebe548dae4b3f2e3f92ba6b10eb00edab1a8c41cfcd25d4cbdd9a690d52a2dcede03036411cdc11a66acc954fc54ce8dbc1e97003a5bffa8dbe8416b3d037293d35c4f7dd06f399547127e82904ada9ded633ea86d40cfbd11ef32842e8007a91218b38dea41633ce4844ea0903a3af48c9f417a6028d571a7170242704cf3fae35eb8fc28ea46f8842bbf17c5cbf478e1f929e0dabc18ade487380cca0d3e6c8e56e4335013eaaf702f5b4ff7a61213339a7c41a2a4a05a12685c4c056cf1e95a2ac2982a63584af1b7aab0ee739bacccaac5058187755e77e1f669e910135891ffd794808397b24deb33a371d9982af25089933f0da0a35b1b8fcb3ea2aca07900ad90181aafcdccf47e8e4a801077eeb45255a4df280f083daedaccc9c5ab5a52cbf2bbd1a985b8fa13da3f110b7a08ffa7b277a5158cc570dcfe5b2e64607e20b92331508cc157247bf01934921b8759111282066f01d9dca09fb27894a72c90008c423e6069f39b3d369f90ab42b5e917dd8bab3f558da882259a505a68abca2794b6442e64d287e1169bce61d7d8d8417c5b3c8d7229fd0af8db5ec08b44f7b6a25409fd9c3c0feff7d395b9c2394d1755ba605f3ff502c1803d49cdf93f3f3520e536d5f87b5bf041118ebdeb207122d170bfbfa438e02e2588ba8998e4c92d753172be60d6946c5b1b61743bd46ce9584402b4893cbeda508358fd517abe26090066c1bc94e2e9afb9b5e6989f65f453ffd146d647c54b67f7cc300d4b45a6441ab9e5f4fe6cf1a4b5321cebc784cc2869d37e73a21c0bd4acbd2ab29d87378e471433f15c5b0ba2d6811d1d95f3f8414ab1634995eda2fd6ad4f429b9ac604f4e1fb199f6d6c011e34af11451d700046a13fe3e675d964cf9b9955be7dbaaeff88169d51306965aa534a1ba435b6ddb919f553b629671272013152f6f3c9bd60de3638efc1317e3e4e834f6b3a4c62d86007329ccc0baf8a88a7d8c98f8bd6c55eca6aafa24cb15670eb2afe8dd936212dc5deeee02fa265ac7d45cab37981a97453a1353613958f84d24cf2b2c5de2fddc1d741085b819fc722286f020b2469d9527af4ff3e9155d4d913dc4b9aa140fa7b9a17a717c39563370f2afdc955a2d857568380263b25fb701e1fbad05620fe63c5f73edcfee32b0c5883092c9bc10bd2d2454b53099c6337ca31730f333c740ab95442137a056942930ba6bd4d60ee457cded35d7305a680b6b6269fef0fd5e102b36363eb78b85a4d2978f400eeea2f94a49aae0e1e3ffb5212281adff7ae772088f546c9b992b3f560d2595ce7aa11d83b03bd413289f83ada0a088c90684da1697a248b4483001a46556597d7886ca606c10392df2f17bf724ec18b668dd4f3c98495a6b6039f3a4e7491682b1fc09c9c4529a99099da8e8f690e42f6a99d962d8712a26a8f11b3fda275347eda9e1a6ff297cbe354a0f665db2759ad2608070a040414ee9fd835b88179933f3355adf66bc69043ea0ba5aa37b516069dc4d4f38e1264ceb0833e137426fae8d497c5c4134e8d3eb49b0ad0e1202eaf7b347e5e87a618676b831ba30cf5d20818d5006d8b8829305eaf945e79f109f448d771bf8347b6652b587ccbbe7ebf198a8ddc37271bdac542e9e0c754c01e61713e3daaf36fb5346a83d011fb2a28a9a432b7c58872487a0baa6e9023f5f293aec950857a969b51c395940a65709514f05431ad3213c8ab13919c3d4a0b1cf73c1958e36b44ef39a0fe57096ffa9af7f972c8329678f1e4f51ff84349880408b3ae9559480307789d3e87b38d1080df1a0eea1a282a4ac41aa61136a4f53e34afe9b44bb349aa8b02c6b48d4f6b0d16ec9925a889a039a50ed4658beecb22277b6b342f2f911eed9c375bfb2952965beba1f9821d6355144c2b73b78972564dc09373980f71fb1ca3f0ec819d7f92fa91a9d42b75fc13ae5d0bba4df7a35123fa03110ae554b594c4a3e4b53e4aa99f7911540905d2fbcfac05a7b3cba69926922a8afc43c1d4e27890e30a6e3c4096fc98e7af4f7083e4d399ca8d7824a4d2238a5fe0ad31ef923a6855f5bfccde9da6710d72d55d22aa4e48a13f8f85fab318a2fe4c743d5c00849acc1b9594fa00016a34282a018e7c8692ba5e744301560bf4e4c45b3cb0c9d19893c0a1fd196a97c50a03a005fdd816f8844eb8f45f175800a1bca4c8646abbf27b99479dc339d411eda9e9c3174969ea7d94e0127a839746c3a9f3590d4fae28b21a18df7dfa30e16d8f69d1514d1a0924d56c15da374447b910c977120522bbf5a7783aa02858b3e828a2a9425f81a51864cf86f49ee974008589aaf907b42ca4e5e847d04095fa0c0a16c350fd4b7ea6e78cde6016e16c188cd65d48e3cceb4e3a0b8f94df832447b848b803a2d1c67ec21694835be6908f7b12168815f7885038446a54519ae30997caefd0fcbf4cfe790f3204ca4371d3f4df5f1d1aae746955156095536796e04cffd35f475e52b490e94f3aee9280646e90af9e5e6c3ff815012aee3153b06a2c5a1af52f59782f9e1744bc255e5cdf6cd880727dbb6b6afc9a01b597f9dfe5da8c2f39211b4dcdf51baaff2af167a354096a4fe506675070328d81d3c46601cbe878a1a92e142e3a88fa8a6c16313ed8b5c56d20e7b437048d36e9914e034c75119fb543fc8baed2c1abd445172a205f703a80cde9e29d5dec86433cf108045a7a0cea6e2114fe52784763528ee2e65cab31f1286772d1b0e30425534804e8008438c7a416406b3dff45be10e7dc0f54c93454dcead5a2b203391660dd8a55fbe2abc372667e93f9d93f5b0cac75f9dc7cca12580e9b5ed5cf8d8ce20bf8eca107ee64557c5ff71a888cb0b267513458185bb0362d248490aa89ff436de0fa94567920c9c2450324afc6558e82fe4d5c3e71c4d3e111a28716a6f4216dd33e4a60c49f4bf2de568c9174c00d99cdb35d51a4b6dda4d3370da67ce1f8a63ff647b9692658687c5fd6e00076cc165ff4dff45d0c9fe2f9c0b8dc747f358187d0f0c2cf6c7bbdaf8d781e01e0368325905899134cb745e5cdfd2b15f2749a6b4cea0f7fc8224d087e04ade1a2c95aaef46ba25fed903837bd6f14da02125b2ac8a801f2cfe8a0f79fe102382511275cbf6dc2ab65d724602d731c4914ab4e76e29f5cb0ea3b43fd61b1dd7ded9a53cf5ff35c7e5be8a4ef8c9dc3eba0abdea019545232bda6c09a71eb720b72c17a773470e2512641344659638e2a4ca0a666db4b8500a097815f3ef272993b22f5d4fb8ae6bc5b7d5cf51258ed9d6f06101bb70987a339aa10ac276b518fdd3b70791395fc2861f9798c55e254bd8e68b63f2af2bc82ff3af901c9ba8167af7754c3fb16752de042347c829475f331250351a5bbb63857e6a510a464a4a948633d5630a0f4254ce3f83636e3a3d6ede771f3c5b8e73bda19af2935fe1ddd2e8b749042b9fbb71e5b4f49d15470e11b1cac85e97ec1f60c6061ec0ceb6f6bc85c9512bfc5fe4bbb149437e06b6faa5f20fd98bf71f8ff554777b987b11bedbc53395df6596e6bc9bc8180e2acf28b10b0ff9c8636eec04b3b5b1234e395db611bcbc284e8ee8fc09f71a5667dac1bd6392d11fc3205e154a8869693078fad6cf2b6f0e9f8d130264a0f25da61eec5162600997ff7e0cb183b84b730714bdc16949559a40dc8e561589482bd0e4d2f670404838ffd01f5fc50cfe48bd56cf0145de17d319c38280827bc3c9cb749a33f5fb360bac5ebea8794d2bf03886581ecdb25cc213891708153d0b3e81166d9159597c17ec6f12130543797462ec7f9e678ccd6d147874773599c992d81273970422c265a84c4328d2b691db21d06d0b7d3511de05d6c2554955a5cebaafd3cd5f1eaffbc93e786f486e1a2d5f794aec7676d11dcfec2828bb3a46f90e36b6bbd015ece3358bd971cf32bd7203303dcaba15b5305802cf7af210551bbcef43eac0ce2125d67b8fb5d0cc22b3f53d6e2cb1da64218a60dfd2569f793dab22a3e19812f5c79258c2c3b102f0f81de8069ac38f87f84c4d7fb94fae5b65c517fd28bea910d353689924dc9dcf4763792d9c58fac5bb8513d7b64507a29ef1167a489c5b1b5000f53d5fb76569aaaf370abbd8e5c7741ff81051a070f7ed176642c898f0be478145d6fcac216328e96bc67eab16352a01455212c8b2025c20507c301c2fa0bfbea08b84229b68c9f95d886e3955b6e61341c48226956af2f21c51098fe16ac09e50847e81991e96c7557911ea6cf2af3d368f2820e0d8b77612e8d959cec3530c9cea7230e42d963b9bc1f22721928d676ada8c1f5df3b494796a2be2be547eedcbe5e899443ed23e768796563e3e887926ce378cd264f0359bfe849179c54b2a269c692380f950b630f387e1899da95bb293b0cd08d2733fbecd6ed0c6bdc2abf5387c3662051a8d0f2f4c2ecb58f7f656507f4cc7e6469c2bfe70076fe4ea5880e0aa3ab00b38a95c606da7cb167a305a2e2d6fd64870322aba139c3ae3cb190ebd7a9733b2b0f45eb172b253803bf2055441a0ff9ff9eb0229ddf8f0626dd7e8f774b6b3a38c545f48e4b9293e4125a1ea43460893eaadfd +Digest: e8099071a601c3ddb10a38d9aaa5acd1e73dd7849a4dbbb1fd795ac456557260412b5aeb58a6d196592b0477a26b5139fc937a3b6f8f0d521f15bde18fae6401 +Test: Verify +Comment: length 40288 +Message: 28ecd1c37d4ecea2990f8e975c1e991a30d0375e471dd729250cb1e25f6cabeca2c57932f68e090344a01e2116eb3b149f68c2c4fb4e5d47b8899df89468e1c988967ada064b0c4a80c3374d29f0777eff6c497709b1909fdd8c364466cf16eae4471ae234eda01e526023431c93170059c3149ff9ad37d99efdc6ef5c0912f6bdbfa27209dc8d27c460282c773ee141b4576b6254a91c9d03c49320ff7e9d961ce85ab40c819b0edda98f30c3589fea180f96eba10f059113cae600d5977f7208a989cec542927ba524a076874917a28dd3dc606846bb60d6f506b768ba7f3189ea78e8bc88391525b9a2274b7812121c8b87ea32b606b0542e3d6c4050677ba793702b7abc59856451df6a984f57e2cc1fddb085c7ad2a965ed147e3c2fdfa6b8db7be8644ba726ad29d68f435b0b9a67827dbece17a75a36b0b71db760a53dcbe95ca688a248540262548ea92e33fb07cac92ec6c3339833f3312b0d65531030f5477a9f45f66ed33bf33ffcfb91df414b6fe0fd0a1203fc09151e849a83ae6683becd0ec32bc79e3b251bd52fafb7a298b46dc758cd0ded86c570d36c9168fb2915265d96730ed1c48c9ab846e8048a17494dbc4bcf1686e0e4ca607816e06d39fd0f023c46950c8c7c451cddc556866b90d9523f82ce669bd573c2398ea51b5ad8ffa311210aace786938960e22e25ea2db91fb09295fb3c2a056f2d6317a3e02b70a6d18cc0416a3e1e745ca8ebc73772657b5b88fdb3365507cdc03ec8958e86fa93ea04665889053e644d941008c7f1570b7cb0662d1ed8f3749e6c284eaa5df5e0c7025d50c86e8bef903e4b69003d1636b0a38fd75a4840da1485c75dc8230b14052125c8acfc8f6ce0f1fe4694b82b8383fcab307d058884cf1616316c78a2a400bb503eab11a1629c79994fe9f4ef88530678d6fba3230b2a97a577fbc14527566b5d1147507a774f1fbcd374760aabca6b59195aa3b8c3c384f5801a9f7b0472abbcff062b6301656ec98fc8ade5644695cc962e79b245065876e83d55acd1f1e6e0367c24f3977be15fc35b2f1858541053dbcbb798058f9cba1ee89662f630c77775fdbfc4afff11d01ca05c0bde7f658f48d6cfd29babdc2fa280d43607dba7d33c1f7e3ec16b6aeafa3cc7489d24ffcf6bb4351a6e07615801aa918e8d3f0293d765c2ca624d66d0fa94e346eae169a4b2f889a7f30ef6b3caca50d4dcf78239f65520001911a0428c2d529f6e311d9fcd283033d14ef6d34c7484c19d719126175238784c5471b02d7a77aa8d909620f8b7cb167f33dc37251dbfad3559a9e899015e8b7292859a6d10d500cf8c5dc8f41bacf8534a214fe34a64204b0c470219d724c222384671b964fd3aba90ff081de86831f41e608de56f14a33505f30308380da4e1c22ec6910b52a0c52ad46ef4928f5be81d1481ca1043ae89d3386bf2c88bbc27dcb919925877eb85d6885e06ae84fe95c2a7cc0fb263bacff0718d57fd11606ac47feb2bf0cf6353008555d290db6293abb4cd04ea17505dea4917a64a514a3135edabcc58dbb0d3555606d6ee15405834a5e5681bb0f7ea2d397b6c34add2018d8cec01f52f4c7d2174b1821aa51059fa05d597cbd319cb35ad29284099805257c81c4b5a3caec7115c1662ab1d5b1f785efe227ef05e97901ec15902a6ddba1139cd36fc8650379186860713e0792f1c1bcf86a98b0ec5d928a48cdf58528f465c6f23508ec9452e8e80ddf990f2ff61b6da32d015d2dc5d3573124b20877853aa82befad8828634dea765a0916106f5caaeb587332351a8ef8da7da81e4dbe5ae98585fd6046160f16a1cbd744bec24c1ad9d334578bc589184bc120ed34068d3209df419d76d2f513981b4cc0c059b36674868cf5b72c8d5d8bd662a0b3c59a2bbde5c0664000c88a6330aeb39e9a5936c559c53442b9616fa1a6b65d53644a7bab80c4e42d06502208f44544e1ef0630d235263bb3d3cff79818644c9a4965cbdb96933ec44d5584914e5b9c10bf81ffa500f63392e19d9d7513b39712ddb3c25310769d8d3d9f57052536e2b371934946a47e43684d94084281ed634388fb091dd7b529113ef5446d631f3f536f04b7bb070694bb7e7ce1074958dbb4b3074741d29809d7b921f3d0ef5edb77209cf00e13d54e16dc1dcfca533c24edc49d25c5e867666814e90b36b13bdda7ec229d47ae3598fecf3e7b9587e3697625864bb30369674ab91635a891fe6d6b3b60656cc26c9afdbfa98c6fcd94d0d83c8a60120ae735070e70182c77eeb54c751cf18736c37d9a1424ab610d96819a73700debe429f7277dbe5dcd4b54dad1021fe89ff282695e367880712f32a5443102f9457b77d6306dcaab90f57807834b31f3bddef185cf8e6db2a91bb0645edd06cc28b619faac465aab7f5da262e8b619bae8e258fa7782caea11b958e571e145309d7d568a226f3704a16c1a138aaca1e428e6feefde7b59cfb0f2715104a487cbaab878af1b52295ffe082743f1968f1a85d22c8d8ae2e00a8eac45cfa08e93455a4fc5901e56f7649f1a131aa3daac03088e2afc051d2842b3d01a88cc073347b22b8656b3e36bba8b8b24bf2ae2c048b8024063d796f920284739a410772d79bc32022862614b0aca41a35b0e1493909e17b6ea86b31a4cf4f7ea4af4464a827f4d832fb43860fb6526d815d5daec84c0b3d3bb9cde556d1fca75a201dc520b03654f9230d1723663210a16099b95cb28bfe0fba17e702bb2a721d5bea20dbb5160af7a5f924962cc19828531be540ede2425d51bfa3430b475370bb4fe433b7028eb0fc7e4ac28a9f8898bd6adf2f5e8c8ea6f94bc69212d1eff6b6959bb3268a34b78f230643001a565507fcf3727509577f1932bd7a92589c11e671c3e4942bb17de68dc3a21dc085efbb48cea4d1e721384a1af456ea59ec54c36ad942805579668af52f3a44209beb5fe4cd50e5846085045b07d18b445521b5c768576b95e113f51f85a603c90cba5e377be1308fb9c7c079645505b66b2b663ddd9db66bad08ad63836fed185cff4ed756e04357818306fca66bea1e92b43d34c570115521b72c4794e250ad010c9a4afad88e8a5c49606b2a8098eb606eb322ac88dce0e3a1fa5226b7eed59d74d8f8b4247286ae7d353b7d2d92ab68bd50adff42a97d674b8009d55b085096ba73672f7eafdafca12de41aed87ecf012ae2d3a37e7a9213665e51d464d7c6160021cd92196f5cb67930b902ac91eab211436e9d317e2a5d5046a6b042ed791e80d902dc7b8759f130d08597fd6bf0e4b3b418a9ecab869b9f4004b0f1ce0bcc4ee57b9db94c8ec360460f357415c7e037bd3991570a8f147ad4d39e1a82626893cd9e9d7ac7e476311bbea3b89659eec6e6391b19a22b120a8b7b406412683a761ad5a367fe4151cad6f9ab72f68c5588b88010da7c43db76ec645e788503892053877928fb8f9b54ff2a134a3e4a5fa4ba7637449ec0b8e780f7c2fde31d9fb9001be564c6b49df61fb8a4e7757a524375835afd1288f185cd9a339c349dc268a9fbb0c3659a9fd9bd0b26f2a304778c6f103fade085ce775db678fd816b3b55d78ea2efe227e824618b6112d0cf16a83283affd0e9d97e6b8b45ac7d16f52a9113c828d4445c20093a01df005c577be46467294a6ba93f964faa1a32d914e8ce06d1a4894db7395dcb221344acde1f731bf501cafc30bd9ebf215389cb97925cb8930c5d9d0440ac3293685a5cf9e7b7d58113a32a047add5037d2f26cf199d5af88daf1b0e7d88d16d248b20b4f471b1787c9836398f9ea894a32fd3bb771b1523f9ac637c66368ce6b3efc2622c0156865bdec3762bd4ee0f4de1ac65dbc885703b64b802473d7efcaa5993c28d55f3ec74b4e13f62762edb44ecb8b58ccc31481d81228867c42f18d3709cbc619210118fc0997c7eadf16050fa0094d44ea11465a8a9f60ff426a0f4dde439eee3365d76adf215c5a0be0638b08ae8f9765e3adc83563487f5ebfed648731f7e6eeb38f021f5f280781d35c6b8609b446def244aba302b17ee069841575258575bba0ac4c4a9fbf65c9655c0ba8a93fd5bdc3877f53fc1070700d8fdb588cac1d3283bbb4016197175b2ceef5d0eba6c68aee02adb8cdf9e6a5f25d1081d5f06febf339d3a443237eaf8081b4af6f6d9baec832d141e6e253caee686f91afd6d03065b325d3c2f91e4f16c0c294a318b7c1e884649fe54e4a87285e42f868e3d0a8519414e05f9c78b236089a11052cbd4cd593e22327b23d33569b35369f9bf3dc5d694b8a7762106184d5c5a5241e1ea805ddc46c4c92ae87efabb0ccc263bc24dfbf1412b90e77e589c4bfd17e615e7bffcea5ebb28400dd6a0c403b6fdf8c1a5ee2191982e601a69b31f326829aef3129e2e11207faf6ac4c395df2f6640635619ec51f638d503d5fc9fa04cf2f63502ab7208fab5bd29d0cbf7493f4959cfe7e319294d958e6024dd95f0cb2933d6168b7cea51b4b36f8220b2e9ef8e8c2ee0b372c0a62fd35adcc0c7c9edb6aefdd7a714602e63d967632a8e66461d21a8caf3bdbf08edec19870cffd4bb81afd3cb65041298aa7636fa5253694cde60642c0ac3cd7cb720c4ac2903b93c727e807c2e13a79771d307cffec8990aba918b8e604c930975b984d47f9b1f7872622b726b08c833a039006b97b69f8797fb44785d20b9b70ffd80867691ae7867a5fd3382ac1c7520ee495586e522cc5fe7b8736906e68e6e35e14a76ac0f433b8d1d49ddc74c64d73a0b15321dcbdff89d0f06ecc7c29778a8cea8e7b3eae1d463b33ce221ff08ae676e34022642ca4c6570ba4e2bf6d916a07029316fe65b1c6ee992fb81de6a8dbc993960c72e9541870316f7fa2a5c3163ee54bca8acb8f9f8e5d58fb090915d80b5acb3ca3746c14af2a24ffc0529af3a71b2f025e4005547cf8c0577be8504fce91662f506e7b3f862e6bff930477a6d21c936b0353c17a4d040c79c104f6c785efed711437ffed77d6badb853be78442524f40f4773275710783ce72df67b3b3bec79e596178c306bb8820215979307a648930bc3ad6da8b6bccc22be821b8fa968b03ba5b6444a5455a79f1ed9b1fdcbbf7c6c51f2d0dfea94df136afc33bad0fbe4d91b640e6f5fcb8257178cbc6fbd1016fa984b3b43d689dd84da6bab05d72c7d889e29d2e5b4a17df2a8b99ba5a3c3c87d41bf931d9f222f3bb6d76bb8e784e310d60e78f57c5fff37786736e7a660fcbcf357c1b570e83b00a5495a1b278a7f396d1ae9e7df8e6fef309e757dee701980571aad536f626a9d4fc76276c0c6b7cb08560b0304b537e2776640aea27b879115103f3fc41824d85d5c6a10d9c0f48d52c8c791145cbed8f6c87fc4eb07adb7d44160c09892d27b770d5b329b019f48f07a06d8360b6c9955cb1a05f09ef5ba3cb6f6201359da4c44e41b242e101ec48d74ae21934ba9ec3b78f9badac7c661f676eaa55cf4a6146de8932eb975dbc9cfbca8b452a3dd9b50d5052ad00b8875aa8925989ceb9c9a9921ab9864b93c1f5e5cddd99d9c706c3ded249ffbf0a4bffff88e41fac726a871984ca95963ab8de35c34d899bccb28aac53f5f820080049eca0ce79f0eab049d545caabdfb8fdd06c294f8708e54973e673fb38ec3850f2f0789d3b24b9377c45dc4e3bb0950d56e98e7824a977480a2da0ae347c01ba759b7ec4e5c0345c98ebc6d9c7816563ec4e614be4e6193ac7e268a37d47fab93c4e31d9ec5c02bc2a5783e1d1fa908dfafb203f4a5731ae47954a5f75e889b9c1993030b1409ac2aae991eadd64bd082d8069c6c76556fee3b6a456a0c64558a00cd88df726730c85428f796c58315ede6e9c76dea90fc926d7351d9079a3f25209b936006611f653c2cb01e16d940e982646c4129ab289ab774b18c76b2c33422040dd8f97fe2c911ad318eeed5b73e547d732e5a2e5accc0774dcb82344881ad11dc8d7249dfbc79b4622e7800e3b4033ec47da6a1fcf231830dde53a936d26ac8e9c89a487f061c472b45d9e12c1338af4776348d75d2b1a1d90c1099f4f001331cd098032a6ea471741d3c01fb229ad7e5602d7a2d35e9d8999fe28aeca3195a5def950249beb63725fcc7e6b6aad2be8485b8ee8ce2803035ddf00685b25a43956bb9ce42bcfda3262ba21ac773876c0d2bfe73faa31fb1950f639427e76ef8aa8d2bee7f311ebc5ff2f625944562ea699b2690df3e6e64a17c62bd3a08fa81869d14ea66e4c48ab898eb8d87e80b3f7e1d59cea37c1450426e160726dea9e40fe39b4b619f95161a67a8dc0623297336f8bfb3ae25ba7d5e2ba6fc5431202b2fa6e998d72839676ba556997bc0648f78767fc9680107f4defc3b242ac90a5ecd30255930485985959b1c4d4d8566992bddc2983ad7a4bcab29fd06116d0d83d1c77817d3c79d797e91237fe43bd49c3976afa78a7138ddabfa132a72e7d1a422b40a582a6dac4a10ce92b7a8aa599d89896f7ec1956c60c8b7a618b3fdffc8aa3f02a79c022f00319c927e01999ba6035e29a5480ce84ce9a7dd593e783ff850af8989914dcda4cb414b5a57d142be8f3c06a5859e53a9f613e174791f383bfc4ec68871172f3dc506e4d6121bf7ee156d2e04e2125680d643d9f1cebc93999662e22ba528fcd3073386779a3d623d7d37c84dc63298d8737fee59a415f71a073404fa9348dd6f791058c757ff2ab3afe3fc0599c4c2b9b40f483262f40dc7350c557ea43f7a1703e5834db22bf75894b8f4b6c2917b2b813a0e07721f7da70932fd3e40d47ad68df92e91118773351200d5e7ab616c37c24a695d3b5eeec26bed23c3d0d186b1ff95821cdddd44511201ca21bbfc3ce45f8580be257b09214486ef93bafc45b24101a7757ff312b47d05f8eb5a29943b41347cb1983c75cb7a458a38681d60e03b85c4245d91866739528acdf0b21c424e9e84bffc6bdac8f7721c3a40fe7e43d66901b2e18147713030a64fe55d7b036f0dc16eb9cee221a155cc1fac6648e4f8f487a6728afeda48e975faa2f35a868dc75a49372e33dd6236c371131c65ca8a6f7e88777353ab6bc41e +Digest: ad4ad693a48dd376583606a71cee92038efb868c88f04cd4b075b7593b1b49a19640b60760f0a02cc04ce4ea536ce803cf77711197d6ded86d7508826349787a +Test: Verify +Comment: length 40872 +Message: 8b71d263c8be194537723e4feb1e2035dab38002ee42b40258059fdf28a3e00a1ab04a5cb37394fe8ded5286f0162462a16a2e7affa4c8114bca76ec48691ab7042268a4f5659b55477d66fc75cd2ec117597664fb889b237628c1defcb20d79efcf1582b51c94130d2a63faa3caa418e287400709739500812768fb6e05211784c0373d1b1fe90086fd2fc8a195f030aafc75ac52ef1e6f13cf538cc3eabe5b6afcb71e51f600e45bfdb3ae98b678d118c1fb9bfd839e39d4296bd826e94c0b498b7e6d7c2943873433d7f4b0b5a6c2d3ddbc1c33b87d266e3c9629bd8b33f0cb767372c74018b1b7a584e1101be1cd84589f771c1423fe8610bdc5b057dbd296c47d7458c4e9298f5da0bee17090b8d33b8bf3df21f889c7aec9f528d6ad79527d86bd573d1db8626314d34a3a1d4c678d6ad9a567658fd61da0014d8e0faca8aa7593ed311c26d9bdc9687403ef51e9562371956dd0d75e652c3146096a353f52323f422a4e3b9b75a6c587526e8f009e9e03d8bba22a058f53cd3ccf27dac17da4087daf1bbe51939232aab002ce556ec3d795d9445073a2ff1c5666ac64d333b538c649eb79a21d77f605a413d590cd7a35f5501c1151a61767bd58639a1f7d4c16477e2632371d3c5ac1b6096d58c4ab6420a6943547a483f6982db2464d6251e925d934b2b79ac9a6066e4c5e555a3ead3d661383fca22b11106b032e05ebadfa8bdf7dc1cb9d0622fb55447030971b58741500c419abf7004d9cbd1bee1f46919f1a6a261b2ddb15c9f25a6a91832aadef3dc5c045c4cf0a764748d6b00605f5891161ab4e5230c997cdf4161f2754f3d365c93f29f79b79b3f50c24f4a8d270724ccb160c14ed848e6f7c3a838a7f744b1674096d4b43932e2d71d0620e964882541130ff7cfa8fd65f589f65b494767cd72ee5b8c9afa10c77dfa0a13f37c6e0b099c1cd913f329625f20d6bae7c4291305f9db277c7ea785bbe5e5a439f32b5e8cd911e5ca4b4f74ab04c407f1d20b0a96ff7045f74b8986276d03423b4d4288514679be3125f2055fc238a2f615702cbc7bc56899c5194136fbfd8e660f3620ed50deb306f7939ce3d5bf2c72f31ae1dcdb44ffb28fe95f711f2ed948ad98a0b7a49b74ba54b6c3edabc1f4e6ef4dc28eaa698bf0107c394c5331c361accc9046ae4a73a9a1ddf2c3d0ebacc08e9b672865bd9dd0db44575f1480dd2f71547820da662073837ba20cd196a4ae45861850a9cb95b364d441ffffa67730bfc2b0ccb5691ba65e026a2f2a5d8ceea8908e9dc2fe0436319e71c5511d21e3dc89e2b0cbedb590b614b3b1479ab6302c3d12466dcf79d7c6157f25d55f8dd75c3c76638a4e9ee110250729b5e8c0e1450e4c00f6da66f686dbb2c7d8e7eb79b33cf45b7d162805f0b5dd0f01c23d908766a453ea894c311853c4f1f830fb59861dd50f10def18ddc49cdc797b17cbc67e8b395d576aa05ef102e5aafd51dd52951a104f1f38bd7375331e9f4311ec37b06e26d340cf0f37f8347686c4ec39b217ad0c37d1e47709654a1eca3bb84541533c93082c6c1684e4fa881aa089d1a02ebfcc12e99c4e87dd0a65632cb5ddcdb11c0964e2e9c02dfb7da5d059d0ab052378d94930074bd5259a7ad0deafbdc410370f4f2ced121b86e5540fb668d1c73effba426ece75db8523e57b194feb0cb9b52d31d0201634cc5a1e4080fa4bd0c77df7676b98d58245cd2fcaa53d718ff4bdeb72972bd361170389c97f2d1f060619191fee0e71b0acbfdf27492057330877d27a49b6518bad081f137baa575343fca7d1c1d8534e03227df9cea0a3e23f0c69b1ae689998d79268863c18fb9ec54d29e7aa9d8345921d91a8fd665f83dfa438808deab272ddc9eb8a892011cfd53528c87205077ba1d9a49c9c1a92fe3166c84db0e3a4ff07d430882c6aa3cdbbdc2bdce1bae9da787e3d3c7364453b7d7ba081ddfc78299ddbbfe6eb9db882bf69ba8bbe6131495f33e5f24cea7f210b0b4985dddd35d6e608210e8f6159d529055d3dd3a5e5af9d202326ed57489a223d49c0782de3f02b81dd66e0608dae40d79d5ae62b0ff67b6e7f3e1f51a88e0b392a9975958b5eb46e7b58a53f5cf54d08014ac09eb605414581a3aa80a8e30f28737a9ebc3308c9f8834ba8a9ce9298bf127529a4e3c437ccb2bd568e4f827432adcab94be6d6b2477ea7af44ec6e69255644e8e59d1ba42c99f4eb20a653827e5ff08fe9a9b0b682f4d383b8bd6f0862571dc70becf2d28cbfb130e1b33e83351156e83f867e1fd16b39ecae497ebc9d9d698cbbd8310715aa5aee76802cbd7e4c638cf48428335d6d40b1ce9984cffeae91009f6ac08cefe459ed8a15037982967f42b1ab963b4e81509cbfb46787ae14fbeb5fa987a941f514f5c378adff687a12d31e04b17ecc30d1732aa2112dd5571115a39e6fa53363f5cec9b31097597d8408e2965f46fe002bffb66c68089afd3a45124f5ecaefb8623f45ce16897d293ea7a66a89d90c7bc7080c1956622690dd4554c63d5e9a7bc512dfcfa61cfb05a678118618801f290b56d3b1c281a19864db120bf5aa5f35850d3ec0a79afc992545ccf4f2835f9160b0b43d93ae329b36d0f4246cf6646d0af90ba80349a76e24d47ebc012af33b2fdf57c4b3310123bbeba11b8c8ad1abbc9ded90a172250b09eed0e42bbd03afdeac634e095237b75bf6c2f83cadcf7803c38d7f695c9df83d5b6a765a83b976d7dc81e47d59fce07eb7fec163a8865a4731927d435138be29e3f37975c53b17803a588cf78d77248cf8fe80ebc31ddbf0b0a59317971ee4344e14f664cbb11a438d91505f38d10eed7f693cbb46bc8366086ec7cd7776f2c56374f40fdd4408879cd3389da031230914e8febb798dd9110194234d39687146ebbc7b5e431b67b330c74b9a0dc0ed498123cdd3a4b5655a63c0af7f251ee81eaf9394394460c2311114913cc9a6f3138dc1b1eb0e5fafa7f599724c83bddfb574a245882a389e680763126c1b0abdd0ff6bb2eb00b1406180c8749a9a70de73059098333bcd85c0da5cd7134a14d4e9a0c8d9bbc2d39ff1ccf4bd53b35d6ec029069522c047fea151a6e7179feebfc438812d449cee54bda1c6565d16ac1604a7ac433d00ce927336ea4a6262bd06cb8f3db66cd62ae82fc7e646a20b865fa74829aa6d4588c79e4fcf09dadbac32656ca57d1cb7aee2ae05fb9508da13d011d426d298d5a0288a65fe2b6951e0caf99860893d88a3caa125ad4b79ca7af1aa134ac4a7f93c3aa03f1eb8f60e8456f1dc17e3b592302972eda671dc24e44adbcc3e8783f9858746a7d8b96858be5eb4fe72916e1a7e8588268b0f183178640ac9a923121da296e563d435a978b66baac6189d4e6bb5694b98072b17365fc6a1d034a13eadbbefe63cb934a0b696043bfeb20e3fccfc5a230ac0cfc07ec0f806aa8708eef0fa1baffa30be355983b2cf6ce7ed28847be278455e02fb50c483a31f49600a2f85a1aa65e0dc50aba7fcceda6041f0dc5b88b2128acdb0f392eedef622b179b284093e447295d9f22a6aa00ec512811cc4d43937ec36c7b054c121f9bc0425c120dcd2618df2b8773484add0bd69c28cdd4f767c2b4829cf2f85d3eebc60f5a480a0d082daf9d682ebd35eeaf04d9b73cf80cfabef08bc984dc15b9ecdced1a2cee09f7000b4195a7ade192207c6f41bc1f0ad8ae2806952d6fd23d19555a1052f21a7f3a82b6a49072d4742aadcb5cadc2579e3aab71947f2c1924ebcfd4d13cded50d27a65b295bb4951108098c7c948a9997cefb5b2bdc79610dfebcebe15d0cb02d71d6ad787bdb99d55320110602c04771d5a831dfd8003054acad1da52604425c83a42c367360595d8671f79d6b0bc79909228434f4391d958000d8a14a3df216e78f65c7d4db6a063c8fbea75fe5b099c40ac0bfa38c6f5d1368ab7a1c4245e91808c8c102b5325bcfd9c4c833b698e080c185c48892dbf7d13514743e99b45f9f90f396af7648eacad0b8549926c709d9d73207f5b4ba0244069243f3bcd3c6d8c844dd1da7242fb804e7f0f29ee16239cc53ee8d9aa018d64da34e0e141acb7e1f5af8efc04a971206f201d2876ea62b0169ecb28d1488128ad616d037ffe9d9f6947e984a22bd6327552bab88d5321826f28707348dfc834e9912dcb1098e86fe9fd299ad430f16169fc2f01b9b92abad7c41ee0982c2a2f96ae695f7be460f87cb9986823208b525206c52a858443ff575a1f9748996fc1bd9f6ae74848cce32a637c1316636cb03857c15b761d35f9f6d2b9c1e08c5e93654c758c002ef5d7fbe31ec636615c2124d96ebe16eac751bc143586e86fc04d969dd5752afda47df821c6a70983234d1c731378ec54c3afb108db0de9a95d97587ad0cc4e1d9f7d2806bcde192f88de2b0df7b480c4efbade97f27f6ba2fd17b4cbb0b6f4f6ae7e94784794eece5579569063985ba0151b4aa7c403f4c26878b178bb5da5f09b284260b0f10ec950c8a7e29f4c0451fb7afd2197c20e71656058693ae9e8732d243ca7401c0386427325ecf3f903406a7d00eeb4e44017be78b087748246e72b1a8a333c3e556ff222d896a7c7e1d429cf5af46390121c3967c1b8b34e46b45eb132eeef7e8aeb2a7cc9c902dd25740216131debee0de89fd593e53d7870428e923ebfa0052c61b029ff6b4d64578abbfb34509627b8e3b76c2ff75c264cf98265b58d96fac33b4dd28265d183007d1d25c475aa639c764bd19cd45581634204d1a0421a86d5e0c91f5ba0d363a7b5f03dcb7370c93f0721afe26673b03c83da7e06c574d1ecb8ecb791039e2bd49afcea523430822b0003ac0a93fddb5f25cd15effeec028f2b7e432c7579040f9408d55f9f32b5e8c7b7701a453a2c5591a53e64d5ca4247a1466a35e0ab16e10bdea5fd9cbd8bfcc605a41d6373c9a52e2aa06b3255b89a820dd5b32b7d88d167440331131a2cf163b7f018d5f1dad76324e40ffdd68d12369b2bae3e37836810039705ec92bf4f0893fb1583f988749a5ab1551e95e83725b8152f01212e2c6ee308800f6b6d9c1c636e1b55d6fa033a95b0477ddaf290b82c3b3c5c82b2a7e9abffaa65ed5d6207edf03333ce5a0cab9d89ec03edd2a555be44e037a43661ea25238cd462b82830fa2a64052bcd17543ae34c9615b1fe6638d9207acde3e1d7171d2d4510a5770151c4b6b3337dad9f3466701f9cb7245160a1060d46e1af1a4a9496a1404dd6e1bc6531252f9255f352bb5f87c80b9e80ff4599d8575753198631cdce3bd7cd3801b5de43663498b85d8a21b4e2d6f459dc6ce1c3476d553e929cdcb6466ce46fe95ec4f62289fd571e7abf90313faf46c1bfe7b7604d3ef0387cca3fac34a4ec3c05eb24a9bc0c365a344002ff6f56ad74e5b29ae81c96963e79a053b3569418c2555cb645f34dbedc60acf1928e71f8be874a562805e39a6d3c65d9a5fb3d5b42f31e953b5649576ba50c4734c3888e674db8d1682eaf638d6d21b9c84a251e868a39a7d60f876aceab67eb2a3624d737de03f5f0bf815966b4dddb656cd6c754c0b6d65d438f5dce1bc5c5bf10cc3bf6e333a807e1e2e4bfb7a027c388d8c0753d9c09171dea9a339d2ebd3a7909226b0351d4f6bb596c622172852cc7b16fb1aaf3284dc21f87c5d8abbbe29862f45fe7646006776e5915985bdde651eb3ecfafc41a485db68e4b7543a701965f199a3774347c3aa913a1c464173a4d0d9499f316c94d1438168f1bff69dd9a88fae49a8a38a32f9302ce4f941b70e3a0d8d51ff11ca70f2c865773e5e9becd66fd05b8ac54c27bb38f63def4d1d03d2b744cda5dfb9c771a486c250010ee57808bc43ae570204991202a1c8a21a28036cfc6cd634e76748ac396d855c4b45f5e0deac83a7406bfb61fe9ae60f42dd74a510ba00afd7b2d055f9c34eeee570d89e93f09b548bc05a9f2693f7e30ba68ee62e2fa5bf1f4cb128448e3d277208a88898ba65dd48a44f2037275eabf915baa6a14835c1028753a9a608a094557fee35396463a01b8a41ab8ccf8ae87fad906d16ae4174361540409add49c42449123b1289255b58d4ca87b3e71d2723d0a8bffa9c59473e590f83af76692542e69cf0a0832b5d9526524b391885c67a115c05d9ccdda86fe509e9306ebf3655fb16fc5ffcd6256501617c78de4564d6f222d510aa5f166f1bc7f7da109c75c1d8f8c4cd50b6512cc880821fa2ec70ef05b5b44baf5e1f909fe226192681721b12bad065296c5f711e27f28a00db89169e6d19f7564b2298d3b0fa59fb1ea9c63ae5a5b3d138aec664d0444472a30be25eb17c8039a6ddcc49ecfb3918c49b57a401bb3602dbdd812f120ddb62c377d6b93b6292c401afcf74ce9f12fa03b5440087976818a65a55ef55a5bb6bcd5b682053528b8febf706f70e5c94396c861fb2ffb0c69d28a3a92823b270f821351b36a1c2f6e7b662071304ca29315f8c4f4dc2adee0ae347ff6bf4aa78925f83646eaf4a5176016f448b4a5e3e9c6d46573388c52aec66c5cd1d50f44eb4e8d4e83ac44f27b54d8d43b2578f60b51632cbf6babd19ac139b96deb1266ffa4d97fb1d9947d6200b3a891ab4e42c15dae02229c0fc46d47a47e102adc768bd0e4b21a986db0940baf58936dad2fd592bbcde2f43e91ef02b49303baf4da5879b6d0041255f2d81ed4cc899420250d9a9477489ac2a2e89771e08ec2e2fc2e4858bfb86fd6acf8e12bedbb472c8c331a41e69cb6235d20b1e34ef86a2f43d5e5d1697ed67844bafbbba170af5bcc0dbdc8042672e72c5ff613c38bdc621614f729b49d6fc223e7158cd1f1f4344d642833b72df498766c0e08288d3d03dfb426688a5f633cb147d6a766873d3f78ff068ae9fb64bda210a2ca6647b89a057e1c97d20ada6e56a1e7134678b205b3a8fdd381d6ebdf1a135a62630172b0f0377ebe74e7fbe17bbeefd85b0c7d0d6725b5186707b185453dddd7090396cc07aaf7e3573eef1c866797ff8b8dc3dffd3fd86083d6dd378b55d4313f944a77b49e2d106557dea7e162878fc041af04dbbe0bb4bd8a977e5425e679ecfdb6385fdac84c8579ef0bf2776690e17266036b6af81bfd6d09e00873bcb6fa8704976e2771a09fee4acf2370dd0bd6661364140b479d2bc558e70f08fdf05077591c4a4dd0129cfc18 +Digest: c8a18102102e8a3d20e39dbb06fd913298b78e4a092de4874e615d9053827534810805b48c0fa0e27aead8dc4075fb0cb228f1df9285f343c2245350d0f140bb +Test: Verify +Comment: length 41456 +Message: bbee5397245f3a731539e21892c18d8e11e681d12d215dd49e9facc569a2bb935425a8ae9dbfbc0eebc9fa7685c3f8fac2f4eebfc1510d0259a0125b53dd1a43d7ddb8d5253145d1864d77e681ea353151a8aa0197f899dd4d39f0c8fb219fc32d5faa94247e7dc6cc0d81f1eefdec3ba74add1f19dea86d60b26e92c736f21a3cf3a773026e0ef4a6503e1d34c5c421aa22aea1adcae3bb7b52b64321e3ba50eee0d7fb27c99d63fc60d9f5bb0a66ea44774610bd85f1ce8762ed6270f19f6e2a7061b3fc57d51cb78378feec937a9e5c93cdf4b0d87cae6a2a3e781c294b7bd7e96e23e7e05b26bd0244c22d2aa746dabc6ad3ee8829640ef2cf0c8d50637fdf9425d4512bda89f82564c8e79595e8a53b4537df60a2f75902c8a62a31928329b9af4da301f84e4f330098839ded8fa75887a7eb278f6f35a152cf5d937e8d9da03316432a5d7ca97642bb670a5740c75a58ac7aa497d58919950d8e3dcfa82390dab89b6eb21bf03450b8fda47a05ed8bdfcdf4a063303db0b8eb23f82ed9a3d3ccba11959f340bb65217ac33ffe501314592c1e39b8838afe3ee858c432a05af30a40f66cbcde2447161db7e8de9ec95b1834935e6e5645e40a01cc1b5a2316d2efffcaadff15d25d41df44ecd1794ff4c29f45eec50a804f488505f2c491054f052402982a564a3a5d35e6b6779e2b63e0b2b2556d0ecea2a2e8a2d522888ae9b2543ab5df3df04090b819d0217be04aeb15454cc6e1859081b30f4cc4682c15a016cf818e2b6912a4ec5ac46f7112fc4a4d9b1f5311597b6d6ac7c45ace7d7536c25d75a7ad1923023925fdd23c180aa6b20057a21c9ec5de7648d63609d36aef0d612cbc4184f4313507f6ca3b83f858e931702461da225d7c2efce6c8e269415e56f14c7740f89a567d49e7ddcb4809698b136a9f900352d2c692fd7a0f12d62bbb7dd8ccb1c2d613f2618bb1727c00a9999be51464db6710cc52eaabddea05fc0b1cd1907bc55cf403d856550df7072fd984146ead2cf2cc9c972eccc3416945c278d780e382a78d3e18b816f25b6572c766891cfd7a9e5cb3ea4a5b53cb68af8dfc5b1cad8d3e35ed9d2195b41ba3f8efbda39dba36b247aeb6bde603ea9c8faa31cca21e378984bee0334fe7ba5b58bef3f46f8803e713e9a709eb58116d6cc393acdfda3432000e8c6db3f1a9f3e8b1941c10db44a557f115bed9c4f263dd469c8c1455e5a02e78fc2150668cf64f64286b10288b657a519d3d3fdee00847cfd6eafe15de5c666aaa0ea3bab5eae3432b61ebf44ab00187a8059c0a7ce332bbbd39eb8e80df5e7030762c72c74a4adb17a102b3050d640fc0b86cdc2b5d3486da096b446f916d160a086903337cfc9877a903094ce6386671c630c87dfeb3dd97ca0bcc1d3b18c8a135d7f08d2b6f17b5da5b5b74c2f50825af6653e740371c810c2b99fc04e804907ef7cf26be28b57cb58a3e2f3c007166e49c12e9ba34c0104069129ea7615642545703a2bd901e16eb0e05deba014ebff6406a07d54364eff742da779b0b3a5146641293925b9e2ebb555705b57ddc9b64d1edc429d9775a91375619585c2d27c5ad905be4d1d21ed6fea636b6bcc783b0eef2a1107d73fabeb519e647caab4072a1e16e1da93681ae7887d456648bf35af63d212195e74ad04aaa8111dd3135bddfaa6cb53857d1a2415070ed0b8684d36611b6f5b95dc566766c5c2f0a5b7207b54fba3405a29962e7a49f12f86392aadd04f4d55e23e4f1b6f3ea07e8967ff0d135e922a7a34360ea08b140d19fb751b9ab4d790ae643f28ab5bd24ee5ed9f9a2117c0984d66a1cb6e159ff1d975d589a69232936214cf97046380e8220faa2a656e54123b87806dcb2ebb642e71f3fedc3389e66417a76f61a0d4d5a996c5c6c7ab7620ac5e7afda12090ed80b5768224de02121e356eb8a958f49ce1499a742f15504b08b43881d7314514370b071d66dac59ef635cd7ac6d408c531f2d13e85f5071ab751610455aa0261bb394ed88a70fb1256e16bbe9f5c39d90357122cb193c61621fd9e8b03d3f15d7507f2ba78e8ccf7a5fff18b1c37ae5fbe4204459c37b3c5ae809720c9f3378fcb3f9ccc198a5fd34b5806ea25af91dfc9794f912c29f6b1c7a1f3ca8f53ff7f26a7f315539ddd31b0b453e2a20a07e18ec49c184ab0b862d2295b923d3c6fb6ef09a09d0f6b6d963cdb7f7b7b913aee74ed93e3df16215f39e1767ebbf4afbb8c2b4a6c363a388c579433bd998c528de3badbf9d1a15830628eed99f1c3e81667d59a8bae53669a69a817b1e243764743f51d620a9a865db7fb67e8c7f34250e6d1370161fe1e49dae0d25e3ffdcfa3fd6400277049d26e9eef8d7526cbe4f073e6cbd63583881f12020dcd9804852977d02d4fedf565ec81310747f492f77e75dbfb121429cda679d66f04d69ebf611a004be268e7665fc78a7c661b91a283547971bee53915667726a10ddf14a5d44ebe03e9c868fe4dd8c294db81100e867788d5e290fb87e675b84af09dae61097cd0fd6af7be55401ca1f8ad1056620f48d0ce84fcb74caed95513b3f7b318880affe070dc3192bffbef50e4aeadc7a62e1805ae13b58b460dc5a460d46df5da621354005f0bde53dd734389455b65d4912a2267bc3c6d3777d0a4fe1e221d86ead40324689260822af67aa2bca96320d9ccccb8df961a07813ebc96bc1bbb140c0a92e3df1041d74a409d3afbdfea136fc7aba76509b94192d6932f96a0f50d2f7cac46accba8d7a5195356ea452133b9e2683f34de736a1161d2d194f8f3f8baf3f753b80cbe0ca34944007123310b20e7ab85355d6f0c68a820849e6dde5d17371b14e91aaafdad97193f78c041200d9c1b8350cdd6aefe7026519c45dec4ad10c191283f953229cc7a1ce7657afce6cb61406e78cfd93b848b3f76c91ab6e44691d15ec1a73481b00e9da65a0426143a25c475a4831487abf8571441bbba24a032dc71e9078a1b0b7ecd9de7062600b20e184f9a19e74aac15a05ef5e859d5e74dba4bffdebc61a571b1b554a88511fac443e2a2badaec5089223d2cca1a5fe38974d24b5353b9469053d4e814caaedcf04d18038e76d55ffde5973089852b5c8f10f0148fd68db583bae3ec6f7d411e3a3fd707bc426ea118f256474c229f1a06998ca4bacd44bbf1eecba8e4263189492009f46dc71ddd835060ba3b7a24e497148d41fbc0462083f87264984ee6e5c6f89513c88b4bdde5079fd180142384ea8bdd347a38fbace0dfc268b67cc8fa58cf63acf6186167e720f9d3407802c0a60563c560bdcb26b0aba2fb64393f8fa8ae5b071ef6c54431a2580aa62f2b61738b073bd5d51e589d64f967ca0cb36e5d9c656b69abe13c6a95a3bcd7c0042ffb24b1e0000a5c084d13b1f2127d8c5d20a26922ffc11c163a01c232feb3f7f1e3d849fa0ae3edff68c0b1e56114322599c74f7207c0dd9c4bef9cb441916a71d6afb7d21ae839059771e188e25a0d8e6f13ffa4a92e8e9442661b89c8e1c7757ab2e3b059a2a9e282302922bad6855f4b8e61ff0f9596c7ca6f26fbbc2b75c677e8b6dbef98a35dd00471fd14110362d4415ecd5e7c5dfd8911a55045f8dc2c765a169d0352903f29f6a15f1691ed5db333dc54c16c4bfd275481d18ace646e1f0eec3cbd59d950370ca191e8e0ad198f6cc4de5eecc8914d40a0c6b4387556190e21014634e4589f5059dbb386a95e11f5ffb15d843c7fa3deeb77eabb77aa0d629b34c66b1b1f0ccab2849f094bf3e1d57415e7bc0f90d0354a2b55e1d233a210441d6487e56c248192d6d3f3faa2a6140a54241da98c7d4da62c1d31eeb981220304490fa9098f7de31778cb1d3108bbabb53b2e723b512fe5c069333404519fbf309d8bd1bcf6c68b90b51a1e69b1d13e7f5477d365f5e2f13061700adbbb9062ea8784c44e01657489b3676412465eaafb998132d1106eb0c42f6fd90767fcd37a2f81ea8757618449993a57f4726bd97130d3f8484bdc0cc3f8b80a51fcebfa28be0aab2ea1c2a51a901b5fd6dbfeb22841f68e924e33ec77e7d4037e2366bf3c5ca76f0d8690be42c093e48229221d6af5705a77c07b3726214a2e5983730afd30e19eeaafd4b60a50294ebe05dc027d73cbc6bf49bdd719d1a2f2a9c51dc3b4633fa08ec39677ba69660553173649aae48e39319200b3981d65b6359069d2a91c4addc16bdce89a32d171090637db3970421b96434cb3ea2d1ae4c68d611f248488be4a4fb0f1f2d4f2fba77ae79e723e6ed3b604a9bf592a49e324630c936dc383a9f316197a09765109f71d4f7b9d779acb597b20bf2b3c7b1b17bb7214cb00c3078269206b28417705bf94765a01424f6a4753b89ba98a36f4673d9c8b8864ce41c0efcbac975deb55c88a6524e7c8131847327a3b1b3d05d6db9091e1ea162ebd755124269ef13563daa522bf9731713d23c16c88c97c6d293d5d59fc3a3e6be5693633bf8525de95bd8db71559a4ee41a1a79868fa70f855534bfdc6bf060b206347ff6093226d5538eb2b0d7549148d8a8c06c4f8412dc2e6038426c39498d52d2c90f211106a0a1467878e32496a87a51abd85091694d8bd2cf6038c109a6e8d8cee5b47175d1b19a8d282dacc7898bcf7c5917617b600a26f5c4763a397524c0f22857d5dcff20f5714d0b3f9c72895cb26d2876e1aa05b74bdd9907519e9325e3356fb0d48f6be1b566006f9dea0fa3fe82f83404922b1e221a15bada79b062129b8084d4e8fee9d9f1a1af44566b1fa148fb4b8c9ec6c6290870c73cad092ff0c92ee456b256685f7e6391185e482a5b2dc60fb2468549b1373eaf108f09ca1e5cbf31f2620ef7a66aca978258137e8c8fdd034e1fc3036b14d3e4cec63edafbb4d600007e95124f554b352ada4966a60da4c898912cada73fd50affb914dd097ff7d1297e6542cabc69fc7a6b769d4815b1b22a311e8305f6b6840bfe383ac80c9917d5d80bf3a91eab5fe972176cd34688728b76153df8080ce27bfbf59ec7e93e669e21f5cf5ada83d20084a86fe80e9d6c34e6ad390db22c98d838e95389945c2fdac2cf10609e97e54819a600f6dc6511aef9330eb7a3aa39a94b90037dac86e61450d4714ad93c1c38b79cea703e740562246319764b1a27579a66292480232be352c26c89f904e94ad4f966e4b34eb9e6feb9f3da16d0f47babf83f1ecdc553c02f056cae9c66df07084810e4c96991b5fe842843a583237e06b2afacc3e210236c09ec1931f66ff5b80572c0ef394f579a6e2153659526e72112158f211dc395806c756a38280e8f6abe0739a352253458d47979d57b813f81b2eb1663bcf08f1299a3023d604d4c96ee388f7428c5d4c0638b3773cad4ffaf01aae2ea642988891dcf81a053aea5d2f2a162d041a3d15777f11cdef774a01f8acf654387c10a5a6585591f66a5339577bc3456113182949e258a6585e2b949bae32e0dbc799d1cfd5f08f91dc36e54f9f374643c1190ee52a310b5fac1b3c41e609d876695b92771a701cbed8bcea7e5e1b38916a654eb11f4303eca74180521e2446f1ab7d7303f07e4065a50dcf4b7f17243357277117883796e799c6e8361c2a3134d528f9dc1fc2046e8c501c20ccd21110d085fd7e2eb4cc38c8d1fc55a9c4a2262f83ae6a6fe36fc1d5ae5a640bf507121ca77c4eda63aec77d8b45188c9aa0b101b71915a88a8a47c84e107e05270e2085b675ee52eb437cff1b4ae58f5333bc92ebc246915e5ce6ac59c6d882112f2251da71c85ef6944098aa9325789763302b483263f308ed87cbf604d94a5b7101c93af743c829a7f98e60a941101039f314f6f0d6962f45136b4e53e924acdda335ff8fc7572e86912a64139f1f64bcee951c8405427c6d70d5883a70d9ac79f1dd50c1bcd2ad39eeb4df59a96d3bf509f6e2775abf966c8851cd42d632044fd30856168b024dc6fa74f804c6c13eea2d7e71503bd4274a412645f184f45c67320039159aafb7379bb1d89b5de414a54076f197124bd40f859e17d2e0ea5bc7f40b204752a09394bbb5a6a6d89f662e2b268ad546ea47c43bff6c6a53dbaa79037233321b9f88e341c68bae9eb8dc8bd7d662903f7a28714b926b43468ef185457d9c605e723e2e152daf3a17f71dc62bcea45365c21e1c9c9f3de41fccd7f1a473805981e25e7c1f3239d2ab26d2e70e5576a3208cd2cf186e09d5485d04c7079e0aa3eeb790d6471c52fec20ba2f46ab5000ad89eec91a646f89f2709210f55445fc80bb97b4375352147c47036f726346b0ff5c1136b2e7132c92698d6cf78aeaa5042b0c8cb91c3cf34191b35f72a1bdf3bdfbdef639935dedbabd1ca11572411c1fa631e76830f834e29d448fd5eb28314fe5a2984cddb245d207da6dcdaedbca59a9b264d3361661b5d651710aa408024bb6069d3b3aa2dd8ec641139e953d4838c2088578901a0251b954938f60ffef37c96565a33ec21d4774eb42e6c9c81e437baeb9c6e3658f4cc2b877d2a652407aac5992036e728d7290336c64b11ea4f0331f725c849b60ed9f078e82e8b1aeaaeb5da2da2e5686b6a4a41066efa384c584c55f98182e3fda8acc580eac90924ee2ec08a612c0c17a2ed7af8be9f92639ed4ad207f290749a326154e4666193bd4f8f33e59043a6439b28ba32147211d3d92a6a3ac864978312811582bac71b9c7da1c5174b71ad897621c0f803c0d019d4be989eee1d214b97861a87fe13a262e9ee3cc988cd6fd24c5d445c4c47d9827ca1eda2f81caa5a5dfac462c4e9b08730aefb6afca935b49a25c4cd328996841d6ec9f56af58b15c259a38183bbde9fde7e917a0ba7c786cc25b2c97b08bfb5436fbdf4bb3a4c24612d4882defc75034fc78f753a4b6def7ee7aeef7a378d9c9b3f4a2f6d5d75fcb6e023e51b4e2c68013455fb0d06c1550ec6199da4b8b8806157ff03f5d19115300cc606ed036d249f2f7569f85c4a3e184b7352aeee992752443d20e92915e4691d8f86b8ceafcf76237e5080ce612108025cbced5bd7f7da7e94f4bbd68d10ce9d10d303027ccf22bad13d3adfbea47a75261ae482dd585681870de26c5ef0dd05da8a50414cba31500e8e8b02bb1edc0e702b28e611ef72d793caf15d142b20e24d0b250da8070e8d96c2f5d9df169948bb3c2f182e13abfb4bba6d2b451616acf8d3f5ba073c26bdfa891fc7a3125ebe77ec6b7b8a7b6e670f5aca495a483ae06e7346e8f2d0267bba3f4d4e9fa888ca26aa6292af7d36955f3a7d59cc481a070e779d1cf3596a5 +Digest: 45f5368ea111316157fc6b53eb5a7e4b79ecc80fddc3a0e277e1e1d43912e295ea1dd9630099e932b0ed98ffa76dde73b6a1992735e699825576e8a3bfa36890 +Test: Verify +Comment: length 42040 +Message: a3f0d1864b7ed2be3358c98afea9048c1a330cbde7e7e3a81bb28bd66599c789500826ad6b673c0ba7ef33c000bc83ed5f23fdb1bf450e548fe442c558760747a078b4670e05c931cfa778a3376d6562ac3eabacc06c1f8e9d8cd857a686ef4c5be8839d7d8000987329a11dede53452c72c1e9730849ebd0b52567295f0070049ff9c3801ff6aa85d1db615684b772579965e5b58b41448a2ddc3006fddd7cc3166061ee0aa8dca5429bd72f2c8b7428a2474de802508992ad627e87a74e816ddc5c93962aaf3641ff8c01ed1847b13c27d670af0ff02176be48a12ffdec14713c3ee6fd12724e08730c6004da64bffe94a3fc6ef698a2a2db0f5664542eac89c087baa7348a7a4547ad800b057af6ec63204f9c68b293a37e26fcc96c9ec00403d7bd19236031a4e7dfd0640be30c822debf8dbe8e66af5221012c389a4e56c60af3cc7419c3a83ce23dfa47045576c5f578691d9acaf24615b26e74df9834f816ed8361186cb8e850a0c40b50a7de772035752bd6dc69db678a7a92bd53019c0a70dea35b88b118702f4dd5cbad6900070099326b247dd8bf9138da5e06247b8d85c5810b9efb95eaf17bec9cef7f2751e0bd78812a9607c4d09194ea39075d483320425037fe2765ef379aedf589b5a7dec9463e771d2e1f4e6b078874110ae282d72f51da2195892f6a25e348ed73b000a5e4cd9278167813b07c6140aa49047ad290370fcfa9ffbbfad6a86f152615503a9a540311877528463b9d243ae35624f9ad295f6d296f9bd1f564f267997dd66eb0fc534f49c194178c63a929a17f8735cd505064de80d5d5ca3e5a4d9391992a6dec099923025f09b7db55e04928ab6c39d46c1c90db73f09c5f2d2edbf9a1571b4dad59dee19206032fb3c5a3f899873adc3bfd07287c09b5eff6723a5cf6db0046c7f6420534f5ba8448417998586f169044700a0ef9075b153a807862a1a06400e0d817174dbd22059ebd91aff00a15190fdb6335f1d4d7f983c25db4a98c91a27f6725bee64883d73c9fb4e66a42819f24a7d8466c5771c4589fb0fa1689ce552d0b34a3057d2725aa50aae5cdfea0490c3d32e97378709e427f3bdbf07e6241712c0b6db544551571393b532126bc404e0338c50c1f1eaec8cac4004052968dd33273c5fb8554cf18c12fd96fa11bac7263b4834234c11d72e914110eefb262db853453e1286d7c274f4d1ebe5905b400c46cca1a9fa212c842f3b5603cfee7128d16be6e16e844264d5ecb1635c480818e2a439e4809b6533e29944021c145ffb2e1afaa350d4e9e222a877f1d9f397d28b496d5183d319a457d57b58645a32b5d5ccd9e6e23c3173679fb02f9dd077afcd26ac7f588aa25c0b8a6c753d02a1cf450c151aa74ca17f113cea6b1c71102714e677dc830497d15a2287f70ab015ce18532cbcf468c28bbc0a9742ea5809cefef36fe7a7e3829ae0386e4c61e52738ac3c915c6e231d1fc47347256bf7bd1de7c7f52f1ba9cb1f1a368ff3b7042e759d22e367890e09b1c7116aa125c2b27a7bee982172ca09e484a74d6b8ebfb42b4790836cc98c10c8306f8244bc5b828b07d1d95d31c69771abf557426d5a50b0581ff1ea941fdae99ce81e7e743495c6280c3930cd122c4cfcbb1de6b7767cbb3b3bcf5f9d4bc09c7905afbd01c064a25918285ac94f10ecf36311e71196a0926d5e7c3a39925a373162a68ec98187a627602729aadfedb81c87c3a1e03d64dc6af28918fd8610607269a362501a7747ff8ec62be6472b64f483b3d5c7cd220fb0b2566a5d997bae989526e619ddac1e6dfe85d00007524a080152c12cd86082daf894acde3f0458307f9188ab6dae8fdf39d6c48cb2eafdd36b311283f1b8fc464fa45ef4094313b67373a8792cf712efcb4967e0bc6de6c33bcf38518b93d28f22060f336aa067b73b6de4079e0e5e0c1d4e48a096539b63fd9db13a08799c121a5a2c10e5b4aaaf11b0b9db535ca7a0ba65c540d31492321b2d0b921ae2bf8b92e144110ce872faa11ca868df7ab66a2d209c55f55951ca3eeda5fe1567b338166bc5c832c4474663e22e3484e0d0b4efff0c346f7a6078b3501ed29a512db42f2a4f8b19c0ae0ec4a1b9c2f617ad1d7d51b370c40024da2314e4c41c67759c47dd4fee04760db06debd998a59792004fe910af7573357b088c86271df3213cfad52575954cecd7aa211c3a15d93609e1f5a225064c18c7de278180119cc732b2a28e964ecdc1e113d1e00bb964ef96de37f695e913253d0e86457389bcce09f9d5e9e483713379358ec39212c355439ef07c66b04101673419605608ebac2f5aefa5d4f5cfa7ec89a84571c46cdd7caeefa20bde5e23c2c96160bbf191f80f304060dbf841a5c78aced40f20ca0ebe88660619d5d312dc48fea529d65818462488998e1d6f93a6a352fdeeba735f95a5f42705394845003d31cc144996b3509218ce5fd7b217e67de5317513f1467e922a73527b1630fb00bb43ffbde62fbb23816dc5b9a1a92374f60d56afbc69e5d77989861dc56d195deb8b6095cf03e23342f65425c6adca22f5eff8004d2077e051c81483fe6ff78f5320db73a9c6625bfdf68fce99bc67026567dd982c00913753bd825ff9aff22f7292c4da1eedb807e2fcdcf6835b668de4f37bd9c190be66efd854047fb3a5b8da6fb13b86f06fc1b267c0401be1653fc5114767a6377bd996b70e13d9018ea5fb06150a8a64d613ecd5ee2dec04df92b64ff4b4529b4619e8c825009e10299144f494e981c19768e2a59b324c2c3221191dd8325f02a9a2469a1d4d4765e2e558b9853b157d304b44856bdfe4de09656df97674142412fd308b6b7c6d89572c96d37a81ae1e1d3572c3e4a92e80c1ca357153fc2a661ea5573aa3f068e102d19fc0e95fc42adab20e0f7a0081baf7ea0ff3f53cfa5f2914fb263b5bd203627ec4105617f009d54b76b6b07896e3182f4e1fdea91c65ced6ccbcb6112176e27eb420556caa51b95c3d580c93d6afaf14705384d309107c651c8c98a2ef922f7be09f4ba06b98e38ed26202d4b9672924371d6c5d38e5ce4a9b044793851b95d0c9ebcd65ac25e03dc67327adb7a022f8e2fc198a246c10e1a8c267759a49b227d0743f2ef4af2bf38a09ef9179f108ed047df0ec6409f0e4c6356cab97c2f0eba4e7356edd8b434abd74cf2258c0678b2bf1a7167045faae93dbcba7f60dfe86b7b32497bf50b29db1624ac2dc94ab5dba15907ac1b67ab96234091d4d9137a38946a14c1275f6770640d7158df460df5f5841abe0c21d8fd1bca95df6e318ac7a30200e8f919b713caf287cd556048a5c182f0c55ff3fbc6304210c9a7a2e1c3afe25318f09fdf6c4eb837b5b3022d950f3dd1e89d47da99679048b90cce47d2c1f25578965aa722fb48c9388293866de69c074f4d843f1cca9c86d8261d839ce01a503172b2d9ded68a857d497b19d44f87d923f712f0fa604e114d7cf85fca14428a6a0c103b47e966b3ad9021af7350e68e8c2359b5d9318f334196c5a10465524c4cedda97063bc59aefe0ef0ff2f4a16fb15ac15862464532dcfded12f1dc32deff9c7ab3c2d48d836cbf4c03f840a1c4bb23b29f3ca65a574538d97a3a80ca88aaa1565724bda8b64cb8a0512d3eccd5d10794540f59b4eaa5cff0a1875a02927685d84dd3fdfc7bb65054c23bf50be91c8dcf3d85683d33234b994e7f70c3438acf665c789c731ad211ce1ec76d4749c43dcb2344dadb79e8333e4bcaccf3e50f076a4bbba3f4dac982772d7caf663ef09ff0cdf4b778061c0f465e11767cbe2cb64be343196605c32bb7b6ffc2520ec83ca7053e08fb20e5681950fc7444170a6371ecb906b3e1e795f783fbaef101759b5691cad44c106ec41fe832d03537d096442ec472c2b75e479d5a167c2d611f44673a3f23531eddaec0f05c923668a7d72c700d667bce50c91304f833ec74edc040c845fdf8915bab642e21c02ef0b7af917c3ce9c670e4a4bf494adb188408964b03866b23b30f45736c2a64071827a5db18f8048be3425f0bf0b47d98d7984eeeb3a774bcca220355701e85a8282042720de9beb27093825ec3dd1f54b5c471939f5321ab1fbb6d7202a62cf968c90cbe22b81f235fff961f886ecc3468b486a1903079d8fa030c32ec6a60e21f4b8d28210d2fc7f8ad22b8080e8920379115804ee6842ba22267fef511294b97cd4d16d08ff78483c6ae900b6660006983a697a11e4a8d613f073ce4448f1c1678d3f1f9e77e434771c20f591e58bc47b1c2505180d4e47d82725682aa9b3de573a72262bdcced8dd7e79db9dd793c1944f01225b3291a3f1432b297ec54964ce7510fd4b8ea689d1fa4a2f44bcc692763b946e6605115ef1dcfbaebb1c31092fc59221680df9ebf728286d2115829b837a4525c2e55bfd5c4cfd445a2ee9101d948c2f2beb3753bf808b11bd7266515e8399f4fc63cfe3932bc6a6e66df02dfa7a6562e1a6fd758d8be8c97443c06879d009587cf0ebc628f1de32fa69e4c758df948933b1aab5f3b2c7d0e01a4f2547e829ccbf2d3e099027ba74e0a31550bb4cbffe9cabcd99848dbed47b66613c4b4461de5d7945226b35d1e9339a207e944a3e3f86e5e484b2852450b0a884f2167d47e9b2559fa51cb4bb0c8dcf94956640a5c87d006e2c00219eb22a51490b1beb529b68428c06272cdc5b39a3c029c3c87d26097bf8e3fffb949543011bdbee27084fe9e0b8ca0cf6cc51e1c751c01f5a2ad496c8e340f47b9c5695388be8efb8df93a180946540baf18cf0aab7eceb7e3550bf77dbd7901a1c928b5807b693095ef349d2ad6c64d1f268e0be7104aa9d3336edf930fc556fabc5aff01db99a90fceb2d377243ebe425725c730babff4f9ad39cdd8133b6d4a06c7d814c9658f83fd7d62f7180486a3145ae78e6473bfdd2c366855b1226f1c0f37e9bf2a140a79e65df3b39b5fccc7c3f71309f6af3308192b5911d2c483f53e72da0ce7ef417af0192eb19399b838cec2f2aa58bb7801dae147145c67d25ffd3f5203e83e5d0d837bbafbeaf8747d9b842d7873dfb550d920db67395483e1b468f9ab154985bb0749409986c5251e94046b7b2d63137e7cafbd114fd3bf04c9b3780c5657e20be44c67915147f6a31f0c55bc6f8eb9122d58941a882bae4ea5e9772e94b19c85834cd8ed31c80d95a662934222aacf9453e1088bcaa67749b0d29d1ab5a0dab14a113ab5108e927c90cfcc162cfd7f8d5513c36bff8a437d523593d7a36ac418a26236efd5e2aede451ba83e77d0ef849db66ac20e203971f4db016d44578341f40874a5680c88452d0ed1c4e96a47019292a899dfb082adfc8d8de582b13fb4a6cc9bdeb1544a38b070ecaf6c15b08c9c6e22f75a8245b9d411e24644be1ffa227453a3970219403608a408e71752ae231483e467ddab1ee22fa69871c84c9acec846fb055d20e4279f9ed641b954ee8f4a7168ee0bdc6390b182e3f315ee1c14921aeee0ae84acebfd85216443ded549d9948cd752ff10455d1d30b1ed2c095b987784113d7020eaeafff237fd1aeab78996570afb3cad68fd2086939a2ee80aa306c680520ac98c2eb450a22e2eb542211cd26f4dbcc3635732ee81631d418b7b6ebb15357a2e3a904e438d2042be526bd103ef92a7d99d34fc6f638f219d45e8586bb92de9d75ada72d3e0197f8e502d5af4701025787e5b251121676182a0b26cdf52847f4d56d2ca0983620caca23062addb115c276e9656dca433067b04a0511ec98063179441feec5f4312a0b23c8f3419db776ed5ab37d9d23b370dd97cb030076abebd7eeeb6845a03b9f3e719899311b69cd51b636f0f94c61dc2870c301ef38ab7c87aa399da5dec282ca88ef9d2aaecf4e5a886a787d31ddf2176197aef742777bff2264ff5514488d35f6487f7cec4a625e5dc86477589a7b20f6a35ab748a252a4d4081de1c5400707363da0c6485da1e382cb55963509afeb8c90a5bdafcea92f3b9d79ba864b98c4c539b185378ba560a40dbc486bae28cdafca1068ec3ee7d4c59f836dbbcdbae52fc712485e56b57c4dea191c511a7e4decca1b477275876c0e88db69fa38d5fed260537e11418a9cccfafc7079b108f2a01b36d7f725002b72d3d24db63f7268598ff594f4ce7d28cdbac6e36a2461428637e3a8dea00ab99f1b1877742428b821b0692b7d6005c6ac9418f396c71fb3fb9ab228ad98ef8cefc90e75a8996164c77c2eb01fa8ccfd0631531f841b7cdd6cde12e5c852271be16834d6e7f1a504b74dc6b1600b3b1256fd15c5b6b43115765c965ec37e59fd10732bf9a6ef7c0e7d9fc1bdc309c8cd1b61c184a313b4f294a0acf2236fe0970964448c69c54ef8970c9013cd270e73c009f6eaddac810b4444d74e6cc9638018d62edda525a6397ffec271e2d564bce1501656caf11da601b3a5d213fd5b2eeb233b8bfd831a67b4f0c956b8a773fefbceb066ff83f3895967891b9d8e2019dce60b05b7600409b28d2520931fb4b07bf05589efd79afbb7eb01898dfe6ac78a890dd9774efb76152e666e26a09f77ee4f663e205e8c93a9b89fba49c083ce50a6c485c1928953494efd9dd7dc9ccbcf4672f2159b30d7ab5ac41c75671384eba9bf890afd0617bb796b3e1b1645129b6ffc545420403e494c0f2e85748281a81c6f51c7c12a4a08482fdd850020f2df4672c34060034deff6e17efe5b695b1279548e9c914e50ac05bbfa9a0ca8c3174466cd8edd127d1c05eb6c349e3067b74aff8deddfeac2136cbff3ceae5529bff458e17419f64269d37da4ecbf603e030bd0de202f9824dad78c779757be9d55d0c98db489174435fa28877b2181448226690df7e2dedf6ec0a1e488bb3d7455642950b4cd0de92ce46ca264870c21b135388bc9ac17784bc2a0d9172b5a655b28f8a8f93832a79b1cca743d32794c1cb2cfd619edda85fe5809a3c73aadd6c389d814f65d3e162d1db28b79c6413a21298f8b6d2ab07ef2fb3d031d6ba05f1b11181320ce88ab4f71c5368eb50c526b03f7fa27d501c9d626cb458e30ca54ee6969322cfe9add7e936323f081334b66cca9d10e9f76fcf45525099e2c945ea9cd2be07f5ffd33370d2cd243ad4e8b80fe157e55cc689eea10eabdd1a186e2d9e6d0ac7c751833053982a00cabb6896612bb70a1fe5f1633e47cd0ad422a67fb3107f4b8d0845365c2f53b900f13cb62a51c4677a7d2f95e4a6bf0a580e7848a263267b8f4ba1ad51405039249eec8232fa86e4b4b6cceb5bd288c3ee0569f0340d063f144320fdfb7227667ee9006041cf066a17b74fcf6a74301fde2f03df31b727806617498e226ee22a56fb01ba1e784bdfe9a940a8db34c0056fb3cd7e61089224cbf0a4 +Digest: b76df4ff82e33617c6a25472e7ce07bd7c8323d90f15b8da1fcb51c04f979dd072f08622192d007b31370a8e15d2f1d751ba210b4c402409dd3b74b2cb90edc7 +Test: Verify +Comment: length 42624 +Message: 5b6173817957daaa25234c15d963b988981de14cd40e5e27903ee58ac2d8c90afb39c0144947eadd5d040f99e96329ed4c5a22a67138deabf4397c308757d92d9564560f2556dcad00e21d7d164c1c081e7def9b7d56c340694422ec4e1471fa7009bdd8d32cb70158e4fc2b28c69ac155aed093bf0f16cd35875d25ddb79859d6517bd91b7283c0ab333609e77bac003b174ef6000cde39a12bb844fde757320d641a79c7d048d442f653811a1059ad16ddf02d08f4236ef558b8af764cb56d5e69221f9ded0f246556d9fa8b30aab02f2b3f9e9f70ee537935e7cf108fbaf3118819356772df985b7b52dc0081a5f1ce27c2b28d2846d075ebcc0c93586eaa6eeb8922eb06c1186e8c458e42ab54593bf901d199c333cd30a1efcfc64eda7bbdb7f94ef252bc8ce4b13b7a1957bfcebdca84648deabd32f380d97e721a054e4517f22143fed8dc0614bb074c2ded399dc2d4d12f44ede706b011835f64f70c4f31fb03a8b11df11cda4d9da5d4e68324087882487acad5b1581f4455d3b99b232d9c5ce71394b16e2e79a4eaf5b29297c5f8dd9f335ce23ca18c2b1c0f52e509345d94c9cd44054336c884e4375a504120dd4cfe18acf7eeb2df9e7bc1cad1496ec713168736d5e51ac1a65b43e5a46942ad362bd0c1fd10b4a0073c912a462a02614196e8700a9a03ed7017c05b755652f303ef04a4daeace58cd2526792ef518b3871099fc8aab19d24bdf57c4ad5179341a125c5b78c4298e58ff29bf70f3da464b4e42e23f6083faa07cb02933a2dffae55c7ff0bde6ecca10914104f4696ea1f6168a2810006aedd5b77291ef91abcccb95166a939740945da51751a2a2fc4df13119d8e4d5f53154564505c96606333484c8d2e1214d75a70152ad62e5add0a36798f9a5254d508321d38ca96817b688f23e2f8fca3af4566e9b211c79a8b4737faf943a3999d2cce2c12e77e007dd30a7208984db309ad2b49ab4b8a71680cb4305b08b59023d965fbaf31b16fd30926b15e9aa9b56ed839bf66e1eb71fbd1279435580ccb01b486164e47d5222381706c556e854d577d2eb585736f1eaf2afea108b01dccaf34cb0670886dc9d7c273fd9d8264cd4c0256b6778e99ca0a70c5e155bf6cf784e09146c681cfb97842bdff9774ccd7c4ee5e4ccd81d026865909dfacc47eee4b3e7551b0a28f938d989afcc3c431df4ab7b1f2e7fbb696bb2a36e66e7dc8133aa4e3a1bf8931ca702ab74fb2ef184655f4de13676ac1ad119ad9a01b39dd090bba68d153a43ad0d87f7f92d553f4cf7f0c5f58cc4d65dc11f16ea74387322216f5714b0d622f391f1d7050bba15bbd1e84a22d771237a634e4723677e44c10e4dc99895d617385cc7b25f3d645c1b1ccf432fbf867ab8e02da610818efaf380de65e06b4109c29591f0d06a5bfab2ff2b1ae5ee0ac26060449c786b6f7b019fa891b6db20e2db65d8f8203aa8d9c9a386360c0905e5ba0a1c9222cd29b1339235b6e08d7a89c9f42234175752dfa73067ff6cbb80ca0e073ceed74dc582d0820d3d272857e6d469fa0b7c6661f696cd57ddcca98159a47f2c195f964ad82296b68c5355c0e146ede5e51912de05dca2dd38f57e137ac399757c824ec09a6ff7ba0d2cbbbb6265a76d2ab400d0f4c2d88178b0e03b15b57d9e7e081e2fb000cca127790353517bc0194316db3fab9097cb05c3780312c0542f86b8ada0011d3ef14104d48d96ce5f7196074934118e064448f6ed72592d46b1fe5ba41a770d7534c593d77319a6adfe8c4ff2b510044e73a713e790d3447aab4db9aaa6f91a98f11aefb30cc34dd2478eb580cd8f3996e08be01066664c19a5db9a684b708acfb1a8e011607a0af5d502029881777607145d270dfbfb8f4a2710c68511c2a644fbd72e997827243e2e51fee4dbae03c99683ae89587b5336ba5404aa00d8b61c570fa0f25bb3e4d6dce4710ce21d2803ee673e2a83cce104e50f1e7f219a02824db8ffc5110492e5672223b89eac2ddea56f9e9886d881dd31a9daab7bf0d19c663a13b9a30476925572dc8f184459814205987c69857ae9258a01d716c36d9229fda4771899d706303e633957cbf5144d90f27e32bd164f491a5baafbf91c8d1f6a7aa678adff697fed815f632b49c14f787545eb679b3825c2afcd317c27b5cee75cefcc2734e2cbe7fea9454a9daecf24e97a9b6b52cb42e8c7e7c032d631c0dd14fa1befbf999b93a2be0412390355fe16c44bb1833127f669a1b105702a7db5686e6dede8b7775b3447a86964e9696dc3cc022076915c525ea30bdc3fc78bd521f4ca09f664e7a67eeb3a39688894d9ba3ac8a272146a666d94d69e893174a707333b2b33c774dd4653c1698b075daac1b5a51ec1e2d898601d1b35978fc091e1d4c73be509a566552645e1168e4d49a1e5a27da9222e52fee5e188b10af5fd797e7721555103aa730dcf895147ea1c2273c6a573fdf5fb0e95307f1eca9d5295da52c5cbc8151167b065498358bf8c0b071a7f669ab4fa59d4100228f63ff8fe8f600f8e966304fbb61209f5e951022648a4f3cc22f3b9a74b8af915b664577c46a9e8e8e275e9f5c8dbb1f0232ae439df6eeaebbc3a9fbfa1a54c2e3493d7d6a736361fd4d4291e8dca29ba2dd19b0d73804a0d9112146b7f6ae4bb9554e0d6590ee37c96072d3eaee6599b30ce906aade0fd78c80280718ddfa704042fda420539d5474d965c1dd23729dd54aa2a173598e9748a934c9a720e7e50a7ad2de352c0f6c8240a1d82a2c682c7c0ecd0deb2b0f84bff4bdeaed7ff51e9a6554181e9aa2c4741e9da37c59a4aa09d1cec85cd2e11434eb59f7563b909152ab07ee471ff610bccbefa02e4bb6bb112c2e5d52d1c1ba6a056f7b7bf448c1d5b444dd393c77c5dee0ee5aca732cb42486723967a8100ba1cb84f3b92a8c449609c1417f70b6585ce6302fdb506549a67920e905e66a7c8eb620dca85ed98e0623d3c7844d304cb9644bbbcb73fec0396cc0e8a7fd2f81734dc9b2c401cef2c88b12ebe232541766b3a77b354e67dc3fd9c8b4e85cddbf120af5f296a3db373fb7f51b13b0b04d077cc9fa83502ee23c58aeda21960389cd762c388ab56cbfee22f0c19358c351fe2829964029b276b161e9c4fe391f761807d2d13ad711f156649c9bdb8b0bcacd4e4ceaf62ba10e317e1001d8a6a008843880790159597ffaf56ef666d8081bf747ba650fd6591d3f15a81d3b7f33b59490cb8c88ecb1b06e4dee6dcfb036ca0eace8a117ca79282cb12883b1133911cba91a883be1a93702d6715e70c4266965f65e0b88785fb39ce8f7b1b4132e818be9d3f894d8ae786b37be64f454355eafbc9110ec509b440225bc43ceef82a967bbae5a1e423ff909ea1c0db501023e5e58186dbdf3aa5dfeefec966c18e3dde1c6f02952beec3d616620b55d5b1b6cc4615a6e77c20b75e5afef46061fb0b38c744fe2bc9f21c9f424430837b2cf8ea450ed8f945c4d00490e5acf478477aeca5c2412c6737f0354ad1952deb8bcf860bf386dbe22dd91ab53a58e8ab7b7441dd70335facc629de5791a31dcdd625e7bf4c1753fa63bbe8f4866205a49de08097d73d8e41a6ade3910bc21ac813e1568aa2f32a356f5cb6735031130bb8a5f2fd7dc57fcddf668c1fc75beb844ceb1b947b82283d58a6cc5a202dda87d1addc34ec35fbf97a3a20294dd459aa882b7e04622b14b7268071d27ebe21c1f2df8967acf3ca6d7e13e9d926972ce2d089c702dc59b74ee2d1ef03f34cb261222340bc4369b4d0f3d82d55d90a2cd32bed3db87371daa893838c14063f530e6a61485b3bfd81cae27135c5ee972026a13f294caedc436d417d912d40ffcd70d081ea6d1c19f80552c54952eda5d2823a67d3e61502bb46f4a7467828f4e8305f6c6e1a6c24e3264bbeb0245f9b0890ff4d83af314b09dbb5e9f21a46876bf61c081c89b58608d8d543b462cce38bf8f7d981ce8920f7d38b2bde3e221e2069113e3be37ea62fc1f93d9b34bae423612af4146ca6e74bd67f55530a4523cd3245f7154f50ee2289be92aec3b3069773a18486b10e0ace8e984f97a636fc3bf9c019f0f6b2c5a8d92d2b35373eb1b1d763721dc44bef48a0de01f23b7d1332658b8d15002c9388594cf078b8e44d373578a722cee50081b75954aef1a3ce7a1ead3ccc9446c18bb025c9be6c2b42f234e90adcf662a34079122e12ef2f97dacd2e0d5dda89b57986c09f517e9ef9aa7dbd8295654c424f8e1079655ea9d51b1a17e70ffb7cd81a8523587714c2d827b8fcf993422a44749f5b1bf06599ef05ac6fb42b1fa892355358de79572148308caf5620b685117854fcfefb2d884f602c3e5bf96d934c949867179f6e42b28fa1dd8182e9e4112254fa08cddefe5cf4418cc4c10ec76cfdfd56ed3081ad7c0aa08e610102cfac3c485d23b09f817e899462d7cb2acc5c39292f4776baeb106a31cae0e72ace4a8cd72e36ea989b1de6ccc77c5ee8288210c6fa0cb73f83d476fb9ae57a886a53dcaa7428c4f2d3a1d492c49bc47065484979bd263c38fd32f8a7055904452a2ff26837e386d5b1731b8e601c43eb0a15aeec827c4dcee291b6dc1422cb88974696ba7f4e7868bef98367a3e72481a05005c750f63128b8587a43ce29187a370092485551e2d4819cd4c695e4af59ae6317b1307c32700af10a843b56324295c6adb9c0d40b4083c4d5523ffc2b9cbcb5ac5328f696cb5dc32e466392630a36feaeb6c9bf3cd54ada4fb4a815e27153ae8c55434ca6633b36b0314fc3f1f7a4125ee677fabdbb60440a93d8181a01fab67e5e8667aa602bb257ee06d22533666885f2d26ed6194d6cce98d8ee1c7339354b16fb2deaeab69fea2590a847e6046aeb81e201cf1797b8636baf7d30f09893bb27a987ad276265327df62b9f37067e573cb09cefdfc89290b365af9da0a0389636985d3d42ba6cf79f3f45744ff50e92ca43287f9667611e18036badaad88da4eed198e061431d003373dd1056598165d5a38bc767fd8dd6449098a637c8f8adf45b1edfad87de17e09bdbb973b83f9502d9af0f78117e7ddc1420d16ef9e278f33ed9824d0d18024ebd26b8ce9cb0edfbec7a9ff12b9bde8b98ea7678f2b4ce9183b010695d348a26e4a855908c3c3468e4d6befbd44ec0f722dedd7c3bd47776318ad32b009877101548d7e1114b31f0caaab6be92ffeac8bde44da35dac3b4b505111b97dae91b35aee88e8b245ad3ca5decd61f01425a76ee41015dfa2e2b8e9ec133b5cdda0b8ba82aecef79270f47d594c0c73f6393c3fc66cf949203364024321da268c6bc63eed92ba689a42bf5a057be9a50dee2e3772aa77248df7f8a63e82bd6225bb86ec157cd58ec5eb4545c9a11d0dc10c255ed111b9f751f61bdac5800e980f58a0cee3b347f07c322f458d07d3337b5acbbdc9ebe44ad4f876a8c061f250b20abbec3f81371625e1256339f631a0a1a1c55b437e23a67dc5b117176e931376997f4c122ccd892abecea6b6b45fdb9da9be4128149c91b624732fb2ef1968c3cc96f842fd33d0f192d316ea89866cd53a5c755ef37795e7df64f9792cacd8016ca5f8b93c8e73e424dbbbbebfcedcb31c4701cf63dd3a76bc2d7c556c72ea984157525d3109fb693e8f9e1a9d5eb29d1628ec61aef607cc8476c12cf99626f01351101824c9efeaa697c6e76a5f76fdf2a73ffe1be98451fee6cee8193e1471aa3e3ad15cf9d7ce259a3b0b6ff8b13a766b018df1df396df426ad6f15933d84cec4d67022bf3c7d83410670f452eabc6b1d3af679ffaf892cde66ab35bc288f468beedcbe43a45f88332efc4094a9eb9864f321fb726d0b70b5ff82c0e15dfcdb3c89ff78ae9adcfc18bb999de7762fc7e933f6be5ffb5d865382de002c6531557fb0c09728a35ca69ab62e5173daf0be54025d0cefe2e53661f6a63bc3c7987cfb6a0765d849474f5f26a3a55f5c96464c683e2b49a90d4a8764c2bace0b971759bfbc28e71305bf0f13e0e1d4858927796e816497d83c886cd319c576ba98f040b7c8297d89febe5385cc4df9db3129841b0efffef8d9bab94b95a3e25b02cd595b11b0c0349a14d3855131f7e8f7141578cd44a8904ea615d51d9e3c763d774cb28005db9b4288361a56d4f53441afd38ba67bbd28021529779afca993b1b6c0c4fd6ff4475ce4244dc47f1c4578c3675e82eb64485dce9d3bf206533bc6515e9a713734be52ee4725817a94a5051878f947ddc679c79b18290e0462f5e412cd3bc2a6c28a8a6f44aa760d84dc4e76af62df990b42a8424248d63efe4a73bfb5afda02c7326e2ec6e48b801470bda5b4a330675a2c688cc4a032fb4dc1db21c0ff9f936a3f64f573dca91a6eebb96c2ec4248fdbbe6f4146390b857ae284009432fba3d438d68af399b624b7d5a995c6cba258b88026296f1c4722ab35d624d950d5782ca52bb6ef239be61ab4f7e623c2910c16faf30be850d01b09433a543862145b9b0fcb410f8341a8bd120a28eeb0dbf120b53fb158dd8cb8bb93165a586fa29449fd1ef3fac08fb2c8764a22ce9e674ffb3873e168cc6540e9add3fce37f666b5df78c9459e26c4b64691f9e6c931d70d20bf564c02442fdbd1ada037e9b4828ff857debd3f2c2bdb972f1626f97e59bcbb72f0207ed0a355d619236d3c93012593059c111f6784eee19283880b2a7170ec38782e62fa731f10a625f8a130672907f88debaf976472be62ce647ed4b2dc4b767ae04f30039a29eb4444b81b290cffb720a7700a4f09a6266346b4fb925151c364c0a40fd9497a4efafbd1a1db43c2a7f0df015ea9060143cec95e1da4728785c259f1f868cfaa47a6688e62d26ff9618aecc3f3070a88417d46caa94da265641016c978367f026bf3155edcb2d41c7a3b6b4875ed9983b60b699b2d028363b4da818b0dc6ea3b325dacc38e0132a448aee4ff35c1158c07d58c301777781b1e8e14c727ae93bd2142794ce521ee195331b468e1260119bd88293a06f102f3f7a75b0e64320df0cf4e256b70b978f420808405d6810eb55d7feb096a23b676e6b2deb13205ab8e82ed1b9fcf1c65bd36f7ce66a47680d75e493c4ebf64051c423cfa602f9e1eeee28bd66a4eef26ed1d23ee0bc95afa083660874a7556616cb0a2388b9b7fba8a64b6d04b7e964efc49817d55b3c2ecb08c5266ad3a6f6de0b88f33a4240f10e99ffab3c3ec965073229cf6d50222db78b68b54e77d138d00b060563a57e0b4a4ead3db63f783bdea5ed2e51a231f38b94b97dc799bd741553ea22ace85890814dbbec19c5dd2e9ba44cfc29594fca70ab1f457e4354f2d46b9e12bd15b5cade1f93800dd5e08867b8ae009c7e66f88e5902d71b7c7df936dc889d3d337fff864b9bc13c79698f69677b0353175dc60c25caf9454d20d3632c128bd54b9d78a4593d774bb8608dca3c1bcdf62f1c7c1398e074a4bc26c682e6a3a32c64f77d5ed2e069e59bad +Digest: 412a981183af19036e0016492e6c4f931f998e13dff5714b16e2b58216d7611ea50ddaf4da5ba2853dbd1d60df56230297f7ea55afc1bbdd2b7ad51a4366433e +Test: Verify +Comment: length 43208 +Message: a2b2053132d667eba8c0fd6ba1b1d813404dd8cf15f3b803444a4ac1e31c0440a368bc89b3b2b074e19ec9d303bd21ed95a7c22ea34ab11cea812b8d3ae92e171ef03bc9bf2e5b1806f9601c01336dfd8867b8a820148fc61f4999ee11725f195b720a571ef26ec15ef848af64bbc42b60b643a553fb5ae82cca1e4c31629f2da117b29d98a5f45632c40bf2f3fc2f5f67bbea8d05a51b69592b410f635ff63b3a06ba01f4eff2bfca84304f789fb581e39f35c8febada33ee958b9f6d116d2c6c68aaedfc7a72e46e61402db94b5f791d89acbe06e39d2d332f826517220be680650bc876eb7bad6683c2f480a9342f5da2d8d7e5c86e3f7022b0c72b37d952be2464fa2bed1602f9113e0b93613c8beb11407c62105451ec959d2e6ffbdd586dce3debe3264acb71333ddcba1a7f760eff6c134763584bf0b1cf03ad1321e1d68a1e03663e1ff0141346cebf7c06d60f94e5065a6b8015c49dd0acab2aadd3428190aa7bde9d592bd6e1496931d89536f732bb64cdd698b082289332e68718f7db1a48ecaecdeefda796b57fdefd99cb51db9c2c3462bafc885d1e09efb9963ebf45457f55b698d4acee7bca2e7ecc16c9690f7c462b64efd6f9b7faee4b375e559809fd7c603df60d700112c662145f88637e1aab397fd29584c5cb8b43e1a1c69bfc2dcad4c6acf3a5b01e51b15bedb65150cf0c94f1edec84b0456dab7e4d3ad686d9e8191c3e8613f0b8757388097abbed631145a4880483df303d8af5abd8d210c77d3725f4ed442aa6dab183fbfc2abd9e61537eeb0508bc54a2e92e03c91600c03237cb1651c0c4b12973340b65262848a5c6695e169cae7845cf119d352ac08caf20f5ebd90d28a10abf8381dd35962884a64c285fc61d66cd4486c04397b6f39bfa8bbcaeb5bc3e249f58a48be16f07a7fc0e92090e71e4e35175b51be44cbd9ece74d1f740ea50201a9bbd98b11badb5cf99e43cfc13bb2ffcc6c5e699e9b161a39a72dd34199ea53834142b2d02e25728d4661f1969b3584f6135cc3ff4998c81e4e7881bb0f15c020bf16dde8c6e350ea75fdbecdc9307522e50f45dd73bc7703a771f7c1911ed7f089c864b2218f689fa1997fdd525e30c165d877bf95fb879846ccae0bbc6ffb8145c9dfd2aa943a1b5da7cd5ba2f9585ffa3ac21c2cf0aa3aa0cb3cefed83ab3157bda7a0eeac35fc1ebb2fbf47ac4c5d36b8cd89a5263f795a0ffce4a0e487af53f664c34a01fca049460f7ecce19d578fd4e27e9af6c7b2b6fd9680731ce159af169fa0696feeb671caf5209f23cbcd8a11c9717afcc3955c367259d09778aeed80a0dea9309c8d2cdc693b2b0d482d99f1baf8c1a2b39fce2d18c755ee8e3d73e720c4a5ee86b2eedce4251ce8930653e75f7b1b8338206154026f5f8cc283f69c97f8dc042dc61c5eee84d1505cc63c852f7ec508a1b5da4dc79869fc95f0da236ef1b81bf21559d4f0c0e4ded61ba83d938a6acd80fe7d7cc0f911a87922931e1e35c690844f0bd1836fc3eecf454b833414892c6638ef639707c32afc87a5ef3e3b83fc54d1c6c72ee7fafa88f18ae879a38cbfb2138484a22b0afe90aea71947797cd9d42c0f385bdff6ac939eeaffecce01f2051cf1628af9659dc5f60b1eb2861d9392dc49a782ae435f8fbbe01c05ea755ddf93aa8fa9f95f731cfc568217d7e2c41150fa973be96d9dddc70edf4d8f437d9236146e97814539062ffdc5dff568e5c038b68a0ff7d1e1fe4edbbc3c3318bbdd62c381dc47d339f21f755c83451c732fe1f1f257701cb661b1bb354a5c51a301b83c5bd0a37600913951d8aa6d89e6c0eb3152aae8baa5c8ae31dd00918acdbf94e37f1d3aaa27440c27bcadd51dcb23b3093d82b8181a7382d405e749209667875d4e3a63ec089b164b6b0602649ab8e7ce156764d19ef2de26527709bf878a0e0e5b80b5b84ef6d641766b7bdad000e8047cd17553add72e8d452849b42b97a78b19b8a69b44e7cabe6116a80d059c4240d659603ab180e29d50839faafd30d2382b2acd01950e7206bdc01d57a5cb6517a457cbe3649098cb0711520076b61ca9e25f8f87b9bb5aaeded052672b4eeedd79651eda1186cf8acb4a275122c7f564e1df74aa2d7ee33b66cfeda810774e16c7f9bfab52c3e5712fa686298bb6eaddac22f2c55ad9ba20c8272596ffe4e168129e44c3a2e87902a6aee4d60c336b98a3b2a075ec4c3df3857eb0b044086735ebcb34bf8c54f8b3c2dbc9f33eae060a6b1704483c66ed18112f058077624df4b5f915fb79a9f30906a5ac1d9d8738c754b87498d58a46231db0aa842472e448f3a05f03e557e676e4a51191a36f7244032f98043246e798fdcbf637b5cae8973769766569df5181df52711beac75104f8d4e4f6fd2d3fee23a9af17b5cab963f3bcf29c71a0b2be69267108ce1f338ea850c20d70adcda732020ba0af02e533bb036a15975c8881149967d4d7e7c845942bd5a447390f38ab4db27efc03ea8aefe5337d3563417e6443ec2c92a15dce3ebe8657fb5f7326e1e529ef473e37de24cae51ff6458c1aca8e646c88ec828d2a816a94d79197f69870d88dfb125ba1dc3d059a3483b6cada0177112529c506ca3ce8e7967ffc3c117954e79240d47a88b40b588aae5012f5158ab6e1d9a3cfa01987cc926b0e4bff571568a72a20ccbcb86cf76305f697be6315ca697c8d4c3edfcdb075f34ccab4a290ada43edf1cdac2b0d3585b08ad9852aec80693001118d8313f9b99461cd3d46d13040f4dff855b6d98c4fe04e9057ccc4c53bdaa92a09b48c68ddd78d6cf74f125610c1bc92eeaf9a4437f89cea839e4a3db4ccb5578a18ae1b720537d29fcc37125c5c72e4a19fb725e4ff5b2d3129e7af7d100ee03835e2dc212747455e45a72dcccbe736940d9af7fffd75a28bf303e43eae9a0d3a968e719243a40e5c43ca6f071805d0ef81aa822ffbd191b68607a59eac4326b9c01ca36c643875c04d089fb64bb2f9db834f8e1dff5742dd6a59b84514f072dc3df23a578feac1b3ecc987806ad8fa809cf1e27014effc262563e5dcee893acc937afefdcea23c5ca775ed0e7f5e1b0553f847d13f8109b9418cf60b40f5c6b04d1ab70328482ce406749a07912ca49231cd85e88af5afbf463bb179141e5eb1f03c2c14a6c5da72912e5614a92add51bdd6645cfc333760badae0cf71eb4af7064726d64eff8e2fd10ce8ddce400e687f7cacd69d24e9c327d049b46044d1a917a36df12adf90424d741a0908567effff2724fd76ae0c111485b5d1e7113defa9b7c90e424d27d48dcfb2415f54763fc640957a8ebaea710a61ebce113ad4f246ed02d59c329c0d1a86792cdc223e4f5b2dc7f4ee31c90c90ccb552e3a8dfda75acdfed427437147bff377386a81e58465882149cf9f20a2e2ed9056741a5cfbf5d29ff3cfd401238a4b4bd66cf5e8210278e82a2fcad926cef2090a4ee70f8aa66a8b290b3ff2edadcb7b3827d45f44004b2e5082041ccd377529ba298867dc03024af4880bc91e80e0afde49b1cd75e56b7e5d44ff8e1ea2e37cd6a2530878923659d6c4bbe62eaa4734294122b52f285662b107018f9397d96cf037fb63e8ca7322502fc4eca6905bb2a98c8ba8e85f9855fc36bea3b49ca3948758c60c9512555ef147ab4f1ec99aa5ffaa711b39e19dc29f628b6d0a17ee6e1c9367650600394a2a9af38fefbc80786c29678e8c64f352fb08ec4e0ca02664206633ffd42abb8e6ca82221a1efa9c4af67c36558403561cf9875b924abd811234fd04f67e8389657edbb96cde972f50a0439423609b0896d9fbc40eab16fefa5ceb0d639cf5cec4cda2461dc2078943c7d2da7ae280134559d0487d7477a7a18415a26d246851aebfbf115453b272c974115081931a3fd380ef2d072e4742b0b7630b3c9f44d8c95d1b623a1701b18aaee83d61fad154e55740bbd360ed98cefabd8ff795f02cbdae9c81f7985a10307d3feb41a00e1926e4ab3c0a92d371a4570b78c68cd61533ba2bb5b25e265560e9fea04a0b37573b3119f6d34d6095d9d5350cd20e5d5ad38ab14893efce49c4fb0da5a4c5b6d6cf4670325717fccb167c239443a2edc544251480c3d5b8b404ba54427656f15e88299a38bd7b0fdc0355be5741d1ee1c2f933ea66a984e5ec82fbcbee84452b70ee47d502efe01914767ec9ff321c8283bdd1501afbef70eb7602b6324193fa80a7f03c2d22a3bb08bbb96b2811ce4b1110a83dbbbd11a8e79578a774f5c22fb240013d5d08623017657a5d9144aa87f58226f7ab65921a4b71cc24394966276037194d3519a224eb145ff5cd4327d59b92ec027c7dc731919b5b90f194e67e250d970027cefa15de38d8e83e85ccc08dc35602a16e478b4462c5923060c9906b2418eab7a0c06f7b53538967850fb55683f36cbccf8983fe78989c6845960acd2b0d6157279bae4cf47e7dcae97740506552a5211a13b80a3d23041bbbb249a572e308a8dbf26ecd8ca829eb0b89de35d7d24060c65c941231138dcd2bc4d99eac48450f365b1d779c7f124a63be0b616c10c31e6cfaa480e4d88dff1e443713378bab0cbf3c26c59451cb6b9a9a445d829ca19c664465d0d8f089242ba6eead954baf23df2c374214ceb9c108850594cbc4706d5ae064ac8dea03deac637cc85606c5e73e91bb878e5461dd5634eba198269423b3450d6e6423827149004dedea3b93c926032fd071615832dbf0530e88319141f7e8dc810c3b899e6a13ee98d2587d3c5df700e75e940144226dd8361c840c3a91526e9ed6a08db88804eb539eec06c32ef3db26b66af193c1f3e7a2b58c49803808101263e113523b59a0a8b074a4f011701b091944ad9433390dfef3b8fdb524708d86247b9efdfc98cb02b770fc45be024d18e7bfa9e7de83b78547a87d4c1f322354a8ee950e3438b6ec046f51368d10edd0b23a5ae15c9a70e031c96ca750b36e1851a8aa158abfe0ef27ce6834f72279caf953452315b3d68a329a3079917aea5bcf4822b658a4f566b22c95d394bd8d523d890d2fa286350ddaa95d1539ff1479722bb333366e50fd04085ea4de587520ef49f7697b7828c59a65671cb2c678fbdae1b04eaca2801ccdc046fb4c79ed919f24b86309003e5be25cd2f2b457847d79f8ce5b13b80f305002d3795798333ecd97b49ef3c4c23b52fe25298738c358cfef51db04355ae23b3e8891984a0282eb11708fa42c70ee5cd7d243c3d0b2385d23df510690ffbcffe1dac676f5b7f8782060b792adb6df70686eb3f2b5dd76a234eb5f93516a0b1e7b4e9a9c21e02a155329a957def0a92e3e5f0c9c5ea19e2fa0fa59230d3657079968804065077213182fd75c16dab5f6a837b00941bb3955e680c04e1ac14b4b9a9d1a2c258a7b21fde7b4381bc1905a546d30f1f566b2c57413476d10a7327b1d60bab7ea05afa262e5e2442441c2d9c17421cee040b4fed82631186564c6f68068047c28f57a14e5aec428e6d7b7f56df0e508a8e59a52914e2fd8af66534e61f769c178d68509f4b6ec5ec9f00a2db8480d27a5a1ed712ddf9616554861f340a36d5040253af22e72bd5e542713f33f0e0cb46d2218cb0c6ef659dd679d759b008181256e165de176d9800be97fd67097662775d2c6d0cb70e33bce605055df8338dc7f2da1bdbc47a39c57b3a857db989c0946205222d999cf04aebf15149c9015eae3c067822d49cdebce2227e80e6630c254b75521c52e2c7cd4d0662240db8b04c9d2d25ba3118b06e591691757a4a6fb37f44a5dfcc28decf730ce1f6aba1ae2b7e16c9abc139d66249e066665c8711c5663ac580edb65dd7c7cb75c78b047dd2458a0dfe6e4678201b46a45a746219e3681f57069fd36d6eb00ac7a0952948c95c5199ba1e86c0313511f45aaa22af95edba067ac9c8361a96937f88b1573599293314e7bb42d41c0109fd6de611fd645dd477e353dedf66e12c4488c7d86cc916f8268e2cc3dc69e5f5689b107528d720355549245a90d7fa9ebea7bff216e1896778b6594e01a14b9edcec10975b779ea546b5268773f747b096ed81ee5b69ec49b2672a2e6a4b9acd0269cebfbcca40ecf22d40acad4d312c7462f51462eaa6667ca987a941ef3a4882193335735a6cd103bc5a10696121d8ff0f04ab54ec1f867c855809ab1593d703052540a9af8b1e1e675dfccdbc7d7ee0fb94fd58f5bf715d028594d2460d442d338d29864f0699ed382fb801e5aee4bf2e8e50978feeeec529f693de091056a9ad543931c4430b1836b98c2e641dd342b1dbed394114c75d01944df7e704d41f7b60b5d396ac3b4769e3c07cc23112148b611c659399c2cc92450c4367518736a39be8934ba8f321da969b1286516bdbc40a24430ee5a8bae4f216ed115f37972fec199a6d9ef94e90b8661938e7a44065bd4ffc396040d10084b51b6d96abea263a8f0f84f8167793326ab8615a86ea7562e3b89d7354b6ede12ef6045fadd6916f931b161d1244ecedec188812d982fce0299ec084aa14b3f3cca55d20030377726de6ad75b55ca2d03760357765af032169d72cfd0c915ba0d6500042761ae02b6597d068c768bdc292b9f0f1f11a900ceb8a694440d5ebd29321762ecec3d582c357085e0f0f46ad444b42e8476aae89f6e0fdc30e896e704c3e464bd3a55c5fce4ddbbf56fa4478963db2c42d486280d30172e04055e9624acff8004d6980aacfa2d3f364d0bf0bd0b8c9ed6c5cb6d9cb1450059ce06690d2fd15b703b6464b0e7d7862013ac04e3ae30dcbcc4db17c24421d99ecd3ece22fef24d7be35b82ad3075175f5e04d291be708c614c45b5226b26304f6d58440a7cfadc8468edd306667e69207697184bdeb42470e68bd411b8da9ad838f359284c238f16368bd430ec6bf23017e3147661842b480e2de3249fa78fe5aa907c00cf24ebcdd6b614c154c658ea9c6975a5f96907733d9c70ef922575e45ca02b2888776907b40d034c1205f3dc8eaaaa5f08cb4f6eff67ebb742cce350a9a2f503fa939d5068f12e15b6b3596259172106022369b7be10d23ff4165ec72c395837b7e1ef447ff303d2a5470038a64f884f9829fcda1417b2ce589a5e945ea3c318231ad530339312f780497eabd0a43e701d177f327bed1c06c2b15954bba2d439ee86e5b05e51d9e8ba332b5872c5b23c13a4477d60116c6de503e584bd86fa214cbea7414aafd74ad58c9cbb072491e81e390c076b25226811fa69b0fef0a342f04a807f730d898234be594008314c289f4e236cf798ec89ec1d7c45da507e336b8307a7720b6f238a50d783f08c4f52096c341a8fcd1947c5d593dfea26d9670120b375c229f6a338ecadf34a862a18ff0ba49cbe62372651cb26cba8f44352637c0a46edd9ce85b2da331a80cf5ad1f2c4fb6fedd8c4a9f266cbb581495a7a152d72b74fab454faab20d663dc8501156f0af00a89150473a20e91a2d867d62689d9333820f096562fc9372dbf1b85bce4745fb794c58829b821555e84c2a900044d2380f85696b7e227bace5dbd215bb0146ccca3a5be09922c7155bfae0875ecbb65152af13d67ecc1c80d5f76bd39 +Digest: ad5b5c5e83206ae4cdba928f1d2566d815ee7e8c031c6572274675281fa4c08a35066592e9318470242d6bbb5ae481a7aea0fb08207b30612bb0f6d019ef9fb7 +Test: Verify +Comment: length 43792 +Message: e8b1b7b0179fb988397ca09cdf2130b386a571c31cd45506c0dc9c50ca4af5a00b3566f556b9ed633ea86865227bb275678f0fda058ecac2452a1c90c9125077cc1e2548abcd7488a4f212c6deaaf82baa91a1530936b45b6ecce33cc5221357b3d5bd5120c49420f3c468661c954afed815f1d530b45cfcc328b9fbc662866749c0f6b7bc849653b18530eee424ef167882c50983f00acbcda76675d5baf0d01548972287f6c248689c33053c3f319a1240e69709d206f013b1b153f9129bb9a0d56a3c8a025f289f7339542ece56b32fb71c26cb4397941eaf633d3b52cd4b70d035aacc91b71adf710a83c1b9a788564f2e5ecf2906df740744daa162cfae0f9fc11755891047affe6d39fde86c420f70e6e91f6e9cf89f231cd3362ae90905acd6292ed4b3d797822b1eeb44ed08e2820a6cc3f89e082769b3cfff926284d85e3b885e58e8f11f650cdb92b3710358ed6392c1b157369243d17706838449121cbaddedfff6bdd010d818fb1e425af819b900237f0eab6a183d7352e3957d3a5019d0e4af276431e9577c2c6ea6364a6ed461f14c0a8e3650c06aeb9cde4bd96121084a52c10ecb5951b02f89e6bfd7557b5b31ff94087f532205da94a7d976b79a2e27cf0de224c98d5c0c594a1c26347896ed80f441cc882beb26b5384f99ba4ce9840e5309c69fd427c9c51976c07491bb2cb77260a559a2c4d7e5d8d6cbd2ffe268f7dbab3945eeb970b49df42b7e8f72f78c568e922d513af60ed09692677ac1db72ecee0321a3bb08101cbff1b9396255e7e7f21c6dfef3891769b679e1862de567cffdae9dbbd59ac0dffe998c59344eb06eb5ca7f72979be8e85e05a8ebce8fbecdfec21ffdae2dac2edaac61b590eacf33fe25cc75cf316998b8c024714de05f2c1ac51132efc9bc517bb19f171c322c7ef6b4bccf435582c0e931bddf52e132347841da223f76d88f0830ad45832daf97c4ffb8479a0e1ba71ce0dcff8498202f41bde295473de831aab2f5076be341c5928e26a67c651c967756e7978c0f0f639cc29153af25d47f88bede277d5dc85285ea6fb493606dd5221a4870114ee819b2d74f231e3784c1cbdcd06b60a22d84c79afc39840af6ac46b46552bc5b9499aa8484cf3c7ae03f9a94339dbcba59a4802634fdfa68a0630bada8053540fa2bad51981db2f6d1411e6f70833bae33f9d7177ec79b845141988c785023050117e3c7f3d628b33d0e7ef4ede68385a2cdf5f344610f65f28f16d93cfc2fb093a4736dfdc245ba0eefe3ac138d3c4790660245ed91ff136c96ac1d5ed1004b971c86cb1fa8b2122a2c751d4a420ffde40d2592e1201397a59b83de45973fddf4c5436abf5117c37b0d5bd1fbcba3ae860a866487d6f2f887e9c2a75916936f94e8d3d147861ad6e7d9be508cf1a2625da54e42497a453ef9c792fd0216a5085ecc5d881d0d665258dac520677cb1215326a5b58ed6b371e27c1b6aa85e1cb03abb0a18abaea13fb55699cbf2347af44fd4b244bfb0e59a2c518475b3b7a16f10fb0208573374a5e69661d997e1a5e23af99e7742d182c1be8ef6a78be9dc4ec8d56ce08b62868dd2e246d0bd4adaf4fadb90d6800133ec807b988698bc74544b917029ae0580fe6382703acb38c03178c2b1eae107a0255a5f939c43f8128a7f77386a28e2090180bd069e2b73ffa19cf8293acead707334840e71f2645df64dcfe92b60c2ca9d11dc318544c3404c4fc41f4eadb94cdff630328b0ec9fea29de0aef5c06c6adaff2718767ef02b3b776dbbafe7f4db6f88ac277400ef9c9658f3ad4eafaa92c030e6e4f941c16775fd3c27e4e526c62dd24014b42f9ee0d964500ec19542ea588d61bc96f5ff9d02ca7988750e17b421bd3321d1029e7172ab3ffad3dbfd19a9fee0c9d6027274ebc56c09ebc98e4e522fcf7855e3b6f96c1408990ee7a3c8bb6caa3240d1e29537d55ccfcd80553cc8115a3ec839b01dcc86f212f922fc9e97bd08205dc817a7eee49305a39a32258b4c1d9eb06b52879ceb468e1cf4cf4444db42bbb350d85319d957d1f67feeb1a4c660be97e365dfe42a4d3400c6e661caaca02accd2ef41be9bf15b4c9651891a696bc60408b0ccaa2b4c2d2cfe079e321a699630b42218e814a9cc30492255f51c85df8042fdf7f8d68ea02806fba3830ce72665603a809c2bc64c27ff2bbc3dc6f73192f91208d5135ab67d448a17c5696003f53cff23e4c89202bb213267fb510ae3c295b8a64acaf796b2227ba3011b1d5468b238a6c7d35317731500fe37a4031d987eb7795de3ae6a4f0698ee3e0966424428afb44e3552b3d7445d28f7a72d099d1dd72a1846c757dd5aa7a1841b83f513082af37fd4d7fc7016108d4542cfcc58d8e06183db8a87e3857163db39bb945cb9720b6499291dc5f4e3d6285d3091511899c5a58b3e22e9efbedd4c4b5748a8a34fa5056c923c5f449caba9e0997e1146cbff863c2d4f770056b6de399f387e2e886968365882c46f04b3ceb352bb1fc83eb72ed79d37162000979aebdb8d66c2e7fe97ddc4167edee397a1bfa3710308ba94a645d7024db78628864a536ee8c7320d9a4b1e2015f801ff2aead4c8466c073ef56c23d7a52dae10ad3c4f048da5323d7766aeca0f242591701d2ce76f5eec5e2336c8dea5ea41f814aa1676dcc4af373818bb3af6cc19f87b41f4f70645339c398a1041d5560687c57df1ed5e8d71a2e5488f985157a3da533c751f9489a29f3e4f4125bddac766c79b289199663f2784de700da92d8ce001f8f488a09102103a6fa4b4e6dc4a3c22ee038917b8e26e1fc1a7c185b69bb18c5bbc59b2c71a9635d18116d7c658b2de5dc9fe60ec231ebddb7cdb6d599af6fc4f14bb5292b4da385d207318feb97004cfc417fa68c8df67133683e9814f5659bb43d6095a96834afbc8f232ee351d9c2e3afd6f96995b24511fe38293847aac8692d15e88893a7493c3bbacfc9461ac6174d747dd6037fc7d7d20bff8ff09fd9a49d5da8255a7bd0d57f70e929de63e50bace08a4e31ef7809965291889ac52deb00903b1c2712d51cdcee117195159e3540a3c55ebb61e40bbd8465be90bb53a0e96647d9841cc486d67abf3d14d060289b26a5740a778a62ba1a12ae9cd2d96ada3824f9ebea3d87eebf78d8a804c95a2ef1b12aa9a0d9a30e9bfeb4f9ac2dad359e78d9d91b9ea4a814a4f0f923384e7e8d6eef137e60513d82a08e41c7defc9e01aa15e61166717522ea0272cc3b7a0c62353dc250acd1d9569e770f865bbd75fa3f1a6d7c3352e862ae899f6051615b08aa9350d81dc934904f2bbd9832744fe0be7409bc73ed744c7902e97008a8ecf9458c2965418c01b838f8c65dd1b5ae7d8e9f3542a6859b48bfeaeb8bcf9524ac8c84c698a6beb346f28ac447e805f3f956186aaf59dfeff009be100424daa4aaf619a2d2bbc5bbb5024e41f6b3c9c31c7b6c2472fc40c4daecf8e18996cdef7cf8c768b40f259d9acebfa9ead3959e2f8506fd0e0c5ccc51c037fa7c9403678b3afa62bd0f72db60de5b6684d5dde7daf9755f010888690d29d7a56dbaff9f6e034f3b4e3b21f79fa7ae2265392722875f33b4dc8f482d5580748cdd6a37198e08125cf810b774bfc12447fc5bf5e0bd1ccea8f0ff307bd37a7b1b3c203e48739000423b3ea7c539a15a61cadcceb504b8a2b5fee6d5e70f6e77cb0a8b79bea76175759803777ba5cebcea412a05e1c6b95c4656c48d0151d2e736e8fa6deea1c30e818f1dab0a7cafc84c0fd25029aba557d48916da3d534e35c927fbaf5afb5b27d090dbc6f436db0921875421eefbf3320b065c41fd7c47000c780da2760c905dfd3dcc3fcb5cc70bf5382dff94602957347f1358e44543c27b39beebd26de91d61f66d89e266fa2d21a2ce5dcc50ce440b23ca936436daf98fed7dfff287ebd2a95b4e49fbedfb094147c3a0f9464894d9c4e0661fd96311d513d93358f30f3a2dccdcd45a4a300cdea79c7dadc92ea62ab30365599572a7c54d3f3a7827d9b079db97dd90143fc44432c7485c51f714987e91f5a4038027eaea3e79d2aeb1b217f81daa2fc480ac3c89b2a57769285c9d981abba1ac221eb07b5585eae04dcb82b2cceeabe39941021d0cf9918738da94901c1bb4e7cf08b090f2c333750469448c240f76f9e01f4f5d34c94d24bf3b27e7048a705efd5265abb4d64ed56c27c7f4c17133500b937ecaa8a8dcda11eac21d62ac466a13983a2c1a139f79eb63a78d03d843be524a1af5f70cf30fd765fd93c4e5b9a1c856b8a2712f97eb08b94da599992a7d8aafae6fae5a124e763924fa99cb3c8e81fa6b9f787eea915aa534eec1387a25eb3093981d34ad1e84d0f2b25fc16198b71fcd939e75ea154793f7b9393a95301a7974efe21135e879c9c14b856cab58fe1358ff31c928df5621f0a550142e348ee6cd078b744f44db802b26b9218c37cd918852f0dd29680ccbca23b459879bbf05065f87d25bac10a08ae4598486bd8c06e63f4a266e47e1fdfec4b48f33ee3150bb5855bfdd96bf878b04e50a2d72dfeffd04bc3959e77c24e8f8ff09d5a47c6646927391678d3eb195f8fa36e2c02fb93753a58a8edf11fd2340f26ddf470692529e6ffb6c0824cb2640f77f395e01ef2facc49e7f8769d3283d2d3fa34e468149ccb9526d9ff810c66d7b67a384ed1e306067e9ae88da43823e0dd3d432d29fa6bdde3aeead2f4ef0eed464b3dd47c3041f2e009e4bf9caabd412eee49d3169e3e25d1951b840b22045b11aecdfa859f5597557c1592ed51f8feac556d5c95cabba94825969c306fef29fdeb104955f9e7fdc63aa29000f57d1d41b9d85210448d732ea480a2ca9c785df4492d485405a22d1c8cb4413b5ef3a9d464b23ceed55a8b6d5b041e41724601dd114c80ea8d2b2e3dba732c075303a74c9c22a39745cbf7eb924799fcb9021c9f8c977780572d08130c06d9cd9d552193aa500e735c87c19291749b653953b724ff34b77c2d4ec485c996d0f304901e90d66505eae237f1489fb1aae3b9e2d953b54bc848d536697a3b4a9ae3505da72b678910649e828df7052650de03568a14f505304a178effdca84bbe034963c34ca7e3b84959119f860cfd14bedd58d24f068979ecbdfe8f9259c0c4bdb74b7adbdc9c8401db8b2eddf95b7eec1090baec31002a958d2d1f8496d2357861bcd4c04fdbfdf4ec9943e4176a17ce64a549d4be92ccac51c4ba9aa7a9979b105fdae348c9a98a54e3e583ad5266cda04088edf566e69bcf6a65bcd36c75908cdc932d0e8e122cda101ca2023bf4528e087d201da500c9d0c82ad2634454be9dda0884eb51c04048c8f0295f4c47c3f4a632568076a39e1b8610c49f58be8d0b013fd2253a3a3064b56a000cade9899bc1af75640255827a4b1f7acfd13a659dfa42fd05730862f77d910f5187620d4b02fa661271a1ddb3bf60dc3bd651ae1c6d19eed321b240c8c86e3f760238b6cb101d12d2ea0c178f8bdad32b9089d05101ca8ed76fc030a13f0776c245f5ebe5952060ec952098d6579645e6266d33015f5fc45983bb9c4889669d7e7920165f360937a79b64c950ca9a1cb5c18240f72fdf77a0852beb864f939df3c5429e029de2814c246010c48df03ee089525dfa185391f59e96852339945c6652e2eb9672b32523579dd6fc48a095afa564f3d1c2c2f9a0f586d2e7ee73c422478865e35c820b745da284bea2b007693e406b45d63497e9b4823a9a1738bc6ecdbd74b004591b875ef780d3432a7e587b6f2b1efcb25317001325035be92b910c0780c7123f3da381253403d415e1c285789d24db42157404bffbeb6390fbd42bf1f1ee2d3d5912eeb30615fd7a18f083e3281e1cefc546e511241ad734137f53002feefd59571ace2960d365600a2a9e3933d666be4bd6ce8e08585ede5bdaabbea28f2b9d1f044910a903b5cfa1b8fe00281262b98f6ce5c00f6da095bb2c5cb2b2985f11991886ef496e94d0c4e1cac36e9bb8e77a50522ea22046611bbf8d64c8d340bcae9dae4ea8dcab695bee2b076d390f50f2c93e60273af84a63d9675d4a0677a644dde8b52e15a2a44f2748568db30ffde020d1df08845d597bc31224a2faacd7441e5dad43e0208986d44a3736d361f52d9e3232abc31e954bc5b5413677865897a934bd4f06cd1fe93d5833d05fad40bf888ae17ac2e207bc26783d7045ad3023c6966eba50526e60aa9bd1c3209ae780290075db4852b5b430849fb72bca67d2bcab47ec83577ed4623a9977ded1f157c8bd75381c16a91c2901ef72f285068bd59ad04d6a83582bae5e135561fa662bace869f807d5ebdd5a17b60b62851335578c9146cc7f034fd62fc8c370bc4fe61eaad983d13781dd0bec7ae9437399ba8ba8133d70f2872622d43f2ad5bfb36f662b4e4142e6750684abc6745df69d01b917dd9b1f85ed9ad97600f356ac9aaecc92509a2187cf3f0c7a1f1478b729f2290077c9a1e03c92453c9484bc2b0c8b980865f638c5956fec810f315b5d4475228c6a2dbeaa7cf5ac4f8247cee312ee11b417bd4d45d1806dea1d33cf91f772eee33d313e8cb5ad57d652a2567db3bf80bfed5729b28a59d5dad2829cfb49d1d32c783ce82df0a18efa8dff1aa0f8e62d506f2c94b2c9e26c7bb4868a42427a1a90a4b5853635b999e3bac5e4f5e74b609026a456ed95037cf54da8600fea560a364806dd4e8addbfb8615c7a248bd761a69928360df6a44b70254ee8094a4bed46ec96b81ef9f549a20a2ca4d4e97077bb511efdb7f4ad2213c2e2e8d9694209ea18cdde4d89e97fc83e9d2cad0bffecf7d4f0739598064906aeca29264f24a8485513178442a1a9538417d959f86d0681ac04604fe99808727170739905d710882ad02a6b2d060f6a6502727db8a00e8260c48c8def49a77f913a8eda924589d3206ce0a951fef93668c6c0c454824b217997bff6b3026d5498924190fe545d51be4f01e7b772aede15cb8bd3d3fa07877ee4c0323caca41a0edf556352eed2298ce255cc654b778bf4799a553def88dbf71558ea932d92f8798893fd95fa3284128ba301656f9c658e39b7f09a4b18466d914fc6be6f7f1763f7c003cf60c389d9b3b52dbfc865936a71a84cf3f5fdf067c06d6dc758b59e5393a7200808ce6168c351f9793d193e108b36124fd57f006d0a7988b5d27bb6d2c40ffa49da9a334721400d9db5028d09ed29eab7d3e89f07d73dbe91c4188767f2bf3999be7128ff374910321a66a9dc01497b32d77ef4be8f7fb86215d5389a858086019c9968176c36ab41538eb9112d5e6ec8c98b28199a081d30affaf2f3e51a89885c5b1a1727ce85d148c2e631db2f6a81915562a160a0960479cfdcfb7b55e936e6ff6687d2d847eae14a58c3728518661725cbdc4a0ecbe55b9b1f39adf94e1322cd75f0d41d9894066d364f5a28207e44428b54be1c63db3da8e235e4cd6228f80d6fda956521d89f74a85dfae029d2fef6c991259007ee073c4e78899aca7c51067ccb7d7789bd94a7d876bc75db682e87ad19e8335e27a1a08b89022831171301c24df41d794ccd4eeb2107aee04abd3e60766dcd118df41cc0f0b93f3d0228466ce7621d998c32b10ce74454dd8091630a301e26c728e6f7153614a79644761da0222f409085ac18614fd92f7d10943ed2cd62052901607bb3e27d +Digest: ddf3c1c3c0cab7e3e1967c4666ebcdb19d108971a4f091fb4089c0930b094212ba9c6ce9cfa2ddd7e1b38d3b2d58600a76bc33c7d924dd49b0b54004e2705903 +Test: Verify +Comment: length 44376 +Message: 50acdee79b0468d37ea7df8e29511f5b65fb48a38203583d908700ecd211b0296f7af5236b080405d6da97774386f7677c005a0974be701c7d193970bbf719a5d9a72e35fa0ce1b5f3febb57b7ed7bb412c765c89b1cdc3ee48133eef332c1a5f6fb33243258266b3ddbf6376dced0c9901a0fe9dd67c52b2b859771610acfb12e3dacf8fa33fcaf1c38ed1e4d71212e5cbf007324e55269bcee0dfeedc96b51e93740ba39e78b0af8de4b143f1d946ce07ee16e57e0ac82fd833c9f7fb5bf0e8faf9871d9bafa033996b6212b1b510a83215ae35e9efafe580ecd5bff18f06f886e5c25c1f572234726d64ef9b48190ac6e12d9216865633455673b553829fd3c3c33ded9df1af08a5655a2912d4c86c52fb2588785153bf822b3456a5e903e14e0c5a509c21bf46bf0d826dbd1d975352ae1687a3f310d0e3b598324d14dbc7624bb8139e49cb750ba0ae0c0e751e564284812e2dce262dd6800fd6cdb89ffcbcebd7b518fc6c0a27e90da26b6db5cbaf08f5da5a54fc1cd7350ba2bc26c8d7ca7729a3909c197ca02151cf787a0649f4c5d52ace2a1b24622f3c247cf1df0ef7783e6da9ab4c42e0f3fac19a2c8847b025af7dfdbffbdb03f8e1daa4ac5b08e0697671a8cc7cf386cb694764f7a45b6db2f5626d7926b7390ccd43a7b8b53c01b5726e22524414fe323dcf4d6de2db89f84776a208143f7de52ede1a99863ec806b2a1baff0a2da3a2e8a7d7e1dc6e916006091fcf5cea5f0cb73851e13687cfb7a7bab705678433a7ea8f8915f98b2074c1b85b41692e390dd6b102025e8d7552c227cb17c4df1abbc3d4c55cb29793c10b02c8f0b191a8430df69f8f66d65562b2674b98aa84c558f5263138a04a77bf32570d7fdebb3956dd678eead7e8ec51c8f7dd2a912bcffa0ee2412c3aea58d9d8438d2138e148b3c59254973a4ba6baa667e420112a9739719779c9fb0da3ab7d56bca768ca72e446f58536f6551117bb25e52b9307b771bdb44f74693ad49e91ef3054d6dd3462e20f952ca4cbb7d377b074af9f49ad4d43d736cdfdf8884da69b7ccc1b7ff9aa174f08fabde607887c96072ebe76f526b46ed43931ad2b133bd9f66faf495f3467425523ba5a9c913a55111b49060b888ff98c489cef2999b23931d1fabfc19c52781e3a128fc3a8216c2717f77d6d0d26e5d37ea825204bba17b3759659cd4c596ea8906efc2917c259bd872253a60f29d25e3ddbf59ba3b423ffdcfa9ddeceec7498d92836497abd9c48fb521f2318f94d6118b0c6f82c20bc8b7aaff2728eac487376c6b4814b43a26de71f3680b525a59091bf1fc25f806fcad11efe2515e958acfbd2fd8d04250a70cce2402b5e3f69713b6f6686c863ac4262d02762ff5403c9dac587b92fb243063f33b2af9e973777784a41c1c14af096c25bf4b8a55cf84e9626d982387bdaa2909c0479d0dd6e07cac827e00496eb1c522afc92a264949fa07f6994c8f23fba7373cc06af629bc6b5719f7dfce7ea57a4c5859d711b77519c27be5d3bb5f0d25a636ff284c74f28caceff0804ae7ced2ca446158bd20ef8ebb85e480b278c6eb7d366b9fb9bd6a27d48ecfac66b21317c5fb4b76d48c9fa11b9bfe1d1d761040e5c46c96e30e0c84f67efd2bcae65b8f64037df9fb046d9a0a469b70a362d26e06696ad7726ec0eb3b45e3c51d8b9084d0e661a9dc8e41c0af0d2343ed43f4bb07accd280fe66ea3cb6de84208aa993c302c5d4d1f35035c3378fe5ca2215d701116fe52627cfef5cd7e736932495e00ad5bdbaf6cfe9bb6bd0f94836b04f7d44b2e631d123a582969feee034473c7176ffd429569f3f116765b4e82f0f5a931de7c6550c8286487c977c0d8e52dbccb9d99fac8c11beec486e39220d8fb5bcdf1886cb52b4d0b56127051b0be81256260b86b101a7e7807142fc924cc1ff5f2addbe112e4b133e06f7209537676ea25dfe1fd341d25782948c85c57736860e63afc2a309a5cc56b06045089b614f35c439c18fe7117d7704b35b18176de82f1bf73b1d7f657aa40ffae8e192664284fb3712434be5c7b2545fe326a7c89445d64c9ddce9fa9c8a783f82bcc6d6d724558e9899faefd4e8f5dac46d92e728e70538515df3e5a09e7ba6b8f6a3438b788598baf07e70137f8bcc6549734a04974b12fc3d07b73544acb8e22bb22cbe15edfe0fe3411701da68ad4c66d351b5bafa94f4e6afdfa9016dee94d86e030d610126fdfedd553eae2ee5f0320d9ecae6a606e1e756dfaa7941d057695156f80e519c0b8fbdbb185f410ee737bc91a29ec01139bb97278800cae6907ae6a8ec5271d5bf227ca92d62419097e45adadb37fb2c72dfeb57e03c6b99d669a87978f1c45c9f6374afec5ba31388c452cae36699b113c0bde131809672afd211391c50eba912bf305fe3afd7f040544ef2499f3e67930a99440a71fdf97320ab7854f43a33bf825a0991d362cf4510a9e17c465b88771a07f0c984e4a6c6f1f1a7a1504294fc793c6d856ae5f91d85fe08f9e073cc467b8487fd3dfd0321b26e578fe987456ff061dc1cdaa4161030b5d95112097b77ab897a1411a98709de8bf88f449abd807464d5f6b75faee38d5be3005faf4e9136a137bc846cbae5f2d51b0df5df75b491bffb71656b1c0e087ab6960db79e09894651451ac9075c8bc42faa51d7f692c4ddbd3b7948f5d64e7cb470b0c4e2673ff3574c595104b405f3b6e2fd16c8918a388ba3778bb4f2abec7d2eed59c430a732aa40a4773bb2fdce41365c1e54475e7af747c4a5d1e9cd34612f17d8bbdc7b8ecab0a0be04afdfce4f12f341320acdff70a70529f5021f0f110fd4e421e11952491ab287f821387e41076741da723540983fad7a76f20db70d3f88eeaed4fd37a5fd7e879ead7458b7920c72c61430d8ce701239d03035d6a63cc86aab3eb3a951c7591f60ab2fe8233177668d574d4293e6f7caa92313e88c95f7eabf74c921ed06d6c1d6b0d79704641c8f88b1f6f88912b2bf6a61246710c9bbe1441daa3bc83a7c117944e7ffebb8807050baaa750e71d77a8c60e3dcd34668d0e1afd35183e0ad80c0ddfd8d499d379b6de7f4429492daae87b8dea464aaa35c1081d0fd90880f8235f264c99e80968348b040ebdbe430be04bf71682544efc5495a2faa8eaf16a84118da3f5b0141aa69aa3cdb14e47e1b5c1b489295d3a2bf049f4be2deb437758ab7aa492fadbd83593c348b001217592622c0be46a5609bcab7b230f135f65c7b6571815cd46e909ffcb4860e0b90f9db8c8645b858ae0e143a0f1f76a2d7cf8b98bc729323d974966259569f2f7f6fe4aee5b35b5bef68699c9ef8cf99506143c7e797430a8281e4e38f77440c474dea007ba1a03da95d43660e677c7804942c798f69ecf6fe5af416c3629d006cf65437c47b475c603f3a1cb9e5fdcd48eabe3410550177b1625c629192faca750babab3cba8166a880a6274dfed417b1d7617e1703211b203a766d7692fdc8d3f068d160da1ebae6e4102c171c9fd5b3eccece0fdebc4fdf35ea7deeed066a2e470450cd745fe7bfbc1081c1b9a185e39d5e9a675243945307114a770bb54cc862169fcef3c56b779b2fceca6089b6b55b8969b9f84767000093298b797aef56f4081501e2ffb4c2e3c6798dbbd8d69dc9e7b2845b48567ac4e8b1a8a0d7a04e5f6156f2cc6f6206385cf8a7f5ef64214ae21b32d5b6e137b67a696b3c5c2e1316baec1e1a84e1d5fb8bf295d96dfdd46110fa62022375bb77d0b72f8668d749bc6d3ae057e0b2a6cfbbcdd3c0a4f22b9eecd67e6b1ea26a6b743182299e4a56a300d9e5fef362ed076500ee3654ef9b76ee46047af8e5e923ed5eef905ce5ce8d0e3f9b8a4d513d45302241b4de44a86b9dbf70bc42ceac139495e445353815bcfdd27d844f3c0c0b75a87ac6a1afd6ff63a96f999cbb27cd128cecd2a7bfc0c5483908778951ddccce1a05e66f7faba4e8aa4dbd6739e0a2ef8a85a334fb543885e9d8de8c5126fba1ed5f9e68329afe8518977232c96b5774453b415d6944892f5b4b13b8a87c3a99a8f4495c77396ed1aac9526ff82c3d59137a3791882629bd03fbc1aed641ec0db370818cabeb6846a77ff8af34a7d6f69bcee071e65dacb78a4772cf491c9276b330d1a95f458d6cb517cf511d62b6e534a5f66ef27f849744da71aa9f60c07d2ed1b412efbc40ac4a2d310600e15f9d849bc3f93ae043e4ca0178b147c2e8896cbfa359fbd4249ded3cd82e8db82397e21ce3913e446d189078e283c0979d14137719ff0201abb9f4a32f3b123bc55d03a5dfd76af062bb2e9d3992986330b5b984a27270e93879170ca0dc4d0097653fd3132c4f98b734fadaf85e3dca55d6a564b744e6ef6d63cad5c7528c8b2c491d0118106a91ed2e9bdea9473f117f0f8d93d2f6c278bcf276ab2d6e5f5fe66111cc69243a7077007804c6fe0afd1eb8c88e7ff8a239a9bda0d92d6043d37855b4a190c83db8e74315e9dbe32fd1a77afcd138daf496b61dd00c51d8c8aa348f8c0cf98ce2dfb07efbfa42871c23cbce70f8781e381464ab9a9135485c38cd86fe8b3dd2d859550ca0b2a56a6e87de1bfb70c822eb3727ef5724323f7d0385c48298c84a7cba57849aaf7f0d956260fbc2b6a3899c7382419c21f31eb99f0fd0cea213445e773a6f505d39d10f47e6d68d4694c2ba6e064ad006d276805fbe342953b960ec147035482860555aacf244a1ad166ed36b2673a96f6ac77fea3357291a2510a4169b7f08ad7d1af605f5bea66692de560f55548eb82691f6c2e1c24461e0e415020e951868fa927fe783bd11efa4a1d0df3565d67d9066835e5bfe11c7775bcd4b6c1fddc7634c36c60ec86ac4c649d23f2900372c22a5a421047307b742d82b671687ef6541b8d925f95917627246b8c3b2ec174067dfe7bf7db9acbdfdf9bdf9a065c3af1058d59bf5e7be65332912e16561fd56da95bc8e1a4a6747e32103678c21d12159bcaa7c670cb62973517f3ca31a6fdbf53791218c9dcde1acfe8a255c54be587854c66bef30954bdd603c1a1e6dd55c425613fe273c4717a5d2b0d77376d1a106a1b7ced0ebe238bbc5f82e19d4d4344c71a3988cae7966885e15e273f0c1b78f340d39cea7137ca8f331dd3807c3006e1ace651f5ccb3aaef137dad05af4f87c7c25112afaaf841f9857abfb4f485d31a2030871dfb320942c95151b2de1e048fa9e09984f1cebaa05f81ed643da8731a7dfe7069fd794d2709c45b6e22f0b9f2fd677791cf21fb2cc81aa4b6dd03ae8acb37560259f23e45ddbd1260012d6c99c7cdf5ffcb59ce46c92d2ed25efc4c1213c57f0f9703a3454c25c0b1053de62b0ffc5bf66edef99668a2d1e148fd14595c8f34b9401646ce5ee2ab88b689ef51dbdbf19d3e1844c3af61d60b216dcf08ae7dbc28db92ed891cdd1b0e9b774fb33552fe1dc5707976a652857773b445c611776183f0df611d8dfe5a6b3c70cdf82449cc9e8b4c5e56545e254ec53a3e3c8e6569f307656a33ba2eafc621dd32c8b1a8a1471715bd0cc16b00b7a06682122c2f1d9fa98bcf73a9536147d32446cde257c640f1345c3ff5625cdb8ba2d8eff4bec5b05dbb5a846456b918d9afd1acc13f83b2a10f0398f92c82e20e560a7becf8a94dac5dd10ff320ff5ebbe49b1056461fc5af107cbed4afbaf3b1e8de5f1ec6109f1dd7fdbb5c987b44022d6b9fa855e4a0a49e8e5b8ed54b36fdc11d43921144cd3892a631a9a574ef35f10b01bf55186c0820001430857fd479498fce4fbf8b0085f69419e231348adc9741dfa32c045061009b93c0a79cf5aee8fba95db92e608d6c8e1a0d23013b7f89d6e15dc4f07539a527804922ebc022072a7cc4e87414d75a5edc3463242aa72e92aef303240217776c82d0e0b45e5f0ce5ee8c33a745eb29ca085ed8e581dbee3cef70d3e72084de31425fc83ff7ed61f2a7be810d1a52429b46946c8b65a4319e4bd91b83f707424068fdc2d3b2526c195062bcf0bc930b983ddd066000895f7e6b38c33eae280b5f9bb3b6b9b7189724917ecb965236ee8b96418eaa7a12e0a5f694b2616e6fa15783888c3a2fc649d9111c964805c4523af8c8edb2fbc71ddb95f6d2335e656defc9842c9c42e5e9027943054dfdc49f6f0c7b09c0aa317ce7f0650afea791d5f115af7f2717fce16570fc00ef61be3cf07a61cb1bafd76693aee94208707b42230e126b25d79398cb9f4e6f74593a9385e9821b0d334144a5788a629be2ac1d4f5db4d9dca93376fbad413a250fc10bf801e7e2dc5ef87ce6f55153fd25abcc3baa9db295b662e3bf43dd494aa8da0c106b9706d15783781ece45fb766000b9b09cd6dc9825ab47dd092b842b4f0efe94cf9a7134476a9e15aa6f4350bb344a75db66412d1f930a1ea632d40f2ae44a4dd4f9094d5536589232d513d15fcee9541055c89ccca4944ac3fa1f4061e4560323bbb863aa6e0d5f0e8154437456fd13e3ac582c53654e29078c4f041d968b7d64e865c06d9a2442e57becec2155ee7bfb72db27dd5e9e821bef4aa4868351853e89f8aac74307045fc9c5158f52235401af38d39118ed1fa62bfa67c33211e159a5586ae0f01d6d2575c605e6d506669c6b5779981aa4c651494597fd2b315a5e446f48df29ce44df87d6064d66fe7875af206019ec2940c450157a5bf71bb8f56e248bec7682533505df5eec8e735433827bd23d17e655a648515a061d35c3c52c5f7d3160a160cdf9c856ecd4cdc07fed50152c2241cca03ae17d2525e94377850864d36e9334526a793675c1758501f787720d95a46f592dad2ce1989effb2820889fd29c1976a61d946aedcd16b60a8083108f976047a299cae62fdbbc01f2a4534d5179150bde5d2cec0ad4a394508bb9a47d51f54aa36984dcfdcaa4e6685a8ad83c26c29f4fe4b15d3bc49b9572088f5efb10727925d894f50bed2712e9b193b30b2bbe8b7b42d640d9234b13ff758892b159645d9a555fd0f299bf11f758127046de456ad105e0399b674eaa495119f218a34752817e59f31a86d95e21ac6ba267d513b7f19c73a9db0722c2f039d7ff997498027b9217de1c0b0261f92d239bf6a685fd5d850514209953e8848e271dcc53d2f7d95f1de45fbcc6d7de68beff6ba93895553e28faf4844ea566ccabdf29b7848d3b33e0c85e02a2fa51ddb23f4f73983aa94633d0df5e9f641783caa62a16293d019ee4dcaf730373f3fa91ce0a8c1137aa3bda38398eb2bf3731f81555f63da1dd1ebea3cc9474cf255dc23e35695026e86d6093abab25111655d8bf25ee4e361e31b2b02ddd73566655e8025881c172d4798b759e2a6304657dd0d62254b774555685745bb49bb447a167bcdc6be1c60eee9f409992f8f374f8752cc3c025e7131b9b82cec03a63499ec5c0499e3d7ae81b30a7266b5388f5843a1592c6f608c7ff594e0f76fbeddccc86af187f312c00add3fbbd1a0f1f477f941307cfc453e4506348864f4cae81a92eebd1a56933d904fdc0d6258830fb6917b7bb410d4318dd3e04dbcf994fc8c32308fda7523ce1cf1288fa245b6871cf3975f5d12d60a5e44df5786e8e2c2289178904eb6891bb5ab6d6a18cf5104b108dd06fe6c1474c1417bcd4a287de2f8950ee7fe828fcb6365f1c54d5f1e307eb694981f855315bcb2fad791212d03042739be7242fb862e07fec9c75be3b08ae6063c48c55e955a7fa59fe13bb9cd5230433a335c96f61f79da9d102d692fde81791b0294fc9da091c44ac5deebeaed967285c83a28c13da3cd6bb03b7853 +Digest: 21af3c94cb7200954e98b1956bac5b65b3177a933b7dbdaf7defa821f0c05a2b881dbc8c7482d74306778a2bee8708dcc18a7aad4498c6ac7f7f55317456f2ba +Test: Verify +Comment: length 44960 +Message: b2d525b96268c224a26abb7e0432dbf64d82aa8ad55fec7731206bf410c6f61f638baa38c1be700d09cdc7b549a4c481de355630dd58cf62b2d6a05007c064b9e80621202444ca34f6df0890e45139a4e8c1baf3ced76180ddce4e82b9cbe45f886d12d854a5d781b0c805759fe24547b14e5b3c6f83abb7f931fcf4ee8d7df98ce805ca19879fdd81af46cd40ffed528203c3718905b4f05026330d6eae37703ca1835d3a932b2eafbc5401904f3baea30879fce404851428d67a3500d71aaae0bd13f98170825e8319b677577b36415c86054348292409ca6959d46eb02f90c0673e06b4c6ac5345ebf4995d2ae6f4f5a5f0b07d1c9bb97e0658527ee07d0a24c58bec9c3fb2f73d5d97ce690554b0b58cc0a94a84f20a8cd50018f9100c0153ff821401819b30b394267d45b4875be6640098790a2fe63bffd88ca6e7e55b963eabe4ab346fe8eebb2910b7de87dece5435e4d0555c34d4ac69174f0e0f0235aa8fc56101370637f828ee882b5d22b585e9f5180e80dc9f033922ba2c92dc786ab520ed90fa72d673ac7f8045100ee51ea33318dca4c5e42dd213b0ea77d3a6a7a55b1588c01413563c2b66d1a889a548ec069a68cfd9eb52bc53f9f0c5ce0988e8e0a29191d435c6615a047a2e7d3c2b4bd6645909fffb987d4b5de584b4e73605155b55769a86eda27420e5a9d1f3ee480b40585a1f5e2a9f62a471bd6f89d884640a79764e4cf387e183bd216d12ba6b0df40dcb225a2eaaff953d77e63797ee3475a89ad8d0009809f5a89f39e1b63d44481f63ee38cd248cfaf1ba01399bcaec6588e9205a3a5e553d4e291da70b451906372b6c402e977099358ea8d60ba0f6a2c16b0e32cc602b2559ca01aee00bf2f4fc2984b97a8a133aaffcc3570ff9b9f4fc288b9fdc26f4736e87cd3c5e1838dc17671fedd886dda70a0b3a04d15b9d23e1297dea933919f0376a699aacf354842fed2322711236a7ecc4f52576510af61775ce5c182000645c7abd10f424acb4edc17aa16cb68601fe2ddd02296068374714643b9463139785bfb1e55b34aa36f9ed0ab2f2fa357ee751d8e310121fac180f29cf2e8bb95059422e630baab5d1fa79bd9c2b67abe64f35cf0f53ee971e336d03620f1f5959800a1ad02c0e344c986b79a93e845001e0e3abcf1b7c39543f36dc3a5ea75d78a31f5f75e5e991707ccd281f54d98d964062526b90456b18e5729ba044ac2c766a8ae39a5fc233054ea6b14794efc86f17baae2bd9d09630cd2a28dce9b52e1a7c529087c22182d3b5fffc69274d6a520ef4a6561fa523659e666b36744acb2e827f4c83358ee6a15adff1cd347cdc08cc162136894d787f002c4cf60df36b78231a01d7e092c738e54e78bae4028559fa2b0911404fff469d86b363de3976c2082a96ccecb48d61fd55797a5f69cc0c403845306b331f821a7b88c60ca354d2d8b7f3a8817da0e24afadc53cc381beb4547bddb33823ffa2213b367c2ba6d703cca00b3c67469837647898e53f8d9bcb25f595ac0c3c9775b571c8e26042a66dc69a537e4214e0e264468721e306d482e8901f4397e24c16d4eab83600bf17b5f9fca7a030cb84904f862495268415762cc9df2c63cb8a00101498d99572b766e7157c549be10feb86b5d591a29bcb1f630159c9183eddcbf76dcf6f96e4120b0e93460e1bebcf3eaa542ec9cf9461d91bd513abfde2b3c4eb74d04a7da9941ce0e4993f19426f141affa4800634764db7c39147bd2da8957cc8500cc239da16fe87ea6a2c9b4bf65906cb56fec274e7e74b672ebe9628b81bb6b328fcfb4073c80bce01be4d027ff507f7d111e4fa31fadae9b37aa2b0a758ee6e11968453cdcdde98b856de1efb7f81de70d80252b69300bd8889d9dceda4de0569176ba09f807efed07ec4fe0348e2d3a8b9a12ae0104b371064b219e59fe40da207f7a343807b44ecaea81c21f1d96bfb5f57ff3923190aed83b1d449aabeeb3ee0ded8543e422f8f5efe15d1faa42beb118d2c3c2c088d627f5fb86445bd12922a77bc6c2a62032b181d678dd3f187ea78b75e639b885331a02212dff17d386e5d68cbd5c569543262ac8dd00e30049c0d7ce24a0216e0bdae9f90175e6db105e208833bafb6b747b711f52319fe265238347459f042ba78e32e9c94bd0d211b610d7f1849d890dd9de44a0187aa61bfa174610dd68a34f5f665b4f2cdd9ecf142be1bc6144d75667fa9d8f5c7c35b36a1c354e0355c04b750cb659be162893a1fb0f5ff9f93d964e4c93e6a6ad75759d197bc7b8d369e2f7ac62b0a98258a48407c7a0f5c3a317b55d8f6f9d164fa9bb968043a5eb865d0dcfc71c9629174ce6d77249fdabf11fc5b3f7f0eabeab96eb1bac8a72a40004e1fc4d642d144bd1eff47920b8b80ff7a5d8343234ad728556316763c607bd1f98bb5c52154add7cc6e542eecff2e5e77f54affd24ec8abe245f1998491aa6f65d945cacf7d3b6959432377ae9615c3678adcf186282dd897c2e2aefa4e7a3d15610b53b7ab8bc648064bf8eaf0e5a2eba6dfb4d9577522e862502317f769df7abb6cfc74700d930b30241f0c900c8156d1b9d6265d4d0f46ccc092681cd7ab1850e121805b3f44355942769de3f8f34b8401c207ca0412553aba89553f624470ca1e7f55ddaf5e38da2d8c196d495d3c463e04f7fe38c07654b45479df9810167f6b427f77cc35983b5bcc09bc6c43ab90c51b719a599e3ca334a0506dc7b26bf96e2777aa148ed60543b2e921d03b0bec4d71ff0ef5000aaeb1d9536a9f9003b07daaa8f516be64c08bdd226e2397efb11da51acc899a82cfc28bfd668e2d504d3038bdd95148e6e58aa75fd1c50ed997ec213f6395c2178edd14d8e1f20ee4181c4e10d742b2befcc6adfbfd32f43c090f72e764981b4b746820505d89a931b9a8773c6f79906f6ec65d8150fbec897d1e16ad300f0a91190a2b1e49a380cbaa5b30ab1254467ac410428a7d9e5c647c8e88eb5669148ad519917d26ee2a0452ab06e750615953952ad961c388c83f7fd7564c6844cd8b414ce00785a8098e4b2e567bba2f4dac4a7c9ec1c359b48d0f9eeb2ab610aa34d5eab337d69fa3cc1c4bcbd2b02ca7c75c9c1f051d7fa5dfa43bd410f05b1efa1b9977a8ba038d401e89c376c2d7dc4753ffb6b6026920a9c6348d998792b05d8acfa9b470923a8cfa6ed9f272bf7faec91e124f42a4997dfe2f941eec45e2d19c03d5f5baba100518718bb03051e660248dae5b3ec084bea473743baee34af8c7bc68e6f8e9b23af128354a9c2dc50ddeb4d744573b870e61a69a5a40094d25a68fef02abbfa5a12d09731c06a18ffa802a49a53c73f4cfae4f930530165dfab0c4d4c3539a4eda247bc1cf106babc8916461f85f187274f2b4eac70f9911ea6f11c6c3710832486015bdbe49ca9cfa8ae9bcb82f8764b0c7ad0e1a2f1ffd7749ed116d9497e46e786da374037cf802e520b66f3e4f6ff5a56e79792ef97523c9bd613c3eb7c9dec5ca3f8aedc1317438afeb77fbeee8a6149fb95e8fe41d62771912b9cfe676fbe0d1ce6d5955ddb0edfdc87cf8d453548da74a44b23e5ad5da76c250d8b26058421afc85e699515b8d80d9e8a59e5483892ba8c63686b1d05c5cdcbbd98a1a7671ec368f061a40d68fef9c4592ab50b58f73515d9d4bb6f48531ee35530c09d8f8ebf8c3483700b47d709c1e4099dc5d1934e06556fbeeb4ddac6367c586b2e23f80dfdd1d9e2577deda35cd2fd85c0caee6b297e425ad83de22d8cdb1a8aa34be51483706be23831c8315ecc0f55426c8ef644fd5478803ff1bbad197d054431dc3ce5b93f59f88cee19907946f594defd552079ae01297c91d860df89c459fa65eded535f2dddb5e9c5b782aa4efe49c3f2859b56db1c1b49ec6ed547af2ad1088f61e7d34830d4419b9e8e4346c7d566333b0b56f0a145a15fa0a2beafffdc4e8a0a1ca19038137c050c461ac639a970820970b626ff222299bceff7aa1f43be47b09bd3ef3f982469c85136b79aee6946b8737c6780d953038a63f889d32fe12c1b0c714c8b8bc0319b599fff33cbd7e610bbb29a6a93bd03d4a7cb3563c83da21215818e6515d9c44d035e884c6944ccd9f15fa70677e6026062789517355c125f610d9f155ef68aa6f97a382df0375fdbbc8c759cae5869f73d0590369fc6e2c8961c66e38d9feb6ee3fbf91d873907dec540ee745f9b9e61e07c100a2d017c165db7cb17ca5d4f6c68eab26656d12ca9b383f9d5b3350b66f2e4fcd9089746115de5b6f83fb61e69314e4b4e868736052f5d7e09d2b016ce1c463bec5710aa803fae0fcf1134c02de62fab1e3fe38ebae1d76656e394296005a9b78b43f20e2caa1abee46b5f9e802e95bc1da86e9a9070f897050e67abe5551557fef4c7dcde4732ac7f73be1e2ab1896595eaafc34f85c9fa5d7db30426b693038c91167b5cbefdbfe851d9a9f218128ecc2c2e71bec75077a855ff9be8ce29a37e4268536eb683e0662e38a8a10b391f0b97740da6df97f72cc1d4daf645e2201c3144ccded7cdf843326481ff3105019a5308fdcf74a66033e7b92817c4c360ae83324e73cae2edc584e49ed4337e1ac18772ab012f839c03ef36ed12f3d64c7c63ba41f437cba9354d4065e8b8ac53c85c3b7d04b83891e402d392b07922cccef7650d2ac58e12dbb4014003699895f6f9eadd9fb6cd292048197db9ffafc9eb67ba1add1d3512fee2ae96ecee49c6958607329cd1484afee88f17f52c86291cdc42d1d4e7c790e7fecfce6ceec7cfeb2d1be4c1b2b3dec50abec82ba9aed6a97e8398d9ca4d73df31ec524b121b994114ad5bd70115ccbed82cf9251d2fb6da7407d8b26ecea52ca38e8951014c0bde6345fea56577fc31776310a93112b3f6e756fa287c520d167b3cdb4563620c0c436b37f587e0566512eb77808d5eb447fef664039ce293e7e27fb0f1e2668611dca86e8d0f58c2a4cf4a9472d81ba013e271800b75841fe5ffde701b245f603655830936a4e82834d60ad146ba5161a3ba4fb508b042995afbe1838cd15582c3d68571b8ee96705e50b295c6dd09de3faf166ac1f424e98cfd10520c9250d40089340edb976c826a65cb47b8e64bff2fe95009ffea31f8c42ef443630f593d34941b4867447246a03cdc51e5801dacba8f84f98a3a71ac49b514bf58ef77a8a91fbf88239fafa548fe6d1a155189cd29c93ba22a8becee65bbf82fb4dab3faa553aa34d8502b85a9d2070a0f01964ac4c1fc6ca785aba75e6829f93f7a141c715763b64effeed00ce131899d394c0bd39c4fbfc8d1b5bd7de32e87c174a2f6555472744d53016cb95373ff85a1b4f99e85bc035617121a0a558f3f02736570987260d89df46b43f84f55d490e0d5fa6da2cca01afecba44de5d58bc91d667384d8b348058b343b11fd6070869fb8f7871b06fed92fe7458dbc87d2e01aace55faff62e4fc0653e4b861b3c2f8563d93519f3855e526ee414012d7b0d133fb0721eaef1413a0433f0120e9e533be086bfc4199e700e696828dd50f019b028ba054e65f9a4a21c0146c8c2ffb96837e86d4302afd60bdfbb12787798cc986eed6067a2ae3f9fb29296d1bec82ab56ee686bf362259f2d8c41af92adbed74192fca90ee78dcdad0cd27558a5f6ec98f67545f3b5dc16b5c6b8789f12146eb326a8df1d0bf41fa7d9a437baf2e4d4ea1551d4c9bcad61d7498a34f55d29da6bf85efb3d0eb37a8c2e1306bb49b8fe9ad972aaddecf5fb12733b474dd56bb4ccb6839fe7664868ca68a374e2110fb44ba15c3ab8ad626ce7e24031f121668865bfbb2f94b92f64d317ea04c7ff45a07d0b7306e2946f11d7f53d8797a786bfc7926a4cdd6de4f946ba3b38c55af74daf765b81d4287894634a97baa9fe58e552cd155a19fae58085de2b8372ba911633807a4e05e01b6f0a50c33d909c6973a7de40e9e2f6bda520e24f6748a49f94d9a853ce1041c3fc3d965492e3e814f52724717ec0d7e9e19864fb66cf8f9f33e26c7c845bc40ee69d89d05d2c8807e4616e2b8b2c14d6906ce4c4046ff21c9dee3b590370fd58987aa9aafed2f29ecbd6e9d3919d44206c1ed04dc2b272741d7d938dcdd8343d9c858468fa6f9e660608461e148cdc43bf1eb5ed243f77424ce1036f35fa2f2a6d1e888ed26b01ea4d75f14fa67343ad23ed14169b5f770396e91981ee6f44ab84d65471095db387ec907a0caa0920e9152a697eaaaaf834a5c6347a59a00b4d6e2d46d411a039eb7de85eb9a196ea741d272479d49a8161d438e2ad0a24e96ca383fe1c8ddafb717bfe0dfb1fa506daa693d39cabb698f7cc91b28e62666595af8ad8bed0767eb65142063596cc0c893bd1055b9277a582d96112b3150d1664fca2753f8c0b4a26b844e5ed8974720c576f283b2b664d7f853781af74616247055b421302f1c44efb870ba77a26cdd093decabfc90ae76a7a858dc8130bdfa87425cddde7d2939ba58915e7eb5b86725ba05b5e0dce09c003cba5b17374e525a38276f4ad163ea940bb63235fab227e1944589a6c383b0cdb8a57e01835293b3e01ebfbc5451bd4479e91ee396e2830773b40f966c1e1cd4c3222d863b512458e248b67c2e7b1b944b310ad2b4d0e45d015b30f7ff3947de063850ef87d16f11e5ae3ad186696d4a2997de487a05b3ade341d213a65c99b229efd084905cdba89156340584a4192fba21828e100856bdc46ede3087107a1ad34f938d7e79d0e3904a8d5e52b3890ba7d9deec9f6137554aeb3d97cadc52dcac61825279b1b68c87922b25151e23a697c7dba94f99bc3f1dbfd590984989c15d2c851ba88af6692134f8a1f86e51c733f25f0f47374f42e6f2906219de87918eb8852f338ef643043adb1c202a7a3823625364b0c357254d8d55577423b514e60e68d743451fe1d8abbbdcb8da05bf0e1fa0f1b1c53cb1f9970bb5d2a079110e35185b0036d90d4690822ae6065c259d322cfe73c665ae93189cc55ade3c52ae357b0391e98d8df5f0174ed237e63177a2e1d31e4e3ce4c219efcf3564679d6d177b161ee6a12a8fd36290a6f40bad4477a6b7d9e3281a2fa0ec1b8aba60bbf3e2ffded1b67facb9424b3887c6335faeb962f4cc0f911a82b87bf082699174e99eeea1d0e08ddb1d43ba8d9f34c6115b71ffd02059dfaa6266849845f8608ff75432a843ec357f63e197d816c62c89f3a76494fd497b9377b4ef59faef37d6c40bb23b5362de5f3321ca611404ce901f6179878a68cb9c6aa9a47cc9d77d0ff9cb56a227cbef44330d3b70c07712ed87a926f3f03d388fe34d8c48db369a033d9c0624e9afd2f60eacd34d42a6616ad286531e56512b3389a98d075897f67a3987aa0abe94ee3d6a067840c31924cda801e851e52a0a4f05c490ff687ff93c95932a9dd004abe1f02413906b59c1dfb320cdd4c5523eacfea77e7a31780b10f8c96e22478671a9470d8d8661eda26898edebef1d5130121d583dbede0994bf0a2f5fe44ba3a85e17c9cc6ace5d2d30027028ea15ad47480ae1b71395bbfc1274d0e32a02e1b8c80a61ba84d932ccfe97b06d0cd7f0ea186c49d2c37e14abcedeb1e33b97cb0aafc6dc3e1babf3e69bffb5a39f88a18348ec997815c39e09beefdc486030e604dbf3423f786b28e2d0e387b0e9534979a131d8905089e17fa95058f8e1f6bc0f143a9ca7e4425a2a63eb2f7e335e6f34ebe40e02bdfb647356a92ddd0610d4942143f15da55810251cbeb4f3c4d19b1ceeac44b6a43eaf4e8ea164de17a6b6f9cbb5494903d4d23bc5051ef9e6d55699713281934d7d4a7919e003e25be2eba8da38ac5348de28d424677577df9226133e1dcd83ffdebe5abf0f15d31beafa0716762363baa09b58038dc254f82f96f2 +Digest: f68aff098d8091ebc05dff3686b9d6cdb7c82075440cd0b1876989d2d8ad1d2e9155596b6ff8937e04ce8d8e1550cc7ea7cc164b57b3c240e12ed66cbb69c5bf +Test: Verify +Comment: length 45544 +Message: 3703750e252f53918a765d164c76c9d164976e078fee1e15466137b4f10c757b58e40aa65a9af115e1c37f9815353b69d0b4effa52cefff13703fa71a6296f9cca0f02568661be4b64cbad33cf61a655833f6749416ce403c705de0dff97b61477cc84a6114a643afcd81071e2c2b49b637ffd7dc3927352dfae0a0f661df3eb4563b81f631e88ea8f30d0d9b7200b455abeda1d3f0657e66847a6ff4285ce2a1e1bc748e4a4d564061c14f3b443535a4f4225b11f9136c74818dc66fa95eed8e93dd9a9fda6f0af4ae4044842f335e3295507c2cafbb9fe6969d2cbf816fcfd8e1115cb14ea84d342d0c95fcaf758e7d23da8d7a80c8791b182b0b6a3cf9fa2f4dfa435933a37d9d5288bc0b218666e31422f78218c498b0aaa9faf638a80cd05efae6fe05cb1c8ed3371f4631e04812eaec52d9d42a6f15b2bc73fa00d4789a8885a0265189ba8713aa48246d1dc26b1c7917f84f747cd8c4b4fedc2219bdbc5f4d07588389d8248854cf2c2f89667a2d7bcf53e73d32684535f42318e24cd45793950b3825e5d5c5c8fcd3e5dda4ce9246d18337ef3052d8b21c5561c8b660e60bd1c4dc087419407989a24c64edc6ff7cd6ecce04f716e3abbfe979378ae09f18360beb8bf36d8cd8de1dbfc9d1f1a9704816f608e722fa955755dba92ae1e73b4a46d33af4510f8972bcbc76d1dd34e39d985c85810582118b3115a826d36307771c4f8ff7524ceddfe5cee67df836294fc77de5754d2e82b3f193beff3376ef54d2ad156cffd9888e5f63b326c101c3e74ab6b30458346b7a1df2582490b7655c307845c59819dbf65017476cc64c45fc98b368eec5485e462c9e0e3769890c058c4daba1d9927ab08e562dd0865a21e817e09174f2decd9094133b982c8035e96c79b18232e7c73550acd0d27fdfda426ebaa7378f7c2bf1eaee8ad7681195604798f1d7126e541d4d97dae31131f193f3ce24b6f9850bd2978c56659ad18d12a427d72116baa3a0eb839692f8e4ea455d879473afadefcb306938d333349f6918b2fbf0be313888a10cae62858d36def27370ee303b3a443c219c90dfbf4eec0ba6bab65786853d04af9cc2458f69d9591e449729d19dc621321c3eeed61e03f39fade2911f0c269cc8cc32b76fe5cd07e479fedaf56cc97617122def1d7f5976ea4015f95f4fedc004b75469a35d1265629b95e21b39d6a15d38fe5efa0554fc330bc0deebc2fb14d00877cace1252181523eccdb787763950cb20ccf0227ef9e68b63d03907b711a71a4d6944b7f49678ad740c4ed810b4ae7325a79469400691298f6bcb80da3d167725a3abb082571992cc1c65ae4e99c2bb8d8d5b3c3098bf70941017b0bcfd9aa99128778e83d0546e457c806c786f49feb8ccc93dc926cdfb225ba239e7e9a02c20661cc46198d5aa80ab33a5368b80d7480442c092374923aaacff6ed367c37953db2fd4a426f9e1fe36d3eb019523bfabc26c870450bd74bd8283d2182e710b9bf60541e3f15d7f2e9df5a052128f126465bad397f99778ab8ae3f61e74357d7945419e798e5d0c825f1d67a06a4f9a028ca238d5a863ba1514746d6eff8d296c57794d0d649504a9d8cf939522c1a0f6a5a74945d3ae838abdc98a7216e4a9f58b00dfe80a81e205b960c678c2a1b1b12f5e675101e49f6cf567efd050d869958e6cb9c1e6903f167f9572f3d05c56d2a82c359fb982584c49b4000243e502dca0317d038f6c765c79b22b7ec25e0adb9e85167a7114389929526d705676e03b8ee39c257b632258566b52721f23483c811d9c89bf26cae422a78ab31f2a9c2298f799c02110bd9a94057a865d488955ee4a2a35fa1689bdb447da32e45c91226ce1e83c26f1c29391352623e33a58e8349f6217c88fff765ca7ee886ca969db69372a11e382bbb3fc6ec7c377754143f281b6a790df96be9a4c3a1c0e7d808e1c6bb1e9ed4013ac2416e1ed5085bcf9b695aa5de9a1d9e6dba94f7650656feaf4f4222caac664ccb6c2072a24e82699ef5fbfa34963439fcf43912fc8ed92529164fd42b262299612f499d25b2938751b24692016906e39b3af9190de7292556042a5c48abfcca8c7232cae69a54d4ba898395d07a5b4554741e3521780ea73fff1ae3a9a4bd87541d241f6e6f8ff5e362f92b2633fb062e8aee8dbfab5053eaf06891d7772d77c21865c4449a0a95d426f17a8dfbaecf3264b24a6fe7b6d061c05d8d598e1443dd4b3de2f0818e5a94bbb3ad8c3a3b4866eab193b99509c7ac553f00b74f3a93ae9ef6a1fb8ee2ec2a0b87eaac596b18d4053591261b11dfd19956117a24670d3bfad728ec28d0f4a1fdb55973be06e8849b846b3de296c1da73ece92974625c8e4527a04bb61e1afe7884246bd2d45f7c95e74a86526014ceca47af4ca6f426af692f30a1a295054b663e701cfd9c26c6dca6568ad33681b688b08c6c24e514a44c37017453fd5e90ae29680da828e46a5709b6d0cee2b099946fa81055fdcd77d8863b4f311eccd3388d31c6393e426eed5893e1a92a487fd6cc2ac0a103fa30f36605b7a4bff81eecb4f6cf1aa7e8dc88da1443ced7f271360f3a0470c142d5871d873614aa8978b2e5ddb1b12b7dbb0fd86280a3b155759c7f02652afd4e707bf4ea53e9a528ea72670ef36891aa14699aa420927f1a96f065a76a3780c508b73356978b797d7a1483b21da6a316ee806803a9020be8d91a09549c001250a62322f28863ee2f328081f1b7d22769513b8aa7a55b1b684802b32f81eb7a9751a709e7b0d7cbe71a9ea9f24a56e64d468247b79b047841ea91ab60a3618241112b2f5c9750da4c395742de5d99a868d33de95c1467ea1cc7ad38108acbf0f7ee97dd7ac337e107979196dc790334620354b6bd97eb38a1e83fa467bc8f8d60f1d35b69bef2a9bf3c35eb1525fc54e4dbb0f703acf82c775430358cc317212521c7f15010ebfa1d312c8ab1e9ecce966537f355dbf68c47136634a827c974ed875ce7573f889bc97d5cbbd74d3b6b1fa8d2f4dcad4d21b82ecbe9e26e0f4d61297884a8d533566a28afc6afda51f328ac6a40bfa966b373ac469b6322507628110411685a53f1a83b0cf26217972e587ae5202758a70a1f95be9352caf3b5eb47e9d6c2544f352dbd5a88188d73e458192ddc3c4079ed65f21d1ad8ef62d352d10d1bdc4d91ea9eb683d0f8c24edccf9128bc25eb4525edca4a761d18049804b95a28decc80d8a62e6e122b4091df66ebc0080be1717b5e252def48cd41cbaa07b744f15a84c6eb2e0396d98fa2b5c52edc0715a867b4610baecf82978136ebc10bb93d7e057e15bd2aa32835eb26936263026cca8d9b9d85b55cf2fc2c9f70f140cde9c06bc6cde4cb8343bcd2fa788f3f4137cf4df7bb9a2ae0c186aacfe19e3dc91da81f67bbaace7c50acc1f81ebe570c9f3d0e8f6253f5a116bd648ee5d1eaf503bf872986171bd7788b1fe92af793abcc9e372c3bb6fee81a28c0a324912f98c08c0cd3d6339bdce2e354954740db65e5793296edce2efcf44f27d847e6f4fb7f97162f550734d2b73bc8c41ba317841357669521a06b27cdba02f3f6d8216766690e03a99acf031e1ce33e4e272f4e7dbf3bf17f369eafcdf2b7bdd8709e229d895a187af455b5400d0dca89d40b0c4c391971ae97b0dd1b7eb0fe96b553744d7f6436711eac314496ae3274b39405a74d68df57cb87f9e0e6537ed7b029a79ed49324351fbebf533f2e3cb6cbb083b784900121db0d4b43b30a0444670602b70f4eac6fff71a69591f5b1f72548cca365f99fb5ce281a6d6c3c5a85e4d4ccc1b8ff94c7c7af3031136b58e1c7452994790c83baacc2b086995046412f794ee3580da5e47e5fa3504ef8fb1abb8de2b2462f74d97dc253b5c2b091204edfd04676e0a76f2c694819c805604a090a3f2456cb39ba4a104c2270c303cc4bec99119ae0620fd9b467b50bf8501ab7a2881331499b041a94e3f62af163ea2d8af36d4c759e6d8e2a484b9f3b9331cf3f04a65d0f6260f6365f5979a27b25fda024821507223153b232040a34f13958c8fc0664875675e5de0a72e43e1122c21575777cfeb7022e346f08d64d32d75b25b85ace183eecef742a6af32dee8c84d32e750ac225882999457e8aed1db5df3e80cb2129e46c1ce008682ed8da094cc197a345bb346c4bc7fd8eaf7b7c7becfb9c81e7240e9e750aec951ea59c4121c7f82ab751ab569ca7de62cc6115d18a4453a3a770852901da1d194afdfede0bcd9831e8ed54ed2521321f6906b05dc201ef5aea7511b7c939e51b3a49c68512bbc0e15ff5f5daed1e3ff00fd217ca9b1ab6cd379b79edd30d8ac377efbde03f79b862a4d357c5fc844ffb442d11be1e77f125164a87752940553a8859ab9799f0c8db3fed42545b3da868937f65e15200e7890fea01f7d3b88ea8f5ed585228063874b9ad7e32112f92608130dcdd3f9ee222abe3b01ad75f7d3547158bb8f5a44f57987ad2052644570b98a83e57ed372817719d5c873f1b6a0705380e7107b356a967bb0776a3623e905f5053fa65b40291ea81cde613d69c49b7bda72667199595abdae52c8f738e175e8ee26baefeb8b89cf5cade59775c21e60e1f7f1bc05440ee3e34d0f25e90ca1ecbb555d0fb92b311621d171be6f2b719923d232d8edbd5b74fbc09d50b8ccf2670925ed495d8abd1318c3a600ba634d8b1cbbba46d717a8f7545803f62c94efee3422ec1b3d1c762c8e0ef31cebfc0abd38fee89446057fd1896dc384b91702f8e8d6e9f3dc6304e91e0dd951787821b605365e3faee9689a078c6c8ae2a5c40d83ac6761aff0d1df256ad94ce44a3afc0ddc7ba79645cbb75b3e6f873dd3bb92813dd4f34c4875555080636db3f4af05cf5bd17a80ad41cff0fe3cf82f23523e8de5c31725dc68021c0918426c0a0649a65ef016f272333a7546655c3b171057f64ea25bc11f125be44f685970fcd95e3f40480b6047488d34916931f6218e7556d3032fa2a31cd945cdc411773f80ba069a59c65eaeda4ecb79c907c4c5151d2c1d66014eeadff0bd2ebc18c364a4c378d795e651fb60e5b669f55c4b845cc5e2783b7f3a68e438b6dcc0ce09eeae2122829cd9cebf84e871ec8e8ddee1cdf6168df407d99fb217cf4272af9f4005597025cf1f398dbedd7a7bf53b136fd13434c93029b111d224630a324c17fb62b30e2bbd3526d8672b5c82b9e26d810ef6c9b470536541bcd51e9e9011e8932ee4491ed7aa2b12265884bb4cf261b7ffb441da25234ab1eab05e6a1c9fa589c253ad89beec9add64fb7f603f098496fbf349a4df07f5e4e42cbf172853c351d597c7d6d38b1a9cbb7ac92c00863a80ac4a2d9f0e7fdb5d21d09d0043ccc68dd1171480a5f40ec2825cee6932071817891f7a3324098f8d3c1284c00f6923903d581031b6b60c0162185bc223fa91be1ae9cc0bb02366e78b8912d0ebb75f0b72d14744765f86bbd3439da186df3c06ca4f7f83435c160ea89ab3bd59460d423a292653754f03644e552091bb237b641fa721345e2201650bcdd3efe88382e6cbb649c93403069d4bd3811d3175d46893874d895103bd8d3d991fd30a0e646bd01f0e102329f4c944354baeaa34eb86ce76410cdc7faee9b692e4114e352643cfb9ffe2c302727adff0ccc055ff054118eac83940f459fcff41cd2525964d01131d9b9ba45af414679c90ecf512c62a1b5b3f993f104359800c278910a05d1652b07dc547620e3883af449ed83eb2943e4e13a72741ff61d178afb79ff1bb160728f2da1cd60559bc9f3450afd13f220a49e0dd8a17e2b87c0db22b33f8fb6298ddb754a5158dfa6ae30caccc58d055f7c523c6d7e0a1bfd841db6e7d24a29e904517bf60af0c9d17211a0dbe542aa2af5658dda16a910a8e9b980bcc13352c7605b094e01115a469c008ee0651929a69540c9c76e4450af791545db133178ec2760e5fa3da1db2ab4645e834bf9c9fde749b8db90c4243bbc9ad0ecd02ee47fe4c8d8a1c68994a842a5d66ba1ccd35770e921bf830fd47439b0e8960011dfa91cfaaaeba5b2cde5cf2bbf416f798fdbba88cd1b4f0fa88178c05481acc2af9259602382e103ce0ce25de0acbbe845b24c8f8596fdaae88b0130dd56dc289c6122610b0b8263de4304a503558f013d03ae640fd893cadbb95d6a4bbd962df03f0065293191bc47b2bc6aeee3f2acbef76971338a1c56ca3413d4665de4b8f1537ad4469915f54f8392156affedd112b6041dbb549d36fd23abd8f5dfcdb2e9c618172aee16f63fdb0e0c3f5186587f6707cf6ddd2052bcafadddc2ea5a011ebf62949dd69da75fe5b9b83580c7294e33faf113ceac924f00a24b9327918ed967e1b467f9b0f0f6c61a811435b82cc74166ea73ce4adefd3d1289313e7c4161e51cdf4f015ab94ea9bad0a317604a31bad3225686011e108f830164d6230200629b7e1f93a0eaadb41f0babcfc769d6c5c701839dd93ace1d7f1af3978cbafc06e7f79d5a8c6b5c0fd39cf404f572fc8bccefc4bcda1a80108d3ca82bc14f9ef887b492fb2524a3e35ee9465ff34eec336954df8b0da66d8f36cf4937caab2e61031bc52173fdc958465c6988c8e3eee627989db179c7dfc3003b9f66adb4f468e49600727fdf1895155b24267c1b49cc8c23c6d726631cd375e9725d74543736b18c099650b0d6c3525041e118dd470c225d22a41d636de81d3f8ac7277241f2f265a936ee5a4c0986a28663a2102ecf71af78c165b01a2a7fa6ae4accf658c53088a8fa62c3c29038b9bc51259e473c007f92d506306bc02387a88e6dc7c5d7f15fce89b3d57f7ff0fdab56a66eda7c5736368909cda8d391483e3c11cfd04fc051e38ce976cdff37d61a182f682fb6fe3d2d85756e188a525339fcc1f5c05622c6aeaa0d90f23893acd23fc7748d137efa3f7052fb040eed0e60758421df13a126f88c260a37518fe79c74777a3ebb5dd733f3a95bb486eae37d50623b73afc4da89d93ccce473b0ef3e5f466288d5263bd3b58178701bd2395634632cc5511348293a58be41c5802c80a73c14b4895e8ee55fe23980f52b77b5ca90da1d2217d9a05780c8967086072cf4617909018f373298d4862b3b800760baf02ec34a57f5b5d7bfd22a9b4ae608f0be77d16240a082096047bb1656501fab8b10fef05c0532631ac4466f5532de415af752d7fa309d598d6476ad37babc466a69173cac6fdda29b8632142e54748f3de2d685444f4a3164c6a529aaadfd32941f5657d19d7e3d490036b15db29283701ea397a6655339eb538fb13891ac17111c036953f5dfdb2c1b9a6e6bb602c4fa950133a8da7e182cf47e6e67ce8f9fea466699b8e1c7254dbda574dfc78bfbe32d3a82d31794772f92b887c2cc6f702687c7108ac8fdc2b3cfa0eb414cf4d034d095abae825cfdfa138625cef41332cdc66df650124a5b663ad3fb1aaf06eaf46559d6c284a0539761307015ac458ee8eba172932676986fe486caf05789f22bd4cf2d958626200e62fe8f1e5dcb2b7eddabacda6e4920d5b701834eac458fe1053fd5b1eeb70d650038ab71706eb39786d3cdad518b9ca09a8b4cb916016a1fdff0f99e251bc2a62125eb974bf6cb3bcd61fd943703b3d9746e4dbbfd872bec4c2cbfe2941ae6d9af0e7817582b1d739a9c6318887a0e872ff0b0dbc99d795134394f07a27c2104913b7979fed55146d5cd28c0adb855b2b25a9aa2e20cfc557d60d295b6081d31aff41746a4bb0fbd673c73150c852f62e5f43596b19b5d0010e970123a877f67f1817a05b4a6fedf36316d9e0ea944a0b005a9419c14445ad51c500895c2f2af3f29c93e955ec6b42bf43ee31beb3d73fbd71e2b0c3d586cb4419bfe2f7e1c1081362d79afab10442ecc0d6c9c14c2e4aeb0bbda6ae0423d969f787d7086a5929feecd3f6a558498280302c2f7ec7afab1d9a8d81cc3aad5617f100cc0a1363d819ad2172e23c9b7ffdf476c963b0ebdec9a0ead8c +Digest: c4572677ac23ae0736362f49ecc1680cfc65f029d404687f2cc11d2c2ecfd114ba4a52a25efa425900261029e1867b7a0834df8194b5709bb7d08aaaf87639ae +Test: Verify +Comment: length 46128 +Message: 2d029512ac9cc2e279be0173182b1d39bc9afd49ba5dc1183c420e863ab7a51ba6313b90e7ce8591893992c133ce5dffd9fea3e832f5f29c6d7b03c5201849d6817cca91d81d2ecc342215745d80aed20b63860d55cf9df16c87bfee892e116424aceb1e67d3e51ce2433595808a383cba904ec30a33eb9da32eeb095f3f264cf989453d7c37d407fb62982b833422c44e4ea40f3968042a78372f1c8994b01666da81f9ff902017e748e63e4ec695f32f6530fbcab70f20556c3231ef75d64bd5694657d827f4d40fbdc8d7c988b84fc59d998ea6683405a1939d4f7929c072adfc3d61f04476c5d988e5fcdcc2b46279be87d0b3c39d63c475177f0ffa9713565c0d1e2d2ece72ae73e7b86fbbb0b4b18fa4cada0f6fc126da49c8992e83b638515f96782f2563f74473106abcd5cbd6d995830496d5a82f8ada32ff0eabe4bba2dbd2ba8da3211ac4340eb50d4a3151640503179ef59f474c73c529e23824471928d9d9916f3381bbcfb938f6386e88f89a53fd70f72ed6e9bc8afff251ff447cefb3bf83b22192f1ef19dcbfc708e55dfc7a9c5404dd442a5c886a851ffc1a94d76952ab9374b72d3a3787af1e89cf5ad480de914435f9d4fcc750e5caa3312989027c503bb35739581a220f6679aeb9ca6ea971debd5db243509b58797cf103ac8623bcd166d9dbf2ca9627c65ee940854be73afafdd88bda2a31275410c3e9e9fe31357e15a7dcb050c93f67c2eab8ae1f7f35c27ed326685dfc9a84e60da4e8718d046a49280339b3a59f712c18e8ecf359aa5cc7b44c96f2e2f8318638fd50e71f71bc89c41a36fb118f0b25db9ae8ce5de1f061e5c50cf0cd8b8279adb9ca68cfc39d5ee3e74e31f4565d349b944ab87321a7d2cc59715fa499a046d3a3fdfd8544344fed342a5c383d90e1c09fb9b983b4a8a4d3d06e484f6bb375118292ad293aaae44ac77184c48cccb4b283ddda75e01c5e61f1aab2b549e28fd11d3081a3ee26a56368ccb1808b3836da085f2231ee2b89dd85cea5c07a551b7a3d807fdba8d11b9ee1e3ec5481fdee9ef6e79a9f26fcacb1548129574835a174aa29b1bab0d2cd64f95d3c28b8426467141c48a8cfb84f44266c4762f9aaa9262cd41f264d52431e77e3aae47630219e2ba736323286fbfec33606cad6dbbcfa8b29d008c8790632241c3d7004efaca9032f6c26988f3647f3886f7527f161578ecfcc49696e9d0ac8b1fdb4aaa68df2645df06d47fb8b877d0a884c341321a5ff6f1bcf785a900c2b49f299af7e4ddf16d9cced88f17f262a635b37446a834da4b0c6843d6468a2148d25055d9e73dae04a0890a2999c8cc23cf01fa11e0fb5453bd34f00b5ac334c249de1fa2e874a8c59aa3ddf1c69220d3c4dea91564d46acb74d170874e4269cb86216cf581297e0adbcdc85a26e4ed20c7c825d3ac668a0cd39c69eca99e5caee7d8b24429b28a5ef4554dd523479db5385cd4df30184e825a1430adf51d79e70f5274114aa67a2c64e8f2f55420ceeba6eb5a8a986004d668c7694da9764e2e6d2d46df7c7bba1dbde74c3d3206dd4e94121b883de469739034784e4f0f45cf71d79f1137b8c68d5fdebe0f35706558706f8c3aa90bc8e450d9e2124e6efd54cddfd158f4d43c15db3dccfdd6e3e383cc324124624ccf933b263b4c300be168d1a4a2193c646721b092fd9baed7c47b2828ced7e23dda2aafa7e85e8c7c7e461dc475d496cfe43b606cc44b25d2a488e4a189b7a14564f53eed7dcbcc1730a702cdc11d7cad3fed7b39c58ec45af047b24b066637fa1c9d695570167782a4e6311f18465652e692516855f912d73431f163c9461ec25d8daf8e43b1074557ae2946eff1cc7754e493a709fc89ddecc222ba46e9be44a43071d67d4df3b5a5494bc3bca23771273ea244661ba1e58692d68d03c3aee78d4060ec912fd57a3a52291412da3fd6ba0b1deeded8e3749e0e8d7a946659317517fd3f03e92509634331b6670c4e2ea9f456f4f8b6d7119fafa7f15d3455a8f831972c69fc5ac9dcb706393daadadf53750df53837f53307f0c68fd2d02cb49327df5327fbff51f308170b1b487e6f62f7736e01ceb65f637c59b4a9ac36eab2653631b24a8b2842c0d4aa64679155450647de0a0da2fd4eace1fe263b0cc1e2642c56bd7a76c3387bcfa5cd8acc37762bfbc3a55733a305fcefcafd0f26c0bfcf22209e0e4aa96093887b9b24877c72d2ff9d684df0d735f6e3b9828b1d6d86e0c82dd8788f4147a26f9a71c74baac785d3e9c74453006b256e384b51493ef4538eecf14bbd215a131590d5d58138e0df192746fce2c4f202dfc5dbd442ab6481d6cc7cea4cd0147ffaed2be1d0ad5b292fe46bba288b8719b8f0a89692397416407adff6c6c41343800e087eb27e930e888faa1e8cca86c4aa27361aa07f8f6b4c469ed3a383b3085571e00e9f3324e9c3b7869c98187dadf40808c2f5d4331b6ade3e037b858038ebc747040f519d6561ca85b6c2ebc83056e195421addfb812c904228b740074fa36ca2117b5048ebd3572bffa5bb12f623626ffa88034536f20b2fa5df49c4d71ce085997bc5c407a8dbfdc9a90cda69e9f8fd6eb5caacc75bbd6afd5c192549d8b1761e8918ab2352c75fb755678af62b13c2113cca9eacda1598a1d624c522375dd8131bdf4ad951b7e64b2341a1456751528475599741fda21d35a5f300eae9443009bc604f84261c05f7ab31b9b21f20332b081e233126f18d2b741a852e4f131284d36215de5062534f559e40d6b31ec8975d7ecef4f6725ce5a8e1be46d93903f6f94b2a22613942a4ab1db31de38ba73c0df206f7eca2f116bd1f18df282468e2b692190ac8ff48aa24069d120115339b622e47d46a120e1138f91151bc73d5da73cd5ef20822f9c2490f6b3d9c4a1238127a1df4ff3df87795265448f695bf40b95368729f42ca8f928eba0b2578a784976c05e42c8544bc7a1d4e2f7708a9a80fcac1f70eed3f64890ae6052d4f8823598a7c2c7286774220546b6fae5b1982efa9f819c770cce3a51a9bb6342d2876e14c0d3851c004cb405238941cfb8363c1677735698bf77f7f243798aaa00d01c72725925ab0719a529d423733686bcd2d99cbe4658d43aa6fbe361711369a5653b241b4ede64241df9bf4c392205721aca772a13bf335f6ff4f33dc085f74d74f640e2a9bcffb543fe4dcc3b9c1ca039716e7e66d5c52e7b66dad31f0991126f2b2d76de4dc0133fbfe66a20abb38d5a56ea84e6a370eef2d900eb34a51f3a7f63539f949990883ac4f3ef9158b382a30254023c301de9fcd3cd4faa638a0ecb241a2573a9555a5c96da2435aa02c73cfc12c10f84b565bfdea9c6274bb8d67cf9eacf2584f9d2ccbc05ceb5a989a44ecc8e8908a81eab6681fc17536492dab9672b664f326238b3bedab8b85d306101fb2e21cfa3420317452e0bd8b60061abf845b39cbc7ad43825c3a9e7cfe0457c105c530b7d07b4fab0a76a5b49ebb57933a07bb12927ed84782768ea067f99e8937fe5643f5708394ccffc8726391c4ca0a489398153cdbe3f6ebe680af6a56c0cfea084f01945f9a10f880154d4df4cc8baa4dacce5ba0f03ff7309e42eb13104434c109835b46535cdd874dba246a03248933c13c5fd9f4a444f769b0e055f03b5b1b33f929da29372b286c48d987166b81f085edbde959fa41a57377de91d8fbc9613ee1a48db4067dfdf167c1fe6ed7010e6b30fa41987879b53c165a49332c0c5d8adb4fc36c5132728d95621284eda2e7d1c4999558c559b1340ad7fea732904ab824803dbabdd51091505e75e115c4076a071036e3577e23fbc3dc24ada601c3477bfa3f37a2f2729d370b9b1bf601078476f2b8f0a53387e3dfdb5daf0cbd51a93ff25a6b8706f311b7fde49df4d642c1a2b59de94526578ccd59fc33cd3f605def1d11bef07f2c8f31aa04df98b053a208dd5835adc30d670adca2c47e0499f617dee7ba65e7897652945e69682bb49627ee6a7e55a6240326d7c3e975b948d238cc6ed66dcc9467894163b3d9a4d01e6e4d572bb32c35d18fdfe21b6aaa07a2c049f9ab6e9ac7c34435b75763b850cb6a9eb0b66ce1bd62d4598fc2c37350c85cfc2aa1eedeae1a21f5cbbc9cd290fdab36d9b6e943252762d91f77f691aeb35d3774426504b1ec90e6036bfb802b558eca64959eed07afd9e333c39a719c044fa0590577b97dbb2f9b10ddf64d8a33a3add3eb143bcf6c97ec4f0e15bf833bb2ab6b738d496bf63c99569b1397384888759a1fdfbbf6de2b78d3e00ec80eba14dd0e152c41073e6645572bea09afe48ba639bc67ea188512fd64c1dc27991fe4a9c352bb4cc9f43b4394f8dff17b984bb435493332aee1dd0e742c045abccdb0962dc4d0a93ea80a08829a7bfb05e437241f3ec8421474e80074972ddde453f726afe40302dfca70f8c2792492e958ec7a5a159d8503ded297f89b9f2d9a4326dfbc18a8c627ebfeb8b72d80458056ca2b68563987d7600b2982920ec6590bce25e50b588fa18d11bce310057f857e5ebbdc8912a719a920397512c334ab1e6b9dcd1498abc71e4879d8d93acd433018a02916cf7f452a804c72b672f50b0b7dabb6dccfc7132001740ae186ab63fc967cd097b67ce464c9d6fdc58483e35382d434bc845e1022db3febb17f86426446a665746e3c61d85b6d68f87e7dee76f9bbe94c4cdd48a744320dd19c0a68e7a7c14a555d1a57f5c37456a7d72f66f660a726f49fc1272dcafee3ba529462074832118319a3316d7080495c1534f742563a805de3a62616edfb0fe439b0a833968d3da61a7388701115b39dbf0b19fb28fa87d0bef8eff31bbae4d7b7ebc5fd11473136d5f7c7ddf3b927e54b3e4981775ba0058835cf52d2c3051d63b225e456e48eade29c69e7b6cf08bb303af065cfc26b64e5e95eb6a187d31db3805269c5d9c883a6fe092dc8dbe898047db92870e33c674e80188f169de1613de2c5fdecbb5150c9890020a87459f44e930e3a2922b59528a6775c9059b28049561b2149fdcb8d90c9f960e40caf6855076a2b46f549671aa905afad6fc8e38c66ac645c159992b32d5f5efa298b5cee47576c68ff7a658b245dd8dc2487137d71045791874e18974f9c8b594f605a40df508dfd95bb08f084ca989b3c9f887321bd4b88e75b87c39d5b668fd2b0e9133bdff0735cadd9f166d64f690c54cb23d531d0b0aa3458bea2f6811c780f71cbe9604468b8a550f4272b7dc418594406280c8797548b13eedd085b8d93de9ce1648bfa5c3e43f67f6214944ad51f9b708697d0bb5aa231dab80b6631baa0b2da39bd72bc620c3309944c335be71a3a196d7e3c8b311c4b18c06a31c750e86c3ce57f5e17a860bf193a1ccb85b2cb9857692a2b857c7bc81f92cf3eacfb38118fd43c0cdc85e3c324b010dd46ccb64ec0f6263e38a13321558b84fd611df25b29928e1f998ef817c2b2b2d91da96cb5dc90fce52323c4ef612735ee623db9a1b0bceff6dd38200559ae9d5f78bd517600c608a0c388b3aab9025c924edef07dbbafdc3305f5fe1480001ad0f68d06f7d401e401985481bbc39963798586294780d7dd44926ce4ddac63c5ce059cffc3dcd11978200bb1cb2748d51494a7e6b7c6e15dcc30f176c9552628b724719e5271c01384e902b6214abd4bf3fac89b16f448f80a3018165000d3be1ce18f753c493b6ca851fe2186a4531288267cc91d7f6b16af3e65561a35f8e07fbb6b16e9a9bf7f6309426643daa6d341b618f313eee4442bba5dc8707b125a401078f5d339d8e6455d6406e1341508c11841ab92b930faf01265b00b369c661e9f5d84917ff41bbffcf785f7774a1d86cb7b452274ddc5acf511df32ff13ae6ba67d659cc2bd9a33366155feeaa2abf34e1a624b98471eb2c0e698904af49da7c44cfb6dc871ec6fb836195024cb1ea72ec395669a09709214586e9b90dbae638760c87cf7dd7c95e0ea22a3ac0ff012ebfb210bf09165cb4debd3dd67157b1f5e4d5f52b73ce5765f021461e6fdcab6e425c7c4428b68defc156aae445e6e4bb7672287ad3c916160f260f37c10f903c5d7ebf7f633f44dad6995a6af0302692142a47430491ae7b54f8b00c1f62599ff85f04f82378287c06cd75f0dafd2083a6467b0f6eeec89ca7e14f26ef9baea0fb487138d12ae2dd373c22fe6b157995140eeb6579a70c7ff127150b9a8336454e812ec6d31d1a05522c8a1d0b3fdad146cac0cd8d86212e1813294589e29a98da52642a931977fd40e6d5d42245eb3d25c221cf1251b0b106edb35c238082a185033bed77e6a1cce7b22aac18ed53e4973e37f470d1600ea1fdddd6cf24946738dbda96e94b417a31d7b12c5500bbcb858529c30fceda4fd38acd3df7987bf2dc236aad5012ff10059f94dc4145cafcd8e020c55810c57c83deab1802a2dd4a572412bb140182954a50f8444586297e76974480b15eca9b993fa0f0580b63789323fb479ce17311ea3307edc7897f5949f2bc7e838191b6fcf6d44c619ab483766b4cd95279798ccc90e95e311775953838b1473742c1d4964b6eb484197973ea432ef99d933d0fd8afc61fe9f8b33b2ab34a61336702fe4e8596b02c4e5950d6f2c930e5f566a1f6d7c5b959f4e05309a9b056e1b8fe3b0cee76c9be03fd2321c1440593689d4b0e520eb3e7d3a4e3bc630aaea8ff5a93b8cc3386a3fe0cf4b5f8c8010db48a140866ca95fd5ca9f52b2981efef02c10e3b68f87043082fc979df7caabca1d404cc5c21e8025894903e433da3208ad9b57b0aeb0d06e80eac55bd898b08f72423437c3a325e9010bdddf86551a25f4a8f61fa34e8556850a431dc16295a7d217a530d3efe78c9c383f0912282dd49bda4d57ffc86964e9db9f5824c0e18fc7410e55954d1bace55ea5f569bbd3910dafdc0e26b7133639ff48af853c1ac3dc4ede2a6a5358b666ffa128ff98a1e7b48a1086ca830926ffb5cd68652ca7c05ba1a303d59b15358b9bcf1846371f454b0989762dc4b1d3a5cfac27371b2f21ffe9eb96697ce7b6dda37e57d02fb2361b9eb530f2e4a3a8b68d43609daff7452378163688712696d7b73d4c1fdaf136b0ca126bac7b6532bc7f51b8eb23c6c650dcc188d520786204379a8997d162c3950c2f7aace17cfe32262574b24ee41212a86bf1b20353a4ddb50474daab6d7952e57ad286cf316792124d488559f5b4e33b7405b1823eebeea009b25ab1a7a454e67327cc9d490b56b44788d70d622b4d36783956359083919928a68a9c77f1257fa6dee0c41a561a9ca2da19b1cfe1ab09f6f11285ff287100dfe60cb474cc4f21846c65ec3bd4382bcda0dfef857497266ee1690be12707679de533a204b23c6caa54be6e140259f24671ac3f2950ac2c5e8edc3fdd2bbf3df128a1ddde2f67c1772c6cd2396cda709bb0d0f92202348c343dfe8a499323146814d9d037b07bb08957f3a1127034374c0310d61605cab68e832283bce9bd5b615e4e21c7d1c2ca4f7be56345b911b6c5dcde2e6be7f93bcbf2eaa4bdbbf8a37b59613b050fe76f37ecb48139b3ed6f97a28b9a9a052aac8b01d975b2766f6d249ac59455c7542fd13ed39364dd11d23008bb8336f9f9593a44516f41a57c18eba6edb65084938cb9f6e5126db1397f3d53e070b942cff2581f0509d1c5c9474ee24c297be41ff640894b76aabcced70e289cfb975c18e8731646cde953b178ace163564e62640d038a8948a27c3c6a30fb438c67c28eac09ae9933fedbdf1da428c5d52e6c0a21815f10f0fb5c2cb92450669b91028bcd8a6c9ed498caaca6c33cd61eb27d7ce4389b95180bf8fa4476ac88b1a9888acd83c4aa183dbca4c4687226ab711336b597b468265acf3f8ca6743c5727e1161c743b6d87640e51d7228d3a03d0d9b2263d2e2c847e4b66f2125bc4048298b84ada553b9a824c2e5f8fc282a0581d99b6778d34eaccfa0b2568b7e232401bebc93496a6da3f02a4ddeed683197d6b37d7054613a1fd579697180d0978e6e71b28017421bef0ae5fc2ee2dddc7c75f271834ed6b5255e083c78eef9c40fd86e0e7cf725ec12dcbb9cf0c2cd543bc45e1eaa4e78 +Digest: 84f282d7f6ab40f7eabd6100c36a3d88118edeb5a153e50766545b82950aa271b76327214e6839879ef2a3ca1269f2dfa796b3da451e486965ffd47fe15975af +Test: Verify +Comment: length 46712 +Message: 4dd1ecd3e8fbc19ee71c41b6195b469bcd5749f4dd158326eb3e5125eb87dd8be170fbe7ec31515784f1bb59003aeede5baa5ba037eb56b622e577651931403a4ad101551e1ff9087704bea1376adf8301f4c77c43ece452747d099f9a2211df105ec6c886ae01da49bc1236c5d561b3489d562f08017723686ed07a774098a4b97e11e62bc4b0f481807ec1b261be96b60dd0628e1355518620949fb7751dafcf98ab57154a4f7ea7bacbea06f83c53d5acfdbcde08c70356fb1db662a8e728da165dc44c2926a244d1c158ca8125132de3a4e6ffca15616168326681c13f38605fedd5d9477d86df2d28b406e4bffd44188f87f93f87942ecd9d571aa76d07ebdb2331c38e9c520036c8a5c009533aa4b48448d55165c4459324323844b9bc02f2c98112e5ca2f2f5469d402d828f1d5204cd19ae7f6182f23909fe07f6a7f2e0ca56cce335145f5efd2e8d339884b5dc3afc950e883b973e3a8451c40ca7af591819b006277bbd96fcc8a3c14b970c60474d8003e54cf993d36cdf36f1fd2e2e923b5b05985b9643c1f6243510487984d65a7b1d0b1812a9800de6ef5b2b27a7c5363e400c2691cbe9317f3d8b1b8590548de6b86e2f7ad5cd02193b8cb4047b3db4da63f78f18b5def525191082d9393e62536482e5aaaf06c3e6ca1b2a4d0f4821afdfeed793982fdba6764510bcd6107221bfedfd2a9be9cdc0198ae079da80f73f2256b2aad9383f83c3ad37d90d6728021903b86332d2aa35886089137384bff8b9c382b6ffa4ab3d8f9d7a9635af1e551e68b9fcfa5dc3d7b510969250afe67d24b9ca5071d1a94448ba5b7ce554afab1e91644068e7c4f72e3f6b8ef88ef52cf1be1c0fe66bb4387d685d0592f46664c7f269e5f51d08443221aa51e19e86989f24da3da3cf467a9c4bf1c8d51add1279101d56254a181f8f8bc593924af5408ba2a7726068ea8b33c9ac2f12147e54c08f0109700b6f1994c23fbc8130eba5459be63672e52b0ac255fea0e08dc47c2ca3b7787bdd97a2c0598b4534dca4376b95290271b05249c6957be6a6f33a291c12a33b9f4d0c4bb0d63ac633aae9875c02d26ed3572af8befc7638fbc159cc2d3056cb50b64784d4bcc0a7f4281615958994c42e460f7829ffa0405594add5bea1349046c5d3eeba71bf730cd0a452a68dc2aad9096a4886137c752ac9a0e67ed9df32d7d83bd9c09979afd4312edf1d73fe9b6a1dd5fa61dc5d4001fcdd7ebc4eb92b8a89e9e6859891c6e0c6101b68f0ab1e57ffdd0e3bbed549718aadff157454d2e547588577f39a40b90bf287f7785a9c392be9e4723f76f9d01facf808ef34c16e8d1247264ef5b5d38f40a5677f8fad743e871da3e2b4c9c41854ea1513cb8f8ce7a1ac0eef368eb6ac7504277aacba9f842f3a5f2d0141b4013055b886ab95c6d381149068cf43d8f02a24c5fe445c21a95caaf2830eea3666c9cb61bc376cb2dd3b216950427dc106ba77a17ee90a912a99e00c99103bb1b57babaf29018cd7612a42e81a1284f53cb08d68810d3e6474618a1bb3c7bebc79e0770f518c6e8b0be8f9ab4ac201ec2e96d68989237022034df99e8797dbbd2072ddf0da5a9a6439f1d60146c36d2c48f7c3730bbe384073a9cf0369031b4a45bd10f207de98e987df48a8b2b93f2c083e04b39d4fff46322f7af8fc8c05da5619e0917e9ad281520bc1f002f5e06208e3fac9925b5db9bb297ddda6a523e3ee339d4db311dfd23501e285ac2c0974b7842633af62bc019b32582ffbe0ee0d5a74d78539d62942bd4c1ac832ae12ca9099076028f892b44ec48a7e50c1dcad47780fe6675a47593754fb362afe84da209d2f0db37f8a48427a952769ca784a1197a6dfe000a29c4fb6d46df9bfe829e3fafd6ac38a0b4412af08e99b5d397a655e4cd0287bd37272ec56be2344a540574d0325dd8a8e2e3bec46036a1c98a49f566275952e52723d5ff2c53c4f54a3f70dc0bd56038b7d2abcdd236a6b2e5f4bfa782eda9a8821fbac3911a9126edb4fb7c6afe187aba77b9b4eb7f0db6310e7d50e6a5d431cf85a3b7a120e406c3cddd5856bf47947338b021b3fa1efcf5fff5085b691aa696bc5986644b04bd56f0dd17d70036ae6a7e57bb338f20adb92ef078ea21c530602ca4d6e2843b722e86c561f5a92ef128b2772b72275df0060535489ab51bf6b33d4b5024b4cf4dd1f85be0b9a37584343ad81878a81bee62eb8e1f740e65211a57189b31c10977c9ac68392ad453901680422b4efca3ce5848c1a57e12ead81ae2d15f119531189e0cb3175125123d57ea7d0cfb093db96d859783c2aaf4443d463f46cd168f57d67f0620347ef9b27ee2506287b930d72b08d86148bfc98c0aeb2af66c2e6a5dfb6c27fcddc84f1813cf85d6fbf2c64f193a4ce61637b2da093a5a17f6c40c52943ddf5454e95d969e19e20f5e9e454abf83babb36fcf753c399965274bfbb5d2a59f6d09fcb6b55a82730b6b8a4f6efa64cec88b0f4e021bf71a74fed09c0a644283417c854c07db863367212ec216755fba8f48a09b56c852b56b5698963566a1261d2d76ea6355734beec735e0ed954fab7a7ce22bd5b9e2d692cf027eb95257f44a8d20063a50c028ecbe3e2046e2cafe14a8426411791e1a85e8bcba28afbd7a642c3f240f65f3670b86a604d4e6484ed85b2ff89c8e6aeddf0415dce5e76824f47b12c8550d836295b11c02fa084dfa5ff6294dd9426fbce8d1bc5b8381ee80760a5957ada006b845bdfeaf38d152acf619bcd85a6d83244db1feba8417a729635a61767bd5e3d4861ddc6e03c9ecc34526692c82484ba078257b8e5a11286c36dbc9993207b153c14113d40d5a72d9c7bcacbf037b3fbdf2bcb12b97f6e8e57b1ef04472cdd592a1d85355982b8b5cf83cf604306eb5d947e82e36a0317f01ba8483ecb090e73d823419775695acc94147d390abab748ed22841141579416d4fbce3067de96c90ecf4b4cdab214dab4d3dd3f8c7a9c24b4c0d98586a06d664d518ac263d3fbc596c9ad3bd0866f47f86af658136f2459afff8a2881092b4a4d5382dd0612c7cd37b86f4ba10df27b2581d06de5c0d64fa7889de17ab755299ba9c06799c0814bb8449766936e25df06bf74674b963a6e63021d97b8d5736a00fa4c4a6408b2a6e2162f73f0d290d962cde92c8d19d91fad160f3484890d7744ee2c6caf10e1467dd63e59fe60bcd2005237a6f3703ac84b6c7d9f26fbacb72f2e6ab7c2009693512ccd0206413033a9f767bbc5c4e6d306ab6ec0e655d79288620e11e4015af525bee3554f9c7462256480554a3c63a6a67beb7f0bbc177019321e645f3bb3d4c237883a239a11c93c408a5bcb013babf386fbc4df5af3b9a844a49779d52c98f13dc499c8638eceb6348eb5903af548b571a677a857f3d5fe43a7927bf74aa97878a05a871e73db5ae7924be1101ae7b3e7f480afdb9f2de3d5303dadcb976f1f922366a8f34957f102a10506ab31efb68eeec73c0d80271fa2468056769a53b03056a3730b96aa432cc0cb4632c2c8860e9b3597151d2c7953f143bf23dbbbf1fd3ffa308ee53b180ef985ebce56d9eb1004b0071cfea5ba90396e31f8e310ac9ee85326a4bb74384f531b3ba6748cad3c2f21d54aacf8aa0027e9f21d39bba7be59979e73a2bc6b98d7757fe3a448933926714ac6ae8f114cc29c4abb6522ab0399ace026217b78918b7bfeac6e7666b0f186acb98cd0b71c136f83faf0af7f15af7c34e3c11a28e17916022a5b7cee48964a434acf256416204be40161c9ed9da6eee2d208ff4331a92cd184f2c3f3aa1fa459a2fef5dfe5f316b4f940d7bb4383e9311d8093912821a6b4e3bbb33d7d937b34e8a1a7f12f94ba3c091643b2ae50576be9b13ed96feb6df36f3fb4936afbb91d4541a5629d091dc45a69749a87151fd6612269e5ad0f68d64f052fbf195e455ce16556fad65c299314c4d23b75d829baaa5b7a7b8b937ea5ac968a8731c40739e39522808395c4f35eacc55c21a35d61efe4db64b18199a7ad782fb45b36e7fc735971be4bbad82a60abb5c7327da3125646f268c6e0a0257b35840e3ebacdecbb3aab7ad7d54c8143480a42516fe3140708294e73b97a673d55f35c835ba152e0bf387dceed08402f0c2c96267f05b02bb2e7e05f1311b51c5ee368d11e4b760d71818fd90bf4af4b7d848b58b7f12eeacc93e432f64c5740dabcf8d10db3a068d6ec77a036f816c02578e8901f8fd66bdf9723966b1394d050e5d52a2fc2181978e2ffca76fcbcb58c717775bec8efd7725a6531784eb6f549c8c7858c5e2549dfcced00d3e8ea5338d8feb09c82c3550e4471ab28e503d64ccc958a2d70112091100ae956a4e8c2b31346e8c1a6980e3abd11ad80c1c49ce15909e019e122c518181e2e0618fe29858c17c6361db72a7e2d0bdf8ac8406e90d7e9305897a161fc4af176ec2d74b034a938f202cd68d062fc28e84de3c175e2aefe21f37cd61bc3104a6a0ec991814ad473132da0f3286f923071d1fb8dd85e47105cf177081cf7d1f3b176d59ec14f748ed1c07d9f5b2c58eb211ff6edc08d08e7885a6f808b1ff4b2f42c3ae39bc9f052d6c24bb59122b421a13ebe2955f55a4a4e374e8791c4e350db36dea83542b287c73bf47df1d70f9998363989be20a602568ffb63566d05950d9eab35b74121f54f335f3fa4d5d21caf105155249652d8476a5e5c01a2c248336c88d14a4fa56314b37443d2a463728ed3edd4aeddc891cad05fbcbbec8233f4a65cc616f3a69bbec21bd0a1ca2c63dc87f44f857f6ef886cae6c9abd1ad1cf956115a42b58c63f6693c303cd193b74134500ed004aed4245fdbcdfadbabccea838ed6f61dc08464afbfa9c941023567e3e859b8f2efec4b98260ecf92e50b6e36bb825cb4a8c6af9c8c8471a0e0a6f39ca47865d39809a47bafd5537dc1a02d7680a59901adf07f388c095b7895d290656cb2fe2e13f3d6135f69ad24a855d04bc588d88c37cc7e8ca57fb0508981e4482851ac8cc7728a651c14060f03f0ffbd72743fdeaf20529fc03097b1247b974cc09b96741c4e687bcf1c86c7383a61d56faff67e7bb5a379c6623922ce8752791cd9e56e7a4e175c61ca54d3b1fb9f9aa48126f405531a239d5ebd2bef6fbdd82552c002493c4010b86699bbd4fb6015fa34f7c9b4c15ea42f6c4c54eff97f70c15050b9f1de8aa0be387c080b014d4c570f9084efc9180462d30e2636ee404ad919bc1adafc9e1359872641bdd70e49a5591aad2031f04c20dd2a282c15aa6c56f62dae6d602371739dbfee51434a14ca5bbccdaec28d8350d0c9e3393863e01e2fcbfb10d1c2c2f3c06e97310ea9b3b05d9f6b014498b1daf512ddc61d13ae1b0cbd8b2c16230fc1395bc5c400d5303da6ea0f817fb8dea5942ea0398d63dc33d52ce62af8ed5fc550afff72e073925b80c641963b96139bf544b4fc50fa7450d13f92703fc9bbe74c92cea3782ee2f1315b8aa83fda58a35f7d9f752e827d59491f1968b35e2a0f772bb9bf8eab27e602d0711f542bb3a51c01eb0eefa0003685f303791b55b42517a3482eeb9569243b4e7f6342312e8a72f71f2e5afe04cfcde4d60a41556111752103595792b19224fc3adcd195d038aa87c43c3944910c691a1c85eb073abbd9ce73a6994a061805032cf2c8ffa1980bdb61a2521aafd5a0bc5c51e212460b8ad21f7e7b67709e258add0ef116aa92df187ec76d266712bcf31fd6ee208eead2548f4ac38ef70ccdbad4961283f20f6c69a4135413c0ab03e6ec7cd6d6183ef77c4c703a69a44a45bb99f4f4ee81f5fcf459eece87c388bebe4bab64deeef14273dd5aa8a07e41d5b4b48e5ffd602ed5e128c0a22a779134a2c4cb5ee018e9fb61ca6ed5db8dd7c5cdaece1b5b96a03f5996f199a6e4afafbbe0448d839c106a6e9c1688c1daf55c300d1befae2b3584842de97ba012c87530267eb970844cd7c0dab98bfa6c84e3025cdca49f28d3eb89741110c30ac5cf2a1fe2aa4fd88789820cbea42f4c6aa26e207b02d59464bb90f3cf1fb4d38f05d151d627c79ea8c9dabb8f9c088091e199e35fd1f977cf3dc3338c721e750c5f4c46c3fa80e097dff06e933a2c12dfe8ae2cf0d9b2dafcb948bbb1cfa7f92625c48612e923a53c13edad324844093efed38496e2a9c4d3764713a4fff766c49e609729bd58f67facf900d48cf76e956d3072b9b3853d3cbee9c4cfcab7c4ce134903723dc6da48f43bf0e1d0ee48cb7bef7ec115ef4d1fd7555599f78f1b2bcca652533316597f31dc04c1dad09fca71353016d08ffd640ab44e69502674c511a00a3665ef7b0cac03c5dd72467c79972d1120ac0c54f39f2e38a99b25d6832a5fb5829dfa49d7add9b99b62f8e6c034fca848710f5ab4deea9ac0a1334a4d5e0ada9fa1dfcac87c866a64718de58791cd7df4e63f18900f11fc162af9d70bf7ca02f5394506c8603160a166ae81b6f7c6198dd445956d79cae613fe1f85a53bc6b4ec2fd406bda30321b80a02c336ac0f037c03c8da35653ee11fe44c5c04732778ec4a35d1918b2337132532b2edf8d1c3283b71edce1b9574a2a528650ee614d65d51106f2a61b92a187fe556c42534e2f844e8d822e3f62804095ca7acdeb657a70d0ce9726cef8031dfc4b8a37a5fe756e5d4a317058984add8902ac7a134823246d2464ff6ebc3c50e76df733e7b5aa9e8dd5497c8781005da6bf74578b7e066c30a8eab45d57a3bd5a4d31abaafc45813acf58976e85475d7961510ab67f7ac4e5bca6da2d62efdfaf69d823624accd2fe98dd45503d96396b98c0e826b526aad6d017d5516667245134491f9019a6f033c2562aef12638e07b652945ec7609a9e93bc3a6bcaa0280a4d0314d6f16a6594bc41ac8dac35d7d84a7473b11edf20a778026ddf0821571504a497896a9daf7c172e4ede53938357d5a52ad033e8c98bed99141dc7713e2c0b9c1c39dda73a64437a8633a0f33d00e8731e3e9f13e1b674de91ba51065999c258176ad32d92e7c1c4e7302cdb515de35cc25ec8e725a19e517b376d6715e8b9770d9ed3875571328bf6565fc25cd966c0bbb349e8f1e7da803517550a0fb351578348674ade9ae64e1818a23edc0dd34d6ece8a9fd2f3b9e953dca065a3643aa80ce9f6eeaabf8d69d0f9aca74b65c96150231352355facfb6be9e8008d95d5b71f061af95669688dc56bc792277bb99b04336cc6b5862444c1e194710aa2a3231e2f4be14e23382849f19b95fcaa1468ff820f53cff1c0440a362e2dc725336a9ec7f23d1e775ca7e32d8119379b6a39b681639fe13d0177b96a2d9d2f87f6fc1562a67323d046ab357230a264aa3bbbadd411e1a5d2586e43f00b55c0657e662671f11a1ab896a0a561f2a81061093d59dc82ef6a2c45862e5a5fce16283a2726883a985fbacd06a76f6fc0a75a435d5f1d4f1fbad5595dfd1b839c9d5aaabdaa181b746f314a6bd00d0052a5e08a8a0218dee91457f45424c62f17b27740a835a3ec44c5c6af4ea3cd4cf498ae4f420751aad2131ea71739ccbae61208bc654dbe557fefd55c0d9722be1d0c2df223b35a4b6113a3f2159091af7e28894e7346b9cf9c6a07e1472eafcc325cca138dba85292cb28265bdedd785566263a760d548b310b0b8cf79deb70feb270d341e7174dc8b5c34629e95e0c4f55c3227ac6dcdc873607287242bfaf19de781d4247cabce039d2489263d6ff6d1827f7fb474cb483ad5cfa8b49ace09c10aa2645e309c862be1fd39f328b7837151a5f0278ec3eaed9d2a94c9afb2c0fb2d09751a31c99d7ac7090563fc6a036b564029541039f8f2231debd1df4bafb2bb0176f6f4a56c76a8e27c172ce9ef160cc8abf8adb02aff14040e5bbdeb3e8e3134fa62fdd28b862413fe8b3ed9bf07f1c9c853bba8d94acc878cc5a033e5c42c0e6fecb1b3634fb5080d1eb69bfbc781ae3f13ce968c8bd912d7ae3a984e1b081857f2b4da9c29d859486008b31dcb58f040a75b0bcd38a6308f83f19acfe951cd43237baa8ebb0a6200fdc9b1ad89c42aad8ce56b13b7d06b14d549bdf3c595a7a1ed8ac5c359c7ccf7265e1a13997fd7b6430256e8afc41cf810c7645216403204bf469ec2acacf46b985a4ef860d861fb581631c4771de0a9d4ef405371edf6dc2743a8152a06730ec232e2b4766a63fd3ab59e2fb43a30ca7015b +Digest: 2612db4c51a0b77013444d168d31a7ffc624ec2de94ecc58e0b299bfb7b6159fb89bfc333e4d2e4d4d3a5a60794897b2583ee2cf7cc31c646a9bd9c89b993d64 +Test: Verify +Comment: length 47296 +Message: c9cd0c1a7ce56e33b6e6a03fe9874ada926665a51956433ef8fad06f209317a5981608a46882787ab57069b12deb8cc9a68304e6019d6dc5550d1df44ae7a943c291ab76bf1dc33c81d6dc65ee19b14f37678fa1b9b75c3c2111d86fd458236a8e6880f648615863604182c1f4b9c1538e398e40074e188ca52d8a4787908c0443c00c8dcdf33ed59bd9e12e0672c5bcf4228a2ab407aa9b298abae42b34ecf82ac4d9a3147e7d7c79c58315eeecc374af4a0ac7888c1953f54ff0ae88ef4c2e8b996ea1e7a81e3e442ef0dc72d0c66207d8967f4a856d9b50a5b40d6566b38eae6a53ed0c192805423baeed5bc6d36e46f4b6bac499af5a84b48f698b442900da5d11f14b7aa3b8bd1547ae7075f480b2c8f3e0bc71e67ad7a3082ac32fb66c589a2f146e73983ffbe343897b8630809579d459fbb51ae2929ba8b8d3cf63ba714a35bd3bab0e8245ce28e542a090563532e28d490c537afcc3f57b83ce37d26a95ab567ccb0d68e2fe80298f6c1aebdb19a3e56d1e9a2a5f4479dc9dd13b9c8ea21a46f77a9ddb1c9ad2bf2892d825ce56a1c73194f6da0145bc41e7837501249a0af57561c7c339cba70ed5b9d2ed5812649c5b1670722cef45132b89efe773a401cbbd28920682b8867e60890f2cbf7572cdb44b0fda266a9cbb2f8eb138c4e989309976078d3f8af7778fac97c84ca655c004dcdbfb37dd499fbc38c1da5f91298ccff32c40b86882612cc772ab47ce95df1370dcbba970d429992f29b78cc36a4728480b07347bb0a4fd85a9bbf814b891a8b01b03c24dc6c0901cf1b593a7d2c96c1daccbfdea08a8cb8b42e2a6a1483d8d449fbccc99a7cb67a71fbebb66eb7a6319157259de13d65d8448069b9ccd4d88d370cc0d7ffdb4e777bdb94e283dc3d4e550e6917f57947d16c0111d2ecd286205971dce2552e2d835d28d92144e0a8929650decf45e4bf1e9b4ea757fd236e3841b9556b32dbd02886724d053a9b8488c5ad1b466b06482a62b79ebb663dfd2f5041eef5217ad2c1983654f0cd336dab639192ffcd345f8f52ea6c6fc098bf8035b9fdf2a971a20902e38596855eb07500acca7df51581b7dc45950784aa21e5427ff6f62356ca4947085348fb83e9602d3d46236b204b3e7f57acf53b18c0a907028e722790b81cd523429a8849951739e18a92a7cb087dac9f18cb4c3b185603e018f94ec607fe4db2e80dc3f63fe4c7280c3e339c660ff49a6cfc40a7a566c9a72aedd15d16581145981527303663458f4fa8870ad06fe7c82e0aa0d4d475b8b638e287cc7fd4b039e7433a7e351d4565c9442aacd417e6b6b068f54931ed51abc759baaab0debb2e6a0a6646a87d477a0da386e8ed9271c4a8a9b68b5a4844e65ac5e26e35e0829174ed43100cfdbc0a91493445895a39908b4f5d019a10d2f477b9a78d9b84b6f1ac6e4960df2913b5d8a7ab4933e97ea8bccc61429dd1bc548297729f3e25c8bd850ff1bf9b99fefa5831647a79cae15bd1a35bd4c1f541951001cc09ba6e28838344d492de9ade46a498e84fc778e2485e66b52e93060324b46b2c538ca866b21b9f5a70f4d622392220bf4fa97df1eca77905b6ad9e8181c4460c13117ef3e7d2820be08ac67b30657b51d0ac44a0c7616cb6036e094d4ae424f3bf055c50933c9f51481cd639caf2fb38992c576f5700b44eab50d0b6de788a6bbdc4cb2d22be49d33e079ffe774f42ec0fc630de1a09e24804f2af6ebb15d8ec95dc35ca34dc13fa38e78e39b3cec4d48ae66b4d9ee1793ab6cfdfc57f30b2feedb846b8381a804eaf492b6c0f16139ab129615e342bdb8f27450c6b895d8b0b1be55887bafe01492798f215f7a9919718ebad80a84d9bcddcfe9fb167e0d3a9b6fff5b91bfb296238436cb7ebfdd16208c9ca5539cb3c6f4e590447998f1f433544a8bcf9966b2237f505d28a8745842730222c87293ffc01f0f49eacace0701d6fdc13d2544921cd1a57e621da8065eabb5fa70efc18fc8e32db170fcea9a8d5de2a4e24c935b95e2fdd73606bf49fd9c7dd353f9849d949ab12514168fd66052bfddc6f49d38171a200fab4b0248a6ae21567a792651adad644cdd0103e3011b5d13f106a84f29e1d6cfc9d4b92ce1496b2aec58edd49a820ecfd3a38ee8f82284ef6c6bfdc8539fe6bf99892c1c36d521f7b17c224ee3837755fee57a0dcecefb183e09e4cc1dbc19862253a2412eba0c67d2cf0ce61117668767af0d7c0a868c376fcaa48310a037cd6d1865c25060f4205638f5c5aba5a40d15ea915a34b4fdf408958714b3b3083b80c2bbc8252fa1ca459e23133997fa8e107c4cd2d4bf17f60f51d3a78e5e53796537ed7b3490da0ea8ebdff744542db2614f8709730fa2e68fe8d1662a07e22e2461420205e9689486067199534408220f4a892a980c666b8d41c9770e187b03c326048620a31403e7d72122eecf528622549c5bcc1e2b2e13440302c2f7e7a04c70792e0e27a403d34637ba9d5dd285a35706c496adb8d728d9c630cf0eeeacc626eb2356dce03e533bfa88e95651c8993a108f7e21d60dd5e85c28bcc357d03a30a08c802992596e9eb3b5592297f70ce502e10ce24d7821590b131180ecb3af76e192147880ff2d57ab6876296cb9043f24e5c958e5c114141c1957ac73fe2ddff55d9b3073d6964e27cac6d498b68a32bdc03ceb6590b602d76115aeb558bd5526149db83386b46c7203d389e297a5a6179dee04978c10098314d3f07a6a65c0bae0a07a88b88c97d33a25b114045e8178a26509415e291269591ad989db2f06fae82edd3a1428b8919842b5f4a4bcac29f72b642cae0906d25970d1ac5423102e55ce4910418fb8f544b4fb4b20c70f72c5c87b2023b9cb043c6040a97d48c69e4e0926d4e8c97d476603ede01f87929a34c2b8e565404b48296f8e49fda61091fc65dd4cb0dff1cf28b5f27d4a051eeb6ba382421da66ce5482724547d45d751866cd44142d8fbd4b05471e8494899ab93f24000f3f41825c20f6892a42e012415a6747a45bc82a02668d4eac358ed23d3385ce78e31364ebfafc3cb1b687853d19a25c162937079b377824b613e009b54fc3dbf9765aea966909ec689fb2225e1d050dc4166aca87f0be3d3ca01bc5b3dc64b50b598687ee0395f4c97f0e9e46ed05b94893c1e74b1ab5f4aa6a907aab71fee6291d34b1555327025ed4eb4d69f23b0b1e21eae2771e05e779f3fcbd2ea8d8ebcd21d41b5ec043719321d6a459d50b5fbf6134408e93048235bc9ef19fd9a9327217f32a7cd361ef00e65f5778fdfd43a6a23c85e3e26851682525bc819ce656b2600043421508b712b2f3cb59e587435e95622729b477d18bddff72665b06c5088a8a0a210dbe8652e822746f244fcb519b53a8c261d99f1b47aab7d0ac8119ef07fee39c15e9c94c2679e74b22bd682a247f8f3072f3f680e2a5f132f9eba1c058ed6435d610fc68de58985079369642d1545f16705d84773f8fb32fdbbd19370dc41060b6ca9c33704d0c218061d23622507cc6e28cd548dea67209ca6bccbd87115cbf408d25269cc5c730e0b5a86e88128cd431f8458010b8b2533e7e58ce6563cda3fbcf23dcb4613e0102b885668318e3c0f72671a7a604f8bea07b29e42929c7b1511714a0479de5047ec0f5b893b2361f9aadd649ef39c98ea8d8dc8932d1ff69e8eb742bd6ea60ddad9585df4a9cd832a4e4dfc15cb58965b01ddd38130ac9201bb2cec9d2b515df277c924508376ecc9e621ab88f06dcb65ec0988b6a22a99672039124dbac889b750cb7746cf05e2fffac0399f6bc1802ed47bacd78b8351f746447a7423f4d850ebc7207e9762aef413926e01433efce1449a0a8ff49e03dab4b7edbb6cbc94e6d023e59fe27598cfb8ff125780cb89a4c1ce6983e463f637f2f833ca9f0703a088498f52b926e7b9726fec482b4f6d9fd57f905e63ba743789711448c3bf6fa79a9fe63e235de5d9c84ac57d4ab4f1fc071548c6798bc302008858dde1cb1e228e8fb10c2802d85842f8659de8e15de0dff859632fbe2cbfdfa7c6320013593aed7fba63d0fd095d68e194510abef975e6918bdf8c3bf797af3528ef287f67173dd9c7ec2436c011c36e1a41ba330ce3a346a6df98ea6cb1f69a44bc61f792e00904a14e2b95459bda05be14ff28e0529f80710e5cb4d3363f3de23fb46320bed6681032ed03df2435104973e285bbe960a8b511df7f734d0f88cc2328ab5ad82e6ddb407366d7d45df584056932e6d070243a932a35951ff0e2c90ec6b78857987bcc1fc4a875d2d91e34739e17a930575ec83a43bc81d369b3a0a9956ff2629dfaa978e8af014731f12464891d4b319bbc27ae34fe7f9203641a9b9dbcdf22c3523bf2e865c35aeed81b81312a16fac6a81e9805e1d784445bff8ce68499be95eb4a36cbb00334973ae0729e2750b4608977a0bc4fd0d0b601172679b1665f982e9eeb997a08fcb47e3cded8fd4286efc7f86d632fb39fe1be290e5d298f2d5681feba5baa1bdbce0ef76de8923499fdca6aa80168c8184cfbffef9ad65b4f564d334b182884f96c51d9c8d5d06e1411f994f89fe457647f1e5f6f399e14ee20fb0645d8dc8b7d16afaa97a79e3720b4be4006448aa8aa02911236416b00313df13c51a3ae78905490318166e3d9e56c80347af84203135ebae0edba2469413499a01682869259af5c372f1b899a8ac4a839fbc3f4afc71a03903cacb195458d5af93d7c4c2201ae7b8449ce77c338419c1731ae88f5edbed3ecca20facd66d19b0e6d9ae870afda56e07685959b166dc596c5c0e71dadd291ba401de658cc87c6a84fe342c48cb953135e4acb6c4dcf8b7e5f02f76f30dfa7c345ac5f809e37428f8a5f4266c0d5dbe4aa24017c04ef5796a67aa1329e6d7ccf82d44d8b0569778bc716d19d72b6571c021c1f1564568fa74332ceb01f0278a69f9d96c228a6cd64ae11d5b3cae22d830d380d7d958b9d79dd32642fd928030f430f236d3075ace1e65737eef1e3c7e17482b3fcbe16e7d41d804df8f76685d31633dcd4445f7ccc18f0e0970f418bfede02fadc0780d780ab266f539f4466bac210a93e8deba5ebebe5b7f54b82e3a2f4bfc8639950d3442e2cb487fa4b0e8cecae73f532a18f07083da352ce3036945ec107db9c0e45ea4f9802de2f02e6113e16203f5c09a2e716008ef4c0d2eb9dc3109d8a37439438b574439e66f25411604f9a6533ac4755be365f2448f16c85ccb574b9937628f708c85e10c9a1c153fa61c7aede11e417a8e8fe2a8e14201420b772afd82f69eef29a3b7c7d9996a0b355916486c0e3f67b1e524ebbc36f11681e81b62df6bfe719f4c22aad6239c03332dfcd5242aabae0de45d8f787c1464bf28814ba5492a825dddb617f82147b230098336b1ea32b7e32be0f69e67e79723c6e12a8d04afbbf5e6e6b1b838d992bc8a6dcf8dc3410fe21a63d3a6a0e7384041df81ff34fa68f7d638eaaed0ee1f291f0112205c73307b3e3a8919bdafc2a507c0e464309713c44a2135446fe1c21635e191120c35a42f15e98970048dc0c2a739b464ae1266fbb13424018c5125f46d83eecb5904e56e2ff577421c1dad199eae947903d8bcfe99f6297eacb8b554346c6dc4c96d7ec8faf2c4f86aebf21a6c93e709c866a05d62cbd8045774fab6190fa086e3cbcacfe545e50b87553a657f8e3e9f62589b88aa39924b0332508a99f2299a2ecc73d39d736a13e805e05b66020db2680b0910eed3fabb367d714215986b6710ebe484821fc67a035a8e9cbe73c6eb401a93769f0f73cd6792b78d3a76d8862086a743119f8cd67fef8f89d7681c9290f3b54a39608ffa2d2eadcc7722136fd43936afea671f81a4218da34f635150d112d8dc5c6bc1d9edadce704a0e8e9ca2701d2b7b2b1134168ce38984da179e671488cd56859be53f9c842921a0bc9521d7b536224fe4464dae3bad2650d1e3e9654f9de6328094798779579c9d1fd1c8bcb9509e4a1b30cff1f07e824c12b9ce8197be5a17127041db287c19484aeb0dab741b3d9e28ac03f49c8e57404c989cf5ebbf4097c4012f23fc073626a03977308ff69ed08ee09022ba4ce3c20208cb3ed611283907bf77de6e9971dcd2558bc857632075d096eb08b44ad645b572dfc8c1448f7f6003d2871aa33acf33b7b1ff84f160f270377b1324f89d3fe97f412047c9d4df7f86b5aa6aa51f7256e890327311deeaf04ac6ee86e6b7350076a5e1c42196dd98b0a7a4f92f8e6aae609d0dcc5508a3d33964d74495a2b9bd016469e0ec440e4e0a1f232093161ccca83edddb3b6cc18b8bcb7a0875ee3251980335087a7ac6220b82918b80350d1427fc4f2a2579c8abca61532d17f83380b318efc56c99a9972d887c846769b027886bce53a3ce3d967ddcdf3cec6f41aceb0bd682332f3d2ff87740c5c922aa7911f3d7d246c874ee0e849ab273a1c1389852a5d95eb9d55ee5058aaa260e508b8d3af8108ef7231504fef2283e4e46d64393ba254fb826a68b89b6bbfe7b56c13297bba8dce8acade9b291f8bca346e88535a01096a89599549a5175c2f801dcaa907f05c10b960b3535e6ce7f6f5601d5bee405c4199699c8adf762041306106dbbcea1dbde63df6fff5cf3e700d894ada5f28f4879ce4a603af4fb424ab81ef48027277def9a7d0285811383e6632385714817a447910da3d7e6cbfe0dbc4ac77424e127ad9e76955eefa7e6ae7a20f5a77139580183661bfb593ea7ea67466f0e24797997045e80e1f51b8fc7723f66befa5ee44619d6211ba8ddd05f6d7443c4c25ae43a50875db53e08efa00fb1513e4012c973c8f06bcf7223f7db2376fe2e6b0fe81607a3a45f26da66e697395d9beedf88291527547d219b9efc2da0e6a1ab0305a89e15cd364c1ab5f9ad39e46e632fa0c482fd63ab53cf2620e094a5d4fecebd70986060e12a443d67a6357e1c298d93d496e511e075193de7d0b4b42ec2dd8ffc6b15e7c62dd16daf36be932bbe63e1d7c57107a3021436bf92a38a15b3b9fdaa9aa8ca7bd36cd73ec327cc13ae6d0b5c93238d69874ab126aac390303dee7709ab8b9178c7510a94e013617a55e380c1946f4baa71272dab6da78ee4cde58ca82240d5235638685ff2042bb65171d2a52dc6aafc5c241ccc6fc1aed9e029bef4737afe222c8d80ee8d7c635e3d928185e3cc23c5a4dc0ee825a4a85611358e7d336c84fb96cae4df16eeb0e866b01dd23ae25eace7c964ad23b2e40fdda36bb0c6c7f1f6416ae48032cd8cdb5974f818b7abb4089156ce89fe9eea5db1cde72dc20fddc8a908309045ab6fada23ba0d7de7abc6f3e0e9cecfaab33c61a4f8142a99690d92a0d398de40ac1d5cd8ec88e03e1e0474a7b6064cc7a58ef8392baadd20ec3be60f47fb7726e3bfa37e8afa9ec83b8375307a98fc88eb2208a21f3adffdaeededa4863cb954826717dd3f6c9eca2bca5c44de8ac934ae80faa87dcf1778d6ab0f2939638a11b29e20bcb0e4c88f156193ab8ae69a1515313413ed6e6dd98dfeb4640776d4a79beb26e5886d045e22d1802d25b4567149bc20ab1621c967fa6c441f997f7e5c64d6911e6d0c3a7e79a18d9257fae79171a92537a1ef136b467f27209685707936e7c93008cb5238445921a1cac234bdb681aa8135e1332d98bfc630a791924538a736e300b134d4a882a3232313253c40cb194f7bfd12f519b3871674aacc0a939d40fefdc6c99acfa37de10df6a258360fd96a1b4d960bf0e3d39ca4d8060e6e52504ba913f7d1e14416a02e719357c0d6529abcd9a8b647d71388df23289bf24ccc90a99fa7c305edd62b2e8fe08208a6eca606a731404318ada3cf941af746151e96a873c2b664272549b6557221330a0f58a3c217ef0e2d0bb51a32c46a9435ac254c952ef326796bc16ecd2f7c6c872376382f440cd09e938668060e3e0132e0053d0fd5c2726c105cfdfe00dad9a790c970f79edeb0f4afdd6216e1b9b79621fd24e99d6a70877ce20cf0cd85a2f1be19f0230fafd7b6c683af6c2325dee8d6d6a92970354a52181b42ac7fc3f0ed162e63bb7ec56d6c3f41f810bec89db1695873d9356925554ace4839fcddeb24fecf6fc5d26a999e84dde50898eb1d78414b2b00d44f2c197bc5c59f2e1bba1ddfc6bc4bf5e383d5fc1f1d5e9bd586c5c67778a7342f842514c662e7fcc4866022d9f354ce7b54980fd1491aaed0ff2160a403d53f5158017b9ac7184d2276762dd1bce94579347025b91042b822b01277997492dcfcce361a099b3a0b7bb3e66a75be1142244ae4a6a11be0a3 +Digest: d198b2eb281dc94bf3b4f6becde8362cc70cd9172a9e9484a5977d6bc6cb8fef5ea05a2311671120ef48885101011e2669edce9732bde2c29761965058c76136 +Test: Verify +Comment: length 47880 +Message: 4a0281becd813266e255bafecbca094597c34755474e16d9307b177aa06faf9ac4b40b45c9d3616442257934cae66df7ea8badea3d554576d12763aad19513e9613d4ee0ca5a33bbd79694997f20b43dc3ff4f06daa6db218cc80efddc6da0ffe9465278163d2fd46951121431a1687eecc63792676660412706215a0820dd45247620f3f6a5de15c0fdfb8c299010212b896d772cc05a3d6b8ba3a89ed65321da76bf3bb2bac6e7a34358ebb016359049f0f79b71da537f20fc9cd1e6b688fcd2ed373692a371b3dbcb30180c5b5e320ea2dfe87edcd26e0e0414bc28e9063fd58491cede8967df313c8bfb8586136f41482d459aef6072fc491451ac975550abe3d4eadd932ed56a3f717c65c0ddafac89e7990f3b84f3b473a378b9e6fb991cb10871d8ea50fb517beb83f230425a150e17ce23e7c659fc2bca1999018280f096354d17b555bbad9900f876ffccd8457fc4cb1f1bae0d9d19901c920e726fee3c6465e21dc37c4540b9c3375403920483f7784b01c5755fe4fd69ed3651cddf489da1814a24a5e2191ccc7e586eee19c2b7bdeebe92fa093419e9f2a0a9028b65e6e93b63ffa04ccb34fc923295554ee50c82517d9d0465b3ed82e8750176ba3949255a91ddd44bff0639bd0b00306994feafbd646ffc3907801d19dce291346ccd3d24fb45a9a75d9c6c450b38e53376962c789b8f484ed8daa3cbfed3bbc0a77a19e2cabf87278cfd7e7359c4de7434dbe1ca4b85526ccf04fa47025c5c289259a2db25d3d6953531558f1e2c81f475d6b7fd9cda815a93050cd51105dc32d471be59350afeb7ff41dbe181f9387ae28d9458b5153ce2cde5bfbc5357a3a715cb56a221eb67559334f6b0abb26ad0230a6222bfbeedca25adfd46efd9194eff6d53ff12ff7a3998129046c4df7ebcdf5507a4e15efbdb4264adb90e14a6f138619bb830cc9d2ab7e390e9f308de07be746d26447cceddcd12b75ed78eb35668af1815a2dc39ef98b0dee260b6f1796a717aef0fa0ce986dbf027d73d1a646385db05e91b7b751e280627934701fd9885318496b5263d4cb74785e0965e9894f754dda24e37d183e5c04f597bfd0f1c3232e7a801bf5588f390048c2d0e2e757fed6d284eaf50c534baca0b02a6c87c0e8a3cb7582eced60148285c69cfb28f501338ed85486f4ca5542c0a8395b642aaa61847310b05be60fe75b3c509b13d3854c5649a7979a4a82ae9ea6740650a7724feda14ba96aca3115134c75297299920972ff6d92c47cdbd882d364d312df47554e28bd3fe1b482f5f420920f0bef305229212dde3b0767a8b357902b747c315bee2feedb8a4b0b6f48dd2fb4a67b680fc5d870e3c7952f077b5980773c23384916df65e32b38d36c55aed5800de841288c4bbd092fcb39db2001bd1d337e65070e60aac18d23e2d265b90adb07dcc485c7a39cb83d538f0eeb78ce872135bf7e1ed945db78b2418bbe26592d5bfff80ebd079558b7d5398624e63b1bcef04e948e72bf9bb490f77da81e47ded2fbe5acb8a0315166f83d2d13738d4301561b32a5559e6808630c926dc95e5634759345fe95f70b1265a5e900454b66840f2d41aca76da93dd489b0544e25fe49180bc2d80f70ef83c479a43287fdeb1dc48da7eb93b1c81b8a75c1a4d5243cd889540c8e36226380bcbf45f25f2c3c951d414eaa3ef42c6a2ed8aca688e479ab737609683197d0d3f581b488f55fc0b3c1531c31d3bd3df267bb59a28dec1e887c7aa3ae29579f4218c6d93c721edf4159cafbc77895637bde25b0df0cc491384c67c1a745e83696cd979c55fef101058cafd2b6550306cc3a1e99a72ef53c838c454b9caed4ff96bbfbe51dc0618ec903098844948f8eae24aefc401a068630e41c28d58ba3600c8bfa9cdae1f5ee5365e007ba5ac163e944dec1f3f97fd609fbf5429a05dbc3bee49ca9d588368a6b5b3d3660d222ed4541b5d008f3e996d47ad7803344068f766feaf456deaac8db8d27fd7d2139958ac43b11c72fcb2d5a08cbcae76fab2cfad4eb65a50bdb116aa2a6445a728ec17f74796d78d6ad03634ed80800af530212baa7e5093651cedf43c2f340ebaadaedfa76ca620f1780b7f40622c42b857988c9275acc889265031784f375b414499cfd3b12ce03920c1da15d017c0cc9f923aa72ae342828409ec7f32a41f654755426ce2b04daa50f5efde68b6f79a7eaaa0590c78a3e9bc578fa1781eed9f3c5dd1d39ff4cbbd9f142b1a8a9e79ba8b4e6818a8f15f4715e5859f9e0c38478a3fe898474eeceb51a9165ab442a9953bf9fc767ec1f703472078ba03007206b768112b574313dc1f213c0f842819c31739c7f2fc8eeda6b684e39145703d455a52c61d6e65f2d85e2906b968d34ccc839a750eb0acb5b9faaf30b5e3fffc9bd9ac81eeeb1bec88a50cf0e8d0b8b50a37786e2a29afe1b579fbea885ce42262bbc1cf106bf973657a59950e6a6ce51479602de5c60cf411baf79b991ee16142773f28025f7319f744ab6d9a84444f63effe3ec214386f57342eae58b86c1bb3a2710765341d62a6aa5ee52dbcf36680f19f1b3fa2e6a61e8c0dbd57a7e8c42eb403f799885ccffc0200963882eecce424bf4dcee06c4aa0192123166bebfd2c3264731fdab5c47fe22ceb3b649ae515fffb30e06b4dcfb471e57a0582da2924942f048899cce2aad1206eb6d08c419ef9cf7f24920fa7a41cd74ca56b57dab05fa0263453e6acf545a79b2b553754d7a8a8830bf32664f77072f586b3d97447fb7442d377a785f7b61efb197120b1686302e6f70d367a3713552f29cae398640e27f4b69393f01aa8f30901a2dcc9b9df8b15765e9479eb8bda33ff3eeab99cfe17b68e36108de6a4c03f6478c01054649d891a55d4c67d309ebe877e635a4b41e002aabdb1b1d4200328b2418f17b0a8b6cc53818bf274a7ff194307e1fcf78ffd639cb90c0e8bb1383f8bcb7e6266f27369a2701e805a6897fec279fb044a2eec43e4b673f645beebfe51452262dff83fbb979ff0e2a6d8e5b98632f3128ba5294e13147dfbbadf7aef936d2fab9420886ca36fc7abd2af64e3fec17eaa648930cc9871ae915369717dd291daaf2bf1e9e7466df75e762282089cb4023e3d519f59f55c7a5998036c339f51d7efffe2e0a5f129045d09f8e99200791240ae84b160aa1365b70123d7bb4a3b8be09879e933442f6329f688f81a9a8f134410a9339b3754f53c1741205f639d8b137e3d8019bfcfb867d46939fcfb74a9db0c2582441d8fad4b52f1f29a8c264a0b299421c3b4a868791c002bc373b83a5819803a05dd31f2874cacbb1724344d3a13146abbd33807f045e45a08c3c8495d914fa75af6ca69525cd7d63fbc660922d334b78c8c0cfb4fda8c21374c335b5e3bfa66bdead7764f1c09f09ec52a0257e28b94905f75c6fa527e2dd97d67e4cc4206f4a939e7addff2c9869ecf0ecd3bb98f7e71ce20ff723620dc59f8047a4a7c0bed9754698477899d04ca4a72ce60d096f1ab489d096a0e1ac9531c67803b225f9e12dadb7ec838daf79bb7f48a49b0588a975f28892442d2513f8b2f9b20dd98a2a62dbc01249929dbada8028568e13aa5e09271d3436cde208994bb2f9e164d77cbdd99c02f12f02d5a9b3b4430dbc3dff153079c49f49493bbf998b1f564c4a9fe6ae3104a4ed4693cf1fd5b54186a9554413828aa62ac47610a56d6e931b495a8462695f8a52d1bcf5cc71f251fb57283bda22cd74f7ba7f34763e2cc1583e773ffe2b5dcae80b18c2c3714366a3ad40a58d40d73038931fd414e8a2078c90bcc1885e448d375d6edf0bbef0a80514642832c4ee0376b61e988851188e3ea7f2af0bec5dfac62d88f3ac3e413ea9f55e6cd3955b15378d4427d963d57df6ebe1b48cbcf03a1de42ca7afdb7e5117b6f41a779d668d067f592a0f0423fd3dc4507615b64574c4eb23a31b7cee08d8c1efda27c3569468f42448331e4836999a089dadc2a3d144a8358ef809da8c737c1653eaef7551e7546e2a4c988d4f95d5d2d25dc85479238529114f698a047051332ec80909ed0a08ff77625a3a71b6dd74bd2cb09e93ece9c9d32786469958a70c12c9fa5b8f59769fd87e4c97c3861ab6052262ca47243cdb7d88475673b1e56ba8f6a8b3605d0716f5a656ec6e8cf5625247c71fbf55e528b67a9401b90675169856fc59889d232b75e560809950d43e4ea4c5e720064e782706559194dcbed589f1de942ea233a80140529c6d5b20149f40456895c0de937733724c2bbd287224d037ad7af29d5340c11488123442aaed2330ec430afd404f0ad47ba7301bb310faedec9517cbf4db6f8e8caf63a0c8e1566cb9556c1349579161652fbeff62f577ea99a79923557952a9f06c71a43822e0e317f16e887436d20254eced3c457d5014fcd7fe0f3dc3734bfb72e5b5c159c97b504099c58a95d5a08e05483a254e8c555d4ed0f67360d95df6e9473a2a2e1a1eab697430521ba0215ca35462c910339403349640c0f98cc829f9209d3c48dab36f94883296713d6f06ee9b1afb6c4eb937b0d954ec369572dcc8f645bf501122e5eb5b341c3eb470d40da4cb8109e4ab41ea209cbfbefb455781549a7bedc7535593779cad2b0b0e0e29f7de2491fd54690bf37f013ac628e14abf0437c8052d06b764d311e04c2ffb691db9aca9a19bf73bda657951ff02c44bc1ebbd89d29a427da84210047fbde4f69dc6e1fbd96832a15eb6f0acadbd46aee1b7d3d737824f0dcd50723faa9f11f7ff6c8b2faca3636606db2ef3d840b098a8d0425a3bcb76905b64fe3bd7bdca95cc1271ed2335d2b15b3afbcd88734a339c9fd1bbe65eff2ed8e87d9d0dff57f88b225cdc4504c7abe43c1fe2c63e5ba7478a4aa24023320ece43b810554dff47c40314a41af98a7c294961db99892d1c31fa73b652025759c4dd743ab68f0cabff1d61eeaafc624bb2ca8a600a3c06b9e05816a023e4b536431e7cc338adc44bc5d80b62fef6994008256218203f2fa6de0af908bbaf95ced26e9754e38f70509d9cd9a71dcd7585b2c4b1ace37af00cb37ae594234d3f49f9358c95c01e57e110d194660f6b3f3f380d3fc35bd69013e50ea1ef62a4fbce40db242dd640c327a5df0446ddb63e99236ad406913959e2fe30f7bf809e118530c827c52ddefa49e42ef1f08e98bcb9f942371d8c8d91a28647adad8622c89750645d04cee145705526230b2af8ffc745fd31af54b8817a03bb8c607b176a2c28188d93c02fecc481306140babd50ec8c028a64f2a47193fff35c8167673d6b414a81190bb2376cefb2753744d1f74f58bb0ae66d37a8140159e5b753f98a7d2264ff3fb8506e9127162597d31b3c1a308f78dacd5b70269254eeab46b5988a53ccd0adcef3d85ab2c23a086c8367729de69eeb1bf70ff1394c41044883b1b95decbc0a5582bef017207c3419f1bf81262942bf5ef2ce9c7ea9a46b614b1b32c72a8afe56e5687ade96b2c0e14d8d6f53be2dfe9e36f550e9d4e0889af51f1e19f00433d7041e21908ea657cd7f1964ac0e2751e3aacc340333bd02fa6905a5dca5f04ee3c7280db46f1e9fe370ab87ba81f86036369b71532f0282899015ee97b017fa7f16cd65d2a1e3402d068b00048067d29ec2a92e613179af50509722d27b41ddb5d95752728cbde3b32a01f812713d4f24363f94b69fe8325692d268166d359f8cf80cfb1d9873307cc554976dbd4281cf7aa5cbd9e218b2a43f0fe9e9eebde90d5b35895a2dcfce90bdcd049ccd3e0da77723fa5263d1d8403d96ccd6669f633eea1923b2b39766f7fcb4682708f99eb4130149aa89da4c3476af3a623da4b4298e02f2ac92949fb96851ea97d53adaff3786e168bbfdb588d0a25b17dc9484d62d361dd0328e22dfebebb3739ecb698fccfbea146300bb4235b6567ca9377d4bb0fecda6fb4d96716ccbea43ca72f46cb8a88b37e8ac076c8c3454190d55459200a22ab75698a475d23ab890c1f8239fe5d5ed58b2c9410dbd647c7771b584b3036a5b8aa938f4f5077e45e0ea259d2f39ca38ff291f112eaf8ef71d3b20e3b4a39e89a75df62df8f2dfb8beafc00b249ece93b4b5751dd64cfaec93d55e099fc785db97db98f7877ba739af77931487fb2b2600be95100d7bf08462a537a07b57687ae18ae6fca98a1cf23dab64615f37271a6aac4590db24b7e71115734d513a8f8d0dd1aae166078808efb1fc99b43c0b977be74e45492f983c288bd9ba285a423da41aaa51c6da31a64df223658ef11fc4b9d778d95e85dbab3071328f089ec9b22dccaff2d2ec60f2e0d6a06df63eaacaaee48af1230cc85eb02e4673faee6b13304e816c91235c142fc63d58f30bf6d1e2774e389eada67a302add0f04327288350ae8680c686f35c328c0cf8e404900dcf68a53d951bf2a38cdbf0b3152243bc567ac8e49a4df7d2265f279cec6ec7f24cb07eddcde5994517fb30e8637ca5167cd948552bdf513d6e69bffbb832777425c8dacad3ebde002a883c00dc7abf5a4a46af62f9df920671283085d604110be13e43856573337d4b0f5cbcdeb114d0355f488e62a33cb5b50713dbd4584712157d33adf1302c14effd2d4ce8c42810c46fbe4814eea3d3c0a2f45e21b36c3f38f235a4e5874a5f8fde186199087ba47e046b107ef689d91a783cad4c8a02dba259c3fad10cf0c5a13ec86b5e128203d8b9f9881f7f314e38f36719c360ad80080069203225c1dfda7b97faa656dda75b0cc41f64dd4cab92910e4414bbbeb4c0829fa597663016823121701069e1177b596536ed953e69bdfd8cbcbf1fd8f2725cd20b6f42cdf23edbdf6c1aa02eccc04c577f283b791111858cd430f16ec183fb9ab2284fee0b76f82c5f23be294fb03215488334af2a43d5693b08d4f29a7beb644a60e232cab0f2b2c9ca086308c1c71933bd15232dbb49bc51a52f06f5c0a8c93487ae1ea87377ed2c8c136e908b67fdb104518783fe6ef0a894841e5c08b033f12b08142d44e45607e863ae7f63811d51177e4ed573b190a06568ab45aaae2f10c984a5d18bc467dc4d7d951de0cf0284550feb8ab1ce36e98641203b2cdf3503d1b8663dee84ad2a49c5d4f4899e47db4b6ad03c3ef13de485b22fb515efc05ad1f7b7cab3c180725bd0c0bbd47b57c67923af3281d72011d2102c4bec3c6b7648d73ce091f7ac34f222faac47e2acc65cdedb2610fc8801f9ffa858166190f6b4eb4847ff936ae2bb40d57e6a60c16b64d0e68f62cdd0256bd526623adbdb5c94886c496331571c059f038aa27230163fce53c6fdb7830cb6451902b027950866533b6d433dfb417fa1e75986a373673c1ba57558663b2857a402b21cc1688ab8c0284c4625c1e3680e03738d5105cee83d4e13094642f8ce8675e8e725d073ea53a53eb28535827d17ea613d1751cdd2c7c01866d4450e9970e52f95e13724a97244ed3ee8e0af2d740e9b0c7301e47a3fadfe179cabca36e7d2feaf70374d44c089a031ad3db9d786e29971d070934d096a4c81fc01bc254fb1ce9a5f4b3e6ab2e620316eb73329e4f8d513dc386ac9b9878c4caec174f33d2417fd0add7879cddcc5c489e7bb8302c3e658d2c3cb8ec47825cdf185650f248c733e0f789c0075e00951ab39b38164d635b7709d45fabeceb18c70a80d079a6d68e3d9a7198d4fa2736f3f47ab938fa25bc6124f5aac0cfda80ea8b3ed4b0349517505e3617ecf669c73a27c1437e7bac0fb543489f1338781db06238667f392d567f0b8045359dedd1591517ded0171fdcda2f74498d6fed768259158dceffc6d33368f92b9836dcdcb78625931618a6ac38b022ad14bb6013c6367d5285cc8617d53e47d0fd085d6ebc42936938c46b05378dfad59166f97de6c21abb8ce998a9cb55123c4d5c9911d01008691e6493723f90a3c8edb6e23b48c591d3cb9e22117f7503786e7ab84c5bb92c9ab03f4978b87fc68e0ef440d556078d9f2a324dd85766c18b4aaae1a7c506a804d79fb3a10a230a30de673ed4764fb42992ef4085bdeff57dc8343cab76bc24af79caf9749d4418b5445901bf1266ae78e91b24a018da4757cf5ff2dfd7a647a47f094479daaa97252710b41e9115249419ff20b1d0ed5e2049752bcc4e8bbaead2a4bc39271c308871d57d7a5b22be8608e35d414df1e3e01dbc0ef84432258958e3883bed638be709f08459d8552355a00e02d7f6ad7d9f337dc4ed22642e8afb0ed10795474f49d7a9f2467078fc09c7ca38fc35ebd56673ff74334ee980f4a26cbe26859025b7c348efc68b51f0ab675d27377171933cc58c47503289c1cf3546781f2706b438b514a26391aaa8416710f61013085e2a116a65ce340c9a239be4267ae271a5d4955634a4ea49cbd6af2bce0f8178de373fe2f535be39 +Digest: 6dbf528adf60ad46c921cb592e06ced55d554aa36fc7d2d6df42e878343eb7cb2adf28b3582bb5151c4c1a15937fac215ba29220ac3df42cd245074c64d6404e +Test: Verify +Comment: length 48464 +Message: 146a9a9f45e53eba1c257088c435657db249d088e6f14ee96d9202472b177cfdd7e4e0b6470b4439eec35986a3164e21a3d9f1aedae118be5e743fe93dfe721d78056e354f5f03cdbfa3bc554addc265f686fe5098b37efc528c1af15b0057affeb78b45e648421f98ade12041f489f1b2363e98a9cd494c52c2da870d85f25e72e1800e922ecbd780c90f0d11c16b6cdfd3faac9499415565fec9d5dcf50ccfdb6b96b7de79649c80df904441ae307e86447bb4e17d2dc093282d004fb86dad413c12684f92d6169fd7aaee59219fd0ae7106d919e3d634e4284f33ef36dd9ead3e3f4b6fdfe8eee599a633e184810a5f42e642c332055a61e6779442d8244a25586485c5c964cc5a0dcc3a623e9ed4a19f611967d280da114bed4bd204095bb472c841d9b91057071c632c64b7bed47d70c1838d2b0f5bfd3df881272356765f75b4a53415b638f3acb5306d57a9b5fa9d4caabea57c852ba5e15ec79ed145304770d95d461c1726a6086f0786261d210e4bb681a88e01a56cf1093cdb43702ed14406dcb50b9aa9f3a511b9acffb5f9ac05cf5f9c0c7773786dab0e44739f61fb78543ac94a6c8379d43d0b31fa248a5dc41bdfe9bf8e9bb3a06bc3402b79d2ae53eafee9a333bc22dc1b867de012dc0acec589f76fef2704d172e53631a688d01ef1b07fdc985dd507d4b1f87829f89c6df3e52ee3421e5247e7fc904ecf8b4a2290d9f2be426d7a9b90150b8c0ee5f9e6ce7cf7e52e89874bf38eb54a9ce405a4f000aa11daf4f8e176381ce26cab0b847dd5b83b5b6f8a25be250dedb49ae8ef38ad0f9d07fb3921afa49544e953b88e2878daae72d8431d6f4800ffc0b5da4a91688929728824a362e1dc782de3ea4bf9eec6061bcd9a7b2f80f647673ec5fc23ba807fc2a6a1aeb8755b46e166880416bee30bfd5477862553578e523c904e152a5c65a05a988bd9ea7878ade17a02a7709885c178c2877a4b8b9c28b72388904185a4b4aef183ecc89dd4385ea88ad58d4f3b0e3e63c655f0fa3992b866f2bb856304a5a994dc1a9531242be4fae7c79c6ff68db0428bdfc90d2d384541d3bf805e4c1c536ade8adb9c2e2d7c585fa725607ee6d5481e3f5e2a3fc1699c75c3badf46c0b559d3652145bbe72daa3c9ab0899bc0b55bc69e37bb39d6295f1ef0ba4cb83ad64a01d2f0969201ffd8c4cac65415c35964cd24dd26e11e8f72176e080f6b31bf26b1facff67d22faca405fee28b398c84c79f8d7d50042a2bda8642c8e274e76d32c0446cd42f22768f781b16d3ee70af91343ad2e5de96a2818faae33b339053bb719dd84aa1b8d9b3356968c7f572855e22ce89bc2bcf09cb15a1765d99973449d611d817d4234493a0925eb3b91294730dc0f82f5623bffb9a9ef8b5f16c9d824038d2d8312255b56c0e6f33d3d15b6437baa4dbf84533b7912bc0f0e590ede9628b6f0833067bacca3620c4c02f58c65304163e8ca413639bb0858ae0a4a3e39f71e334747024ce7dc209f2f88d0b0db235d2c38db0cda41cc5ace07d186e056994f5c95fdfffbee90a812af78ae0af07d85107760bc0dd86e3bd9e054c9ac3435d1d536fa65ae28ea83cf947a9782eb6642776c005ab947c832e1033e1b8a1df42a04f2e73c4dde0f383ca635940013051bc9e064edc5d704c74e3635846257fee453906c8dbf592a4fc3ac52ac6cb283986e9b347d19cd47828842e10d1c2b7a8629da305feede6151cb7078e8ae0e0741cf6517139d74bcecf7efecbda0e19099ed96dcbac1b8dcc5bbb8504eae6fba9f5206b5b53913888c0404fb9dd6c16aa4098d17a6202dc433fd4d82e9551fc4396045b76ed5f1d6ea154bb9b3a6132d2fe4878a2cf3874123f8f7b5be89654c9762ebc5435957cc8f948acb09f91e04c3e64cdd53220c7a1e147d91d733887a42bec0863ead8d9202e78adca7b52b15e777a3b724960598abb9a9c03b3cd177c1de8ca366b9db51cb78139293c4828823ff55c0a535b9c2534f41e7f28a886b9c2817c3c366893173aded95d70c6b86ffe62ba1e0e872219d3e0eb10507f57e5c06298f5e9ade5981f0df8e7b772e370494ea02dd9876dd11efd8c37b995fd688df89af3e3e23f27da8b22585ec12c2b9725d8aa32b0f1d37c867c85c2a109ea81a00ca6b3ba123f03c2e01ff52604fa6e64be23a8b820998328266b0a14efc45215688ee779d1561161bcbf093610854597bb2aa9e1acbbb96f34580e66218e65b5393cedc62ef589d412a61965a134a34b6a1fb4e1e88285a800ed3e1941b1330be90135137da5d3968c75943969810ddc4573681d56b68e8f269b27a2b2d5408612ac6bd63fef9525749e0825cc02fbe6d7d6321889902a610fd24997175324b0207ee0a2f82b350d759fe3bf3b22e3d79bb8815803d7efea4733126ac1c34616acf931fe38f149cb09fbc56a49795c4afb8af45027d65577472e1092549e3b3612bbde4c74ca39caac221bbb797edbad81ddf9959813e184aa33d2a2425c5a7afc3754122e2e8b98c6b365374d9bd87bc9121f9cc7291abecae4c71f0d864a61b3ec21e3e786b5b2041020422868d9223bd7c4da278e777223a17c7d38948196e44ad636137b5eb2ced8db70bc5e645d548f87d24bac6e4b6efa4121361f766707f3df8d4474dcf7916df5575bf4e0799db9d719a61b95a6e77fd3cf987fbf7e9947ac5dfcfbb71cf6501c4a99c4f41391e74124c94454114772a2bcd23dc32a12e6cb3c9f78838f682faeeef8371597bb88446817cf4016e9a31c9d75f208160f31ca8dce93b8bb514d2b98e9c3bb82852d5f682414d0245851cfc5e61514bed8b918d5eca5cd4d5c3910fd01035c60893700b980ad8ad60e3f3aeac51f6f7119fd34b98c5737a1f3940d7fb07e7ebe2245c6b09ff1e68895abcc6075898ef94d7ebc8d2ff09e5581be7f958a8da907faca1001d4aa69c8692812cb89ebe9a3edae0ee54a3a57c4b148c5c2f1c951ba8d448b01e10f8b2203549c8074af060d651baa465d7d0a9bfca39eac88ba0f623445865527c9d101fe81d823b84b7a926e382d14ec311d47be5f58a6a1c8487b8a3d90603b31c204b5504429e7699ddf4393f5f5891f063480ec9245ff7c838319ad47b77e0fd496c2406f07645206409faf935c866f5bfeeedbba1ed45f47055d04facf629c9f249fd2b740c1cd4a72dcfb83be96da9503529d6e75d2e9196ebee5581cab60785ab867cb6a8213c0c2760855902cb937ee56a1fdff7d92614bc9bebe23ab03f695a6a009e927ce0fcc15467775aab3cb2c55aa071026f3b5190801bb78d3ffa061e4fbf15115648e0c154677d3a332a529e9f6086c81758b52e44ece80c8abec4bfdec2016ed7fd1ef0078c53ea8be7c838e167048ffa06a86090675dffba160b04be104cf22686201616dee2b2dcfb7a5bc9bed5a03fcc92ec0c92feaef68743b697b1dce26c6b4cfb286510da4eecd2cffe6cdf430f33db9b5f77b460679bd49d13ae9b89d0350c66e62ac6a90844365b29790cbf92c2eb35321e655e35d92681d80e6f2e7b6bc721f734ed68338a10c9f2ee425eef012b822c8dfaf187c9a12a8ed942189495e4f2058b6b60f647c7df00d26b664f78014af6ce5c5f85f4ae60de18fb90443bcda2b5382ad67a02c366fc2d6e20d9b0d65437e971f059e1b3ea70d282deb3e6e9f9b1421015e6436c258d0733d4b630136998e423ee28181a91eb0fbf4a081da0bea1b1076463932ae65c69a2ca0d801e51c1c9599f1d22491df7d79a1c6c695abb2c8ef60a1978656f115aa349072961d459a0fb4d5d86aa563d33fb9b06517fb6fbe0c4502f7c858953e31e9accb242b9096ff03e13cca303652aca10ff5d7778b6af5b7ece27f2fcca0bfb0683a32bca784022ba657d9eee17c5efc37e15abc90403a2dc1d0014901fda22d3558583cd4e1a780b7b2002ddfa0b52fcac0281708de581b1458f540dfa587b4969deb28b3506da787e3d3799b604db03b0ab6237fa5ce0476d5c183a028eefb2e83920ccd30a3048965da5eaf4b8731fb398b7e4f371a7e4bef0c9e0e0836454f91b3558d03162c4ea07b4975c30009add52e6401f2bbed160d2d0c73c3fc379c50e59f6d5805934a3c3cc6a95736bba5560591327920e567a8a93b7bccbf5677399f4708a01fbe0e819552948899dc8444a7625b2ae7dba34a17c780b2ee1662c456e8c96bb310fe292b79d1c7b7d0bd199a73d6988f447b79ef2d1cf706ec018982f13a2b6e40ab9b55a8eba50f2cd25d45325f4275c432b095c8cb19a86bb5e1c9fcc55fbfa1a940aa6c4c910e6546783e1a3fa939bf7b86b246f58b310a12759268158915d859b1a0406f2c340eac02fbb8023d59bab844ab1436dc3f3b89ad62df85280f393f86cda1ddd72e8d5585f488319f442a7ba316bcf97d31949e01b1afaecd1a68ed08991d23125c55d569bf07681f87a3280a5badd7fe9699b20b0574fce8b5cbc4ef792eb96e2c1cce36b1b1f06ea2a95fe300633cc10cbf8831e4abf9fb6ff6797404430b6b3c368265831484ed13a195e59b79a274d27a631ec5d12075b76d5d6eb0e6b369fb47b48e99ab701b59103c5a835da38aa65ee51a2f70fb080a94e31815a62c1ae7a4b70a7bf35c89e199e5da6e9bba62e6e180bc87f803f30801cd0898fdefde9fe21c71806894b95b9314eda39051ae1286c89e75f2b5f70e386dc8b14a79257284475c6d87d31a15903c0cd8e7f3bcc7c32f086fed8b64abad37d1053852901e1fea1399ed722cbe15dda0551f3b2f652b16b2ec451ecc5ed4cda9fb3406aed0f9573f7be60c81a3a87c40ce827266893321f66195daae964391cc09c9ffc259b52148aa2e0c8964ac9a76abde3402825fd37b665c398bf08e26afb766c88b16e7dac7ab01fcd47fa6baba536f1a840f25ad9a6104c5d4ebf8eedd9aa6db5976f5e624d52e47d3633b4f747bd1805b7e1912ebf82c0a19f7286cde19e6b2ce1853c5f8deff8806adbeeb4d8b91fff96d9e95d8824e70eb80a13319cbb2d94979a61cbc1ee247febdb5f09de92cf3fe4c4ab8e8a5c884aa36d7b4190697d96bf9513cd72b92e22c21c4f1fe3aff06da98920eb4b936dfd68850627471121da635d9b8d27b7de10f685081d6e7a4a31ee108d9955325cd00d38fe084919e2078adc41346850fef28ffdd12c085aa431ba413dc3309f1e6a9c70a90f1ceb88c53df94ceabeec546f966ef17437b7c7181504778f62447b751c1451614aeddbbe839c06d6aff3aa3012bfb11c86fa7c8c0741822575883a96960c3c295b89a39764adb521c5cdc6dc0bd8594d7a89893599e0a7aef1d225771140b28dd526a7fbe815a2f288e3701c89a1312e9dcdb6bdd2c92e525c8c02c09598fdb5422bb09018ba15727f9b7298950280e8762ecdc9bbe45f38401d9a192bfc64ca290286fefb8555c9325e93f736e390a28d1594045a1a818924edb528d9542ef41312f1ee995eac1e29959ae2752ca7856be8d513b951de6c91641b98a988a45a87c3b908fb2e6099eda6500058c50eb9971056a1e072bc0a0eea930fa3800e250d7da5f328dbba6405fb7dfaea960d6599f6e054d566648b23e7e635ce24b47c2da87e58284f02a4f9fae9773087ebb1fa013ad4a2131e1658c3dcb4325ddd8870ac0cde04708084520d5b203481f2c641982eca4f6332d336e63d31d711d2715df2172ec3287c2a979b9c9dfd6a68ccf62582dee23de7eb44b8d157c629dc5e7de067ef6d5e3dbe500c7595932c96eaa20fffb7658886860aa260cb068e417756dfc3ca0bfa0c6905c7abb0ffadc449ccbe6dfedf2e57cb110ab1389f2649e67258f567a4e331523f36099748d73a11fc9a945a5916a2e3e0598d449adb3ed059b1c36d4003f4a385c056f276903f69ba0b3b74da28aff600f8bc97fe9466609154f685e7419c8160cd596892c21c798f792cf36a4cc52bf74d06dad3390bbba4a75656a285731657c5dba2a2541a6a024c2d80116a2eaa4fc233b521b1730c1a14aa8978b7bf8af211a448b12e7f649cec07c3d86a309c8fbe0acff1e6e6797901bcc572c0c905b9177c01c438938ee3c18263c634142940a954d14abfae2a4bd852b39786d9ae35402b75e55aa01161346509e4b12278e9ead96235241248170035faeff237adedf4784d1b7cec159eab7a5c39c7a1b212eb612bb9fd59fb66e12d4382ec2a2b699c2d316f86c0c1218f8705cd5fdbfe4413b4d4de32cc6abfe30136595dfb50329e10c8e760643d724955aba862168505ca9904acacb3beaa6e7b7a7b2bf343cf64eabb8ef220b2193facf7d3b69b6ee078da632c51561eafea61b8f040582dc85482b169253c489edb53915545b2e25a853d9a650afcb357bf7c97c1827235a6d8a25382dfff268a84142036f5a209fd5a8b515fc0eea5295594c0f5db8b84f0571049e009b37565a1b54c7eb0b50a505d8b2f2359751bae1571da9432e9412e39953a8b8c9e5cb59cffbf365d310edbf707ddb8bfd73d6c65da8ea76ed595e9e5f9cf8c4e080404dcba1e66e45f3c2790c50326d85c34edae9884347997a8a7c504afea393b94d9c9ae14142d87bdbb918f48768e4e28b9597463463a77a1f3407e82ad347e35bdcba2474a1ff1b81f602b54afc7f34056cc33d4e299bda852be2ef2de26180f374a605f0fa4e456dc6761d0d96d95a54e71a07e127eb0e74ea7dda583f95249cfaeae056ca3aabf790dfb64fd677a7f29af820addd199836e645343a794740c0d5f55e16705891a7eb9bfb7229deaf56deda01f4c7ac0a73a5b58754fdfc67f7ac61d9a0bb0ca8f74d5777250f72f2fa495c36665626d793bf5b4e385c28fcb9d49cdd85d8db448e2c8e93c8f5d9056550eb386326fe821f89a2e3450251917fe512f456784916a50fadebee8b7549209c03828bb8a78c8fab39010b9f0aa8c26470987307ea72046d31da062edc40a47131af4079c6796c7a6a021c60b8b529c912446c06140904dbb708906e728e7976f20911e8bfbb2e9dd270c815e0490e899482b2017a2e2ec1a9d21db8ec850813c14a808417d45e8beec7cf2d25c6e93c53cdd5786153fac586d11e9c8eb6e8ee2bce0cda434764ab3b917204ddd15247fca056d98e3cf14dda801387eda6945c9e0e2769e6a6e9923548513b8cdad232eb84b6b3352b9ac111698d199de682f594a560b1665545c76866fd3fc755d1939cf565841ac26fc5d7e7fbbff3d93d2fbc1e292f36f511c13177d69ff1d4e8d0ad7cf3ca9373d8d27aa5efe9a3f13b8150c31151fce8d6064cf56dcab0da80708985d1f533c27e6d860dca3502e106911f4e99b81ca2fb0d076a334e78c920f9bdaa90a27020b8fd969a1b00b50b16c5541b32d01ad6094bfd30b799ae3342e2b645b040dd31211918d5630b2ef1f484bbb36d287bd479599af37b4ae5bb7eb20ff1a16edf563f36793a3282d51828859291b92fb440d3ac7d2ceed0a3a43cfe3738e47afb128bdc5452fa264be01b1e95509754588d90caf04792a96c8ff61da88609f3b4f86f81269a3a53f80c44d6205a9844ed2d492ba0de0753a4f14296e0538267917a72bb5c8a63aa6def4e32c02a3c6fc69255450b4aad5de15aaaf07b4bde55251b3de182ae168811fb9fcaf149e443897f6dadac280536a63e77c0e5b98e3ac44d199a257fb37b88c3a1f52024204eba26cadbe0009f5c681f617e9c3712871392ae5bb169daf336da0d480963810fbd3b1546633eec5dbb7fd0802b4eebd8778e649cb306fd9da0a12a49e9628705272ed573826d6cb8f4d25d8c0f6baa9d8492c4e3a6e18bc96aab91515cbb92ad6c7473f9ea06a0ecb8a950e8a507bf44af4247a719641604d96bdb14dfd94487119e892ff68529678b87632ca8bdaa7c7c0f858d67091cee8174500aef461d10ab2f8dbc347356b7c1defcce76f7ec936f7cd6dd2c6b10d50737989a177c7ce88d89e9f5105bb96c101296549c410627edfce43ce5e48256bf282d48c506e46d5d40268136a8d1e2dae4b845852377b89c020613001ff1f23de8869d845ff41d8ee4dbd703d530baa6b7eb27ce19c1a3ee4ee4f61777e025f7db2d1ee1f22c8796da727d048b4651f7fea761d38e64a85925e96ca886cd60719299334a57ee1a09b372d9b5159357333b658a320be10461198bdd2fc72a402f8153714a1bc9735be26573a21ea8390cf0be07661cc7669aac54ce09a37733a629d45f5d983ef201f9b2d13800e555d9b1097fec3b783d7a50dcb5e2b644b96a1e9463f177cf34906bf388f366db5c2deee04a30e283f764a97c3b377a034fefc22c259214faa99babaff160ab0aaa7e2ccb0ce09c6b32fe08cbc474694375aba703fadbfa31cf685b30a11c57f3cf4edd321e57d3ae6ebb1133c8260e75b9224fa47a2bb205249add2e2e62f817491482ae152322be0900355cdcc8d42a98f82e961a0dc6f537b7b410eff105f59673bfb787bf042aa071f7af68d944d27371c64160fe9382772372516c230c1f45c0d6b6cca7f274b39 +Digest: 114224bae4a8251546db8fb858a3246f22c75371960b9a2adeefa4a4132ed24bf8fe031f0d9dbd242f862add10b9eb3026b5f3c3b6bb968c7ae995ef62a1cb2c +Test: Verify +Comment: length 49048 +Message: 6f928396d522d1ef43b2d506d0ca854d3efcbf74892182d1bce55e05088629dd17d8f4769e8d3da532b367955c7e67b2ef48bfc699d6b062b9ddab8070c40a66fbacfdce40aec743a6632ace2aaa1fd2b0a5cb359605afc08f881fc9afbff50fc21586e5e20dd59349cb07f963d61775271ccb07a837e7b3e7eea027ecff539e151c7704ad33d15bc0f2e65d2e8bb663ffb4a785f6f2c003691817e4500a8ddc9bc7b873c9a72164b6e1b043b44f6463de7647f7a9c1a277bc0d6d46026a0991fd20327a5df12f76d19e4bf31dad893f6d6894a5e829f5d989d588962aa73185e22fcb61919a6159b933a1b5902a8dbd539474d6dcb421ef7779521bf2476c7ff3fb6c6f8e2921d417a799d13550d9a63802d0d4ade98e822f00b21f80d42149d88cfeed7c26d6b093031a8e35a6d3c1c6b991e58250a45958728fe8fcd6baa938ea67238319e7b5d44e0e36b8b4e4d8a3c19d528372cc3e9bd8d3bf8fd39e68bb1e9159c98bbeab83905c0fe50374b17722de63dad66cf7a03965ec6155354e0a2f62d77904c25a47d2ec62e51aec16ebe43b5fac05ee4d0e9d2db799e3e722cd25c4e4b90a5b8ac91ba676e081b2cda6109b902485b8088e0c13685f061caeab089ecab127f102b1737295fdc1309e51aee83c67e034f0c78fff46dd443cb84de1d7cf8be2ec8ba6e238056461cd5394c409aca09dc8cc622dd99a3828af095bb7593c6cc3b5ed5071e00f3ee9f0b2165ce628f545de6606ef89ac9b37dd697c930b597e53b2f0582752fbb3e20385807d67f78e5fdd845cdbf7c42cfb2f9f587cd56de9194c5b660d7611ead36d927930746394732def0bfc0c2a13fb0b75987a9fc2d59eebf8212934990c4496a2aa7cf5b22f0a366fbc57ae2579bfdab1e495519e6968f88d328575da40bde67cbb69d22d86ab5fcc17f6c6ff86d0051ce3d6d44acd01d9e340291f1dafc7c5ea53fff31cc2de12cdc3e03dfe61b5f27e3e440e0e2af1f8c2f41b1caa80e99bb21a4740c70a2bb73b691df96b33f60b9f9de8e831a8bebcf2f66552c9dcacd09dba48a275871bb4deb0b6e48e231cb746a6c84afd6ef28c3aed0fabc2eb97cc73d80aff706135727e41b2e5ae5aae5d3d04ee1db8a514d263821f0edcd432f7fc1f9641febf0159e3c319e314ff34674a5d6247ab74adf5365c9f6260c005baff34f34e68c908d2d4dff3c8093b363c365a2ab21e04445d7824969196d6997b46c22910f6a9d1431b3d497bd3363d44c8a25044587c6172f4810d82c63f75a3976f416def84e5157e8422e4ba17d0e7cadedce7a3058d9b711c0b1d3822219bbbe3424f9d85cab1c65d87eb0807788d02b5d48245c74e43b69c984a34a826ca7ac7349d46d10a7dbb6f7f78032dbc9e3ad042fd87e92fcf8caabcf101f90b979bc3203f33932de324631273f5b2248238d62d40b194b5a8bbee80fae83c586ce87e0d1cacf1b94acae048c424bd38a1c5709e320bef6a360b0feb4d319a96b027a1031ef813381a768f2a53d9778164a8469cbddd23d5e144b606d3243a4cca21d30a2c612231baee17bf085b078631abff2fc86e577e122d8ad872084502249ebd2b2e2d462d94fa2210ccf496cf7194435f3c07b4ee2f8f34691327e2402566076d0da5a6b30f64552385ea4ce58d2cbc35fff062aca2325bc19fc73a8f354058d9af116b4b93f35a021d86504feb3b10b8fa718840d1dea8e9fc317476bcf55875fdb9bc7d886ed9b57a10cb95f589e7f115d24e33265bc2e814adb97e224eb04bdfe4c2d2579e794286d0e44012ddeae6395add0c077053c6cd82312dd01008633edca5d1664be3b3270dc4d7a900c0a14c525d53dee7008b11fa030e2c0607c300e78c031e3cbf10471192e224bb122a3702f69112867340c75b58a69ff756750f4e9feee73bb45fcd2277eaead48887e3b2ce4c0b1654edd7ee577f92aa9d815159081c2a0e6aaaa1899b766313c9c237aa100f315e4a9828fb29206be883edb04fec154d7e8af8ab8e250ef7427ee31a31e25fec28fe4ba4caf5119479b0c3137a765fba53bc52d3783e3a0e274ef076916cc6a43a180d32a2e4db7325cd0b6120cb84d755a7bf01910d83108ce2f33210d7cbc15d3fe7bacd1e0572b482cb848a160c0e4cf4471d1fbb706537e1f336f74bf7ab591bdf2591ca17f7ed760d63007d7dc6ff4af20f6b6f8a75f0f4f96a8eefd0caf65500593710996c9952d8e6c92861663752c9bfbd5257a981c30cb61cece087fc954f3f0619143880bd35f52f403f58bcb4d3155d8c6167b1f53402eb6aaf483282d6bf480d10c36a602a7878eda003561718fa92443018473379364190c37661c59cc2431413751fe2c257ed560bcfcd23a154a5a24a250c24e43a6786a67a5106a92e4154a7b666ed027ad6a40824e881750ddecf39f4c8717cf6a575e0bacaec06ed88f853ee0926f4ca7bfe1f6a70d99c0b85f385ef42c14a524285f7a0941fbae56026a085ce379f2d238dd9092ed21f38e235b47d44bd543788dd75937648cd00130614e37ec80b8c1879bd69e715057a3dbe5005940da48bbda6e2fa3a0f4824e8c23970e18041d0a0e954f3664a56bbddb6e1f1fb5842382a07c43fa61b323b267f9795be0848df0405240d72181be20b44eda8414634241729a5c98315932c1668b4b8de0728a38cf7b720d2275bd70f90fe922e808439cb330c0098a473df00a21a430a26ea037fe495954f201e8231c39b178aae3a5d904e824caf71db3c2c58519c080d95e627f744d2b1ab6ccbb9054d9f1c785c7aaca28e158e23d22be1b0df2da0633136ca554e41c06f4e9aee7d9a92ad84f4776856b8c3fe63619468d24e5c9cd1c7dab1293b494315cbd719540d58057d093c0c9388bec7d98f5f09e72693c3fe5dba249991510444ec6a82b12b59ec09a4b1e080876fb12c64740c17ed39dc93febe6acddac3c9a5b83b71bd7efe2ad0ccbe2c463c3c8405e8bbb9892db5b037afcecdee9d065be037322ea08dad867b894b370c2f8e070b241d58666d7107937ad293246382829c71380081e0cfcab2e3404afbe9ce03e71f8030d536d4a84e66b20596b39f05816f33318800cdbc1ce385ad3bf1624140e1ce8aff0f465d117b566b6d15c5ae38380d07df740d25629002a8f3cfb486bf73edae0c802fec84c2a60dd0115c4369d4accbabc4f9cc2cf3a0834b0c2a9d0cdcc7e42311f81e4e428b32e830cc8dbc4cfac41779f87b211245856c2f2e4dce2442746c4b07bb1804eb24ddf97d54d7a7dd3c481a71f8e9f7daf77ec0275dad5448a510b5c58b890eb029d6f5d86065ed3f79692fce0c2daa4821a8487d965373c0c137d89a554a6ac08afbaa43780c2607c4a040767f9531754b134e97c06589910e083aefe30220058f75a22766745b1d6515d6d119c8964bbde75adfa38e9fa5d5ac652afb5a36657f6c65edf0469469a4f27847a26fe1b1be4bf4bc0674bbe35d4be1b566fab6caa40779fbdf2ad7d2c95caf40e131188e9867a596b2bfe833f00b34f6ec89a71b446f68bbfac72e431b7d02249fb745cc9164f4d670182b7dd417e85754b01240a8ccba930bc6a0a1e37df95ba4a86f52f26a6ae206278ea95295853e6816fe201845f5edd8ce35d56a841c4db8ad9f0803a08d233c9318a0b2ae9115ee6473a5db02a3302b88f6c7f5b9f463a36edcd60b2fe801dc04d1483c899643af417ab63b2c4bc4ca9cea5fcf4408032c922ea4543f00e5ac24c28a384f1b307356193b7eeb76117db11a863f4ee0961dc29d5a24f75f357698f24fed27a944024a5a1ded66ab7f0e6f8c228cff05853ca532e0c47f8c5b000b697da43ac7e723c64542d0c6727643804a1cff7efe3752e4f41e7c000fbd132330fda5affd81a072e1936f32535ee6895c5de0f453132626ecfd93a271c576884eb838afd37a3ff536f811d3d79fbd35c8cc77888d8382142063538c39d9f3e3cb95a562d23ac9f84c5a00d185a1912998500b6333ed2c559a3902e7ef6350dcb07b33ef812905222c9f8253e6cc2910d4d3e5accdbbed926268e9da1bca561a04542b7f68b0bd1cddb1e08180894f90823c4e8ce4548d737ed7508e4676cd46cf07d5391035b78d67766284de3ec951ac738c2bff20d49ff86d7e2af7cf7d071a7c79460022bc1ed3d84f84855560fc595fe7b0a6878abfd814bdd7b73d2d06ec9b5fcdc0dd947728bef1a8ff34dc3992eaa94361f1767a24b353bd0d28a7eb4d4ccff7d9d0073f6e0f8e19d24505af5efb180eb9c66179e631890381f8b15d457710ecd261dd1eadb56fff89eea307c57b7e36356e13642578a7d29b151404dd046bd333faddbeee97dc81a9997de9cf5021e65e5254e2ea6ff551e4e798891cdb28d48502d1c4389d1cc7bcad5cfb85634a44bad8ec9b3cfebba9e3d704940be48f194fe17fdb94af79fa4a9208e8ee9c4078d369a238230d4001204b22ccb008e7c719feafa909b53942d9af495612e34dab316e3f61a784cd8224acb8da152d7a096cc32bd69f97a5c6f36ee7eefa21b7055a4d8cbdd14baa5376638f65423c8e05ce97ba0b5e3d05af1f36a957ad3cc7add8704ef5a84b1f9e9fd66f163d1e6ce3cae223f04f90a124e6705839331ec5cc333d50b0346a7488256f1f9510b95ccce50d2f2c7976c04ece82bc3e95adf989f11e59977e91f03b92956989c3f7a5e8a97ea668e5d8ac5561d59d0cdad3aa0d9c7a30528da9dcdf6daf139b5cbf915e9d9e504b999fab6027d1c34b0a77227fbbb89e886a98809b3f27e672e5f8665749d5f47e9fb10697a7def6a42e81a708d7426be11b4824988f64aab7658c6dfa368c5ca8fff805236965fdbe4dd882d0777f5f07aa9f10fee5ce2711e562ee70eb294e72bf5bef2cf5cca1436f66fbfe23d7419f1e878bf4c9cd24296c6231e0f0169383e9c10ed9d47daad89c1259bb64b2db5480e7dfa2c4c96ba602747d73ceb9f3858414a8538ddee027ddc4e62ec078f3cbd7a652315d2ac231af801c500c7c351d993b06c2a8590ad83964e880c19152af2bae2dc91d58f2727c6e54a132c623f52f1e704dad55f293b9dba8d8ef66c0a685e6b8918bbcc31070266e8bc9fe83b54ea52d1c253a5eff640f6e5fd15d0558ec363ab22fbcfcb49491b138588e1e05feb88758986f17c442e9823cefdfe86f6886fd5491c16705ee9567d067ddbc8b483fc4298c5ee58b5b512b98d155329001be479d3a34caac891bd67a7e5325f233222db68b6e8ffcb830b29b0025ab65c0c761b8b17bee506a0c485f265820e0c8490a281c07dfbe606c5f6c03b91b96ac8793cb7e009b9a9b4e03a7e65476fe0e9ca3a6c8919b7a5bef7a3462774acbcde724ff2a29983123cb507947afeff30d043f5915748cd7b29f4b1aa6c900ab2ccf5e7b3c60afbf0a6976fdd0d15367cd6728698d197a7e6c661a47561604ded02887683c0ca6e95812bf5d09236a0457afa4fdb8e62d16912b2ee3fac51f0dc2d8e8edb294465916ad71be7a0bfc6fb2c2fc3d1d446c482ad6d0151a4019e008c9c933276257b74c22d54bacf2d053e68a7852449c00bc3d4e48053feebafeace1726123dda1aa005933292641af56fced5f64b554b219d57ddedcf037c910b50a2aa02c6debdb3c39d383705e6120fbd5fb9af9d64807f74adac2b68310bd2c2b3a18cc7afff207acfc7f13b3ae5aeb29921d97888a30ad9d83de183a55ae182ceaf08a6ca3966a9af74596a65eacd4d16d1517d44239fe5e22599ec4618a81f48251eeaca06f6be90dfe81a138bdbfb4d4a9022136cdf375ff5ad08afcfa706d4a6281a0be26158283d25d0b0536b3bc0e01ded62f9292cb620a37f2eda6eb7e8a4ccab1c4636d4da4e8b04c8dbeb9d06546365df530e54693915a65fe35fd0f893652477ccd7d32b76905cc98fed8d81fa08f1d5050f4cfd916c14cf550ab0990499fcbac0d4c1a037ce1f2ee9e18bd8536737e089ac54f7ec1f50d9b9eff52e7ac3ba31dcbe2ebd14ace2856458165df3169e8e4b563acc8bb7d12b8c800d3d688ae3997ae488f69fb53d69a9b1cb975b8fac3ae4ad3d0002ce1c11475b674a5057ef4e25e85ec13b6f962804af0a18ef4ac772c001ea16d3caa84764e2a1e9b4a353bc584a1ec17a34635d1f70506740d0a6c27804d0959115fc2a8fa63b701805a7809c8a576bcebc4b7544c64ce6d2a990b667168ef0ad688e2702269281fce761276d198714cb6fb50d3f114e3c273e3bab37c753ac9b1ae4e976e455a3d5d1071d44882c70d2b7269148e1d2bbb116fe2d4497ed4deca586de585fe34a355b0fdebd46b5f4873b168e1ca88909f2cc5ec927f8aa4914a0ea721109c9d99dddf1e831e5c2144b540b7004d5cf9b8eb6e3eb5c6a2922a59586415b6287f661d233c63cd5cf54b1aa8bc39c0a14d4c77f14205c8cd86f01ebf0c8720a9c1533e07bf548a74c3a3ca70e156cb6076a4f8d65f4a2a13682cc2ca0740f6274ba868100f1efdab7395ec208d1d15a05b0895a6fc4b977c20276c02be08dfab05adc2c89489cd09ed69a94027584769e4bf76e883d1b511972645ed97a6833bd7a975b6b65da3961967285919cd08c3f913c4245ba42cd9b3747515fbe48be2a9e6a862de61265be0d792f2ca4501b7824aa7e2ec8ca5dc5d58230253889fa563aa8455725eff5f28000e94a287da4c67ad46ab9e51c8237e19783a055b668eed3e3116dc1cd5aadb2bc5c6095d3a8b9084ca06d9ba3cb5fc009b477b2589a42fead62d82635145dfa0de10678dc97ae6175a7c0590aa9bc155b4b11baeafef11f59c23cefb1b371ea782fa24e030244fad1f948a9bb9dbb360edfe4fbd81787ca9aa7f26abda887e88d90da81e178eb49041d6d0a3127fbc686cb87e1ca746564c29c9f43c3641e98a0ad05c0f25c2fe06e7ca40705c8ec3b759660f91c8618927408a9f77d96946f63ecca67a03c7135839f940c94011af93dd916ce58cd2fb8218488f2168087d149c87ef2959a5ddce60ea3978660f6a4520c0fce09da096a5d88e2c058e27752c4d8ba0e2ce6443af842594437590db14497b2749a0d340d7a9e1deeaf1cc188678601f6e0a0d2c45cc33b7f3169dea4a804b55ea4074e361b3cb0d9739024d6a468cd695b6a882d6619b0c50f03c7f2eefb6ee89238a668b1dd321d50fcefc1fdf992b1e7a3b2cab6be5f921ac788207bb465aeff11db19d1082826c1b3a0dee6a0f88d3fdd0120c119ae830f156db1e0f8302e45336acdfb35e9824044d691f0f74547ae86e1c407b41404368e073bb11f44c2ff0db3f992ff1ccc5720ff6faf852f7dce21e3291d2626923b81d3025e921a19a72175212abc384160f899dc64a30d9c194e73c453e85cb988a15fba6c0926aeb7eefcd93505a29e080c247cd309762f1a5d122a5e633ce6986d1bd84bed00debbf6d9864454024eb70c2da55d00efa33bee4ccf9f3f3da6053585c080a62f462da989bcdb3fddbff859240a7521d0950872922898c4e57439ab2c27acdd085187a78bf16c217b8e467395f0bdf4cf711a7a70d9cdacbaddb02e8d5222ea32ad44516ea8699182261bfbf21c89f242c3bc766737c05f244f034017f4756624a60e379056661888140352d6c28b92c10998e6f3e6f344b844ad705a6336c954c82fda9f9fe41ed3c47708a2a7155ec0bf2a5c954be8f5fd6b094fd342c99c49a033bafac9662d1bd3f19de42ec9ded860db37c9fb13fb5a0eb13f0107b05789baa44920876ecbb6befd7329ce1b7b6e7b36191058f6cd54bc4fbe62268d738b741c15af4e60634ae21538d2098cbd098ac570f70a23d484000f5e7523a388d568e5910572dd8c3ee9b35f7b65802c1ffc03cfec730db95e66aa8fc883b4ffee05bb5bb1b948bf093262478466b831386b7b967f2826e44a4c9bd2cacb14513bd6e7c6327634743058ac819b817774d94587551d8e01ddee4e4db80a6e54154568f571063e23345ad8fcae1f4a506f8906c19c4639110ea0d84abfe5e1f6c4a1188eecbb758787df1fdd2d9e25d579be4bb4cc87adf70f08771d4b0bda7ed7c5720e89b0b0f3d733a9b87076b8693bef70db76605106578b973ff9ea9c4ed72911eee89474dabb0f13292757569e1ea312a01a5ed6d160b0d52d4cf0bbf94b5254ba79c535beabb7c8a9a2be94f6aa5fadad38e183eac30ead5fa4bcce009cc7d6fbcdc1781211c456b482fb07e567abae4d5276fcb4e70b8c61a1ad26f753fff52d4517c06795cb29d448bb03fcceed911ae7ada5b2552e0ebdb4507b4ff9715bb9804683419022de73547d3d9f48bbf29078f4238595ec80ce6d252f7d05b2673affcc45129961d13c4690096f7d8d5f4876c8da8111cd9f3e2cc9a7f0f139943c34179a6d3a1eae798fb1fbcfd5d8139d71ba5f475157b677838c995e548d8f179dc6e7b3daafb2c5a0417942da32cc29ea47064aed0172f5020c6817a804a457bd48a188f39baa9b18dd266b0313f55850dd83fe4d51314118b798bf54657097131b7c4f2d68e28469d377aae8f20bb3460c4cf3eadd9de6482cafb7f1f670302fcdcc88e0adf6fc03c2e174e4639bc52a51b5ae5dfcf55f00ca1183f95e2fcd73ce06c8a5c1648c8729f86b8ddf11f87e2c7 +Digest: b9c74e4f4e2ba924350e240e18eaf0f573e0dcf273df1d828f36de96c068b0021c2ffd58431d008793be1bd26c9fd7010e6657fa5ac36274dd33a08c2f65d552 +Test: Verify +Comment: length 49632 +Message: 0a3290e3d5a9e0180dc4877731d42572fd7478213e0fcfe1e4a3c24259c4212011e32a0f63d0fffd977e5712400773dbccef54a859ad2b32ca6711811afef80df14ae12475a7508b63b0fd685e4acd5f87e500fc4dfeac5187e86ae0c0cd4fbbd1f01ee9b634bb0c9ae2e34134a71b4856dce6e5c30a3b8542ae3625f0390e70da5b4727cb8129c6639d7065692545dc625e6d2a63dac118233fde19544b1d753415c6a65f968002e7670c9ba6cc3364d3f2fd95d47524505325c884940a641206a6012e1879aa084dcb1fac93a5ce27d121feecbfe34e76fae85e2e587fcc8e789462879e348d20be4e1161d7b7fc6f8371d8f8cb2d25d13f0e07de47b03b33b4694f789acf1392627a4b801b0ba682116cf481a15a93ab4b212a5e09a79a47dfac32cbb45023a560d633d106a7b5a9a49ab84fe8727f4a46a93174476cd21324e6724693c1a4a3e1ea321e41950f2c64828d29497ed0f7572c83e9a905c9dfa99e77b2e02980d20c3fb12d73dd9e5378acdcd86c8570faa6348884d67c69f3965ca9d642919e7b0a5c16c74585486608a00b25f88f469b5c48a80f77d9999614a9707c6200e6e502c9cab45f97f7ac3ee784d596a53a22a1f14b50332240114b0b346ae77e405a1d0f36bc681a926e4008adb3edcd34d69cb5d911b36148ac620c5d697a14942083b5c1a7091701f4368bf086a6111c01761fba189e9d98af81345341c3c8ca805b43d23ce9952c8649f9b4156879dae956b4562d9ddf1862d20a7eba69a4cac2cd42d344b19cfb6ca0d86029dc0c57d665fe161a582eb00d7a16479c15b07c2e03392b88083556ed65b35e8aa9d27912cb8460a6769248f7a4e014ae6ef3c90c22b042cd97662553bd0f150078d329e4afce9d98a013c86976f14eb91d7597a3552f80de053950e4d276ed53f1185093396536b97dba18ab18d05e85c93ed03cc23f4d82fbb6bfe9cc6f4e4abba8d46893d091d1b68e2105b305aada1b575a1f9167118021e45aa9d383a0af7f8b9fabe29718a8f297c9bf6f199c80bbc71f94eb3034a11ecb0a6e0d384b48e4ca97a451433205dadef92073939b3e509605e3f8211ead9b73b57ea519b7de936ca69a055b46b1156a9a71e8fb0ede82ccf653dfc2376c3fe54422c1ab4d383379b3d72967be754c4492fbf5da5f26fb72d92dc99be8a5b328a0a28a7873206dfaa5a1e3ef01172772cb03c3b6f5df609095badd3597229e44af462707925ce9f666415b7c775f4dfe2bd47a1a38d15c2c143f4417aea9a9425b56c0e013b54e75ddffbb95881767ef9cb5418b90c395503d0725c993037c298b197f8c5cf3457ff22228c39c051c4e05ed4093657eb303f859a9d4b0f8be0127d88a92d7de751d8df4cc8d1bf315224dc5a0b91fcb5f4e2d7cf7bf6b4f17d216db097aeb3d875696bbcf7b6da7fa735e85898526704137c4b939122ed231a5426a25cdffda2233f5c05915fae9724a1f752280e33500c9a65894566047b18192cd05117d7befba934b90e42b8325ae78dc9431bce44409b9a132126877426fee4bd3d1cce995f556a39f6f663bbca7510406211a43b701e6db3bceb02a8a763e2eb49254ecbdec2712ac3e14dbdf3d9233a1d6661cffb81650d7129f27319e6abcd2de7d4b0fa6efdee0da9e29357924b28dda0635c4362f462c679d38e0ef5b3e553cafd0322b945062ca6aee6762edc9f1b56456af841a06655412233f72f7fb65355241cf8300b05b96e2f11c00d6bff5ede64967a9c0d8a86266b1f52e273d2850ce678db71946f2c76dfcfd5cc7dec30cf6d595ad08031d1702aaab2bd44ac9158b0a15cdc95950e472d5b27da96c809afbc1e199d9d1eefe4cd60872e46c6e0cf2f20ed0f6339c755b45e26c62b2571d5dd6f2741d88409cadfdb50a41e840be69e621c58a1aff038f14352fdcf86e1f83dc7146bb713e7b8ee659fbd10966b259b0f6b66c57a115760a55d0fd86ed27d79b05179bd40d22555a9d4e7e1608702b1634aa8432a93378efe756afa3fdbec0da57f0a5f9d8196c21290a2e56508145e184aabaf23fe5fd8a96cad998c66aa6630fd8c127c5e93903a437cb12646c11d98dbdf6e18db46da4073363ae6fb6f1fcd4d8d7a8fc1926c8b6de3c936cb9f5c5f8eb2045b8273005e599342a20270a6e4ef7cfc2a63199370806691e91f15b6e6c3c2067ebc7ae75d605365703475780263d91beebb9fc1942b73afefa9baa9d92b9de8f4c1a50bc827d507c3d9d41fc04b205e4f23ab6360cf99779d13f4a181269430503aa7ca1930c6ae0f9b131a88f5f147be43c2f560cd568d93b65a3a79355351039ff9beeaeb76dcc5d0c8d4e704ba4cde845cf41ed52956462961d14bd839df9169f16697d883f889135beb44f7e9e2027dffebe557906636e59202639fd6409c11453dba886c95cbeb42da3d201ebbdc9912497ed51a41d873714a4afcb708563e6bc0bd7b9f3900c1241e2a4db71ecf5e3a9925ce255dcd3b76157c6f3abb8239bb8c3b12aa66ba2d6613b6b141af4d35ef5784a3402e67d616f07277ffce92abdaec9dee0c836a988f774d0b5cd1f8c89701061509485abbda67b7a764a5f9fd408e607e3423a48b16a567ac572b348ed8324463df1fe86546f7d66e17f63ab662de2d43cfdbca8d822a9124cf0f92e10947aa403039c35ad30d393c7823d76fd8585ecf2e007f08587353f533139677c0ddc21abb0a6e0505246aa303b3527207897f80dd262494001c1aae01cbb1ab95410653be263b1c63e9e53259293e7586edf9f96bd14db92f817fafe99c6704dd3de19be801cce965ba335ac6f9edd2bcf268a948866cd02d4fdd8b290a391c2f010e539721a5f48101df9d0ba9f32230334600f1ba04819fd3cec06e99ba4a0156c70b6a0a28d65c7d346965bde0dc872d1ca105e0a735ddb9cdd018cf4d26da9bc633cf2ff7f74e78ec5083aa397a185c5709d39eb7758d6e454ab62f642b314c665d450775ffdd8161e2d4036f736a2d7f9c1948d7b9257def80d51eb1df9bd531f85a25452880133f80d53de560f33d10e815736a892c450722e42198ac80e2a3957d0dc829eccadfbb15ce5dcb59e7956e76a2f26e0870369171ec9b2a76e155a52c25817c6a04bd0204491b0af4d987afab5c01c0406bf86cecb44bc1e45da2a7f600f3989e5d61f62f12bfb85a6f521c22030b286ab4b715d33cfd1b5fc4253e5934b0e6e04178f804dfae4c0135af44894c912efdd71d1cb3cb519f5f9157a8c4152c1fd63d3c9813f4894e7fa8d9a93f7d161c703f74e21d03cbb65a51b4a7d536e78be6bd5756dae5b3382c557bcab3391ca9487a69166d6aee08e681b68bfb2e45b3a84e43a4d847de819db8002992e5173e0d04642a23651aff6abdf7f5a44ff94f817c7c028a8f3db35a4d01364d2598432469f09ded86e5127d42d3557f30648808a47b0060208355d880f981405f0261351788c21a44ceda94dce32bda640a25b472cb2ef7a031e1aef0438b2b15f800a599b76738235ac027c8a1f9445f6c710b43e6decf82bbdf341789c45bdefbc9fc6ce6ddc5a6fb6bccb28a4e5b771e2273b448a0464ca3b70e6336cd511e5ff5a00da19651443325ea17268b7e6f619294308b040a626bf1947fd4f6b958c74c46f87241598f94871652e1412b9d0949d335088a6a6877277ca9eed0d312b40647c9c33f5ced9227c81254ffe18457c0b75e5ba414d377c11d8ddefc6cd098ec28de3f10b9e2be5075c1fc284eb9ff9fb708fed16817d046fda83fd9b516f84670c220361f136bc9b5ee415ab1a2432f68c15c92f2ba0321a3658be96a5a54ada5f2214ffad43cdbfef3bef7c8e1d50833141f89334e92f995624dbbeb1f309a3f0abcaebbc9a40fb77edf8fd2dd17a2bc7d91f4a82a02374a0affb1b5ea1e94b2585cd2f04833ed75ec3d938e08ad975b6a6e95dff0d36347ec1c7b692f611596877c6d36f46efdc0c823a35908e95e96770fbd391778e605721e796363baa55204a5ddde42a7a91eaf5c2fb2327d50f40ff00b422285680929802c333b9dbc8b4c639574a78077e5ee31a92839ac170aa1a9e089966b41d99eec0466fb5cd398eb303488b79c02cd113ea02963283930e8b7dd8de7ad0bed3ebcb26d47aa73015d962b98e72cb22ac4ed95346364000d218462bd9acd3eba856c86b494f9235b100ffb13bae50e8555c8f8e79ed2340608aa10a7243e52c80f9621eb57bb6d1caef81387a7478073605b5bb19a051da1ea8357c91892d0ac39a3f4602473a8bc86f9156330b6a06b511f3e00d98f556763cab891ec4d40cd90207eb17fb47ec1448d7144ebc4f6d3c47f0073d1a353dcf0caa39013d01bb2bf96315dcdf047b1442fa79b3cf4fc5327055379171391690e2db95223cdd9d1f47fbcd393a9ac03124a38e4b8c9195ff54c979f1e42a692384e6a46908903c1eb3761a16563043d3b8795afc3a3e650abbf5d445ba30bfefba726fbfeb412091067c055b79ef8d63c425e5af237dbebd6d8050753c729e5c4e27fc0a2b19cfde08b795f0ecff2547114e374d8d77267f3113f569b21991d206af5534113fd36f81ccd2bdf78793e9679d59bcc15427b9d156cc0a644c1db9acaf8223e5dbb4aa3966c4abe1af60b08eba52e6073b49d113f0dc3e9934cc7906d289c1ef17f8f9f82b74a0f4a113034d4c2ab1a6541330c08a2dee9af9257addbd74f4761929c385c3e9857682344c6dfbe907e8c80d3ea0cbc803b0c2b025f81b4ba6c409ce6fa9d72b43b07d4bf2b77198cf13bfbf637a5cb46321b7f6e0219214be1f1070672c0f43c0eab7e15df0533ff17060b20817e4f9f835027e141ecad924d0569612d61238e66c5b7df4e34ce45447d46d93400ca0a836c8d02ab86da1c01f02c8d86e89129c7d8fa821570291e2e043786ebb7cb05d6a347588b720757a533c8f21be1bdac9667be94c131d4d8282d45cff50db31fe1b6bf498e38d5c3ab62e71558c7197577049c8dbe046211c77afa0b0c9d22c738f98d5c1045c5ee88efdf8dca132512de01ecd378625139905fdcce8ed08a7a40ee1a16ae135836c24d4ac1fc5071033012581c8cd612edf75e6690e8326ad79e26edffd43bed4aec0d91484bf98dd511a836bf67da277d70f91fe8c54d343da526817e1f2a25896aa34b874598cbf6f7263142a5d92f8691a2713c928b873afa5f7d27eb687170d290e2058598cbf7552eb02ca36d7b87ee0cf302dc67c44e02442963c57161af9868fd596883fe44b0243bf40d019bffca7b2de20f8c8bf551772ee839cf668440ade5e98ae4e36daca94d3f2f30116cdb8f7a40a8444eaf6c6ae5fbb4ecf09d4fa2443c49360bd08f206c44a6736c4d75bc70b533397cfac781f734c354b0693a1880d84fe1e82bec1c01caef361d104d74a9a63cd6a765d76edb19e191066674633433fb92f8ce580eb6288612a463a76a7d9a31a64e5f2093fa119c2c6313a304c6d5c8a3de36378ae1f3f77382a637e075079e22e2654773dcc26f81670f3a8fc13453aed9022ee32da3bfe3485663891884eec6f41690811b92b82a82a7af66bbe6191e99a082d9e1be4bdc55f2bec6e088b01d03c1b06e0f092292367b762c0f51856d909ff7c1b6ba27e94c19ae2c55896e9f92151b7d5fac1b52f2f92342441d25364e6ee22d150dd0749b29b61bf01d96c91f8f365155e22ee758bf3b3be29f74e3338bc68e754fd218b3b16b2848aba5141c7e856cba41b9b9d82c228b735ef10ee07539686ff6a940263f31e3b7ba362b0981ad21d5516864f1de7db36ed23613c5b9af4d5d88c2857321aeb0d5dfb658672702333f87a7532634a1464daf908c53d79c9fd67cca532b0736121b62a236d5ed2903615af31ee5cd31b6883dacf32b4d85f253490d23ae6e7caa01198640b6228604e351d822c106b376b702f7c2bc99ffc76c8417818db5c6cb1f3adf008895adca2df2c2f9488f8b2952a5ed85783b6e918aa485f7497bb917de6d18e0dd8514c5b9b4402cdcb63d20d38d1ab5fea066e32620b4ff423ed7f2b716c08c259f3f8a0f1cdc180e195e0fc22eebdea0675d2ec79f4104386d97ee41de624ce1329279a6a2f3554d3752389711fd5a1e0ec5f6f766a6907c866d8d070a7abda0edc22718dd226f2a8eae5ddaccbbd2c7f545be3e1d424e9f27ed316f417648d53f2324ce21e5c0168de6c1f5b593b32eb930f70439c07900b08b9df319e1990e9559d53f27c9e2a1b3802780733185b2d93c33c2229dba51bebd052aea5908ad8ebabb04452b515cae0ed1037c01b514c3abf7209e367cf2b116198f3929224299ea68861096a697dbd750e73680eb950724a387d3275b74161b3d888cfe706e354d406cf0a83ce3ab9e49b4393b73e4222adb6087ecb0468c3103bf6c257d70ef77f4f18bcc8ee0bbb80de30a9e08629323116312f325fa51fbee9c4d5aa3fb36eed8ec386036ef7ac9300c1124f390d891b7d80ad7270025d06097a6fa7e8d8a166e959d2faf9067263287f37cd00f611b6157e6153de866630c3a0f71877887834886107763541f6397ff07e2183edb14906b2b19d5239208441bfd7c397c8db9e94638c3fcaaf205c2d9e501569f9511b78a506177324744aa85e7670eea2b2eb35e8cb1d6159d9165911166f5a23d97592ddc98bea4e4ac923063ce9241de56492772bd8a24507ad2bcf36f80072329f7ce460bf5ec08b4ad73e91f5e2415c51d4981437347d936acc621a7800ee42e15f42357b78801d15ef8edd5bd01700fa22d3ee04c0096695645228b7059ff283637dae89e098ea72917e88e495a6b7a6a5b12205edef67761a25ca7cb58e2bccaf1f35b03d0fd9a9e697fa58d9f76a9e85b9160364397d5417656790b8c2d3066cb031b737eed10115609c7f4610022be97433c5ccef9279839966bcb743d377c1b60a67773cbcc34662d42082fb6593f968e115ce178d2b854a31c65a1a1467d7bb2788a5018138a3230b0535c07d1edf1f89b912bb55b345ff2f76484e7d20d546f2e2694608a5512daaf408653016c021917a3fe2d459ec40c8962ae7f5e9e4e0d23c691239557b0817b6a2f468c1c7f46320fd95f164a29664eca7ee66092c0f2f5f506dfc8f473abc13ad740c6919226573f6db941e8e876b42686ab7c9d45e7214c45f399add4d00d2ceee0454e133013bcfbca5cdd99d455e1463d071055201216df1d8bf66c94abdaf6938ca45ad9e3f33400dbaaa605b0854e19949e675454ef52ac1460a34049af8ed90156d1aa348c870b22d2a57130ad0edfa98a04ea6650113dc77f01895325183f47c82017a1e36537d6d810ad62b2f8edba85a658d2c3cb2129941fc654d60314c46aceb8a8926f156c4d6010d321acd24bf3d43606d4b1149f62469dcb3d00180bc125f3b514053267851c51ee838b0bd26716f88eed9386ad4c2e6622b47fb7826dde5f53d2b80d3d21cdd731532428e251d716e788c2d5e7c43fb5f7e6d261ccc340520169080471a5cd17281af887f0369d279d20cfa0b36ce303b74ec8a55f5404824a4165c68983c2a85f3588c790a7e1910c602a75b4a8b0e5ed5692f09ea29356aaf661b2094e26f1334d555628084ce9d1a163a35ffa31c30698f1e21f4165558ff27c556557628840dcdeb24aea27a8797efbd809e3ee21af8035e86592f2e575b0263f22421dd3f43e857a5dc01a436053637266f83e9824970f71e619e4ad08d9ffcdb490a17aea1cfa0cf52c9d4122c92b10eba9bb8d1257cf2d3568831295ba598fb0c5b5d38ee2ace8857219283d3ac3220c7aed87054cf568c7e1869cc8ebd3f39b4393845f1a0eaba343167f1c42bc244dde3cfc59e122b3123737c1fee8efa7d8bce2f3d73dafa4c3222dac4c5b869624662273acbed79a98bc4f28c42c1d0afd742ca893c800926971c74649ffb306248546736a20749defe31517954fdcab8e1bd918f14391c30ab46bb391a9b1e2c2ce11821ec09a2b7c6e22350eaebef7ef1660db8c3ad3d52b8c939acfd413ca93a30c162719a8d1c2a00ef78cd3247ea4f65c56c1085737404cd7623129491bfb96aea63f96311f571b33e59c57bdae442e34114c569c77ed879f9071f3d2557f3b61c8b4c0c362ae422975b996eb15513080a16a8003f587cf54ac1ede3005a2e3ddd42313c04a4cb7682e613b2d3230bfba7dc82f3e6ea386af1b7442f2baeb326b8f0729b84496ed68762f9f0483870e5a0cc1ae9c11d54007653ebc9ad3dca9a32fdd5d2bd02146b2f3714cf197a8aed7e503a8bdad717de62fcac588eedbac1d5d22389b7b8065d01cd2cf84dd3a33cc8cfa8813801cb2d3d194d84d6a8cdc228d523677b518dd3868d0912ec2a01f906b12d72e384b6148d1497f78e5549c6b36f9f1510b7eff544dd72c6ff66ed4dc15d9107e44620bcdc545256bedc77f4ff085d3b7ed074ecc52630bc8c71af607f3d9ce74231534cb141464c6c259f7593092780ce8666e091d10c9b9e328f59cbb816ba052c96ed95433a7fa2170970f7d8c38c07bf0bf82e44cb0c3a91d5602a36c62a361e30c70fc2f897679cfc0eb4dff9083165ad5d26e938b66a76c89f261f75dddbf16a01a726463dc49bc2775185939c555f923701271a4235c9b13b46dceb7bff8c8cc4e5d7ed19bffda1d2563157ef7a9502ad45653857a472d85f12d3f0ada7d7de37523eb5d263a8e2474c4d0faaa8ef47e77c0d5b9ebd5a8531136d4c +Digest: da6f0df39e1b245bd3480871c233d69b7b2bc0b6417a366ac176c9882b764cee9b97ad0c37001b76bfbe72bd5af69f846b1e9eac82fba587f628a0166c4d8d6f +Test: Verify +Comment: length 50216 +Message: 98c19a812bfd4890ed2b9c39456b492faaa3a8385b6a0a3250254c54706facb704bfda156c4453d01014ea369a86a70363dcd5272a2657ca0c633b8eb0e89214c3067ec1a4e78cc260b9444de00eff2a6183f97325a0a79868004ba596b2c5c8bbdeac0e3bac9d6dc361d3077fccf8ad8ee03ba2b3a2a3a24d46a3238994eedbd6918c82995c2ed92256bfebdf853b93d03bc43e3bf2f3f2a17b6c90f058b556fa6648a726bfe60f66de2f82690470e411dbbccf27593e904ee8cd7235c4c14011a405054b9c6e1675424b5283103ea938094adbde9f2c823ad5ef53bfa1bba10294ee226ebc6df639ca3de596704de92d0d96ecc88c66d24f89f9baf6b64a81b57e2888f9e88cb899bd2ac30bed46acd82fc9894de89488734e143042cd17e912aadebf52e673637c653d72484fd1fa21b70b3bd57a5eaa906a683c0bacc9e0015f364de37ec9ffcc089b7cb75e95dcf0ec8388c80b6a428d261c66b91c096f6ae658bc127a379570ef6f69bfe13b592d175afb8e63635752ca5936b4e57f9d35876d9449a1642b5062dfbfc7a26a7ac080b7198f4aeff2c79e463565cfd2724a8a9d5befbaf9cc54a813083967cb46916fc36c3488b61ad4ea0cea32a2abf691370f9b6b8e9d7d640b34cb7cf906c5882ca67be3e461d761f5d2dd8425b132f3d6ecdb27e5f94868d16a91f820c2ff8efe87ce052898315608c197c4218d2d56ae5ba48a86b4344843dce115a3a7fd892f8eee031a02319b6b019f585fe6efa408857dfc3b7749eca9b3433b4c5ec66305e562438348de1866b97daaa46581c32c92eee5caea903c4b163fd2e18f6202c9b1b22f2a1241b64111ba20bbb2ea9d62a97faefcb41021702e5e422be2da50c21d672ed907605b4332dd246b743218f2f2b9bd997ed281622327f3f2fd35333a4e08a756cf45f0b5446e1d7b53621e2396237b69efdc46671c234efe8b7b95776f1d046a13f85edf6ef673b4f981963fbd465033b03856c841d8b91632b45dc2a62eacdd7b7f8b09d9fc8dde0b97678c8ea8a5c168ee9bcdbbd09d049ae973631bc40777aee4617bad08d5c134ad7b5332d3e0d9c004fbbdb293638e6c22bfa2f8667d00552fc77c11a2b2241ac9b9dbd14f6b44608460e24da7717d506528c7629d763f1766a4562d538cd065f6096e91a2accaef75b182b5963198edbc991983f05afd9d93e24f2aa2cc8ebe3953529d560d3216e0d6e612e809a9ec2ef7e183e791028ebd68b03018d824cd9c7fd01bf3f4467cccb6568b236376f4c32b688a0a831693ed1ec1663b195a3926763034ffcbccca413b1948d1a6c9ae841df3bfe29901542aecc9f596f7faaadf1eba0f04f98da7484c7972793a68c278b5cd4af6398a787cba1205aedbcacad060b6d589e651bce7d1bc31a4871bd7a8dc3d54cecc7ba8eb70e2bd0d2b943e00256bad17fae0b028b32bacd9f5ac951a788a05f3bb9a8b80f682453a511eb1775322c0359d012c13d80e0ca0ece1a6d872fd84ec6db0ca42343ac6bdb331c93ed323356b377ed8af29ad7881d484afeab3defa4149840c3a1351681fbb942e5c8eb63541301d5b048e4f1905155b5b5622758e7bb9e0fa6e791152e7cf1189d96b23e840f0a75e1af03e17b3172f4f26a6096921238a3be84fc0ad9d596e82be51b175efdfe388fa35c0991442c7366229e3b2bbf14b78b07ea7a0c9c074c0122aa905d6669b82ab471ec7aeffedb610924c92d28aeb59cced0e54f46cebecdddd53bf7eeb95f3350ca0ca0cb467773ac98a31ed56328546833cf0a5c59bad2852f7cc6ed89a84a16e8dcab3cbfe22e7b5e5b694bde8a5262a7b9d65334bacfa71dd532e9372ddf6542fee2daa7a5f2040a7494f27d46072c91183bb1ec5915b224d7d4786e5a53ca5cc5f00bba3d5ec511614a7fcbf5f344747c92feecf03534d8e724017bb847b4bad45b764412d53d17c3c23a4714a738e6598490b32aaebdae959a1b0bb24bc2d1ac7d70f1b0f5da61fec4c88b2c83885b31792ddb62f2ab1a65af3b8af2a06335a0dea23fa2113b9484aa80e4a818a14796f91cd223a19ba0d9fbd975d416245b7407808a60e7cf23e7ec19f001e7123fec7ce414072bede654d87b48d0fd74b77880725e77ca0394bb11fa49d47f59a8b48d2a2d6802303f88fda79093c6d2de30c21e485148877b50b4883eaa31f6168192459ad0b50120c8b3c4d98712cd343f54dac477d3b92c5b3c6a6acdbf661dd644dcc8dbc4bf4ea69389801561d26df6a14e6f65fc174c3d22173ae968280324ed3653d3b1e8fda5253c30d92470cfe94fcf85a642303f78fdf54b77dcca7ae01408b872fd1cd236e173484ceb36eea9b8f4b3b326829a8138ab08e38dbbf9aa51ba531416a950fe40b542eb16735e9a65547617198cd2085a9eefc6eb8ae3e61ed1d0418f3cee4ddb78bd2e46d4744ddd55494cabcd7a50ec578c9c7695ee25e3d5ac85d7362eb80a4423a0ecd8e436997db9be4db2e80d665b5bdedf8b5cec493c445b7f3386cf659df2cd88df12d7223423f69fdbcf904110d9f856c9d49ba77c342cf7a38af665ecc71e9b7574c1f02f348fe2a6857c152e8393acefd9d6872bf894c104afbf93c6fd1eb52aae699bb547e4d6b1ae434aeae51b125bc10f70b20e0d7bd569ad67a32138367d14408d6cfa8fec7bae686afc7b09579c4eb8fcb4e10188a44d227a07c015bfdb4ae93dbcb90b94731a6dedd9c1e8cd3fc765739b2e1b67efcec1137b4611b1c3b6b6253b0fc25f2656c65bf93633e3a4cf878ddb21a5aa2672fbec644fc6bcc4ec59ec6e5b5ead03f8042dd154655b69cbb1a3fb785abfc6be556d5939af116d5026fbad483b1e9a7299ebf8b90764fd40563e82ae85297f15400ec09035801b86bfcb9e42d224686b0a1ee5b094b0edd1f7e5f710cf678e2c6e5940efe4696df486e4a7d7de4eec25d72f1ef797cfa9d51912cf6b940a924812d540a5464dc32e1ecf60739a0e945783a50ada8b11bfde2c5d81fb6d731a1ceffb565cd59db9a7d9f43ea2afd40f5492094ff5e917ae51c41ea56cd65183ff4833e8731cd9bfd66afbb8f18a4fabc184d444c62c41e3e452eea02c48f66e83de377d9486a2545e243e65ccb3c1f812ce9e8fb7df310eea6b3608a64ff2483ef44e8c1dad580583a834bba0a6eb82cce1b087677c656df87f9d558755d5af853d11aa8aeb9b420b69872129ee2cba4460b2d2418e4faf73027d1d3bf500e2fb1af94f78dbcca839daae3ca503f63d3dce2de6d27f60320e866da6309814a0f5109de143f86c96b39e0274ce62d85a0d8c8a4b96ea37a41f8de7a701d9815827a0581698cc0b9bfd063c5fe28563bf381e40670b3946642a8b63862c13c787075cb045c3c12a267ab5b454ae05f8cb4205f8cfabf70cf0a40179ca2be1579bf8b84ef5716238d4a12ef3097d4f381cbfd60bec05ae0be8308282f96dccc23580158cbc1e39c81524c470c4ccdb82021601025284b8c3994481278a7e2097b23226e1e026b248766a38c64d39356739c9197489b5c1b4b2547fc003d9a738b0835ef73827664a66e5de6bd93ee768225d71caf825336f91f4e0f4dc1cab35af081024fa8cc04e653c37ca1f4a6c053a57cc7e343f9844d68a572e9993b71f0c14fd03cde34ab4ffb1d77975e82dbf102c6c16b4816ae4ee9944e5c2fb5545665e781c18c7801ea4fb3fe28394c706126fe32cff7725b048a63cb2cea000493c2913c67185eb0be37cc3adaedca26acf76b4298bad43478345910e331e32aafc29529b4ebaf5dd39cb25338e2c5a6db5f57174df806e0b1cdbf46086e276eb34c3a71326d32b23264ab70c7810497f64508dc7618ce08b73edd9424089477a647ca3c6906b157e27900b9113051a20390c7b79c84f5549370fb23be67f2ee909d8bb1e01ff2f4ebc1f9579d58726f0c2adcd046a3436b4c4a611b5ef3097a7935c6f91f1ebf305626dd72f36230a518fa8f50fcdd7ff6eab357a38d14a1c46af7c23bae6ddeb32a8ff6319cb453ec30e8285f469a739c769524e3d13281736acbc9a0167217266fe38abd1fb8a3ee5bdcee24ad42e506f7d71104b5b5723082992150de9734312e0ce23e04d5e850a1be2ac8b83d9edc7561662ebe053ca3b94913728e43fb7b6ef146dbd472e9bd0a762572f0f466c5f91b6b88768aa77317c3e72faedd36ad377afdbc16f96fdb9fed244bdbcd046989ed673b64ac7b49a4efe5aec7cfab6e918f510a52d142526709727b0331427130bfa46e10d47fcc69b6551860802367851888ed10622acb6ab35629f089e685f379684a03687ca56dfe7e94025865401afdeb8cd914efeeb1d4177e283bb94cdc03fcf7c4d23a7bb8b1a94b34bf3ba05926c210344f58624352fea135b1836ff245a89cdb7881f753b51e647e1d6b2f487c55a0aa7b2ed0291753ba9f510c953d27b362d1c419c145f4250868dabe96f2e5eb65c20039df69095ef3ec851b67c69267702d1cc9809654065f7b5efc7d5c4ace87044641380d126672a6b47a8d946c0aef77ea5adc4fbf08903e12ed8b9094442df8b60e821c19b55f5445efaeaf9fe5063895957f771c74c43a5c586995a9967f27b667669f0591e37fa24372201140def6853f0e16539222f5a507bf73730ca618af168c9dc04326ae323e83eeac639e3c222334354baad3f956c03432d9edca530ae19b1e31124f695da7862156956f8fd40897daee04feced54c70dbc28312612d913c2b404886398b4826c2f91f797903b5df1023e8ccfa8c731c761814a7c982ee16cad52cf5a424e709d87c49e38117f3b5dcd29d6507e1fce009c2e9b1136fbfd206d805c134904dd76bc75bd630788ac148e36cf07d3eb1639ea84a57c85ece17e4311c157138423984c29d790c8e42aa5b3f9d95e20a584e3cb27ec16fb6e18e6ec9b917e2828dd6295557f59fc2e3181dcc787ec0adba48ecc8cf1890dfc1deab8623ef0fd7f8586568d071717a34b5977344d09e8f9ffab5d28384b34136b0a351a4c680a049643de35116081ffe26d01d4bb60518cf0b9fb8e32c614407ac5f1382c4be4349a5bbae220bee1a0916d0b0d3567cb01124b26237392150fe79e6b20610502ac0c0e6b18b79abd11d2ba01625d88bbf2eedf7b8c7d27ccde1c0401878d3bebb7660c6d5d488c5ae020d47358965baadef0d75a3da20f9237928762b20349160322b6400445fc6187f65cdf7462592e2192d3409ba4b20ba8e5a8fd5455c5080bec9c71b242736775edb3b42a63f9ac677f43dd4ad7a79fae8fd93fc31728382e0e3f70fbc079b3265169800efdb5ac1d00b97eafcd58d4c4eba8b8a2a9fb2d06121fdc254287fb35dbfec186a235b3ceb194a35ef85e31689397e66790b66d1082ae01e34b269610d7d40725f3d249d91c75f9bcdb203c16221747866dd26ed9fa7a80aa4cce2a43ff99bf616513e4e8abddd06e08376b69e1b75a8383e7b8cec3f5e6deb9e71e4b9db058cd6882fb59ea2cc5d6e21c35c08ce8ade3955ec16b99b093152519e8944ca861ce909813c951f3588c0b4721a67e3ba02af4b01f3cc62b13d210df1fba86e278e95fdbb4a36db1f6e1e630c5a82010efce347428ced3d5e79a0f9f3a3ad70efca238c66464a7f92f9cf56188322d18cb41d723847e6d419cd163e2be71b78e7b8dbdd099a99b296101db61efd0ffa3e13a5f36a8d7ecee921cd032130b92d154104192cadeb1d349b4eaba62f11252cffc2f360c77cd4d75d0b715ee75038834be76758e708677383ab5c3983f0fa5d61bd9aa35ba98dea6919b06972a84039bfcdf013b0b8395cae7cf25e607320d922de0fbab3cda22a2d3fe7ca3b89ee3d86fcdce870c23bf50509949e2e6440a8286d7b2d35b0ba9f92c43f0aa8bbea9986bd525c8fef144870996b80568901d35db205854b197e527ef2dfb02305db55a9577af975076d5dd8769f8c3eaa0c60a8f5d6495cd1954ada0fef4413316a77d6147d468bd2ed3a23e6574a4f91085af07d1501cfa1a98f8f64994fe0053e09f53a83cb37173de93b32bb43f1059ec61f93eb360e4f5f2a84390358f14a0012ed12b311e2a0047206a2f4fe8dcd76ae1c7f806e80a36122a0d655e7b0c7579ba8e4369ff533ebdb6e7d2a0389b23719cf89fb348d67577fcd82b8848446ecab0df834fdd6999a2e5a0d84db4f7c8a1020f9850d9d61e84af28654b8d58d664a0495d4b4ef9ab873b1982b0d45f3169af7164583185abd8af62a500a0c666e8075043e4ba7fdedb05d674721d5de84bf3c29641d671b7e47c3b6d4038f97ac56488e9b4a658ce3ef45c2ffa066077b87d77a0964f069d28940720a29c7e8c7d36579133a930d3f3751f07b115f34a4fbb0515dde1c0f615955a618071c236800b50dcda29849ac91693be4fc2a2ea722b0f6881553d3d4beea992622f70e36e31e94f20adc08d00375e962e92ebd2b05bdb0b191fe7fd3c1e7945d04be73da878954a9fac71153985d431c61d3a8d8aac0c900d883d9056934dfe434db18fbf1df961bfbc12ede5509913beb81b9571ba2879e744caa13bebac2e43ab4c5422b06a26f9432251944621be610a0b650604933b3edbfb9a4c85f85859fb344563ce8c0ce4e82bfab6c4e28465798686a7f9f1466c946d061900c6feeea3e5ce12c6c3860b019c43dd5b6028348d2974e828b74e09248b5f21daac948a3bfd4880379514c425ffc768883efc46bb40ba470f49949cf2d31fe771fdbba529d75f5caf955bb8cbd2fff8c9b383149a78b1352c4ccc8095c0c2da755ed6d804007d089d38ad41799247fe9e825f36914e1432fe25585c73f0e29b4324789b41052c046ef39c06a5ca49fa851fd325361d3dd0f367ca9913dff97a6a0313577751d6e0b35a9a60d6f7707d0bd0a1590f82a89fba8895cefbea6228686f29950d73282df8d24af8938655e691692c5a73fadeef920c3c56a2acc705bcbd3dec79e57a3cbdff0036521364c7c43de6a20a026b51486740d89ea39292d591c2c64325579d51356c92991b17b0f2c362b84815b8551c2e25bd564b5f6041715aab0fbf3ad08119e2a5ef09f902db9e1305a4c1607babc55d8d501087fe9ed05813262fbe769c1104d8ba5c836dbd229a22a681de3565d17ac1129f96be3c336d872cd33ce020bf45b381af413235f54a97d3d38c02d8b6ffe11455262fb81eed8f9a5650bdad8917bedb6ebcf0c48ab6cd9333146482fa4f65ebbd90e381076a94e535746f90e30d633e174139e757614c9b2cf1eae32ffbe7ff55714a2561672fa3dd2266897199391035987e2cefdc8d222d9f0677ac87bfc59931f413c155c83cd9d532e5994db908460d2df3c87b17eeb18637cf147585e5157d51eaabd8e736a8276533ee9d6b6cd529c9ea55ef654755420f47ec37b2b4469de40895430517b4737e02d5fab8e44f68f25f3c8c1dc2954cfd708860cee9a92e3afbf236ca66ab53ddc0d3f839d5216517e0c0e379f6de2172e79d6342cba9a8c74367268f99e94314fc8d1856d5f788ab1da788224aac4a000b8fc1a6f0e498096d4894cd27facba41455dda85d4e5e3c4434dcaf349c31355ad40e83efd67681d83af41b975c481bb6c2ba96d172503c131d73695b0a7183540e9c322efbbeb122a2d6f37e8a62dc425831bae920094af8b5cef91493856a95941d5a24c0eb27cb14bfdd34018676558ac58cfac3e3b9739251d6f7b3e76b8e08e46467d286463ff511316e5e3d7a5edef8758cca6a280227ae6b8ad801f6bbd193e96e8d1aacffe87db8740cf248ccc94d0d15c02717230a275f349c7fac9d82ae41bf6d12cc995357aaeb7a3f722dee35cc3c31850764ae7f0a8b6dbafda1908605c0fef9158aca21b13b329f770092353b669b0e592588f80605c84e5a669fddbe19cf482852c17e43f9d27cd7d369edd30b694dbd043e34ca1a38a4436ae4f7d3303a9a657fbdcfdb9db6620514e9a20bb128bd838f12b7df6f3b47691d2476dd9aed3a6d602398f09d7ae99f5376047dee55c84d14baf3ae4b4cb20bfbb2dd45b033d290a2976c2b8f7c6e070db38782297d089a339b6acf54e98edc95349d9426caed8fc59dabd4da5789cca2069db0d90af8cb6a48afab029e082b680e2a51550ed5bb378aea950488a750cf03d9a2938c1381372714d9dad6e8a8e2c425f5c17c359376f3aad4947c5153d32fadafef8cd32c18db4cd454309ab593eaf30a028f87a9127c6f2c10cf12165cee9c612369d25c8db9ba12f51788d209e724067ed5467c8879aa040fed6448cab5283f05bf7b731466df2e34184d9eb34d3b63ccd9fc8e476fede4c853b24bbb37d3c1dd0a49003b574e7ea79f537c0e819baa430a044eede39d46f09ea69facdb11722fc6c59460ff6a9cb63934ea9a28e76297e2084eda694ab30f2a9bc4fe1383c884616ba023e3c5f0e6525c7ad4a780f5220e730e9b6578b17a941c5c4d858d4d7186c5a40298e323ce97549d4c820b0a77cbdefeaf6ca9bad947a2b60985a0795d934e208b8334adc56497d2704ce7fb1fb6a69f94e3404791c1b962b0a86fc4cf037f960d375ce76146a0bade6caa4f705b5471da6dfed04a9eeb02e1623dc83c73d4852629ae7938ba09a6f575b48020367315fe6117fd4a4b91e70a57bcec3c50e77e54debbcba23b2d2733dca93585b48cec5f613e27373458bf99dd4fb9352712d217cb07673446a5dc38260ac837720c75abe2d3d69805a9dd2e8778b7bd62f120fd8313c46568ee0670c62bc0bbdb7c32326a6b83c32bffc026caca503b910cfb647b537bcc1e70665c51bea7697d56b2a17c87d76f03e519113ba71b464 +Digest: ba5878ebbc5b63a444130ee4b71847556d494f9fb1a62aa9b27847e47068a7bc521f83bd34883df721c37d75762ceaf53649bbcabdadbfcd6537ab8eb676c779 +Test: Verify +Comment: length 50800 +Message: 3dd0a23d2864292150ae4716c68a36fa41e5033dc0cf4a9571d241f3d282f7b51656de1dcab68802b855aec50cc17687b539f5990ebef334be6cef6bdd0b635d58e24aaf96cbde3a5b8da600ed65b06576e61c9caa04da5fa96bb3e327158e0bca1becdcd3cbb63101fc38afb29e6dfc4c957d2cdbc8847cfc749543f9c7ff2535aace8acbde954e724a6bbba49334b4ffee2232eb327bf57d329c739b493e156136f8a2c42a05fb7520480a086d8df556981297206b4630f54ad05b55c4d3411668700d07da8da0d426d585295300271a3c5541c39b6d972b6739e46f6047131ce840b1dc14b6a355031c144e6e16b21381f41a1be97890e92fe0f4304420f13a5d70788a00066dc15f25a0bee656fe0910f609727ef085f54acc74e199e9453a6f06495bc80766dfe4f60fc2e24973c49063f50e825ddd1861054dca862776e2c70c0b959141f67938994ba28a757a0baa43c8381c45001a1c9465333464ecfb0d89a881863b865503163aa6076479a8069f6938743256c32280a664ca270f4ce9860767cc7d7c3dee73c616819eda614b7ec056b3ab47db1cd1f7a471f9479f010a108f8e8f42f6a0bad6391fa903ff21e9b5da01393b29b1903f3d5161fcba001dab40f2fa3e4bc2f351580a0f5e4a32e7300b85629a768ac4687591e796668cc7c0c42045da03fc2421bb6a5851092380193368b1cc8a4e7559955a137d6b4d11376141f87de5f5572daa660a46069fbc5898d1ab392da6abfae4d36e1991ed02f8607d9b8ebb56935d6d26afa4074ca4d582e9da49273a6f33ac257fd3a011a3ec09fbb7774bc6e1994bd3ced3d5d23f793bd8c5653fb1c8ec3377ce115f63faf9a3e4d39f5eee48c98e95f03b38da962a0ac5f4f33fb4bf0dc3f2e43c978b1208785f786ebb76d0d57c939c44f70cafd136d8f05dedea5b7ea2bd48bd1031f002ce952d4c2c0581a55ef65a56dc0f9457083b400911fca427180282fa92fc9ecdeeae7aa1774364227be5b2d9ad8c4da2c8136c617591a2f16fe61b5de594235320d1e7d565da80321d892d35332ae09cbe8bfdcbe0525ec2ed939a4dd0a2877aab26fd50be6fddbe8a0a52d23692572c31c87ab119e6df84dc3187321dced22cd9d6437b4aad84af0b8faa187e6bb9396bf56b7ae9f72d1d82e76b7392bf0d50f00942bcd0397cebe840bc70d25e0fadb238588e182a517728decd7af81e40ce39e6807c1abecd5c69461040fb13606f4fb9ca556e295278153e35ae1692718efc968724eee280e9d6c92ef1c231b4678aa14937b39c380a932e2b77b6c4aa778141df1a154d9c7976f09feced61147daa185b9cae2a0c14e8d6383d9e5bf2730f0d0ec857a829f692e4ea98444a8699f9458aec287cd57d5d5fe3689700526aef259e947b9b304772cd975c919515a3bd515d8fe93a9b2f3af1b560695bd0426aaf17e84bcdb7545ed22ea29ae9c6833f645cedb90b6611c7b3358edc1377e4c6d4ff2b8de7c9059e1b38d128efa321c7a4106e60973f0b4cceeb58b8d14c384bbbe0c50a906b4279d13d50034eb3659c3c007ba5872d05106a5f27c43c5926438d411e8a71a7f3391cc389f3affe380852b57a518339e75cad1a64c9fda597f471ab9ed5328400242354e3c0ba8d80510fb5d52c326a9978c2a3758fbb3871a790a5adb27a0b51830f77c631166727c09a8af2fe3dc804accf82c4de1f1b9ea511b7b3eaf142ce9d07b59a106c94139d1cbb3b8f4b5b0e40fd40b77ed15504331d691845403360bc3494c823631d2e30bcd116a7052ca07b7364b83678ee8d9cdc44448b0fe6ed26be9eb633a4095ec0a353ed0d1342a3a65a762ed0bcef202675cf9f8405615e24cc5bcd07d6608d97f8c9278a1ca5fd09d9fe8112475fa41b119292f8cbae9cfe86527569a22ba2fbe4bc2ce6c85e98ec198518c5be4603c1d71683ae09d58efc150b171fb07185358fb364e9c1745a9741925db1ccac2461f0e2db6f66dc1b66a10e19f2a73a1e8d2036375aacef2d517aaeb79d179aef42837f03038acd2d8351e4e5aa308e554abfcd0d0334d8f864ec608e5247174caeb97361321eafab9c4e14e10ff27612b696014eaaff36a316be304b99052c23ebba485fc4ca8b7cf9c02677e896f93d17ca596218b51115b019a65438f9e05c42ad85648035688ae2cea20effc320beb6865eb115ff713879244b12f7ca3bdffbbab3d72f084ebc9fa0110d1a22f27ddbf096a469855ff3bb08a6eda02045945e0b592299ea46fa775ffbde025a7762ce308ba1dbeee22ebcec404ef9a50764b3c5ffac8684562cb433e6e87f14b756d66fc51134e203d1c6f99f9bccff883541132eddbe7e893a9c435c9359f8bb3f3cd5cb5d3c0bc9c51f564d3edfd6d0f1511b6c1d087fe40d78b8e44757ad8a07498924ebbb0e3cf00f2dd29dfad3e87e2b0544d42e2f718b8fb9076c42dc2c9442b45b257996643be0a3b422e79dd7c617fa3b6af637379d2b6f4b6ae22caad0727df5723d494a8ed8e27d336ddda5af5d22db47293f3e2c92023baaff460ba1200d7c39d1cff5d24112b43a533b5b2344a4abd48fee8f1e0d995c9261d157f1938b78e4fbd16ded615ae29e625e000915a83377efed315de45c388bcf7696a714206fda84f7bbc981e38ec762ef9c481958fc9912e32ccf5f7456fe13ddd1abebf4eb8334e8e64de8d5401d1b9538ca95da8da3c179895ec6093e51f3ad10e5602e7347d24df660e057810854f9da76d4566efbc2574ff1604279ee388f593dbbf7908e28cdf4ecaf91d7f0d7c38d341df5280bdd24866f76488e3baa2ab69b4376c8c0fc11e7d89eaccd3d6a9a56ecb7de423adc8936c2504305a210272ee741d4a64517c0d70cf5d0e857d6263f86eb3b44ef852d68d1365a6789332dc909fd38af854183cc6ffc24b2a6e2104feb0131b794a2b9248470b53a5adce590e9bfcb6de94102cfebfbd1b29358008e0141ea2290f9d470c3457d097cd1f68a6fcfb467d7e1e4e76739fe7084fe9d05b1f28e0d4b53275676ffda5957db0ac084741c25b8e7d21dccffd475e29e90bbe45e44002d7759dd85e4f3b453c1c6380ef82b30f51c737800957b4816fe80b880cb35849e2f130dd83df1a1d84dd4fcf6a1080ff4487000ec431a7186e716056e8289200641fdef5851fba94e45dc1425b8dc4a1f3370bd7851da799c20faa997cb675dcd76be8aeb6a3a521d7285868284ce6adda41cb88d06e2e7bf73d3ace2edf7c25b96ffe77aced627ad9c785cf44f07f695651cf811ab5b4356a64a17363263d71869670ceec6f6ad678a5d9e655faf76b13c1785ee886c16cb8206f17de0d0246db69f032d9ac26eb106db52bcfeed7298f2b5680ae53ee685cfb0429e406832c0474ed4219263f1f4d69a82e172e973b24f9fa84f0af83eec55ef13819a53887ae21d85b0f601be99c34335bb03cc00671a7d4da33ec3a368db6c6b0e36b9ae0450b420c40dc35e06957e7434fbbea21f1df660f0cbc79f612bce522d5bc12dc459baac4420d258a514f24633a0e6e0421eb3e71df72bb93f0bbed0c653938c24c4d83218775634dd0848b3a13c6d4238e65ced120b187a6a44e4eec16458538b5bb5b9285a767b153827c364157a50693d9877b74eb5684b9ee7b306d7380b61e4fa495c115ab4b76d387f657336933eea0f8ff40a2b0d48e070287df45a3b0d284eea9ce32b672a6f23ee8ca0c9921db76a3cb185a1f1cad426530f02e76bf9ef5aa5d01a111cd6068f18c2e35ad56f6a5187d609409a3a40b23ea24b06238c01c581e0fc335c23fa2406ed8311e59dcc6b764bdc2f92feedbbf11f15e0ec2e253887b4d2baae79128bbff6c917490da56114f846976180a3ea726fa99d4d47255bbe34e3cd9b40176c4bc6fd948929bdda66c591a08d2629e7cb784f64cf3fc7d52e497995aae0d26eb34467af2e58db7f769b0371a05a495904244e5df87fd44fdfd9da3a63c1083afe574e91bf01c9f84b60e6332283c9e8235af0b1536d1370dacd4fe34e4b847834e9fc62c48e4decedfe800d9908723d32027b8865724ee1260e20b8f4e70dcf5ee1b749c6663004655b1a288f530c0038033809b8f74b49cb8395e2dcfb6ae78326c86e4cf139e7ba61fbac8bcb5fd93e476f5dd362d351d213f6898ef16469aba277fade97323df4f66dc016d8326e4bb568ab3e1caea142a88ad4932fc3fdde3c0b1504c0e1b01c04b68cb7e24f6a67356a1c828ea4e023299aec721f4f4a25dccee647d410e638721f39f6517c739aafbed8261f7db67d7d6ef9b327cff9876a06962e3b85875328f0ef5b8e8231ed0bad06b23600cd598e4e22dfb10db10dcffc4c425d093c720e71d56fff294e67317dcfae3df7cabe43828f7d24cf1bbef1f83109a363ad9f0cea14b90d386f110a765aa39b2858b584516915e8dedfa2b9416d0d735d81e10aa2d3c120793ef17ce2d019b85b1d453905d82f6502a4c10f2127d636bd6041f0e23b10a1b2631270075896fc5ac1764ae4035403021224dcde88ea554cf4c5a6f2742df6ac8679cf2f1ba4cfeced50a037130b2aa8d2d206c1b7d336d2e277141aa5a0892f4e307fa040ca99d849dc21452fdd42ba8cd37712dc194317d55f23a2f7f2c103633e6aa2f091c2e77c21b6588051b301e73015192142e3e27384b9d191aa05ef6eab767f537fb2e12f2748b62eefe5458cf0ca1eacd87dfc64eebff09b50bfbc177f8d7d901ed18e09f7bda8603f404e231b7d68a5637b2e51a51e473f6d563205c396e6d0f688b5b398ff763eca2de353ba16403569443ee2b2bc1ea3883219e17f79003a8d3d20d412f468f11712cec4d37cee847440f4be1c83bdef29bb3952b91e14f76d5995156e86c6a1ae58d51f7199bab90bd71a8eeb5a6b4cd8595a017b6d692e1e45dd1eb39cd7751868c10c9954ebfcb77176f9272872e21e744395cc4e49082668c096e91de496dca859325595cb77fe76d2a8d9d718d88274bdb7b5a9faad0f29052519f3352c8282673aac44a04f6b4ef442094ea6568dc1900f3c66c54461f276744a05125e935db1cba74ab3af8361a470bd756386c5c384446c6df2f5a22ad92b843bc35496a1018e4c8d4cbdd018acdaff34998eb4e260ff4aa6c9ea5c38f7f2cf7d8f3713b51d2ba5f6b3a1d9d9d327d6738e96e287eee7e0f992481686986f34b3c02f9203cd49ba6d2f84260de0004b1a8cc7d618f4a5354f943a597b834dbac59c639cf2db9091db098e401d9c0c6411d94818ff3be0518e18e6ac7f82326a9b6cfcb8ea0daa34268ae6ae6fcff42b40bd4230a28b413da0667497fa5bc74a1e77216f532d3cab38f7b5f86d405fa89082dda76bac70006bc60da254d7b3653407fb489601f1fcf79b22a77eb9f6e2e76e4003c16514a2d980d956f6be9ec0c662b2cb19526e314dbd5642090061e12fcb94cf0b7fd52cd1dbff3a46d83265bdd16d8045e75e5221a4785178df47ad4edf0090b3c35da53a20a7d7aded145bff9c54f0828a67655a99b15c321b504f2ef3add020f65115fe98fbb394c4efaa760b90a239013174e2e429ec9f7f25ceb54ec316bae35c84048820586126695b0866491ed0156586a0cd078827d26e32cd3a69ebe95124fb343b414e7edb2a749ff4a6edb18eaba47c9c74b932dbd2835dfdc7d61507518176f8841b51abdb0022fed0964234aad55e9897062863faca4ce0065fa6ce8c1fb2061149445e240479ccefa1edcf0b212e0a99f771328e0f842b4e0e046e7ddcd0ae1160bdbbac8a8ca62a9719267590d43aa11475103558ec26c66c97afcbc0b838ace6268b1c9943d4a9ff2d02912b3970d8e69dc597af6c199700c8591ed353ec0965e6961b3a869d9561932b07f943f465f44f185d1bec4be852fd33201e8711516465a452743d4b1645b2697e02db0d71c6f4d32fa55405e2eb9f0677a83df1ab6c0b7d694f50245334f2849f4fea0524e5f5bcb4538c8fad52179acb795ed2400440e807d3a77175b6bb4311e75622a5d8b89c952f7d31700fccb7c59ad0fd38b46cafd4092a79a351756f7cd309ad1d27a73a7a410d3354ab25250c127dbaba04f7987af8c286068f88d08a19e9edb35b2960099025dc80ad8cab49e94b51ee7d496c9ea855dec6f75d2ee1c3e02c90fba5d4ed24ae751c9d681324282409fda6caf2eb22ccca0a115a5129d8d5b0db8f855fcc058e465204202344d6ef2b0f07e3f4066d1092fa66e8010b61afc3bda030c94f3caf9748691ea452fb94ff4b29fa389a91087ebf7d70052e6558ab5eb50eda1dcff7b02654c95df5a0facdda9379884d979bd681de58263cecb7b0e556875adfc950d8154d8918d6cb0bdde4cdc6aac786b3e16712092cdaffb41c7b0b03103c2fa1593dddc69b9d87ae7690604b66b16637e89aa0ecdfb2a43735475deac5dd0bd279c58be8aff1d9cbe206d36e86b3400e33421068066ce5284572d3a4416964ca81d5e0571c7acb4b676fae99d0741b220a85ebe46bb0ca6f9223f6994c894373b997637caae164144ef37a330e9dff5ab58eb8cad4245af565834c32aee5afb468319cbd21ceac0fdfb9bea406d5f49e7b83ff810a739da005ba5fd52e24b075d7cb138348e8ac2461ea025381c503d6a68d4971d5439b59bcefb7eb96ee4e9e4f8e5137e8d86b3c1eadcfaa461533ea7cd31c02fc3d5d09d04adaddaced921816a1dd3fc945f13d5c2bab101f6c8dc3467e039c4908ea968af4521139c683c9742d3f05b3d84711648b21edd27217474bb583a7824c4aea3215a7f104242a9ab35a00ef6e39749e7ef6b6aa28d0db5fd5a1268b70b386eb10d45fe4d7ad8d731a4fa767c10f80cef194f4ade92ee1f42a6973b0dbe3a5836b5a04517809b63df035bcd476037487078c625fdd332fec9337f27f8b84af998dcf1da2b0e1adde7e33c79e53bc57b306078828cb88cf3158302c5e473fad14bc5a333e47dd78400c72512c21e33139372cef717dd5c9a9c17ea8b6d8bca6de4123cd8d05a42149e11ae1e8a71f0b01e2241ea0b9c1233e1649eef007a2a2de645373f7b2dfb0e347520039af19ecf34f169d1f48f4e7d79eb887729a99a9fc6c12aee415352bf584423587ff78dcf7c52bf554f2171d5ba2f4faa6594bc420a38704bcf74f9c67e113083b61e5e3f58e8bada97ed2cbb46a25cff30e5dfa324fdbffe720d40a21a6ed01bb9a080ad5f05d4d84b6ccfbc93e718fc07f7a541ab93527cd586d7e0a1bf7a9707588587f34ca5e4f60aeb4826603c1777548d8c029be03d767c2ff0c885a87c2b90ed6dba1f96771451fffc72901ed7fb86f900de69e1b6b147a950e343d241a2d418ad28112f0522dc8e380d1949c40109884e73afcf7f3283e48f968c906de9bca7e4a1a3f815ae0506895a4e35422456bbb386b0020d56cb521b36c26b778c950ba2cb6a6a3f1256196eeeb17a08d1e8f3de6c2d41d7ba5882725887bbf4e7f7c44619b6fdd7fc5a07674ed5705e965ad12da879d764b9e5e633704f0a4ca87f626d011c3b86c89b70f0df4cc0d9ee06c43fd0286b4af1ee0dbd227aff052a865686062cabb20364e69a2469d3f145875d6367bb45e0eecb699dc3add2a50a97110fbd4ab6e04970c8d1c2cf323b3946fd66c3952fccfd187a53f85a5db2b53c32888b18f597e739a8261eef642e45e0348898586165c95fb05e1502d8a4b6e03b7ee3f9d05f7919f505bd4cd230d7cd93674a778351c00bbc3ace39dbf18c2d9c617c7fef9d8bac400f026a14f98b798a715e752e077d96fe786851e03fa16eb5cea90d9bd87b6b1990a2b994cebd7e8a4548c39a0d5eabf775980d8dc5933e4814fe457da6e4d0d23902cdea470a4733419e057fc9ef9517d0c1af2d59de26a3d2e09a0d7f34781a76a7197de8de6de5f4c29d47c3acfd000879c94732ee925996f48db3c806bb42b8042ed83ac64d42dd5b0d8a81234e209b24ee8407410bf9cfbe930927c824fbabae7081a34e7fba79cbd8a098cf02f9f757713c3d821dd4fb834c85f4f54f95900a70f2b8d37fbd48a98122611ca60cab8604084c0e22ab88f71cb2e60a95b123acc2b3f1e1c7dbd858899870a8b1d926352950c951d4be168e7618419491cec509c83dd515e296876d647b5ddfb0d005e933ae2c098ebd22cdfb0ebe1fce5f02a60408d8dc4a6df46cb4337f4e2d91b916b588ea71cb092c1a1e3ea20895e24b05f89d73b179d2adbadb695b50829ece4241799b47042281175200a3fb92e92cbe38744c11fb54f1fc4c7588a35a37940059e8a4e5e4a9f03a38fd1a454fe426132615b88a49758f95a9f07da30f2cc8b5516e9dcac70fc7e725ac9b822753a5b9540a4f86eea4c50b5652a0cc2bcedaf5da63fc8235b496c2ca67ae3ea3c84a2544ca8794457340e1e424a8ab3aae292657712798bb48eb4179e6b8e76fa281db7acee74f086171add5eeebbcb63b51eb4b1ed57ac22d13e7b67241f8c582cb30689ff4f381efd5c3ae09e07d1906e39947b55ca4d4e1cf2a22c2d00f5fe9a4e880a6174e5c8efbc7df0e2d68fd813cd4bfdd43a38df76b8d3130f97799379d586589e49bf2bf322edb84390cbe4aec12260f10f337ee8785544514edfc0d22f489a3e388df01476d35d489d4e5b46fd61cc35b107d3781a71e87b8cf12cac4616f9c7a819be57a0770a7a66e0e6e469506826897c8530866f2715b8757f0f01389dc301293ec68821e55f51482d8fed375d4efd593d18a49728a83c34630448f5adb9aa86176817191681c750d74f715dd2357668a2375d3014bb7ff67e91039752320df8f24533a6c66831be8d2cdd0bf0615d6f5d95978412d7e98278c11a64b3b591467766c5121d9af55bf62f1989df5c1837153a3bd94b83e2a2fa9976a5f9ca9e3a4dd2b6a342a17defbb5f0d1fc6ae1188732f3278e747d21cac23fda14b +Digest: bbdc1f2be8449c238f9446fd499dbe31bc7580af43b29a27247fe2711dce33ec8c2598522eb0610cb11cdbb8e5e31c00c7e462aae55a74baca079d09da8b09f7 +Test: Verify +Comment: length 51384 +Message: 84595facd88a8357d2f385daeeede9f8f6ede268d405c57ca5aebc020ec4bf68d3d2c023a59026503caa7d9ca6c36c62dfbae714a12ca5dc7d3ad5832b8c0d911f9583b65c197f688ded10ce52ffffddd89601c1acda307ed196bcd7103dde6f8f2b0e2ea52e76e6ed45a63699a789af090798369d174da9c74bdbc664df1c484c1bcb5227d6f3118339a79e24c5f4219b97143c1bebe4a787e09917cf7bae657ded20ec8b19de3378517bcc9b60277bb6cedd9bce5fdebe3add5d94fb177c0e4b2a77c278ff1f92f3158b88a4810a0581335b1b5f7a213708cb91038dbe6e8ade59379e97919f761d0e3d9cea2f8507254ef7837645965a18309c2d30756c235d02c84690d644291ec3face137280c8caa7179dbac6256e9397e6da8a465e1ff0ae92820ad6f7f21dbc2be8c852e39196c7252fd407b7bda085d7d143382cc7c1e3fd1cae9aa118428236b0b0d896aab43587026b10328d6884d7dc0453be63f52c71da232928e4b79c85ef740b815b4a79a7de28e78027131b4ec175a0fc3bb70e5686118c769ea1927e6cbbf48dec811ceb8bb39687d3c8d3a4493d26cf962d1314e622c9718e2bed8bf12e99a0a480a5bdd0b32531d8af32413c04ee1dbe7fc213c3fcea03fb7a3413447504a3cc709c8476d19a6480f1c28d6274fed0f9d6a3bbe447f6132fb9ef7e2e373d7fac7889a746b4ff0a11b60bf1833360ce905a3f7513acf688700ea733771c4a1a8cc1f59005045b0ad42594d366e91c01cb321da716d2f14c07a1e29ce7ce355eb47268a67e6bb74c1167e59cd43f384ff187c6bbb663ef463c9b2b2046f206326bb46851788f1ab810a386b595dcbea24c80c017bb04f95e562407275b33c37dfbaf7ff9ba188c3618020084716ab5e122469525ed5f157c9f630019ef367629aa8a34060daf16ae72acd973308e26f4bc00cc4b141c4e885d819d5fcaa6261dc16e0fe039fcbe0867c89ce999f218c262d7eef3f7e3a96ad9a6665fb429dc41878299f006a68e2c3d7fce4e753e93355bf382845f5a300b5bf8e48275679f7d46ef599c3c568e023cf8f9098c1aa034f17b1066142cea512aa29e30d40a77b944dcd84da2b3c573ae5ca484a62c45a86a972100deffdf2590ca1dd29bb76cddcb729c6c01663b65d9d258268b1f8c770f713cbc857c1870d399e7ce901887d121d82f5f2116f8c107839c5702997d8a282ee901d04a9c183c36868e7cd5cf7d8e371990ca6c05707e96f87fd5421fc9fdf9b0388811730713c9827826964dca5cb7e065c40f69598634f406cac47a1cd5f81ac7757ba623a07c61f65802079ed17f0e48d6a92c6369851955aac4966cfa53ae175f2e3c562a75ad6fd8c107e337b82aa0cadf57786db0eed23ced7c9fb233f4900ed23d86fbdced4b6f7c557fd489bdd5665bf07fdcdefce64ae4339f46c0759a4a10b29d59daaaf1e5dbf75cf11b4e4f73c5025ffc36c9f99a54c352fe21b89eda90a2828d976bcb0285f760d5966575b8c4920216e1df74f6e335a2217f460287f9151ddf3ab8408e235c75ca218bb1ff01aa4f7106c6bd24399076f901a53019f3135696eb19b8505c2f8216e4466a0e24512e57ce043eecffdcb5ccd05f8e5828a515fcd4179b11d9776e02082109aed490870e61235e18dd2149e313fc860b3dd242571a395299413c23d6b5a1f4a7b96e42dfe6ab846e7a681986f3027ffcdda3c5f0e80843b03d8788da125094c17cf3481285221ab87fb80dfc98fbe1f1ae1e860f640bd71e755f855648b551c4c5277fef681287bc931a0d8f296e13b3584d6efcb6ca76aa90cc02917e5894773b13d0beb40233435f950185cee47f0a843863fe07cd891e37d6e7d4ddc2c3a387be23c6947b86148b31d127b1e48cbddae64e5e7f9d764011861c678d7a4810513061502e04e8f9bef666bdf7f6a296015f186545c1a7d9c7e38a92b5088986407270a4aa25c1b8a0eda68fcba2295ba2aba75882c182b000f5179d7ef5f0cdfc8b3a0a3166791ada1d7ae4537189d564d3e5825d26718f65c5accf0fc8e3ac2e83a6caeb5078e7148fca06b7ea2bccf0deb92aff76db3c9d5a32719109cced7e639b2bff6a26e7f5497f3b20967508edd40a978f3c288051bd8fcb2b41125693320376953cece126557fccb6fbd05004bdc21236fdbf2329f4ad2506f71db016f8c5f4d74f309f4fbbb401a0a3a56ddda2c8e31c430aedcc0972c749b355c2aebdc9eaeb2a5be71781052107165a281f8a0452689570a6e303c8f81dfd2256048af7a3f956d68226b1597612da5947727e5ea7437c591515eb9602aa5eec32bf6637662a59083825529a46ea7908928085be29d47f2d030bc8c42b175d1b1f885a717aa5bd58d0bc6dafdab67bd1d3eea70c21442655386da239bc8d8317e5076d8d28930930149209807a9f661bd067ec30d7baf9377ce282dffc3356484ce3a773b81cc6f7ca502ef56dcdc44d52915d12935f813c97126f9d353260171cc5100b72677b14bb9de4f6fd671cd12114019b9d5a45cc50a6715badb129ea1c54b13e9d9db0f1af22346b7095f70e0599e1b13cd4cd5070469001aed9372a153991f283e5eef56e87253c0f81dc6cc6c8033dbaf5a22ec099d5787ed11440d01bb8106a68bb88bf73c051225053532b4871285de44bd0054847a665c2489212a32f819b4ea2126b8e0c92f12de42bfec233586eca509c0afaee74add4598aa679fd2b5ebe28fb3b8111e8c33e185c05dd4fb734ce3afc9658d3ca9c2ed18f53442af8fbe0d7acf4f4d739e2ab764e0942cf2cf9199057700afd917cf93808e0acbfcfb9dd368b618e676f949d876ad198ba9e03d2da1561b774af935c145f165bc397e1ddcd0149f8c870223cd116278819f79c22a19d3107410e2a80effbbdf63e3abb07257773da0226d4afdebbd1baf31e0a316b59a8a46b94888d50449d28399f8f84c553a8da1e77f11f36c298d550fb9526c3b08d33fa2bf7aac0a27d96baaea57c35feb0a3234dc3b35f9144823976872a2e0aaa5ff7babdffc67d26ebcc4f4416fee153db198f9094e3929d68b477266436cfc5cd692923b5ea3d61cd746ab67aa763592b0825a1e94a2c6a30cce6bcfd6268a728586071f4b44af4e5bce741d1b8eb893af9f63edb1ac6758186ab8f1c3a3b1816cd46efe3ad0da7daabae2e43bae3acb1f3ecae92ddca8404ecaee7ea47b1e03fcec5e5ab5cec445449a8c5f734b28a37ffee3b351a9f606005d80e8f1033c64d66c49a73495091fd9fbb4d16aec0eb7524e52bec5aadd13ed90f4b321e2793e59a2c5764fda2587ab4d010c7b07597126ab7c7e1245c9f46713ce5fbf7f60fb174e364a6ff485f7691d05433c33955b7d94d57390014911fd448251325090259fbd20960d7ac6f973ca162816e74ef0c7a8f231f763d70720a1953a230c7348537e18ebb0e344f85bf2d82da3a8e2bb8546572b90f3f04e61c99b7cf9e976ddc31f93ade2b4ac9e9225afb66aeefd2646fb88e2f5282152411ae98c3f9e37406f00056f1b655a36b6b12174c52ffacb7d46ebdaac86f6bd3f14240a6c81212ac7ce02a1e38bda6b2a43c1cb5ae27805a8a714852f76ccd9cc53cf59f948c0f76de7ffe8b38e99a67d4c053c84bcd18f499a7774e69e20527948400d6e4b8330b1dc71a603e434731048604aeb05b3a2e0afa91c7a63ad91b6602a97440004514419ec5c6d23274b93b75778e6537afb0e451e0e434da1221439e37a130cb0f3853ee49e57d1eeba78177f391f3cb3e212f93aace9d2c78e03440f4843d8257205a9eece4c66f72a2de73c2dfe17db12af4aa38ac6996d20140d02646ee8be6735e96f7eb368ed2525b522a9fb7b7cf723a7dd2a71e82ea2b7036160ecc4f84da68beb22453e1d360fffa74fafee05fa209f4bfe746578607cb5a0c055e36f8fd7efe64b5a8d13c74d354e7173d5f2a6169f74993687d6f3c59244f532ca90c83ab3e56c6bac7d735dd48cd1ffc9ef858636eb6d30d5c6d73227d291fbe0e8615f466d18013296a4c27bf6c39c304902efe414fd1bc5c47542f4be0919dce2f5a635e1b0a3a60be60b99f0e8e1bf9bc8c43595cb2fde5c7868778bdd35052cffbff0e7c8db7d59b1a99d2f9458be5421a389c25a1585fb3b232ea080a5f012e9fd05e3e3113efc822d13e75879c31eb7fe7f3f1c45632d47f398b0961534213efdf37a81dd5150f1f69cdcc7cd4437f6458460a437ec6f296a34108feb27f4892337f017a85b136ba6766444bbe84c670927eb6475983d59e78f64c09071f9331d420926fab2a069ad5f0271ddf5c884c9d813ef86dd24440c0911eabd78abd74cb00a325d0e84767ba55bb19c1348c9f8139ea7d4519082484fac60bac278e021f097bc47b53c1cb1f7c4968eb729b12468d01ff66c1e9f1cc198c530d60cd84d821647335d33b6c0b4d1831e5807d4df564cda55a33af509ed6b7a8839c44a1ff32a45a85d07ff286b0729d38c4faf796a89498a8d622e8041991349544b9029b2384a2f3b25306998d9dd46ba8d9b82f409fffd8110a6205ca601fcbbef54fb4dc4c7307e180504acce2fd0692e43aca143603724e2e65a9d16d91ad73c02f534544f44ac5ce77a355894091ece1226e0ca0ccfff4579af91600b1c4cbe14a7e46b44e43c60424ac10dac6951d991b24102781076b4da8fc8161a7972f224940c7e3a87b4decfe6ce61db79a8dd4cbf308114a101ad839bbfbd79cae0549d49eb01a2b78c04caeebbd993b26a45adae3dca750a46bc0f23c6aabb892b61f92a2e9a1ffc489eddb317f9778c3caf2f1fc7431bb4ac5cc7d89b82622caab6c2c535ac04be70e972e47125f99f86766b847b8f7b38b90c682aacb8d03de4bf849b9ecbf3767b9114e346039c44de37cd6cb91405fed3574a8a58d2b8257fd8a92dd85e5edcef125e5004f6d224ba6fdf490e556e7fa1a9e9884e447c8bc2becafc60e7b92a31d9998b4c942da7918b0b99f9e7f743aa80efa4fba28fc953ce4477c70c9516fa7361156b5011460a25fceffa2042e34478b750cf617476b983b0208911750b9f6c4f8f1faf3fa86aad0dab8db2d3c7060dcb1c5805cd1c4a7b98a715badb709720bf48a825db1759acc86d32f41c67659ca5781403fc12bd02584bfb5d2afe783d2ae2b348a64b5d81b7a57888af6cf9c1d0f491e083f257e489bfb86d060dc91e3cedbf8c139ccce855d4ccd4ef2028f9d802402fe753c16eb752cb8edf16f0404fba3b6495844e2d2d7bbe6d6e2979c11531ad46a89f701d4ba5a32728a2944fedd89566beaa57ec992abba6aef162a432f337c94a3dea7cc138ddca75591b9991d98c16f17750934332433514108a0f9bd78e2c4ec7a709a28ce9ed3772fcc9c63d5dd9d063eebd9652e38d5fff568fca5f0ee428b52c508a024603f1b8be3d1564a933ce0878b80ced2b23c5163e9148ea38955a9ef0cdc23980a34672e68fe9ffecc96ccd953f3161787cf60dc8b08209a99476ed7afdf5b3184f8839fc1ece6f96ef1f3bbaaf9e606a0d654e7b6a204dc075e019414d9edf7b6d398665863d24462967db5f859e6a5e599550dd2a8e271bce38baea59284f2890fce0c932b0be691cd914fa6dcbdfe3e5f89d447e361629f1d33abc8d1c62be3f34c18dc0b3ae7e2de57121a4a131994721bc77e1b2ab697562215e7605ba9aec63b129acc07503c10f885bd6b92fccd18316bdd18e5758ed47f736905ec74d0d1c2823436192889ac9c31f706e0b1d39af44acda139a86be1734eb6892195335c0af114111977b0fa6a9c31e5a5408c408bebb780ce5616c3262d36b3a113bdae3be7a125ae4599428b50d1ce8aafe2511ed6017b4d8776c2bf98514d15f658117cea433a819b2ccc27d5418a3608bc17d794155b5e43752867176f1d2447ebcbf5846217398051df65b1e7e1535301d8dcac59e7a893fa3b4533f8ed770d5d25cf3c66857ffdf0c56d6e2d9a86969bdd55a637e9d47eee4582735483b5509867329ab84cfb19f1c468937a7f79db716e6b0b1627890d378c4560eba7871883d94527be3454dc3c257ea93556d4296bd245615d6b7047be59b7802523956e06c3316ae105334eb930d637c8e83e8971530d33767b31346bf3ff5e6bbe8659096c1dec89863f78512c99c59afd60016b37e806c81f73dc27a4477f233f03e2741d32331f802161ea63eedc135de29c41c70064bb21de48d8b2b46db76fb3102f1e98c909bb80116d1bfe039bcf6b5fdc4b7dd4b7481b7f676670af8d163feb23b77636b1ff0591c39df0c29a1ca354220b87df245bd289bd08a3cd0ffc4e7b3630f4007d1458e8d231eda1780c3482fc4e440b6a23aa6fc0e0744fa3e889c951d03cb1d7c1201e841e1d299d67c3f1525edfe3f1684c385a350cbeb3a397dc5de073d026cf053cc0aea7e172f5fbaa0d817eec22f160ec725193a2a6f622bc40a8c4e6d207b1496d27b4515d7e81b413004ab063888d94f07a3081e4a6cf72e470557a432ec94d75d26b02c7c900174e236ab61df37b36bbf90be5d57e48052f804e14e00ff851bff7f57b199f1edca5310686b9fbd3ddbd164d55e145357d0b1fd83d1371e45b33de7944b9c8830aff7448a99d683d8edd181e5a70c23de35f971b7b441b3576b9ce20e6110cd8a9463256a6330260530349a57beabe093e132e3e59d9d694a7391112e88733c5c261b45805e291e53317ef0b40b70141960e2d695c3b6aa9f89bed76d28504f15b3842774f11dc7337025377313f538cf33adcc60ed29f1b70c7ab742d7248057fb323da0b2aacb365aabd12d7ea7c925e7e827af6063d9217a6923680b6c7a833baa1abc194c94dc7f87404b92143fcdec268b09c400bb8f61eece153b949838135020ff9b7fbe865d4c2745f4a72727ceed78e89e6d2321418ffa02fe2963e700c8f303cfb0a2c4527ed8a52cfcf9b3feb153c44625aab7a7d15999a9b75800827903611c8bdc371d73e70191623202f9f6ae3551a6bc92e3374f41e4cb0f1526e4d490186dd52f1cefd4b3c8935a854f320ab4578cd343a2464da435b0d3a55ca0d8f939d3284cbf27246448ecfdcb7cf7ebb9be24795a5362f73903155031a211a334f7584fe092de586b88fb7645f1ccb3cdfc2a39478531ce68d364ff3a75dba5bbd769b6bb3669d3620f3b6e754c050559a7fa7d8ba62725cc2d2c5b30664363066093f71cf85e37c0522940e9fa5552f53811c0a734b7afcb86e7deb3f20d6d9d19437b86771ff80ed84198047b121f19230c9d1acf67ceff67041425877e17e86814ce98214396b63810de554cefec4dff478d66c4bbf5c0442d7605b53a1490e3646ac2955d865ec8137e7cfe332d0c335efc1bb328d6c6b4a07ee4f9b5c60f01deda8631c269512ec602cbfd8063cc55bf739a1932c46b2f29b943d375bebb49c0886385169245c2a505c2c95c2316ece58e62756e51461a159f92c0ee613e31d61edb0ddea3a52a3cf201e01aed644f6da71546300fb01be0bc6240a44ff0407be86d4a6f1fd7dbfa5209e061254d13c458231a2c52519b377a22e12bfd99fc2e8f9ab95c69864e79903b38b35d29d0660c0c4fb7cba31e76636500f9dc63cb6a7ed3d92b03190817571667960792ebdf4d417576ce1d1c29f2a94e727f0644bc20b9386f8f187f7ff14beb6db710ecac965329cdec382acec250283a57f9ee903fab457e7ffd3af0091c32beee1c593a71c1bb41a88cb0d13cfa1cb5f9b73f83062a8efc384fb133f937dc0e1f1d98256a1dc856857354dddd179a79c6a6ae012ed7834d4a7888986c0f55efbcbd4fe9d9b7df9105847d412d39200a6170b0971412b106491017b9bc032eb85943e6e46b304f759b5890b7a7cf5bcc3c8dedb1506c96ab969ee50473c3c50c7779d3c17907b668d938358dc75a9c53ca66cbfc5e55b291c58d87052dc1c76099a7bcfd9dbe930f21dbe240265b60159d83c1b4b85e837d58646438447d94493255f8f533b573cd078c1d8b2f5255a6186d6586d90787b2c1ac031a5267ba1ac41d2e44f59cc7271cf14dab5cdfdb79edac3dff4ab14dd693ccea27c200b779e165b3693dc50ba1c484094d39446ff56fa8a17a780c245d316f9fed2de8fadafcb82ede96debfc180bcc6cd3f3081cd20eb36750b78c9bb3cdc8ad6f07122b2888cf7117b4a620ae4140cc7f914cf55a3fc739b5f87ac7518cc4171b4499d95177cb2be558880e2612251b9d17197235b44df4a0ea93b2f57973a49e3d2e9f71bdfd811d029aafc8a501c1f62c787bad97cdffd735df42e7bc5fbdbf99d865d185eddc8559e3e9db235f26527970f8080dcfc4228266606e7e10c84701a013baf524a5e7066ba5a9b3c4b279a509d18f40dcaa4b7931f5d4e70d2fff1c8c917235294209b03acc787ebacd32594bef8a587b1918c147e75f1ede58ac93a7c7416e841db300594491acc8df463d3f38417c35795303b020584c0bad190df69d71c8be9caf9dcff73c6477507ef8ec95fbd59133c2e6758607981c940d3383fc496a5e29c431a4cbc1ce4d88a0335bee028b17ad2e139d03b32b9a774fad55ca107dec2bb961e0aa6713d4ef7495922c9cc54f505e31307ea52c0dbda82274f10f28f10a57d78c7b775b94edc4c79b3512abc2841ce937de26c4fbcee03ae9578e94f42d663bb02639cd14eb56707ef3ac67f7b22ee3b80d7c1bee12bf9ebbe6d4e87dfeae345292f592dc4ff339414db11e76405dc6bef2ef586df10df6f2842b4d14e4f66b7ca9f3d1748363caee2a6bfbc898713a4e75c9a401d391e9971bd9eb4247088835527ab365ed6eca8c742023742032e9727e502630201420b09227e98e8faa328675d46035f7dce2241219c10242687831f5ce0785405e4348d15d708125a51175fb47ff6f0874b9bdec9efbfb65da9294c2896e859b37f964c0c3a7a16fc0ce0dca1cb99887fff85feaf6f9e6f051dda1ceca84ba9967ea0e47a1b779d6c51153cb9bb53ade464612f46be44b4d950162ffd870aba3b5bf4d4e3ec78ec37a8151e6 +Digest: 8a919cdc78f2fafd5369e99248248cacdc6d6fc7efee8d30b4ddbe7778d1a4d91b1e6d1a8ac131ba89630abb9d9c585d82456de797b72ba9b35af415d037677c +Test: Verify +Comment: length 51968 +Message: 37046f28c2937158cbeb5332fe5649ea4957daba938e36e1abddc9ec7ec910348e23aca89fe7b5ccb3645002399d840982f049c374f5e23b82a96de6dcccb929e287571cdf52f48ef415e649528d0496acf2bb04edd75e662651be1bca5bfb921d79990cea9cd6a474463b8db0ee729cb1a6570664fb516a7d1de312b1407e7626419a01288d05181d3f7a59bb88752078544650422a645071540553fa41ebdde527818301ec26f2d647c932db23b62ce944af6af02c3f1fe9404b670b27eacf42737718dd83e43886a750a27886dcc7ecbdbbddd4c989dfcc27ded54eb92255256ca34a2418e4f417a83930fa7a90fa6909923058c9eb980452e52529c13c76765b2ea03e74d12d7090a965c9c77acc486e5bebe3f30c53780989e00605df3b1d883fa2935f51ec79a7cac74d35414571353f97dc1095181094f28d4c4fb4aa023bffd98ba10c381a37c4e0ef8b8e6dcda565bbade82dedb43a47b4636563ce0ebc95cc8f01ac193b86bf381593084d4208f5dfbd437ddc4c44b1ddb30f93ac27522a040548d697c4dde255291358ecb9a4198b74e92cecc0fa5791a417ec4e3647e607573e34bb9d8455c191d425521bc3f7483aa2e325f8a462579e4418bb24e1f05febab6e8cafc34104b79e18884eabb79d77354a90dd8af9b8095dbcfbd76971932b572c12e0e2cea40139d9953ca48213936b083455f4453b4d2b83173926902c7e0a15561928232bd96c0f81cbf88031f60cc61a49296d68d2761216316276b14b8bd15f43df6921a6006255e5edd87f09e02b48a2729ac700051400a6634aaafca30936444dc70ccfbe7c1871cdb38532aee0c84617f4e140a22fdd827335a0f81a65e106ba6676be6b02d257de38ccda408ca21f60a23df8130bb6acd85f1aa7b88c6a6f706de6dad29f8b7f6990db6a5cd8dc1494cd63922151920cdaefa0714427d869b605e58bbaf94cd1b5e23a48cb6c800cfd9cdc7494a97a8ac30ebabe88dd34dbd356fa39eab81c350c5772de54ef95f1e1382f0834ba750ed9e3f1f64a5785ac1087ad4c2b850493b4170a93c10a24aa89c8e4b4c92d8b806697cc81533cd3c6b5c1862c45080bd3f6498aced964341f3d7584e21aa9c4c8b051d4c76b3527100a2b0e4200e839dd1a157af963a6cd38456796f9f0d729ce003a8f3159ea887256eeccf424cd969968a4637b2877f7dde8c5a261135fc17b9d7a8725e702fed4e33148ab78612bef281ecdbcf080bbf66fb730814be895b5d138440cdb26911ef71d0bd0c549ffc8a1ab3e248268206b2267c9c3601aab65e29c4c4ffefd4a38dbda9cc9d3301a0a1c71401ba8d82f2449faf48e199f0d7419cf29541830300bd78f83006abc859fe19b5a092878ef092c9b3a4b3f1cc3c8bef96385f1664b7d326449db5295476d384f1556cbef6803137022609a3cd34b194180495048a477368275c45264685e69b5f76a59e6a2f845a13436f2a447e371d00a07ff7d42e229118f2234d1f159bbf78aad9a04a6d20b57f8350fff267a10ce8929c4ae2ea45438205dbe83e945783a568856f27b77adbaf7c5b9f379f73c62831668836ea7ff20afddb923580ce6a9e261545729d173f1b84fb72847423eb48236b3a30cd172f1c409ec5847954d69b6a15ddcb9c6a425c339d24898435eed0df16cb70f0cf4d2e74b21cbbcc8f7a55ab1392932408a7da1edd2f875e2e335adaf5d66803fceeba10a1e24c28d2b8357f7b0e59c266b22d9d17fe2e40717b3e8d84c596652496579afac0a5ecc302b33dd89b8ff60903bf34fa0aef09a409049d40238c92cab68f8a093259a6d4fc679ca8e4c64d541f178ceff049e83a7f3550b47aab2b73c1ba4469b1e7d58d07cae268546d26fc66cefb6628af8aa940596e6e25727da46a708098c9d0f76fb745c583751521566d3e06e92eb05f74eee93cb9de8337d0f34a9522d4959ad17d70aca6c13ebaf6a4ed36057cdcd531fd5d4233e05db88e0e9118747cb62e66ecc41e3ec34a5261a0751f378d959a44de2e2578e5529e401eec712a2ca330a467c880b7e5d8860be23e18fbfb6b0d4213f44cd55812477ba6c535906efd2ffe80f67aaec369d469ecd0c9cf20cdac9e31182ef5b30d42a538b3ec63be249af9cac6628fc66ebc0022b5982da85e06ddb832524670b42e613720ebf084aa000aa7b0eee77967ab7316550aa3fc7c9a651bab4d343ba7591444a4eae37d0dddc59a5e662246d531174a4797ae97a9d5e8ce1b766b5e475142c3a83fa8e1b0a2af25277edcd947db813105d5b9f47657cd51eb64486314b58136b370bd6d42ed2bda947f838b2009256d083b62bd628e874993ad57e4bfe444304f149d6a252bb02d3e0e92e70e589840d73f153ceee8ab17cca8164d796bf032e3a1c582e7dcf09f8ca2977763384e7eeb676e0d7bf4ad3ecefb002801cb39a1199ec221fb7f5193e8b21db6bf26ac59cd3ab999ba410241330ca1eeb970751d49621fe1e08157cd0ad3822f72b25673e52fa48bfa4c4ea19153781c30fa370a0b923b2d3791878d4b8d513c3e59c15fdbccab3eec84e6e26265ff3ae8d6f3f9c8b5a06e511e456733262787728b717019882a3ce1796f860ecab3b54175305f1932fc4fdd9625ed4a54617bbfc5eb4716e8ce0079984d0f2ee81235fb8370cc65908b2c2d77ad72098e9b8356a793575c74f324256013d02b44a717475039a44664e9add15150b7e94b3259079f0e2372933612757f388b9c76fee3d589ff892416a42f59b194017200c257232ab03dc1fa0345da344fa3eae56626268f36eda72c272b36f70bf12c45c7f849b93e08f2efe758d42dad9baf169958bade7434182c0f4bf9b00d098080bfc6dbf8ec176e0b5ea5e3d9f6d54190f4e5f3064c1f1f8cb8fc027b3bad1758164d5a385edb9bc2d5c799b790035adaf5786f8502e125c4a0a5e196fc7e492267f665161ad814acf92856452d88435b376a90d95d3cb37a72e427b1e3dfae76314c6d00849f61301562ba0113e6a3a8274707819f8451049c31454a7653afd9eed9d2864093f9e2c6e13589e7a0f4384188240c6e5a86f98917badf287cd5b40d094625c348573b9a3e494e1d49ad8212c886d82e11bdcfc5f208de7ebda8ab2865284d714ef1b0ebd465ac2943381c17629083735c6e0ddf6abfc6ed88a105bd78099bfefa61d9584e3b4290104c7ccc00e18cc2ad202a31fc3036f980577a28ac6a6fb0ed101b5c060a9fe643231aad0dea5290667cbb6a010a8d2717246f169cbb573b99950d53868412905e848c36e42b83611acc27f413cf57facf906af3a38cd0f3826915fb5a185922c4c928064e257db95ca6f64ccecf25e90c43e43c6b4f7b7d29f4cbaffb37c212186994779658d00d8e95ace07caa65867f87617d5e83a53d02c0a4ede472fbf2bbfe58174745f8d232f0c26bc7e195377c037922f7c9ecb7af751831a05a452941ffc971eb6d76abec70cd2b1b053380a42071c9b172b071825acc17a94e5c3a2cd68ef3fd4fc7ff1d7e23caf075df066a6711de261eaeff2e1a070c79dfafb9ef2b1f39f75d6b4048817ca7d2b3e62d315fafdcc04e26c5051b7f8c9c7e9e1d0b55d0a05426ef23e0132e6e5c5fe759bb72c2521a51b64799d78c148bbbc5c7f3ff69b3ae2cb1fe96bbbf7ad7da61305b38efba9ef9ec1b6ee6b330c207b56f4b7041007fef5254bed3a659efa3c235831a8e82c8772694f6c19b7dc9f2cb678460dd0323ef5eaacb0389780e5cb8cdd5b035571189f468c3e09b382e0d96451149b438349d25856db3df71be55838dc5726a841482e3eb48dc391c48a8947c74835d1c4c894569097cfec36a3ed0e9c4d994b64bf263b1180d0b76b454549240b64e2bb6244cba10c78de9bc691f66766e5a4a2268f24e940b78f3fbb1451ae84aede31c0e9a1d261bf3510f74dd883c9911dc32572e185f4007f0791fe48afdc9e2def8a8bbf6bbf2c5a5ede289c39a0251c8e63d6592dc534f18d720b146d3ab937ba67320db44d48b34d222a2bd1102a0bcc89c37629dbda4c9704449e31c789655dffe773f4349aa9a46c5b6b93432751453e411fc05d7af8eeefb0ce42aa951d9efbb1d9759baba52d63c445c761a456c12b593c3b739d5d5adc578dea0c65c8470399277dab010daeb06ca1b491298208f812b6e247cae3a27342c16f1582cf1ebea645558b264af0fa5b68a3fc3f3de14c7573fdfe89f2905b78531aec7398ecd5e01b4565a2c5bbea9a80dcca6def16cf885cd4c362f2ea3d012c33bac08d78ef4f92945efbe5d62830d3a7223c006d2a5559afbcde4b79c0e63202a6f2158cb5fc908ca0bb110b5b25484c2c33d8af05e453d5118465058d2e4fced99097eecfeefe735369b3202b82c61212dadfa4073b308febdca8564be16ae17b227d67e42dc5929e8e32de424e3743f9b97e13d964da25726f7d33a3086b81b3302ebf9cc2cb31aab1f60d459182250b591bc5236737dfcdc44a653daa39f7a94312bea1b4fa989f5a6775df538f01704120838c4a3104256478b5c0cfbe8b86e2912c980b390ea412edddb69d461e50f9f313bc17afdea1d570e8d57fe184729613d02cd06fdce15ff00f72768fc6d20afe3d5cd698b36aa199c923c38a2c94e60073030a864b7fccd8d1bce7523f1efba7cb148dd6cca74f5a1f53a2a1c9155ac0ddc5c165a1a6de0dec3cf777d25d5458838b46507181681db10c250fa41c7abbd61bfdf4267d1ff72899aee6c7b79e782f6a08eeea20734948f753ba05d2cf5a26adc71b242d16fe4c7b148766535f6f9558dc987eabf846acbb348b335fe003942226c2e1dd4b8b228c3242f65a22a47efec836764a807ba501d06a78ea351fea2223d1a6b6470470710f00c1f36c81b103d7b01a279252fb7130401a9b5717ee57c530bbe091d3ffd5b3a70d47c76df8110eeeb267b63275b25bf3629bcd51696614c86882b15e975e2721237ebad019cd77d986357483dd6d596d98121f3722fa187ff5c5300fffb472544bbfce13dde11957deb755aef94933940428d630e3b9da3ea9d0954d01809c2acd32899c0cf5fc510115e01992eff052ee0379a3724b61eececc687f636aae8af00076d46eb029b038789e2d6f06988e9dce90fa9859b575aae0320fee19af5bfd511a23cabba75acb0815525a3734305aafa49c1d8bdfbd853579646a36a7873c4cfff2eabd7e3902eccff1192aca1f6dce3cf1c988e6aca9f2c8e69f689ff5f51aaca7945fb734244d5470758665451e54e06164f9d22c5d40a4fd55589d8d70e2a9ac914959327b522a3936f40a89b5691854b585ac24e847971153aeac37f4cd7f67a9226c1d4d24dbb2241bc3d379346d3285d57b7b932e288a6211d1dbcb03b542a393f9dce3eaef4506a4970bb3de66639c90471ba61ee0d04a2916613babd3a34943065785cdec59a6368f1aab8e8c4fc25f18eb693e454bd39f82b18dee61f461db9e767bf55c55ca7ab1e6a96d655fbfeaf7d323b7e164c41b1db409f3e89cb402c6210c89c6a33b170758f5a37bf95ad8ebbb1eb03c81e744f050f6e3f0030a61884081b1b3aac1b69958d65756875cd2fd8ba052dc0c02c3026e9ee5ff912b9febbb2297aad223ff6dcf96b27c6f8e7f342bf2c44b6bde3f5cf747229faede65f77a376033832b998da37bdb771bb58898845c2f1108436104d13ac157c2ec5bb5650837d6259f2d01becefacff19c94317c25bbb449f9d104e6bfebaf351e282c65dd421c204862cf06d6390a5b0a4c08fc978fbe98c736641c1dc8306f3a756560fda98cddeee10165ddbeb2bfc65724edf8d4b75c76392a5d9e7f61d908e9663fb195afc259529fc229b14e87995f8d3591b125fcce8160908839cbd9522d39eb412e0b38505baf04033b671a4b094cbeaa4f92e297b70d9d241df4d8dee8e64bf59b2aa89da73b15b38484e0a4ff686e8bd6857599823a6bba54663f75c373461405947806dc4adc81b32d416ce9e92f7b6d871d9c8beee49205a974df66eac6e893cf1254a3e541b5f0eba56a6ed8e8c43c1f42677931eff35943e1e47852b2b76e65dc4fa3132c9665447467373c81ac6cd54cc3f50b742778beec4ca2b4f1cabdde40be85dc856d37c2162bec1de17c2531a478a7855c7489a2ffde8b176d69a9c0a46af048348291edf47e3483f27b8ebcb04e36a68d23b4758163db830ddc5a95721c8d60221d994c7428b7779bf3d0fdd90d4b77f07b23c1daa43c01b96af7e4119a042b35867767fff01e00c42a127c877c8dfe6dc6fb0d71665497595ca836e9acfcb1560454c6fe9f112755697dc22364a545ed4a67e2b074cb50d6fa9712621c1dfb6ee158f2d7fd37f337f83956138d3a5456518dc7fe954a31168ce900e4b110106363aa72f4d2396c501f6dc0c1bff53192219544c3907944025ac988d7327df91fd373cebbe6be9a8926428993c27ee68702a8e1682eff9082ac5d33a3680bbc8879da8f96016f86cb54df38f35d7c7b1f3eee275337851d7fc9cd88b01b6363889c083ceceaf437fcf36c55485a97f6401c8e9ded73b2f4dffa421067122df50685245d246af4b505491369fa7f7861d4e3b0cc9ea92f1c8c87e4512e17107be97d577aa8491809cf9ffafb7195c7c3c2dc7e3acfa3a39d6cb8dad56ef0b4fc1bcac91cdf4f073a413c499314632b25f24f1d71e627b78069d44d249066c28083b4a1ca31436950426a29b94db34d8e4c83b8f94dfe13cc6a2564c4fa41e2100985080d06efe854bc6fc2f6844bd506b8c275586af05e8956f1483f1649bbb29583256cc6192a4d96943bd11ff46a961e527c18a7c440bf1781201d4b46f6700ff8216fd98ad743b821bcd38776b444667cf6c06b446377941d15e400ff3a525f2a239ea80a983e0a5e6f8224995d1a78880bd91d366cb9b50d4f1e9f3d305f6e6254829961154773927a695e250a203cbee2ea2763068b6298f5528fc8809f22e7dba21556f565de07050d9ee1655d9b66a47bf093d7f783072f093868d11a6403e18685b2e0a1300339f84a9616d97bc77815e08d870400a227ca02e5cbd91dfc8eb74f3d800252cf3db1cc0cc59cc62a873f5f1bbfbac1b1021d550617e3331b09bcddbf7a902cb33ac08a0b19af62d7f981d5032722af7ceb8a99945d4090a87b1d95007953a6f658aeee5bba193916f563aa0e6643b04b089a365844f91aeb0b63e1c72354a9e2be015ec351e2312fa36e46042526ad6581d494177515bb2be21528de209a1bbd9544440d861334692c2912ad0bd18f137fc11b9c989c5ab227bbd10b192de6d004fc07ff00b2290eb81c74d1c14e3c9d2ae734ae5497dec603de4617b616f06334b30f6268caf7646ed0d537eea59e4ba9d04514510d31b09e05eeca9e5c23be4df0c4fd656088b477cc9ea83bdc9c642504b89738063ab81fb831eb7a076528763c8e9aa07ec345fb9835ec4ffd1d32c509f3ffb18ae125af7f7744f120a0ebd71ed5ffc02b906121bd04cbd40f0bfbb269601463a20e4175e3289bacadbb4d991e01f56e70d74e11c2710d6f1b4d0813ac659df755a9529a6bacb952b99e97e4c47a4452548055f42fe679ca28cba111586c6414ac9aa145a06c668c493110df99a8b413df74bef28dcad88d3e6d0ed4f7dc2f63adc9769f08ce6902675c02b324f40d5a1999d1326385f260651b9683101dc78c621f19d02d3b8c5b1a07b387edc416ce0bd8d6dd397f8fe9a6bd82462c97f436d382d1ff971c95406b1a6c847d819818bc1a141a981f77d3083b1a47d2b27d0907dbe754ccd74d58607d75d25b945cdf3445d41206cf71c4947da6ab8ad62caf0613a3f856d67c4c041816980f6327cc7c425eec0df74764516b6e9ddd6bc7cdd8104d13bd7feac35cd397ff2258c4879bfafad135fdbf5d47eeba4351d9170e86bc2dcc873c5e6672973f2e1bdaf9b79954f0e9054aa2547eecd1c57088e41716fe8b4c3e74a2dd4d4a584d825090047f37875b0546b7f4ff4efc4cc2e0f69393bdaebb698e7ccff5d62886e0244f18548d0850bd59c8e2d1fd8300ce4a142802e3df4091f4b5e47321f8ffbcbdff98203dbbefb6ec9bc9fce0ae081c2c087e6d5766033d0d15c5ce150fe09e83682feb2fe8617765fa4f89dec48c34ef983edb018b2df541631a0e99b7520ede5183be4bd7cd882eab1c7fe10fb69ffc8d1055c996e642f8698a3c94367d9536833ca079d05c72ad76d9e6d0d5ace4baae9be297ce55aa9aedbe5ef0d588baf3c7039aa11a36bc4c252ec6925f968b90c5888a537ca3b78fb85e7f94dc9b067de380b3abfe82ee727ec22811f59d1ce8987e55e5e8f7f1409211a46893e0003d9f5af37fc46991864b3e1334dfe92029f1264c355a7adf13427fd754417c3099c5396205b4122cf2524990e364a11fba9628762c1a54097192511f40309a1efa1bc7092615a5471d5c8ca606cded9f054f2bdcb06facf7c3482f8514a66053c96ba9efc8314c6a6f30af5d8662f62a71e6d784aaa3aa326f2dc00fb8ecf6566c7b8a1cd44e2d1e509859bd496be4476621d67803fc7841df09adc7144a85af4d13109933b570ea285a32cf3830df7f4ccacdc0a1c33bac79a49db5110735e7d2fde36dcbae3e575f3fe39a3bf90e588ca767626e3f1efca7c539e0956d2d856500aca08680bfec5d0f14263b0d995c8c814a6851ba46b8d036295089c296116de3133b4b751a318b926c7c1eb5a913b51f1ed9317ade685bbd140dd64f9713526fbf4501d378ae4f8f94a3ce3966046f4b8cbef8c80c94b223a320625c59147b6c59c692e300ec12d034a331e1f7b723cb3b1e8decf8c53c2f7d901731049c52a288c7e5eddb723d1bf38531f484b43768d501d82ecc8261ab4a65dc15bf313ed8f54ee23930c836397950b5bc378415eaff70c1d6ad54895db4a79852b25da7d84866710e287767f26f0ca47f36ae23196371302bc5c21c0f615f352e06a7f56828147ab6eb06360d7dc2e886a9bacbbda90f0d763c548287f9959af2e39791513d62e577a0fd0d544a796819b930749d794f40ff3a92248e254fafe570b6e15a30579a9a6fe5538d7f390c808d998582793bb10ee60568eb8d975c51d68b4e4da9fb826681447081c30abc024f7d683454da +Digest: 34f6aef9b61b935eedc540a27a2048c787bc3efaf466ec668e9472006b4d6b986e70599d485f4d7209391b89e4b35b62dc56600cc6317f3f688a1da4ed509b44 +Test: Verify +Comment: length 52552 +Message: a592dead5c6e873e441f75b07827b3366df48748ca63ec487a824266ff9a45c1096d3cce47bc72fe7d0cea9bd7aa4ff37ded2ab967bb58a8734eba69b4382eb70da5bec1ffe118d0c01a3e298d667f354008a6df25ef713e0a7f457495941fd6dbc4ce4d2de560fb35cfda2243632c42e1cd6382ad052151689c4a4d4ab501649852d33979d131c906b6244ea0aa3c6486c4ca6aa6084e2bb42d33bd7aa4baaa6fd5354e8aac7580585485754d4299e05876415eb9fde21217bb678ccd6734f086d75b54097e13695633665ef13329017e6a31288eeec44fb9cd4e82ed08557e05dfaf139d4ff3cc25da2dd23586d60e2028038ecce2dc2ac1eb50677f8e079b15769852ef28fdf1f0d14499c142864e68391d591ce212ea579dd5022e023190de227edba710191fdda1117b3c6f230a7c24e95125f54ed9a56c451c9f6bbba6876ec9746c102fa014d1fe404e16948b8471cd3d9023783dd0df087d7dd18c2238dfe2e6e62f27babee971afa03ec116a9a933e60474785f037f86ed6e3d8e4f1bff2ff8be75e9b60371d491daef92f6125382152af1368764d228341ab5a874555519749cea5ddc0af28eaea431ef71e9f72290aaa19bfd1b6254192b44c2d81169092027976c73fcf407cea40dc0d1531d7b1f2b8d8d0851b7736646efc5c475c465c60883fcc500fda7b9858aed5c7a4ef58c55bbf5f12e57eee115c09780a9ed962ce7b6f6183f97d636edb15e5b8611f89ed135bc01d9cc2b5340be2154d66c051b6a3943b5e149fc0f8589fc159fefec1c4703c87d7b9e94836ff14b8824ca195a3c13c9e40d9b810af41aadd4eb6f39cf5e2b03b03b53903b4962fe63ba8e39b3034c72eceb16cdf0e26c5ade9519477fbfb754e1427586417618202ec140cfec68ed2517a4414888f988ec7dc3757ef312aea257b78ce05e9f1b9a32606942ce12fdcaab60a55b9cde7549f69e0c47f5fe19d75bc31e055a6c7455b4c090fa21aa8448f146c86cf23c3b5b944d65084b2bffda358eb55dfd842a38ff083d5fadd78b89317f34e554b9e3089ef8082abe4268932d3fd8500f90452a5a61f8d939421874b332712c88fd733a5bc97e1616eb5dea8bff10465737ce150cf34ad08f9236f1be8805ab56b1f6d814e64e331bcde4c796f5e3a79e22cce05ee5baac7570eae89ba97ac8887d71ca127700e895910812974adbdbacf847739860d1d5b4843e4193bc58ede408eef89aa51d9f4bdeceb3d625804a496248b6028b15b3147539e4ecea258134fb744af7972cbf065d40929baf595d3d08d591e38f10ae5cece3baee5a6bec3efd0ca86f77b5b08eb665982e0fee7a4f91f9ec85934a2f569045a9e335b195cbb7bdfa4c6a40d9ab9045abd66ec70b49a6b9af2ec04a9cc80a669a11a280e6a2d18f28d49a56a42593e9b4ddf46d76f1ee1fc2273e985f7b014f76c1ca5f468df28a1a502f7e78c368589c89c867251012320db834bcde371e06233cd4d61d52c2b7b8075141bd4eb79a4923133d7e6db9fa7828ca3e83c309958bc7e96dd4baeb1deb432626dc8f27b8a5f2fc78ebd28c80ecc12aa7b5e9690394ad31add18d12c4994ad9b53b4b61b99740ac9fd20532cb4fc9797fdb6fe6592834d31d7d93e2b5ab669076434d0da506534b3a9dcf54e38b89e24c5f1e299e2ea6f846409300f70adc73f25c5cd285dc7500d1b3f89ad186498b98a8bedada8e49c7ae835717929cf7acb0ef3f586000ebf3ed7c48ab9c2a519cea1e17a116306669dfaca5cd8f4bfe603862bf483e5a004d156087304c5de83ecb29f02459fc4405612546caf5fe38ba131fa44a27d2fb36d2c77cd0ea095798c231130eabda2dc4ba5402b7cc9deedfc88cb605245023d5ab19f0347d15e7d4579e460514b267ce74a3a03c1d0f69fadf13bc223cbcc25328beab040d69dd1712d852b19d6c3b4a1679ea00ef3eee31e11b804878fe1ed7d11f75e7a3ed848c7c47ffbc4df0f160293da6ac4a11c8ac550bc820defe7f8a2fa21685458923581c5414cb2d26d13a34599de736703d94c34d5d5279a52f94c9b05587fe2501a67a655b8943f623fdbf34975abc439711b34807854ed9751c27b2fb95d3a9679c1fe49a9b99492ed453365cade3721c4aae648d616783984ad20ed056cefd9d6292379aac37053be577c7b387b4e615683b09b990cb8ce147512e9c73f609eb215bc8236223149258b34f65903585c992e39f51b782da983b2c78279353b6990103fdfd65675c7b568f363b71703882f12d8e1e819557054eec56395feeeaee291140ef5e0bc73e0794e4fad26de886ada13fe8930be96fa6182f997fce8e33c20df8c2f5153c229249c26d5a337b1fedc7187798ec7a206e386a109afb8bb1f3808c3ed18fa2701f36365bb2cadb92d92882923640f15eccd57166587ec7ade5f1662b9b80e371d8e4a98b823aee2a9b4be60315103672e876ab63635e2c72bfe8ed51faf1e66ae3da84c6718b9e2e58b8aa90de6331a4eba380ce60a3a147aaed897897e993a668a02dd427c6d1e53bf838023942ca3bfde45871fa560d73ce89a2671970d26c90bf0e7d4df371986992f620cdb4e98145c29b12d77e5a3f5243a0e7298e8b0382be8d898b1865900d0e4eb443c176bcecc4b17a9f236ff35fa4ecc06f4ca6b4672514bf883f95124df5a7844271593519730371fb4d34d71c33ecba92b10bc7677d0ae8ed6fe96951ce685a73cd7a34f555f7bf93059132b278099c3bc6a384a94dd7cc61b149dc4221fbfc7edcc100a8f4f62b0e526e4e48fbab3011925432561de2338d0c9db24877c7320aa717e359d8697e143db37107453b3cbd1d071b957695e51888cd348a5634c6bf3462233187b6804fcd48e417dd1f89e66fa5858fde57a9ab2dc1aa3149aa7e478d8c09578b47f9640a15ef9f4bc1df359114b96cdf9149ee04625c64d5912447ba7bddf36c82b1fefc03d9c7188806528a3eff5301a98b881496914c84517e6ac119e72fb0d170c3acf8ecb9cbdbc5e462099e6ccb08382265469211dd525555ac4c6e31e19bfd5b21dd6e9aec24e593215fe0e0c5161863005ba8da68fd70b383febc218647216f639ba89503ca2f09d0270bd7773bf2f4ecbb19cfaeb8992a4c161728283fa4a77b18e2cf993568eb774968786ae08f7c31502d1a36ec9662117cc86e4eea4eaa703e647335cc5be41cac3fec256bb8a4d8002ee088023005d918171a80b0e6214af475a760f9cf9ac93ad85b30463314e8b5624c2d602fb8add24b5447f936b312215e93a1248bb585da7aec14d7c87369561383ac705b259492ae46292d0409cfaf686180b358de59746fc75888416a64cb87b08d997cf496408615b0b419ca8985d836850ffebd4bf1fd1584c065a0dffc06f9594259cdbbc41cec64f73d9f488bf93d39a045f966376dfe21e6fbbee5d1da8697d5bb560c06b8f1cc5c373015a9129b23cef53aaf2f07a9b664cc6b7b324a80cfb96a3a90eea24c704cd124f7c76a7bcc02d52a30c1123fcba1a050ab079d0f8a562e1f4f652126d830d124f7cd4a03baa2ae6ff0d6d8e7e8053e147c381c5a4e14cfae52517ea78d6e00d71ca3fa5b771848b1f7549fca96f87060f7ad0f8aa65b148ea09c02f6167026e66e32c2ac8bca6b994e25b00f5ce2fcdc224ebec61793c667412cf23cfb9c0bf8f560ea1e7c22dfcefc2f53dfc32bab2f070470372b24ade33eeb99a0c55c76b6ba16b9d8d4866bf9095ccf62523b4502aeb56e05697691a89ebf3e4bfb1731c7c43d78031a60d9c27e926ebf917b92fc1d4a015759f13a5e69922864253402d51bbb70c6d717efd062bb761f08515ac65eac6f5584fe70aea84ba014cb1db285c87ae64a921376ccbdbe30a94026640779c100297103fa4062d2ee8376390981d26025b6d3bc355d9783e486c06379687473fef8a86aa1bb9f0f5ad8adf0ce7141577433237af62cf9f2dadd106e619159a9afedb2992dc767ea2c3cf9aacbfc1e461ae908b57fe1eaf359d7b9b1e429304b5d2d16fa660dc34babd6e1cfc6cb701460ff0cd59923736eaa9c4292c9d9ff404ee35cf31335ba1a20cfedc788863fab8e9eb7420c9a9b4b1653337bda48d072ca350deefee7553fd34ea5fbd9d493f2eced9064a0ef6a72e32515d3dd1eaac81b4bb052edca9ba20c7c92d1805d75d1c1151fa41dcae8cb59396e029b05962a884ecd87a986942b13803bb247caec30573dec684ad21e3fc2b8c970dca39a805866edf5fac448c32f832807f4c301f7f48e8019f0b013b464c9ab8568a0c1b2d4ba9704a72cc050aaade23650efbb0ee1306220d70ccf1389959ea906a510a94473531c7a6503bbca25f0a923f7225e664a1ae3c78c5b4577432944805a914bf0b8a9a5391819edd814dac635823ecdca0431cc88dbbe3176fcd5be9c664b811fb22207adec0bcd1ba129f74d39184457872e42e19f00bed0e8287f237246341a8945aa9e8ae042ddf564a335c4b7ac53fb99ac9c812ad6cb2eacefdc258b4a2a649af6d499a03664371331b3ca23eb0788fb747f284360b1f7e976912821ad956baa5416c25390fa90bf0b90f365ebbb54da01533d5343c86a667d08221043a3c8fc2a2dad0238e528ef9893e98492b78ac1bbdf67636959b0ab6a0abc61f69ea019e1e201b5156d262b40865188ca4250350aed4f79b9abf040a75f9e1baccc1e87e2fb667211dcb3fb6b2fd67a7aa5cec056439ca01b0853ae9acf6f464f7767d0944086431378f6e881581e618a292ee907aaf7dd77b6017cad22d7ebc6e5a67b5e7b062f048b1879eac7d145e113953885ea083ab5fe2132471f8010f95e0111aa72913eca5b40370f45982e69ae2d3639cb76bebe28db58cf900fc0d02ca019dfeecd794e3197a856991b2509411e6a8915ea71787c5977af3b2f003396ac1b64b762e778544556288d0131a913905dde8f0b5ccc42c0164ee886da0ae34da0a395f991310e71c9eee7f25b316daa95a1038286a2c13bbe1461bc553d5caa2f03503a7d5fa543870e7098aa8a97949c3837f6f8e342eff6696d7a79b449ec50ecafccb5eb62e41af2f098269ad977fa0df310b8750d0746b5d3684f58f23a8bc67c5841be8d7c0a002f9dd74a7b7b35860178d0426aa936605c2dde0f9ebd69fa7d8527bf6e32dda2f44dc683c4c7d70d28d54731a1fe4fd2d0712fc2969d71ee7bfc71d54c2f1d3f0850fa2bfe8468092fcf2629f92d1874f7de485a23012c0b3d6427ea719b513e344f7b2b6fd96ee2df0f7414bb5e1aac981a33bd8b1120b98d664fe5239d02093ef2526c5fef73ff003d39d930bbdbe37dcdf8d516f7d76131aaf3adab5db707eee086d518edfeca5a017e609d69e5826ca09d880ed8d969f2d71a2c5104f8a00ec21f4de1fc98aab4014a914d93c0ef2e3a2cc0b9dfac3b9895cd495cba4e3c643f26be0144c707d7e8a554875ff2948b45ac646131da3deb8e13ec16a63f43ba00a20fc1ec164a8c5c979192f505d84a66265c4cf9ebd9b367f4fdc5f1551dd6ac9b28691d0ad999052930b77e81223547a190c25d6576b7cb7865b2c2183380ec19f141fe2d1dc68d62193e22ecdc129025e80d85d27bc060a80a25420feb8268255290b8067edd994b346f08d06daae9bb4c749ab95296ce8bd56599c2aea3c7c633a0721d65a4d4ea6a9159b43dc5f869a43ec4a36201be29aebceeb9e5aab2057cb755fb38e5e349a1ee3c21b42b6839d8b42a1713c9d88b7e70697df660d0e8151e892760667170c2ccda9e3aa3df33d01ef59dcdb5c3b82bca34954b8dca7ae61d352946f02465b6745bb337f6055e74c44cbdf88e28b89f1274894af947c0d7fb818a514aa432632ee6e813ec84c2aded5800fc1cae94c09054e25d6bf0c4d10296d1e83e9adfb342a3c6364d016761e241ed4227fe53788cfa27ebac6d8dba789c867592ae728df7bbd408e1275679ec2e0d3077bffdae4d8ee05c8565237ca6ba325f0f87f5d896569af2709b96de5147e62fd39a9b4a1c399517bb808ffdd4195c0e7dce6f7e679ba15ac1082f7659b602a8053734334122cf861967d8274ae18ceaa42ae966b2b370a99d142a2b4ea0e901d33dd0530473151066c206e04f394a5b4b446a78bfc69048cc678ee4763021a406557791ac51f01d693822122c491fc93cc3fa9cd5fb879d16aa63891b8b34f7662632d583e6e715eb7232a42a3a929c3d50a1ba3e7adf124385b10183dcaa64ba590807cf5a8261b418417e8f342c3c179368ba406c1f0e1a9f8136f6490951cc950210d9d549678cd15488a35e73119233568424f9d0f964a1da0fbefadb28628327d6e97ec5903b4575aab0e1f18475d974013248793ae932c5742218a75045ca7f42477d7d44881dabccfce52efb8a2cc917b182a23b71fb494d69cbf6313d13123c3afbf9ec3d01ffd6d091b1df97d55dafebced463c4a46e82dc3a4f331106e9ad0b20c2ee209877b0740d0299657b38b22655951aa9d43cfcc38e3abe8b4a0b7b03135fb4fa8b1e423082a98fbcc76306ab3e70c8ea33bca166ee3f3a7188809068fd58a49281f9754c182e2b6361e595c2b2ead54d6af55a0c83e70f8c6751d282053628b223122f0ff61ad424f0c645b2d98daa9b21ef10fe75b9a5a490852b9b5480a720197059c345f5f1c51c0e00c5dae0ad9bffb3a985eb3e6581aa2482f911be89a50a1bdcae2c45ec0f8fc6ad41de6b4717ad480fe70dfcb5ea5e37bee5657935099f1c9e18d4942ccaeef6346f0cb7e0d5d3b6286c047dfea854c4c9a7783715147f7a894b646919bee4a47d978d4be19f1806de5ef849a98433d68a877183908e523d848e054d1bb217da6f0188afb03b243f170310e61c43a472e9cd78e20e3ec26e7628dfc79a702f9ff4f4266cb771a069bda575dec1b04ea2cec0b7def7ed75134962195ffebed5fcf3ba8f095d0b348db78a4fb9ff92da6d21a953feb4631337e484dc9daf65b1f75599ea0e09cf87b2edfac5fd3db0efdccad077caab6845df2fd64f0a162d6a9b00da5f04258742e0473fff34e5d336f5b27d49cb45c4b315129f9b2d99dda8edddc4187218f90c1fada026e55ec356c2bff8f188ea3e04e07529e78ea13f15f7d4a13ae04aee8e78076462991048f84bda88988a03a0e04940ba5cb6971957c0ceb7f0d6232d70f23dd4dad7632ac497ec776657f6b0f1565b9b222ce1341650b15060dd0b8059963738b727bf3061aedb0b82792d37dc11ae146078e958fbb067b2b27c6aadf16bded820118c247898918d15780efc4c82226c3e23154cade7d6250f3ca87de17918fb3e1e32ccb05df44446da03c9e7b09dede5b4cfdad5fde8f39fa42db8d1c8ceea39d519f0b206ee7a3e29736455a308dd7db37ec81bfb8362893c61266861e9ee38bfa95a269b667524ecc6963f634c852da989df26e891bcf68cad8e4f4b4f4d63624bd1b222437f21ac63274df94f2d1e1d5ae79fccf9470d1d77ba2e8eea4fe348651c01a56fde5df0b4df266cfb1d789758a82dafa34cf7762870ac33a03ee0f96104b92bd1daff40208673c4379c629febea799a7712db1f297971405b6081fca55183bd51bd30240fe3db09eaf304be7b742b945de3e2a1e19d26c002ffefd89bcb0662d7cd1725e9bf0744fe6b877b700feaa63d053383b7a373b87d615218a939eb224b54ddca17e29e7d5a4a135f33835ed7ffc1f84d1555ff32b4ced1413965d9059598a99cff1449bae6d8cff12a98302f8b5f5688627973358f9094ddb21579149ee2a4220a1db0058a5fe4b9be1508b6c92777bb05d876caf6eec4737c1273564c79f5e4a0c47a652e257a3f57c48d75a261836e683ab1f8d12f898cff246ed488a7c66a2ad250e3ba73b70c5e6b6873fc54a129f267cbc7089c0aafa21212943bb23c3d0e10d9851691c6a739d341b8c149fa750b266d3f837d7064d0a608a04be381e4b643be552bc7cd9852c4be4dd788b6d91b403f692a1ae234eea6f800a282bde78836a65bdf5df56810068a392859fcde8a7ee84ce6ba89a565db89ba26d717cfeeb03a9e1b9a659eda604b849a04f40ac1a611f09da68d419d0d64d8c129b8224f782226c8c846c21a9baa3717d0c8e82680615e38271590fe0431615ac2c86b135705fbcc2dbf5c377f4e5986079dfd22d6819da0834919f187975ed8e86e2fa1158b261111f9f599d4e0f2ceef9ed31e6e18b5bb025264dc603ed625e4d2f8637a5dae7dbe1b14a862070bd9d0f0f18011cfaf73ee58f92855cfd128fe1d4dc04d239bfa7b4e42ccf16caa8ef4bedfb1874e92af8d82613e2ff258c97d77b7205884f56f8fba066d48b6dad5a22e261a983c665729f92384b54e71f0ab07bdeb6129c5c34386e8f3308ea09621684d220c42345208e5c764b18c2785cef6e78a31ba13e0dfdb70c6719c06b9ba95dc30aa07038a726dd545e9537f702f6bbd6390dee5adabe0274ed3871327b5dd5bae3b34dbe6b1b9d68f274c8399168fc8df463d4512eebe94f31ef8cfc65a6753038770c44e0cf252a9311f3ae9ca8a8f661a803af7f29c401e1996437ff05c4c975664c7aaca40cffdcf73ac4695839a61d54fcc44fda3b1358d0a763bc1e3ccd270b7ebe234cad7f2cbf0e299bda272363f5104e158fa71a242fb70e013255d1c9d1239df92b9f1f0ec3fe3cb8b119e4f202fe9b74bcb08cb00123a572f4a86dda41db7872c34a65ff908b7c247f5a612409184ac1d3bfc1a8ff7db895d79d07d4e7f6fc349647ca8bbf26768397913e9671ddba91874d7f5b6515b5de5dac16463e1697c3271fd31faa6faa4a9c26c3b5c7ef997829e20c63ec8c3ba0e96e3faabeaac983082b1637dcc785ddefb3970e85ae35ca4e060f4f0051a8a21d5bea8ed43400189bf1fa60e0bea7d214a03f0d35aa3e2c6631ee792b068b466bed8d4f3932d9d8551cf63730b57ebbad75022e5253f0f304fe207ec71b620257abbe883837b566e6049007575c78ff1cbab70e564c2cd29cb35bcc8ee0bb6a630ef4a66bb33128a1316e7dcf142510d4e99419dbe3103faff9d6eecd26f5e3009fa6464e25dbb2393bd7e7026d1195887a4fed3dc9699ec14a48521c3ea000d2d669c44a0ff387f08c62ff9bd7bcf189f530d5065f8764532d2692f69858483c3bb5cd09f2371e699ba613e5d495b96be2ed7dc0260844d80ae82de6e47d2dbf47f0bce84d04ea26e1f7b08af41a51a0abec43e5bd5aa4e27c039f67739d25de7 +Digest: 97582f6cd880f8797849e7fe97f7248160bcf29cc98d2cf0219ab3610e0877843965288760b1bc6139f7e690f60e465f48d3a6e55a1bc51e3600aa65a14ad0d4 +Test: Verify +Comment: length 53136 +Message: 0521b202f798a755abb5e328e14bbffe5d1bc4ce8dec6eb46bde31e7a5fbbaebfb0f7708e9b959fa87c3d9eaadaf399d5a920cec5726f874171abb8ee2ac6c82337a03f75e951cae75d8f8706d78c5457ddb1fe7c7aed6763a32f26db7d6f4d5720b5fb99c5477d93f9c49a269cdeb5e8c9e05a925ad90249ccdde6d6ba1db4e836a9234eb1df3e3abb9d369e8d734505082c718b94aafe5049488744834a8532d3ea4529518163582d49eab34bd278491306c1ecaaeba203c2ef76b94b8e34e372f9ef9e16f6b358b98b35293a84d601750fca2a100393f0a45333b985415a66ae787131647774c90aa19444ec02c4da989808b8769b5a9377e45ca9c31c5c38e0b67877dcbc4e257b5d86bac2c4eb41183fec3c211b5c68b833402e8767b0d6b46473d5e20d960aa5ff9adf7153bfb15e781319a1fc1fecdfc08cac34cbfecc83d2e1d01713e2c4f5083f475a2798c7e5d0ebd59bb61b9c790ca0977db1ac86e9b240fade47cb00e317e2770fc92cd138caf4f450f1e5f3fe881a94a4a1309260631fbaba11a53b1aaf32e2e4a0e289e1d6bcfa8407f58feac359185c23317b6265ec944d1a07cfe62e9f1f8b57304e5b74b25c8790d0ccc83eea96f6a005ae6a5b261bd9c9695bf02685715654bc8b203553aeee04ee47015b5d9526b043b802836ab61298505ba31784acf811ddecba993f4619dcc46b40b910974ecc7204a5af09077a1f534b89822b26c3272adf8500d3c6bd90f9b5e0d8b211f16d0720ee0eaf6462b6c8a80df6d75359fd19d03a0cafb52bc9d4c37c2aa099911a79a92652cc717f0746fdcad627c72f1c216b243d2175f6d00bf07d3f6aa2a04d4fe9f8fbce93218944b92aa07af6b4fcd80cfde2d7ada15c05e96e777ea1c17df08fc06a446dfca55866b7f66f667e27b43201ce40a0bdb6390aba736b2b574511f7373ecc4662e3d882fd4873ab0d153c76ea2fdb139e873bc10bb3aeb3f40b2aaca7e9a4d0e6dd6b9a65070618c45de75801b8355ae63784c8bca8b7b00a68813caceb8c821afa882979c2b554466a2b3202d7be0b075f8a7e57c324c41cc5dc13b0c4d1ce51b3949cc60c0fc1f5b29ea1480ef3988467d35e67b364449dab81ce5df6233a3da14770b433540674dfb8325bde6487efd8e5e556c9f4d62f9228c8ff0fef4a213be751ded940862639ee41b8c69f5d9c3b48afbfa764ed251227903e729472cefc0aaca07e53b5ac69c77be947f28e3bf7521a1cbc22ee209404b076beb148796a37dd9392ec3959d7da3d67e30c9e21a5c8b0d878bd7da49046a64244d43fc2fef58142a79875c11c7cf2af184c01ffbee3008d7d930023bf73fe2bb56bdd3e32aa24183cd6ff64a0465839684f5e28bb5795963b521a104a03048d80f6854d9dec229eb3363ad6fbbcca915375173f138cccad2269201cf87a660227e2dc73a9222940bb14bc7a9756c6415a6ba1956ff9221cc356b68c2350af042adf5732dcf294a8b520f8d1fb9ad7c3ed7191de2933427fbe9941f0531c2c1dfa4a6a1db1c3f12121b9847fa0ff7b83ad457c7bc7b18a4044af66ec103389ba26a29996b01ccb54816cc3d61ffb2e1aea55a5f0d3fa8609260779c1e34d245330667a3060638fcd64a94b67d1246bf45500c2dfc684b224b3400f3434bfa8939834707d4b4ecac64bfd9fc75cf1b1aa5df5479b27d68b3d7cd7ab959d0172d5de6b00cfc924e90997e815572bf99ba7659198a570669dcdf33cb37874c90fa46398cfba729c76f1e8e750a9c68296761c745a9128bb5630b6fddb5f646cfb89c84c21cfcffc0109af79e621a5431e80d30bf1e0b95b4100288967bcd463b2f09cd3ab7249e9f3cb6c2e3a7150b1b06249c6f316babcead6d86e0d035d43c26331edc14468ecdbb1af62b1fb4134d894b143d2a5a566b00f372a2fe56793a67c27e907b8b55b3556d9b601420f631392c9e1150ff1df3d33d53c44b57bc9db85ff63e331b7db8d258ba69cc803c2ddd6f45d3ec8388ceecf2312d006126cee2b28cce851d8e43f982592e90fd6bab3fbc0e6b460d1f6413bb14c7649b3e33ad624a28b9b90ebe93948397a7bf0d1225b903c1a6c66b1e12400579c12e8c35e01838341719879068353d8c5beda9ca58112bbe54d6f362b0280b2b5d41983c457b5ddbe6628021400e91f5f2b0c83ba06a8e4897643f99b41c2fc582fdebb1a234c10370bf82d9e3c686bab52ff1cdc46d3548b998d82ce7c37830768a0cfac0ea6c95fb561420190624c3ec93ace88ec127a7009b458111c6ee52810f83816746677ad04fbe5ea97674f8df0381f4c40e6c4bb5950e02facc9914edb4d9ad5eefb99837d308fb5cbd7d42d5a8f9592ffe0d1e1fadbc16697e825e00a395e56f8e6ad9770a7b5ffa84488718a99b7f97371107880cd6242784b01904013f9360cb8324da1b9ef24b72dbb1ee2ff0cec46180ed36dae496fd852b2b3ff95f1efa4d0a60a62ef91d163040a6a0627faf7d2563ba723e6fd3b029fc7efab07eee05bd0a77246d154625657f507569d0888b2bc1558460fe430b192af97c51236b49c288509cfe79d73eba9e95b76d6bc2b71aa2a6b469194ed5fdbd830f02d7fd8e058ed35609ad362ad7a75fac95d9c6c79a0e954a81485cd57cbe06f9eb210c9b2e23e899b73acdb163a1959e0aa1fb83550e0a8dcf14d5d43f34698336890039e45077af2fa7029a07951fd3f34bc8b5f0a9edc67c04219aee2794f508974130cf1c68de9a7c3faf6a8ae594795f972316e8263eafa1a8ef309f6e978cd43748988fa36f2042ebb63588ce28c466cf966dd19d3a9171d39bada5e1b0e7c74a48e7b111aae8806d780f98c4d9fbe8d7d69d6f3b054afe08650e40d58a44f9e3fa638b98d61bbe2fbda1c0afed476b19ab4fc7e6e601d0b017fb79306bc9f06824b524213ce085984c920a75adcf79fcdd2be38724df6d34771b57db9c9e36438f85849525605b10ef8b7eff61bc99e833d8ca07080b5ffa4e17e2be65ec53da037ab4dad7c3cbff6c3423355135544577ff844cdaad2e6c639622c10ddbcd97483cbbda9b305acd8c3401ffc463307c6f471a40e2ef60f1804120cdde922ee12574a17bb8cf92e317342046046db7f3e45993ca67f77ff06bc0e3c81e3afd1f63ca6fa778c9faa7d5db89f0577c71139ddcf7d1b3ed13d3edba739c16fac3bbcae52c4521461a828ed243e706b8e54464794e3f0cfaa201ced8d92f0efb071c226ee03dfc6d7bdd09c0561158489befffd8a1fbbb46b6e2d6c11c6b4e6451aa330c93775167a41e0f4ecb5897551b7a37a0f7ed07f8d6decd1d44361d5e2acdc5684eda685c1daf6824a9a30906ee4fd47959fd3a388b5d7a965a7ac51118ed9f29185088736ff6dce9f8d9f8849bd49e0dce139b305bc7a6d2641e8ca4a5728af8fac1fad4215d3345c0e4aaf6aa735d015e177105d18419796d0abb4059c44e7dfb1307a8bb4a34e20aab6885a393d80011f105e272fc9b347a26990cbb4bb35f232ff517c627a865dd1679590f9bd8b0f0899fedc898f4ab955a7031537081477afd0c48c95b5779420d279976f525b902c7864e5abeeb85c58e86d6a9997fdc096596644c4e09c44078b86e5e0887c45094042eb0d74a6a13aa2524463076c7d750d992d76886eedf3f75ff513cc679e0d65fb5534cd70485969343b19b2eafeca41efbf31195a0274ba675d6f9a97fbc77e00aca835bf8263a185a72446f3d514badc627b10082218293f776a7f97fec5dcf569de69df1fb7efe91129101190d2bce1cfcb08d3bd4cd83aeb7ae7e20767274c055dc67950e4b8b1118ecabea282ec925f97605744915c0c12477000b649c167179cc7f8c668709020cbc3658ab3be508a66b2fd486409059426847e7bec5ff909120ae7f0b1cbe8c77686b0d9d396cee8bf8d50495373c9e9bea1a5d8ad47546253fbc1606f0f3d5df5a0fae0612a4fe3183bdab7ee30bb7b6664315d2b1c1bbbe9171f85eedef08cff9ede6efadd6611f76b072472b47cd1b4288b69d442b16e37e95ce1bfafc4bccadcc5a5ff2493edd377601faf6360753e8b2e9f475fa801d6eef3f46fe60c660de73b55ec947bef430d7ff9e2e228ee5be8955de2c7820f3c948f4e5e364a312f4ab9df41a1609ebc79b143cba5189592ed4a36351eb1fedf76894039050076a573cba2acdff464a6689e9db820c21389e5d7a8bcc9ca4936017c8a5ed6c1cf170eeb607ca4a9e9a746b26836e9a7e0878ea835f85d3d86e6d1d38d5e2ff0a2ea5893693f93f38615907733c6645c754234465e664d8e20584418b9a5753f9aa5fd4e5d743263d2a7c25760f525325a10733c92852f2ebe00f4c6afd34ae10eb079868da8e46d47a478fda031a0dbf798c7e572e356a1b8874077c046159777b039d6aa5c4e826db210c4521a6bbbe631aefb6fff78899841d376ab9c69c57e2bdab913ecb545ad472636070dea549e8194c8fa37e948e5c70a7db244cbed8a69b8a85af8dd299eea35dd2f8ab12898ef15e8923b4d62199d71e784cd90921510701ef00f0aa0baf1ac243c1f34ca5e00aed4d867f967bc2b963e93956c35b6b68da7737de23d7a1405a5dd4a099c663cdc182d4c91bc35f7d3fd5f3ac35ad7a26dbc45e3e86264c7decc538984214a1a0a1d11679ae22f98d7ae483c1a74008a9cd7f7cf71b1f373a4226f5c58eb621ec56e2537797c01750dcbff07f613b9c58774f9af32aebeadd2226140dc7d56b1aa95c93ab1ec4412e2d0e42cdaac7bf9da3ddbf19fbb1edd0556d9c5a339808905fe8defd8b57ff8f34788192cc0cf7df17d1f351d69ac979a3a495931c287fb8432d3d5525a0dadbbaa6b6b80d31cf879cd23e8302ce0542d37307a0c8ac58f91cd4b79b35c8597a8740e926b65fccfbfa88a997c8742992af81fb69804d1cbab18455b703f605d563ed20c40ebd78a4f99c3b7670b4bdd0fd7778d58b335265cbe61e91d75364521655657a5f745aea61b6fd0642b74a6686fc87ce3385826132a11a11f907005a6721bf30efabfa36f97df53085a558bb12b92f3cbe6c3416ae5e5120b03961561ff937ce088be1ee8a9a2ddd83a66d3769567805750ff1ec07c5cca446110dac0684d33cf03c967cdcb4adf382e01342527a6a12a097404b047d928601b88ec6e46b9d62efe5a146b7747b5ccb7ed14496cd0e4b872baa9b6f2fabaf2a566c0a81559d294fae8bb6e382a1fea6a62fa5fdf96b9871f4b6440e82200608122de2a5ebda7756c0db32278527c35a81b6cd4fa389e2a819ecaeaa1ff872e5155bb517d55c364e4319244d2613913136ed255475710f72c3d4410aad3bdd07877deaa0ba2b4c7d5ecef31b0c6f5271ed5d13d4172a09181af766f8d5f12eb78f1ceb084350a32c3a81075adf43ed63d08c009631bcb6e145dc833a3f234d3d55bf1f1717d221a2ffbac8d149954a4f040455636a3000176d0b029992d921e102eeee94dfb9b029d4019e4af06f517db44d78036a8dce00b90d49dd771994ebbe32c049420d3707e1dff18b7cd8ea3406edd33edadb07e65269c2ce95ed8da2b011fdfce9d79d854fdb295e96d9fdbe226eccdc6223950f5fa7d333955cf55001150d767b1fcceb467eae89e67872613158cda4a96c5fc40950e6d61e6eb23bd8c6597fa1ebab81ed4ee8d413bf31665b313d5f58be4d4c78eb627dd92cadab5eab47df0345228e6dd54009c6b62215c78384d5162147f1d300aff16d9dceeabb4c405d4834195cee9b1ceea6642eb59ed50ace8c9e35f9431735fa83cafe3f1631adc218c178319727e54d5cd13b9007b03612623cffadefb95b5fc3b923f197e3f4d61df22756900104ec8f0532ec2b9b72683f048e55006d8bead474264968e97f61fcd10f1302b1df93e809fc12321e269acbfcc8399dbc2d615f03f08faecbb42b606616af15bfe00c0ee47f4a43c1b86eaf2e96a0ef2da78d0b6c680b9412fdfbefb82574f0b46e1eab9ea5db860d91ad93a2e1d41d48623681b975043f45c19b51cf25a8bc18f0906440550f2489191f1e5f8f1b5095c62469f201c4daec67d12fb3fc94a071d02be3d0772c45beb88bf96d89beb09d3c1e6a1df3918b8f5966316d9480c54975b7d059f27b1032d7baccd4b80464e72aee2c4433b47ab7fe22fe03d3b4522747fcd2e0b044ae6fdc753e9c033795fbf95a586ea875d1ebbecc3f80a3777094aec1926f98cf47fd3182f7ce519d6a62122b96a43c1bb5b4012e9be9eb13471712d0b80d926302623ca9a0728c800ca3db288dedd6f050992f0ebb4893cefe38dbefebc38649072867b4e18e9b26a246be1be6515e3aca22b03546a482f1be7f71e7d3985cca7fd61969612c66d855d422ca48d8bd424bd7ed6be506a2c3ae753d7f1994fc2c92f5b992c953d5dd4dd46fff5c8bd950fa414c774075da8ef7a1a58165bf4fb7670cb1f5c00cd07fb1ce0c80ca719babffe73623fef91298c08b12b35e223bb527a3685bef5e3f04a94a63153992eb9d83511435c89a322b32bceddfadc4a96cf943468bfd510ab55fd1db8851f7b26cae084c764561238d75bb9ccbfaad82250672b34f93ed19daf8eadca0bba7d661a79348ae1e55cb06b0108940ece6ac2875bb176d593b54bb9f1ece241faa41c4977a6ea5fa7f13e00b441a052b7611bd6fa3daaef642a49f7af41add2409d9dda546282282e5e361afdeb9e46065982c1cb464da130aefd0b1f4269373cb88f3fa7eddef5e9124d3c466cda333bc28bca3751eb9579c1f946da65b0db4f83550bdaaf4d2358bbc7c7165be0b4b82abb72d6e6e126bff1a34d69321158e99c83a1753d794afd995a5df62f3e451bf0863e128bdaff63bcaf71342e171a9b528fa3000edfd7585969536e5d6f6ec7b2709e82a7456a15915274d3b01eaae543fd82f399ed42f97a6969d76ce08c5bff0f069fcf9d01460e50aab07eb48457ef41b3c8652e38515afee3c9e43e483924b628d27b6e5f65821ea562d0553153c2f0d817071f01d0998e63ce49d50cffd20a57c32115cf04ab10d7535b9d3c795d8f4237e63c4a27a49c6c5d14515510757025da574ffa93d7dbc31a86e8f0292d8194d399127ba71a9d6feeca1fbb0b8d8c158094694ca396c3eb20d8b506f3a15c4252761e00df5a25e10bd1ac995188b2a97e5efe4fa4668dd1fec7adeb695783dd3d23cb9440e1ba523cc1949a73058853fc1d7b7e26d59dfa0cea2017eabe9cb80c28b7807c4fdf45da204418f0728197b2566d529b5258d5f396b816f8551b7547db4e6fd202e93e9c6447af4a5e12f719a04057827b52f81b83d25322a964a768d21cbcf2997caedc042bc7f136d0f49a7191077c9f10d31d080b66fa2a2c90f7a38ef25e820e1921965ced858b2012cd50dbfcda5c16e950b9cfdcdf65b7f46ca6319a563b21fff58147aa67c9a4d42ab48d823c30e9cd5f0fabff52dabb344070913faa433cd5d05b98691880c3ab2b132232029bedd1a0700c78f4f79ac30b891a3cab38d33d3a8bbbb4383ef11a56f336a6de1bb7a8cd917dc4265acb333666592be96a6998aca82e161752d1b426eb473b1f3ebbb52eda7c5b6752e107598eca77d576847a9f276c09667ad9db2351b07956538e795cb194b948ae60b1dd68eacb0feb98459a9ff1f875f57e21c4cd2eec14189487cfcd33684a9bcec54a9b367fe91839ac27685c8df681331a93c3ff0dc8fc52430073f4e2ddc98fa4197c3a2101aadcf0be170814487c9d1808cccd58e55d6c4d874c45a382a627e0d2a26238da01f6c5d7228135fc6610bcbc4e064819da3709dccc9244c9c02c0dfea45b31e2cc1b8dfb21546d72cc327af6de2665a6e146fa796b87212386108e05e86196bc57bfdba289fe154c1d86d560e3ca4c4d1110b1d5af80d3208659e370e521f1b733581155d2fae808e8624e82f55e365cc828a27a1f1bd5314f7c90e82128bd63ed78e19d72b73009ab6968c5895eee56a4f35eff10b491d6200d38a432c26462f496aed20fdf97fee51096b12648cedb061549ad5ae7b3afd6602d5d80ab8114d735dbbc00b08a3903dc6ade42a8425a89e2f53d242194fea139f17c91209dfa13db1a83dbf68148a641579574f9f3459ef0d40722fec0732edf1779faee0593190acde2180e07be4ac3df7f23ba5c3cb3c38893cddbc07dede421ee145062607529885f3b53980a4ff88513d575e79076ef657b8b551faf6cdd834173e44ef2b6dbbc43cc83bcad4443cacc00991ff146b90d26f1d728680a1fde0c903605ca3c75ec48320ae027b63a23304ba08fcfa1d4e21e87ee9538644f64a80fb2214794ac8ad50255acfa243020b90d38919c26b776dab417c0a0f9d0e9bc38e54c0b5dd43a62c3f07da50cea45fecbaddfe733c55dd41ccf45324948cfb1b24bc075d6715d79dd67ccb8debcf55a1d9cc52157a2e9a318918d5cc11b7910f2524927bd287692d5282496182cd1536971dbdb10c4bcb03deb2390ffcd98627f952091605e184641be1fcd57ce4c8335b9ae94ddaf49940358826f53d3801eb090e1237e86b4fc999618df0bf5d96218f097bf4cc702c6ff5644587bd1c2be4bb2258e5636df3e435c9a4bb3480a6869a331eabca09ab18860c3ecc62cf2c99785481285e2e983d55e3e83cc39421ede4e0787cbc053ec45048b8cc15982b92a96e3608c1f7645d6375027d55e32edbd5d7316e8aad0ff9bbe25c90bfbe5058b4361e8e741082cbc5489986d0b3f6dad5e2f2891c4943422fa0d11f468ac5720375e2c15fc1180fe524565d1e4da1714cc763d65a210524144cbf829444af68fcf229aa6b524fb229d1e10c25f95629a24f2b5c2d7c7b29d2acd0bf8f3439c309779c4f7e0a4e3bfb16e19bcffe3d883f42f2247ba4cdd8d189aae021a1880a91cae3ba81323e32c2bcff1002a67f188b6862342edf24b979aaf5ec31d5c7c5fcb4a5f35d12461fe58ce275a8374461ef8921962c76a85533d95aeca6161c7db1fd8a00f8f28f8bce4b32d1a8fab3ead16cd7525fb1803365dc80e76aadafb81a6d3ceb3c1a40fee4c4992dea37f53b9ada2d6eadd7d5dc797c11e564e2a9019ecc60bc10d182fe8fbebd90563631dcb39bcaf40032ced6d581b2ef7cfc32dda5e1a1795b617d1537004602d43e9056827758eb3f0894abe3b30d0b9a4571d69775a42c071058ca4453dd8c4c983a2f71367c5c52a24ee209daca44a6038f73dd5014dcfb273ca51e7f2a34a68d56f2e79fe04e20482504b1bd919f887fb43cdd3a97921fed502f2e4cd404ca630d244c7b2cc99341419842250826290106ba00fbd5555bacbdefda828404a062864f079208d692d7c92624dada +Digest: e12f731ce256300456602b019034961166e906fa7c71763275db5efb25e56db3993888c2c6273411e2d1f187679015aa8f770b249b9adaa312e9f1a694e322fe +Test: Verify +Comment: length 53720 +Message: 196a0a1fef8527c16166196a31dc486db1fe3ace290612b279635714ff09f7babb0c8c67b16ddd538f34a8d890be9f6ea059b0d9c10e89a1adbe5cc3bd71dfa609ea9850d17f57da1c2704219ed59abfdf04743a9a93c87a63d471818de0f1564b2db64215629c3f4e69b4ae23c64448b6280e577c3ed526e3cc1eb639fe34b2c9fc6ea547beb46b6e2240e6e73ca2f26ded079a2fb7ba8c75cfebca8774b0a3cb8049e22d3da845c3793130b1ddbea34b7ae66a7aa57f936105612540ea6d0f98e0ce5f90857fb497970df64b519f4499f8332e26b12a25ee95072f2c0774e079458685373e41a230a45f9f7b414dbea08e7750fb82c52966a865511274ccfcb6d7f7bcec11f7f6d7c7ac930a55d1f7a5653837c1c157860f6504f1bbd97d4d97bdab6d75a5a898d4287e39c03432d9f3a4014b4015e92632f56b79f0dc90b963202afe9ba45c6f6ff05cfb6487784bd17457f4402782f0167f224f77280c2a6427fad926b31b65f047cf40c0f5ab3486fdc49a889e2acc052cb2dd1863f987e0fba564de7cee619e545e719a27d47e5b66cfa5e123e9a24524a2899d365fb820c3b3098ba7dc4cc34091f4bbc4fb1098d8017d135ec85a1f8e7abdcc4847a46ca8aa2ff4dcee0ca532f032eb7526d2857ae08ae6f6cedddb92c3e06f42b8350cd2143de2c22b8a8c530493f1e25fac6975f63522940411c15a045a4ccbbb524768789d1d019baec2cb548097b2ad868ef0cbe48edf70df190bc5922c8c57e366935fb66d4246618ec1685fa38e19483a14e500f3801c2f2ad08ff2d62c94d1b17a50f09a2d3589375dc999de1da9dab609cef2191e10ea3dcfe8e114547a027046d3b36b696f0f06c9fe97100867244af60e21c86253f69a305bc7acac125feb1e7067a99ffcdc432a8fc001f65b0f3d032bf4c8f3ec3d891c6d0d67db63d06a2bb0741c76e5d736ab057b78908c81d95aafd5e07be6a652bba8190d8a753e34941a438c9731e72671e7323f7e02636420222bda9f46183c3493546660518f9282373ac1a9e8f65da7bd4c1c67c59e27800a5d7c09167d90b0b6263906feadcc1d8dc2825513eb21731031d8f3de186aa0f1d58f615ebc97569af85023847e2a8ca6449943b8adbbfd66483bcb54bb75a85efada4e24bd964fc6307160ececf3f80a26cc1ae226736e4afb0c972f6e8fc1da3427797268d8c2c23865653dde71883fd2e482963d90ee41b115fe77180113eceb3c8a4fa5a4d81776f4d97f3bea65cfaea925deda5ca4d5d31ca935a314c51c87e228c45c41b84c54e565bbeda7b64224e2a8c1e51db98dc7ea4071f60dfff270e1fbd775f88ce93802b0f8dbf0a41e9a59b648471c55f1f6476a31f937ebf70f01ac92d81179778c11633eed0d57ed7ad4f579e6a19e8ac8facf7f94d9aeb2ca0ae3fd6dd4a97db7db25950b45f6362b1c0d5eabf3bfdfa6cd1862af3a73ab0ac3471f1d88448321289f061de1aa8215f9a7ff7e5cde79f686ede332a3606b38f58100ce77711132c078980b299a58a0326b62482224de21eef508055c9d79ba6839a869e759b0526a5954bd65ef4034910091ef8eb89890cdd9db11ad535dfae41620d72124e7e9f0ea401cddd0c239dc0f945de8c22faaeb41643cdeaaa05e31c06ffe6df93f5f18d2670ed9666717dc3f7178786c29d60fd3aa6f36c9c95016e09dc812003f1cabbace7ca0d8b6365939322a85dc107e033ab593fed960375d1eb31c5a636f8870497f4f7b4f38ff1ba4df5a593a6b098d1c8d8e7f01ee7bcc21b8e18b47570c3128816db2f373d8e9297ef03aafc3df76223b4afe6afa832c92b401eed6800eb4fedcc08debf12a8c7019d371639f6885f3c6adc63b0cb94418af63cb3871f8c274982f53603a5ecd20b7ed467d870b843836a11e9dac84de5cb2ef6a95b2302332bea14e79d4da72e16125002503333998930d4db8634cc005c48d1214cc209fdf5600c45f4908435d1e63e9859c456ebce6d89cb3b87ab3bcee250ddd462efe236633fe39214f0a39f68f47c2d9aae94b37ec53b734747f29379fa119a8c407a8f8224430e2168d20f192630743ca73ee8c30baeb5da3ecf3a7e317f07b49831313b5de6c16c795b81852857a600dd34def8c1878be6fc2c346dab78945253b0fc0d4131444c9eaa972b8f543bbdcd30f67e8b785dc41c8401d6ac80d91bff44206672c51f584549c07acfa8bd99d39dcfc2cdd3b417fc713337c94a3e4817954ed56714ab0609b39e017dd7a44bace5eb741d3c2749388e390f96174c8d291ee7d892a28fdc5862704dfe73783995a3a9f0de141fde3d0593dc778a8c41a03b8bfe89f12641bdf0f7bee5deb1ea4a51bbd794ee065d96a1d41d0216661c29859ba5c18316eca6c984e2a8abd9d4176a7176d64c932db1dd6a4faa3d62530187a76cbdcaca23af66b847db5d689da9686b8d26921ef53b02c6f2f48219acd4bc2fc1f34ac89d3442f25ce255d6ad6ce61a58ea61321a8ecc9a956566f4801f8da533e6859a9fe208d3a04237bc69de4e0e78b63c4524299525a5716e7b635e9698312c0da8d21502dca09f7582797a0aa87afe85f09897f728a1ad0b26ccfe41895818358baa69db6ddc4e91b142ccc688de47c0acfe565cf4286ccf7f239b28f9075fbfabaf3cfd17b1d41ed16c42ec1ff1168ed2bbe1411898551dfd1d91b757cd56ee91372ae25adfc46f5b4c7905ee71ef532a57c55e168ffa8929019e6726289254c5089015b7a49415c769db8e64cf268fec587eee7e6da1a37b760dd304978684cf6a2921aebec7a49e4ae6e0237770c7c1447a7ca0bffedf7ce15c654398c7f118f24270b07ce39e587627c5aaf9428d119254a32df5669f95ea26a893aacb1c2a37789d5d6d5c657e622a995bc3103285c879dc96bc7d866ee6e917555c04788b803802160ea68c88954bc5c6637e6a766d66a34b63b806507e102c091b1898a582fd497aef66960f9627e56b68c1976be7b771ec898ab1f30638713f765bff10a654cdec7df0f46bdb2b72cb319e4beecdc8c2daac89fbbf15ce6168dc531e4570db19fb38fa3a35dae2e8566c68fa77963730963b1a462d234e8705db9278cc58dcb817bec6c9e62bcad0ad57c6158ec77f35bfb3d043c5c5355c96f2ae810de4e622d26e0b4605346fa630a21a3facd7fd3cb7b5305701622f5cbc9febd992ab83e4abc52c111b8b3de370d9e9eb4a5e5dc00eadaf1278907901c751fee4f303426814629ddd71a6b212ee4dc97affb10d6a350bc0e883b6bed647b73c3597828e47aca4f4eddffd68bf199c2d9125768895bb6e0a5bcb6b7d54ce1e483e08afd3edc53ab5c49f25ce4283437ab064155bcd1232efdea8251107bb159780bef1cfd50e62551447865f37bbb2554b3423f39ad9f8e603b25a3669bf3b9e8032eebe97d8da573f51b59819038731d40e18ec69632e814d729139f51adee1cefcfd4c90c4f130c8562a05612b2094ed6a7aa2c34e52462e5160b8247e9df5cf85a3e66a43557621bd5a23aa732cf2f9c1bfc3230bf2a928d72f2d825ae74f046589189ee455abde0fdc7f5f7bfad07bbc5eaa232c8e2ecf9c730699205951f005134f891890267fc61784eab618b205a2ddd43e10935b84e9c2dfd37f42a324fcb917c360938a7968a1b0f6b2051c0a2dc3edce689093db77a505cbc861b715a500fdc85cce5c4d6fe1afede05e730bb597336e85148c45ae8034dc8c050244a6716e225daef07e547dbe4ad1735b8cc2ce6199067d8955f6eae9a03acb29346990e54bf3b40b8ebedc888805f239ffddefd4c86d5a3f8ef94b70917512706776c5ffbfaf8be1f0f7647b4fde39a2f78f6229971a38f3532e38763a9b798c4046a729f7f1753837a6cc22ecfad80ae62fcbcc6fad786934fe2866f64e7ee16161bad08f5a3e62e5456a0bf9cc5bf65e678339cc87b6f5b6e1a1cf7ede80f44d50679fd05a15e66c4bd492f0d313d9c29f3eee3849631d6b911b2c1efc2e59668b33f47571ba574f2282546c9fbe49b56f55763d531b6495651ae97107e5753f8aa65ae9218a2a0071f9ccc792b9aa99304d5e36453e5ff6d627a3ff8234cc5ac7455fa5fa13d312b2a1688c4c7490f08aad02dd804a63f27ca7c8150b9ae32ad9875f365bd5e7185d2fb4353d9d816df6eb007da4ce150ab131e27c04964e3229e2f614d74eda63e9eb3c5cd682f033dd8de3a12347e7b22c4c7f7efd95620340fea0bbeced2197d17a6d6db7d36214c71c08e27c36608b466debb86746c310b710dba61d4f5126bc33c3e251fd5b734c0bfcac2027f3f8880cd392c1f8e5dce4f0236de8d3fd8302cdec45256f40c1d4e44b88af7b267c79afb3a8ae4a4eda62e3047dc0296b5f3daf2320a2a7b692ea1b51e28ace8ca983dd08548ca9629ba98ffb50339e4efdc54e24ef7a452168f437bc5432907ae24efb4e40dd94c593314d747fc3c0fcf152214e1bfcb615b69bcff758474f85c933b0f1d811aaec5382b20c66f13009dc3ccf2b20aa89180e492a8f59297a41c0ca649f94d94a5b5f26342fb03c4a0a111dae28b8141c8cc274fdd0f179af236b7baca40195017708847a5ab6159d62325d54e32cba0ef885b7a0889b883c9f1bdfefbba8c54ee3f235cb2a131d9896a27459d7091cdeffda79c902c1f5c139646fa422e4faa106aeb2ccfa41a4da3bf40b0370d7bceae70343cddc0f42db76d793708660a5a6739073e657bc4bc0b6a97a084d130ad162c29e2570ddefc9dbe7f3cb628646ad9f3a01addefd82ea9b3569cec8459720e78af1766da86d3add18091b23d05e450e2dd499dc8feac65e1a22dd7ed9d237d9bee6172f194b9cfeda3bf666d96cfb34ce7520fcedd3c273ea6d9add5a5ca4dde0d4be318afb7eb5c104d387fbf34ea7ae5bd9ac81ee9d710872bd604196e6589355a21187fd3e964f0c3923d271adcb40013a58068b85da070a8ba42a018ade48d1894b9ad17b14e6baadb6d7789734260da9abc64b3a13687dac157e2cf0d363e0ca4c2e18b2b62a8897bd8568a966b2c9de045bae18c1af448540a889b6dc96fbebafdc23640e7d0e8da466d232d788de1dfe3114a0493e07ad9243a84b5e349b73c30f920d6270a4f607f645e21b1aa30ff5d11f7f2ea73f9ba6e9f93cdcdf47e94242e51d6687f47754ae243585eac11a87d63ef3f68d44c5dad60cf9dcf979b28a108d229f3565781708fd9bbc7ba0d4209af3ad1522cfb2cac24410e305a97626f2faab510b808ecba14283234fdab35ca9ce192f3a28f8d3294ef063a66f9a9554ce16406cde11eed1938a6ec9c73e988d3eb69925f8fea0658e36e33e349641c07801d1fbc6a7fd44512fd38c0edc70bfc603d768a83aaf117252f64f910fd8c078dc7a1ae2b783641bd216091a2351abe49f8e84cf335bb79bb2f15ced4db6df5134cd5caad6fdab441f8ac36199c7fc1ad8130cd68f32c28af588e8d206687781793033977cd8947a76c63d8da6500ae94c096346a4c0bc90991165c7906a239a384732211fb0ba2f664cf9e6ef6662d069d62aa7fa82207cfc1f663692385dfbe076cae045f286c36c736b15cb978e50c00db56316f37870bd277cc7725f91371043805d763a84e6f7fe1382c14007fadd14a61070913f4c4abdfbc2c74c67dc3631d4e126e52efaa73185c6771c4a2f2f8f7f289de7ef40334765d0e78b4c4bc0c64b23ee7eff8ef8b234594378ef7e15d2a324056402fcf5586d7a79a8a9164e85458e238471044af491a3bce242685e92b48b3da204f30f655527f40128bc4dd376886c822e0b3c7d304e49e4ed6e382415d6bd0e7f92eff2cf51cd4125be3d4530cb2ff480f43bb092a180fd6af0511b699eea25dd7d25853e808bc53a8c9b6f26aef458146fc7333b55e89835bf27fd023c6b64a9123ea1254cb629d1b7f695aaac402942de7d899cc3f741c7fb2b2d8247a7676cf299bb161eb2cb85c0cd7d3f5ba9e4a6b0bd0839842386ac64e9415c39349a938ed547736f2846b1278e6a77358816ba971443840ef3d35d5cd0cd1299896aa7476feaefc68d17fe5cc801c4b2614bf8e1f1d01edceeb44573701527d11c7422ccd7f9cdad37abd7f0f8c7ca6acbd0dc31f4126c768ab61f2945de2e887433908f8c189f9bde9ea8549f20dab73e51fef799aeff544e3524eed07c792817257af01aabf80ad85d1a2829a188302f5bbbb330fa3a0eafde01449e749a287bc63caef2485982cb6397cc36ce455e153aacf57878cefe35fd3ecb1e5b24121892700cb162269c1e4e9bb1350bb4a9969b3d2ececf00bb673f37d2ce94896d84169fa9c67df1af477aa087b2ee38ab19ea06dfb25181beb9f0870c2db55ca334cf25f6a0104d44dd7440b02eea53cb15938478b1a4c480b4dd96c7ba31f04bb128ad83ecbd9be556d7f6bb078498821044209a4b3d4ba9de42f1a6029ef6df6fcf80d1fada501939f23d08db417978a06875a4ed8f79829ccd22278560c2d6e7006a5158fb2c48fd6f7e4a28a579174c7cfe39271fe0a376c8a2bcc10c06babd77a4928594630d27bc44cf6e3509e65afe14b7766313a502e1fdd6240514f339a1da061f3aa6de3f452b391a54be4e726873b069fd84dfb7958e244cf0802901fb753c74626a24aab69bf7cba908e8194875b46043b6ec1b6fedf7aa32dac4ad01009623801f79006d118be0867c2bc61aa523f7ea2c3294bd97f0aa60874e714ef6b3bb285953c6f51675f7918a81ef5b8c9f9f35474bba1b167febee083f1521e20599df8a4d64db35468f4ea6a31b879677d4d9aaaff204e425dd5ff01f0f463d1c5dfa34be708bd86e060272d7d13b5d5d272bc8d7e3078b630d2ab156a6187268562ceb3f60838a6cfa7151c896c33ba004c0244bf3af66b7e9d2de7e90152c6a30cc1048bb4eb5b3eb0fc5cdd2cbcbf10c1b3f84aa4910b4f1ecda0f43c8b5a26c7c3652e76a04e3363261801bc188c09bb19d0a8d8113bac3dd268147afc89177a1dfe68b51d27b9a8da767e820fc8f3217af5603c3ea59be28666cf236bfc7d0d18f8c0da2b8dd5675f9edae8681bd6db1f8efa3adff127f52fc3b09fa15b6067fa7bbf4b92289188feb9a055ed2fbbd050c4ff39bec7555e16a63c56664dc9720baeeb711aa1f4f3ffef553164a9a9ea55bff6a1a1cd2f058338fdb1817abe1595bacfb48ba00691aa6783e39634a91075a667d951aebcd2bda17a16bc8b4a38dec7f07dacccd048464ab1d54b76c22af9a1da4b961004ae0e083beedd2872c32ffcd83246ce59011dbf686e4b17fc2129dad85e379c107fbc95c9a2adf8409fd0810e3d214daaa575ef2f165dc05fdb4d76e87afef9e72f1072ab98f4a4bbb2097f1a0405f2c91a97028e354b19f441ada09307b1cf91a452c4693a7ad3ebe5221e85f1ba65c04acb1f0d33dbc9c23b917e606d19c817c8cab68cef062ed9216285d56a074d971b596e3579d679d1b24038d715fe8a8081c06d9b1e625d8c4c13dd95d9b653547788188d6d03d02a8c03f7806528bdd4b97b141e3154070c4f7b4d4aa58d1e0145a1459e782c77d4b322e3e4c65e0a1c5744d19d8fa5d46213e2fe7e365557a56dec1cee031715d70de5238aa16a195f4363cca1a01d6e957f9217b8f4d5a549d6b1c607748d533c8493e0fa5c1291a565202fb1cc837aad7ad2c18147d7b1f46a386b713456d90aff7641bd611f1af6a5c21f567ba1a3b3eee92460972122ae10c831b2ac3a4e4965d46f5a16585e5beb93c617153d8eaec22067dd4c7da17fb0ab435443015a02a0f69159e58702db1fd94c7c0220e6a6debfb380ceb1d6703327c7df6072a63c9724d0433572b17f29ddd90daa1251a42a0e2fd2858568887f85e6d96d57daff32a6549f6de2114ef1e7935376da77ae8e54045adac300d07d0dc7ccd1769e5359c344f5f79fca505f3fa5d5cc4202cff2db59a03331454e1506933ff4979841f4c4c8ce3a71858d5c2c351b1510970c3ee9572df999e00c30ba71bb3e8473d0ebf10ab09e20ea0ecef76caeba0de06f5ac7258895c17812b46f8ac71704d50926922f268b73a0da9fe97115210185ff2ebded396d71b6668b6e05ebe7de67f28eef62b5693450f9b5486dd8b4b42ec4a212d4c9eb7342129bff0baf16dbd0960950c9e7a029a174fa5c8780daed82c79f1004bf768ec31ece69c49c0cc3b8fa80fc8c43981b3c52546fe894fa76290f0bfda5a37589e1900af65739315ec928dc3cd451bad1c89badc7b79c7e15cca4d022defe522d457239eced0eee73a9270358c99a6c15ee57ecad1d21cd93138fd4c7d857744297cb4294ada4a9cc00ffdf9892a517ad568ff96942aa4fb7a5d70134bb3643907ea40d36c082cb2f77b9574358fa2462a74bbc434dbf6c4b2b843db0ae2327dea304821a4d31bd65b55b52a34222f9fc89911d8366e88c154c9f7284d9a788f5aef389877d37e63663f0bafe79a40043a66b0470b7ae17dfb12f87f96549ce9e467a0ac7781ead69297d769d2408a0ffa3e059536598756f013c64557a92619f139fed20656d7cc8ae0c6ec86cd740f72bf804749b2f0e8de5cff1e03f09aac0bf6c1adb6cadba199ba48ac779984af4e4bced1b7ff94b0305ee16e4dd360fcbefe9793fb765ce25974eb2e172d325be7633fc903980929808a4bba77ca1f9864d1df3966b1d22b44b11ce5f7f11391d8a661a1af24c4c1397f6c87242d3d1bb81106e26b35e1d8e5ff5c689cad8eed9c85b2d03d2e3e23d59ee258d5a53fd3033cad339b5ae277a7a0282a778b3acb9d71c1e9100cfbadef793ba40eaa9e7ae0a540b159998a8414441ea01b427db8660b1d60da5983ebe18ed6fd31b5ef5fcaeb5fd0288a108ab67b9e7dfa4bee3080a203cbfe8c4d5a465052d8d14f991e4c8f5904aaa53b08088725f8870ff2c077e7337eef2dde65985e2dab8fe02222c001dae342635068852753c4541721e4b63b2b1e3ea6bdba6218c609a0001109dfd333e0724cf738b6ac9645e3fa0229b62e391e7f9f41b51e10ca57b437fc2ff6842270cceaa60507b76c11b91109ec12310bf4047020e226c6993a5ee04a21ae84f538b4a4d33a02b8539c3604afc834d402236fb1c1ce36bab115f2a1617b52664a9cbc040564322fdb6a0d3d7a2aa887ca4133ecbad5a85db06f01f3f899ac9881116590c2f0109e61ff8133efafe7ecb2c1d3795295063005ca1f406608f7ac473b23c3828a288495c1447076a46d435a39e0f05f88ead22fabad2f3055de11fb7e8934ca7ed462d543c98bb5c4c35c2efdceda082d90a49c883e08fdecca5a1c60083d116abec9af1b82ee137d6477bf920faf030fc227eae43476154a36f528642364edca421981acf300163adb267a9b15d7c68bd9ec894442ef2d0ace63be0f6d44b61a08e30b7cac6a448991f8ee8d93fcc93e6263062ccbec8b8adb363bc638450 +Digest: 060126698fad47d563c602860f65fc0310c802eb5ce025354fdbde68458e016630686184888a424f1558feea62be4cdb5c0713fea6970079b29a7d676c006246 +Test: Verify +Comment: length 54304 +Message: 293a0a7ea614cb8fba404b4442fb635f01c9182738b9cac676eaaff0b24e80c597ae72f91fef6832639367b1b2834a35e00bb71ce02651cc95fc2f51e6a98e471140c2fb410f73cd622505d9341258d69eeeb23d469df9ae5e502691c14ff6f93ef7e2cd33fe52295eff0e02f132f509e47af1d28fa62a3678f07af66aca22a0c7dbbbb71e446f0e00276875106a89975ab85c23e6c94c2a8ce415c909a2780753f433002a673044f0a7fd7aba427c49a7afdc78718fc7534132dd51c85d62f58b4b33f27ef1ff92d587b358174336e574685718587f047940e4bcd8cd85463116e7a4d3436a43c158cd74594ef4203368e9b64cc4226964310299a440a18e849ed06ceca0586399208327c388dea0fd2c3ce25cddfe5fdbba925bfe4a3aa1b6c80f7585be45c9e2d6b0b4dfec871f096769c290ca9d4fa8869eec2e13d7e78f3eaba5e6c5b8dc64215d02f5a3790620c2763d2fb4879f913b2d337cc200c8d7a8ace656dc3a04e7aa91fb4dd43cbb0ae56d3d83c242b95f824818307f3eac55ad1b1f1f2b52a9321854862ea856a88f7755a9d21d5803da02f683917417fbd2f6ff3887db88330e14ae8be24751337721376865ec51e7c9643f5ce8c6151d162b6018d714640b4346a8f3afd8b5c6898a1a648458b3cbf54f2b8b7da0c07be9f346a956fd6f97995549a4de8308c88e5a068477890819276cc3f998289f7b13f6bad24ebf3040d8ea9a87b672d4a14f3b04b085a6d73825630e8c81863a865bddc37b05812f6ec7aca18481caa0b891d31ad0f7d7a990b7db142d7fe319058a506a8cc46cf58a2f44688485b6f5771fca53cd15460589a77cdec5dc67c55e68f6b6eed3a809fad859f76d0c5c5a45c0c9b48d2718738bbcef733ade39c5fbbd78af877a5cf3288a9454295ce4578a3b7847f975787bfebddcdc76ce82a142517d5d4001b13c7a0d9d899ebd7774af597e13f9478ca64a73ea1f5ff469e29decaec902afce6b5a281b9eb6793d3a1ae2842076e47c7bd7a6c246df97170f7355b3fab3cedb082fa5b69957d75d30349e3177569571830e1d0c58dd00b3b02b5533f83ca4029c614a17846b1effdf65542e1f83a2934455a26f5e4078664d2fb4d7cc867a69ae58e0e666d9974dcd16ce2220e353094815fb935ff245586fe63a467d789738c67b2eca48898a6c84add2b68360effc17b7f12163daafb09db8ae2813f945986c34fe6c31633e878c9429924fe1c09337a14cc173e00097600dda2797f3cab129eb1674294ffdc46b319b5d8c4d0cf7323dd41a95ec7e343f4d84e9104d6faa84063f8939350d4babeeefbf428e1c4f90f251d5d3e673b0c2e0751686ef7cab06ee415367fdb745d332ef627a8b38c4d7278a9935b62532712f755701c139de350be47cbd8f43da6c6461eb3c2ca87e9146480fc245dde3d5a04c548aaaed699cc5f0a943d3f931fdee0e058e59b3a445b653df8279e2ea759cc1b42895e274c0852c8400b221730e37be567afaa25e7cdf73b07d3b7e70d98c9d1fe4675e282bb161b5fc1202c728a7388607f7bdd6bd29702abc74f79d8ad6a83fc509aaac64b357e43fdde556d2a6463e3d384c3190fc11f6460a96980fe4aab9d3630e29f3f1d6b8d2f91248949cae2625a6979a7dc01fbc23e7a38af01c6b38165dd1c761d5a6d9bc50d1c4f6f139e5c627e6370ddd63235cf1669ab6e8b26297e03dad34c58ef005c86af2810daf2429a48030c7bba2d4f81226f1e8af49df5dd29804f72b58a5b64b24fbbc59d88a5406aeae34c2a777ff312db60ed8f658701d2bf32f6eca9fd5c049072f3b7cc05133b8d9da5b39b37a35c112b1cd8275d9a73ea366f6ad876d0e1f3d631c626d2815e6d843ec1f3070082b2d58f5b5dd9f5a193c232bc804831fefc6df65533adf937fd4f7df2297e991b32e8bb85639ca1c03e5ef75e5bf21da00ca2b7c17ce8094cdf47c9a0a90edb8a03ed27e2f3063d746c6513cca5f4e279c70d0cb76d3120216615c879fc285653c84b6af066b70722808d1e8408d13ee09e055b838ee9ec4a3421f0ca8d6b880cd29beb3a491fcd5f2d3f7e10ff17717904342ad24c92bc2bcc04b93ef738ff19c5473f3d14b0ce8eb4e4c8fff32828b79c12011030cc1e4a9036a833a4210a0f12e5bd55441aa935da2575bd8f93c300c81764c9d5f6812b132034452eb457614df00c2f71addbe8ef6a0ab61edaeef91acccc6ba6829341d759f3eff1536594c8eea23807fae51c773b0e863b7dfb14f69abe622d20b3235f6c5d90868ea32e2639f5eb817233450410e7ba7fed75c8fe199169c4317f441dafd7d378e69ea1e87a9dd678b474f718742caf26b9fd9993b20bef2635462894cd092522cbb674822900655821f8a726ed53f0fa63e11b5a0c844eadcca655572c48022ede993a85bda4349a5b5ce9a1d4e41c456bceb2b3818114d5381e3ec7463af6f76f955865b11fb0d9c100133bc3537db23224e422a988de27382c5977b35870172f694294abc95670e380d8375138b1ab77724439fd02073e1d4f49eafc1719f87e53ada4f647b20a336d8d36e6fa44ab7c35476be4933c6487f5749378fd3135dd02ee19290140004114c6acfd1ea33ce0ec623b08a2ca54e8cd5df3b2716239dbe58863cc8c8ced9d15092c1c1c59ca26162929c1b75d69b0258aae512a398efb8a0117595ff54c97fcb916cc89d4edbc3100bab857421d8e9c7f05bd7e139fac5eec9647d21587d21a7b0f76dda12223db8d5054f9350ad4909fac5fe37d067ed2af7320a96a39dc2cb378a39e4ae1fd64239d1013929c12b08104c0f0f23dd383ce306c4c7fdd0671f6e4fb324ea7996967f3824cd76bd96ab7a1893d0fc05af0cd509321a2dbe1a8b9c6b630090d8859cef613fb9fd4893da7f5012e1218759831563dcf8fd10e2f70b09d1e166e6ac3dd074da64870b297d681c12ac5a0a3f87ea3b4aca336ec84b014f86303648125f6c9b7d36dbae607d7da51d98713667019eb905f6987fd26fc7650953c6a9bfeb09fcb197c3d840c00613ba0d2cb5dbda770794e6f4ec0a4ba574e2b4deafbccaf0bffdef0531d22f4b8e7273552ca3f8be4a7f000f5c78c8e2a49ab9480210e2690deaa66a621db2943dcb33b246c545baad4faeb07823ccc81cb8cccb4bc31dbb0eff24ba13293228484fb30ca94ba8b5558b57a1e813409d05c4542e32de6230e9c4d2bdebff9550d8865c2afd3c08f56dbb62a853500daa8646b93a5e68980ec7c1163a93a6c55415f796d6eba14fc31b67398e62e31937c8c762b77869a99ecf7f59fbb326a87c262acad61a8164678718431abcd34e8cf3cfb96d27ea7c282a8504c6f288280f33a75ef334e42f29db55e816092893f02ee4252314f1f9f4ff5b7d64f8d32c5766f7bcf5ded398513ca79048f3eacfada1900ea3e7890849778a2e9d6e0f9b9ae5a14aa4c2548726d495a37a2022ec09755adcb347b79171ba997d38fc455f21d82d72c88872e4f1cba7897238d8d14dd2caf81cdc857cb2ef10d4ff497c5f3468239b28d83297fa4965abf9e41266c0df69c8a54ffab1553e789ab8febc831bbc0c2c8d589e888975586fd6ccda93acc5beb518481e19a1d057372cc20db31dfe708fbfb3bda0e677073ed397374057ab52283c6efa9ae0cd3813233e78d78353d52b868f97c55978fa81b6ed32550abaab87d86a951d585da096651a04d796e5c568aa9535e029a0ba9e4878d1ba0d1a533bb5e3f88b53a61928b9fdba9b9bdcc7aef26c9eda9f16ceff51dd1e58a8f2d2ad9b8229ca17d32a31e88fa00cdd60646527bcda990303be0a99c72115236aae4451ef32c4ec0a5c19bb79c110a39722f5112ff2079d8e1329e7dce1dac5ac7167a1d11a5f1c733548f763229034ac8cc7786bed0bb4e054c304c46690d8dda28051d1ea85ee383f2667f4cd75d9c527412418d38c9120093fb928b81da228caf62a96a91da97e021cd2d5c9a5da0b7dccdddfad747d77bb07ccb0e06b6cb37031f4c95f0f96700590ffae1e0a7fa515d16a6882aabe0df1820503e5607da61c9977111543fd33d0ebb726d58b10bb77b6945a5a169c0933182ecacfe61f2a57967a17d2a026f2eb96c2e5f40fd4772ce5235d3da0619309310daca6e49867a790c7829e1058d3dff7e894868014ffbbc4df1b343053d5fc356c527341318497ef24fb817bdcfe3278f1db90c5187bacbd8f3946aebcf4938c11633ee732a9ac1b5a2a84c7fb9c6f80a4611cc628148836fd627c02e21b579fc4880dbde300707c31b6aeddfad51b76cacf316b8cf1d599ef3cdc140e70ced44f69eaab8bae6a7a704808a524d0c0c42bccd89c8b3c1e4d2e6f71cc871b829479addc9974de227ee1879807c0b6e5d18f0118416e1ae8ba82a440139745fb4809fdec6fe4b621ee4a1c68ec15ae1305be15f9427eb5bd48b28353cf8416bf56c8002015245eee3474ae803a6ce1d1c87fb183870035245f88b3b1ea97b558287e5f82747cff11b627e6e6db0d77a7829c7dbff83fc2a667cadd624a184b4e24f2c11a7233c113de2a6ca4b540971d9bdb20b47e8282cac841a86fd94fff27b4eecfeef893cb7b1347e7c2b24d69bc7b05436aff10a018eab5bddf7d83fa6d3f383109efe246d1bc44ff46b97b160b8be28dea6432421836eec3ba20fe63a72d998e703d69599e43ea5d3ab114c6933139a73b9630915312b36308a906635ee5d98e2dcc702d680f01a9a5845ea0dad6d338657c52b450e7cd45d200e42219d1c0da46823fe9ba88518a9019a2cd6ae379e971fde0d3971e0510200de0c76058161ac6491db61916a1a902582775cbbef16266032118b11d216cf8b8417bbbe2a2f5b20854bc0f21bbae032937be83d1034a4c755ea9254ee90364e95165b3d72d1414a72a22231165409b7418d31c83794a2c3adfae7b18277a6b8856aecfa07f1ff30de811de4e6807d32113da1e3b1a090d3cec503ce2a17c157d997d98a360bd5824d5b0c6408cadb21870fc0f63ad30f762cdb6ef1620af6bb062fb954998964ad33b28655098d7414277607962fb66f294c90a1c1b6cbb7409f94f4efaee53d10260a043e4562f8785702fe3a0cc5407ba29714b594d493971a5a34b1f2c9cf5998d41e6668c5d8ccaa290d685e7a13dbd361505388b01c0ceaf1c151e1818bf810a33d83c030958fa56acd97916f69d83351ed120ed8a130a5fe433617b7036a01f9da1d083daf4fbd4aa74e41ffb2df571b438793d8d3a0bfd232d4e1c4c63df14a7c788d47867b764b32f2ecb57f7fb31fdc1ab41b13bbbd1008c4fc5524c26307bd4cebd8cb9144eef93bfe2b3037ebc24f41ec29f200023a4d6cb3c2dfb5ebd3e500907bef2fcd98527ff2cb657645b4f593a87fef1c43a37962a4a83786d011bc1a07ab51b564e9e73577109fd9756a779685a77b4ee5fe051d3b7fdc93d4538b1fdde1a3c0af561002d7853fdfdf553db0e01b27366dac791304b42f8b5d0bda787fb945bff16f755ea0a3d5d80807b079645563514f315dda8cefb0dbcecd32ca699cc821ff987fbf7ef6f27073e498666ee0b03e0f2f2bea307cf0e3cdfa2c7c27f69b851e63a78baef90637978e3dfe8c47be4b21e85bb89bf67051cf25100437614067d2438569dd14817c076719a828f4ce072c0f75cc3be6af9446d085f924675728bfca81c075f414dc3801c409e1626ff08206f29b7cc81f39b98f16d15b7330764b6b253605f200c6ade0b58a322b24a5c8616abceb154fa0bba31b13590f7caee9a80820f9a905d9dd7686af97b97c8563a146970348a167c1df3b35a9b68c512ef37317ed8374644b458fe08e97e81df8390eb061fcb4fd4075dfced9e2fffb9ff02e914e1bdd247be059d37340f7eddabb2baf638c1aefcc197135462f380c9100730397ccb068e3a97cef023f1c63af8a45daa48123adc93ca80f9af5d512c6b6e91557309ec0273361a9b7fcd61dcb38b5c881666fc5cc41ecc424d1579c8586091d08c1e8b89b008089e104a58ad239240fa6c66fa659eba7e9903c200871e05ba1390b3eb0c383820629e11b29392de906710b93edd67c71e659a0cef4f07849384466f157454ecea4ff1c97778469ad437cb08d0ae686c350edb9d4d0a5905a48c78fb10a74c4defced01bb04388ec95d165fbb6bee9d24afc8b1a229f5db27694ecfee48f6882b64505af64dca0fc599fa639faf73220e596752e76f65bb190026b219a13f0b3c71d562c9b2bd6f3ab08566ba43f8a7f8e46607f52f79b2a7a3fbd0c391a2b0aabbf8c3b5d1772f910743c38ba803b17ce7413b5bd8a6446bdb4aa66c98e62ace9916f83b38abb35124b214946a18b0f2c865779c097002ce0c8fad75356ddc409fdc6ada46cfad038f6cd454f8ac39031e5f4736206b5066be27409dd5ae478946a5b6039a378f20adb08d5de232ac163f9b24aabbfccf9e76ce2a17282bff01140f44579187ac111639aa1fa540acb4d2a59a6a3aa8c2fdbcd0a4a17b6b55508e65a036cb34b68d4f64a50ab05a9d574e1b03153b03fd0cf6db4aad6de0fcf01c655431a5d320ddcfde18bf91e510862848090c2b72b034bb4aa69b6e216858547acad8cfc76d9afde28f9ed87488c9e7d916ef8a89af1d80ab330c0aa0fa01bd129e8c97960f3d703e4438e28d688b032ab71fe6cd2c2fdd796a7fa1e45474ccc929dd9bd3883dcd2e010e5e94524210d9641dbe91c9d43831c756e27ffa39fa0b073c5af46b344b5e309f8b3db8a777419879709bfaa31760d4224ab84dc9cb64b139436d1a99913b4d6d16ce2df3dd1feeb3bb305134f1831b822931d19cb742b244e3c238d62541c1e78fea04ef88b0b14cecf34fd25d24f7d72c81282b543174ffca8828828dfe389f34f5efc320a09ab584495923c0a31391c31ab41e18cd83ca46237c2721ed1c14c49631472b6bf57e2fc70fa1b299d9526b5307bd7b5369251518962c878ad6b8bd3f9bc41f7f7c172de0d5d4a985c389a3ee85b2028f9fa085fc290b2554132b6d4661c2635779113d2b3e252be36cc7fb31c06434be91bd3732976b91d53bbd736f35ea9d8086ecac0abb1ba02f2f6defb14a7c888ce9eb97505396439acb1f5e0e8a752487200a1903ef30ace5a60be00186438466f2ac34e9f043c0f14ba19ba8d22aaed7df09f2ab1d0cb8934b227a970651aec9568f7e43ffdc808537e4aac29f43830f1e6cc774f6f849a499322de63d3f6e408ff5f202c4c908c30a7909e064884779589315d5ff9bd6b61acb5873ad65595909803eab01a1c0474daf3786a44172b3282d5c52895fe6344a5eb8d3e95bd67f5dbe92b118ff5d6e7c17c229e1078b59078c198f36cd0eab925c9d6b439b9c2fe6f1bc998d2a26c51043284ead52f7b7714fbbc08a6ba6889d4594be7e9ce0e75fda1ae8d0cab2d7a4b1e8795bbc5e7affe8d1baf6a45457c5ca2d41ece86b3202c81c0386499802a3d4611e9e9c160ffdd7e9c30e0f7ea5a62ac5aa0106819c7a5c5e9e003f2cf2882b40b2c88ab4d315ad726d2315bbdeb9180c3b6d6fca934107510cf1041813dc3705ea7bf0c180b1c9fa3df85f627f78e25f9a848cbc92e14971d4bb40bfe31a880f0a2b76b2856ccdefa9d0352914504a3e2be905ce27c5935f79d17daadccd8eeab659750e5d9119d1355d4f6619e99036840d3375de78856880d6035f8d5fcc276378843b75e94e3d64e1f6a01caf54c72753ce5a0374903b7e2b8a54616bb023862b2cd06abfcb82bd20d37d791c186e7a6f0ed153443436c6646b10055beb8db2c3c753a8af224fa27c6e44dbba5b9b11b1ad723a51f1e8fdf33e18c5baceb46de4fc4bbc01e302b9671f9c90f48eeb71ce02c3154849c0996a6bd53f02ea461bf1241f21827e3a66737feb556532de1f16a73a9071bc6c0d3c8cebddbecea1419ae744559b64653e23f7c78586d7c17e1e134f2878ca39ddec09b33e68dc547324ae51d4a725f1a4fb2fb7add3fe541356df8749c7e3b88feb7ac1bd7ba3de2540f1de3b50438e4f5b70123ad716f47363545970d99976a7cd58ade771a5bcdc525a3fd6013d9971d7718db8faa22112962a6c3a486be29a041bce58e5626f1cdb3ffd51348481d0f19c70a4d920788591ba06027edb8afb224ca97e415a734b6e1bad1984b8f5c13c69718add225920d89bdd65f758ee2faa53d5b4000e47fc6d95b5bb6c3b63e71a60e6d781285188cd4848d14c747acc0ed9c9b6cbee7bb47c06ada3458c3aa70e0b67175f92d031f237dee0e8bebf44b236fbe2ef8b8ce7fc16fb6dbb3c087599d178d6e3027390e9e315f146883a2e4703f2c4f565da2b701f356737cb4bf7404b727295f7ba4a16f2749f006169dd3fc924c977fe01d36ab7e24c45aa839093e20a9702d2f2b20bbe715680eaccf60eef388cd1c482946e5968795f6a3dd6072da7909424db5d2adfa2945284d1fd36fe747bbd49ead2dd7c5e7aff8ad93c1c96b01bc47dc2c006ae7ef4efb027573a6f8f22750e99034ab92addb07ce43736b5da753e4e577f21d36cd4d30d2b989bcadefda3831bca386853fdfcb0fd5bf7f38d594c06f7ef0ec702d086ec6d35dd88ea79c337f18c292270683ee7731ed2d82f24984822942ff1c76495ee5ac3723248234e9da8cd8f7ff6a91150f40459fc56638d726602f7fc210d6a8372a5fc5f6e96c034a002fdd96d4cfeadee80efa88982a62640b0094eb6377f3c4361ce58d420a29d75c0d6b72aa0715ec12926954f2e6cd4312fe651ed7f6e795b9b8ab6ff6d7028a88bbc91d55ff3e41a71712b0db36bfcc5d6e1be3d41a2db1997940266e9b376a6d81201f3e800ce68de61d24bbe0e006d49bddc2c2aa6d20c0a8cc3a111e6f7ff1a698fecc5127e2ae47b338fbadd9f960ccd444096f4eeb148c7631462753d2fd745844663c383df081fc75016552ade74828f0113179197f6f679577808b6a7a3189787607e7ff3dde1f6236d0f22b5258004e42b796b2e897c7ed0befbe504e265223637bdb317ca4448802b5627a8a4484e705cb4cbf364dbdc26a3d948a639bdccc9560bddb951c956dcede4aa27654de42c033434653d9719bfc32b7229fd84efb747e34036f8e379b001150acfdd033e8ddb8245226830c002895cc1fec24d139689ce9b3f442559a02171f9f09ffae5fc22297e89793b67959307e8a31c98d0cd98483f20b7f15f03ab85d83812a7431d93943128e50968ff4c9726a560da9ff2ffcabc99c8f9f2712bbb3604c99b0e588c5d1d7f304d5c9622953c742394e97d2cd093e90b81cc7f0eac83f54948804398de840aef59ab00b18c7aadf94a35e2abf445ccd43b4563e0b452780632415535a3153a86b0eca575d761a1468d1dba09905283c788e5e63e7d121b84dada03ef4541ac7b059a2afc20a1fc9fbff969a25f3acc59ed366c7461534e49b4b2e6123f89df40ba2bd790d28c1e69756188129b7ef51feaaf7d2f0b868ed96254626afc5e318c311a51e077a095482fee8be6ef8f9c6e13c98ecac63c5b9836470f45f65f41921d0e10778a8fef904 +Digest: 4d0e3c9134e87fe8d944006be95deb92a7cd5d3091ae7ed986df37cfea7b96df8fd92d7427699ed5666d33a6d5998217d04ed0bd5f6cc6326206781a5d24bd14 +Test: Verify +Comment: length 54888 +Message: 765bbd97773dac5000cac7ef8e200d8da737df13635ba94d2be0c440c1119bbe80690d37e60613d24f5aa3bc0324d4c0739e4219c0f8b4847d06fc99b6361f5a31c4b60df331944706f1a94a7a642690aa07e2a8c1ecfd417c67c385310bd3a810d480c0a9a677d7aef6a23efac74d25d3d988696c1dccadae6be1ac3877fecda50233f90d4d04a9ced357438c3790a6767cfa03cb7469f09d7b1db7d665eaf478b4965f290e83e6eeef8dff379c363c1c58011fe6d91b31d1fd404e10badd431253729b04d23bb597b20f1a03dc880e4cd56465c3352b98d15b1218f05f20e2fa488f54a67f753f4f84a43df8e0ce458e5bed7c6c6ee14e25fb5bbe7d3cfbfab8fab53318ff79aba1cd13101f9050086a52620de96e857b5547e3e7bf39b5b3d5d0acdf61388f2212f5253a7fd4558069228cbf401b5f46e9a5723cbf3f9834d8343b018914ffcc2c64a264209527d41233333b7b5fb7d86a7fcf658434eaa6498d2c41997a10d0768352350bb90c2deded1f29a221d459603cc3091602f430b142454698510b5778b8fc56472a4db383b9172fbb49fff0514416d07e8ffefb96bd4fb98e833888bb6c6a6edcce318d5bfde4f8d0be80c5c7ff9064c3c5502f8365114183f7df8cc6086226d38f02e4fe224e2ae86a9f0149d5f86aed8a31f3fda255878095488a21f2ad26335406dff2911d6e0c34a4cc602e188d05c8eb6f8edce1338c45bbab55941315040487a7c1b1196b4304d64d9272b6731266c4ccbd7b7eecb0ef7f17e9555b9b4f89cb63f2e90aca95c27ead6a099bc41c4c053212e7f45af37bddf5659c4f611bca1b3c0ea3b7320a56e4136d5b8f292c62f5c816890b265dd11d6d52d3b50f70afbe5a9c46e94caba950a825d05a494890deb750c78bf8f6da87a93761564d5620fee4243a68c07fa10a9419d1c3ce7bbe0626490a3b77c77c62ce9caefac1d60521032fe6fc358e2759fed1c4935dcad4b63e87bbe44cd7a0f80709226816f74670de44b46d53e124870ed61392a13fba362794404e1f2e2f8f7a07256af2c2cc339eeb0b82c37f7edaeeaf24883fe158ce08f8034197d50f704f1d1fc6fe3d7db26aac53042d701f9bc3e4613de2b896c609396a855cd32ae3afd47845e17242346b10f5bc38bded11b8fe317930cd5d6554e1dfe11730662fc2b398af43690403c89e576f8d6dd286f284fb03d12793f50e78c91f70f5ad9eaf42e7ccce29a965aadfe2e8d488b5409cfe29a46ece22bc628490050e29e6769f09ce6428ba1aa33959feeeb4177d88dcf42224afcbf003768f9b5c9ad4f900b991b33ef92440049c961448d52114a6daef4e4b3b25e711722054ebbbfecd842661ff23ea6f02d2fc1e8abfe0ae61e2c07715e0bbe4ee307fc0227c1ab04c4a0d011bdba2a447538077ca1b7dc74c84b312dfadd611eca6c5f56dd55ef25d9997fa6d2ecacbf9d1512b3a245372bdd3dd4a147835b3cbbc6b4a9ebf30cae8bbebd35fe40aeaff9296c244a10bb99c1866a61c0a7fd272ba99441b023842d6f6331458c4090b41df78c24f5c4ca4d19c76ae5f2b5d76c9e8796d4d661d610d939446c0977035a7ff1fb5c21bbf3a45a433eb46a277a8b88d304c9cb3882f76d938f0fe25e671193cb22207a70c83de7bc8e43739746f27f3e96971b020b5f912479a7c3614c67fdc5a9285c8da8785685b219bb6fdd4fe60ca4d32268efa7f84e8cca192a23cc1283e8ca445d14f23b2152bdbe2b9de251dfb7f49de7906ee79440fd50037dbc7688798cce89ae29ea21d895d8551958472a5871c9d8ae2303783ea804a7bac79e45c3e6577dd48e0809cc38b676c0104a6f0ee152e69952b06cce60a3618b6c0e3e607d7bb418acf94b962cc4fb32b8b03033b9a58bd27c9304789dc8db30182af4c7a8b7c6faf55259ded8707cd1a02cf07f615e22ea1f0fc1e5e5c16f796a98eb720e7820fbf597c6fec265564d6525323a8ed95660a8ab176eaf39b897c1bc94f7f5494c8c3c2e258e810021d6861d780d88a390a6a7e987ab709e214bbc2a73b213b7c42c17a9d8068add6a2d719a3450e5496c5cab4f94f4c07b53e5c8472a48e020026c468f50ef465989b2b61fe9bd2b3733c31141c203153daaf664b70b14c13e91cd174342a14a012af6d2032aaad0f991aa7864813ef571910e1feeb8be5d4fecbf286a0fe51c60a87a440859926d0d10534f2c6500d7a3c09d6852959e1af09dc2e8683af323f49cbd8a84091c65ee1a5e140df00132309414cc87344c60bd0f68e5c2368407397221140aab9132191a4b558d84b89bc4a614bae10741e4f1dc218f1c94f01cbbb3458f00d3a9782aba7b922fc58f8acc510db214a1070e5b6e8d62bbc8cffad7faab4a0af3bdae7f559f3879250e85b43f7050967414534630fd0f34648c282a92c2e38dae563b9395f6d6de15adf318bbed04cb02e24a4eedf0d32adabd0b30261cda0d460ba613d642fbe329f6796670c45d36d00959d1d0295ce3adcb3a652f299c1e5d36745ca0e3f60cd4707f29d896a86e6de2087ba1d70b13504f3c561869a815766f2cfa705a73dfa7948adf6de494d62f14eca8bdba7c1e64a1677f6c6d9c97043e4669ef26f3b015db02f3ab3ea112b60a6ce59e140e894d7a623db5a5d827a8fc571757d9d44291cc9e031af53b88754b1fcebda460c89d22b33d6e92e92bb751b5af54d3b3fbcde1b29a27b8e2cbff5f5ba0b6cbe170b642b0eb01b55e37c1b7088e60b501300ca2c7057bfa3531a6afc717f3fb2f063b5301c319ad95b04a94b63105ee5aa3e09871e16229817e2dc4e8a10fc297fd9ecc1c5200bc2e49d4835533aef01ebbdc2b19ca84c775f5d72716b864b2cacb4326771461919658d20b5c02e66acbec71e3351d5e64812d555ef7ea9d3c25f3eaea8886c6ae5c51d585312b26aee0ba24596a46498111a90ac502a413df380bd890f7258a62eee951897b18fa3d0ba975e62ff1f09dc5ed7a01ad61530c7f77aea2197d376fcc73d8a0a068dba59b4ee921dc9cce2b0c6f159d7ecee5547acbdfa6860a48258385cd33377735792dfef08516934ca963a28fe0ed394547a88cee06b33957149293c1e9a6d0b218124e2e985491f6a94a2c2b848f3cfd46971f4c5b2796cebd8822391c8511bc1306c0e5c42d0556ab5e608ae0cb4677d1a5078d1c69bf29a0c2b5a5444896cdea79dbc8a0f669d71feef4209e27e23f9970ea22b2effef23ed0d2990967fc621eda0349a7473c02779a3b8f052b9ccede891bafc720f2b31830ed76d4799f032095ebeb5f95f87352debb18ce5cd2a0413c3086b1b326d6ad717ae12de41b4b806bea2032793b74322b07704222205e4228bd4a1b0cf7e76f011f4a8e3ded85ce9a727ab85751bf861d85081922025351cd065c6b95027fed6e2f256dfd725c5bc0396d69c6e7afdf14c852bbb3052a00a7c0401be1c2eaa9274f0455996639b87b937abf2e79bf9daf55d2927b853ccf376f97a489b5b212bad369cd9825a8850b152531146479525ba22a45e22f163dfa68c5ade35780ca9770b84e703d13221d32ff581f44679d9821ac3e6d4f40ad7f405c909524b1215b9b9250c819241010716bac85a604cfe378faf4938246be148abee505a9edc765b86a6cf64635ef9354eca70df5db79dc0c78f0fb4482e088ac7f23bb53711d444bb30b9150d310f45204c01ea0461bc050b8cbeb22afb51a2a1fc52cbde5a375e9fea51fa58614d1fd46801e51ef366eea2cee0999078c67881351e055d5fa8907cfd1f7c0b97bbabb248fa377314a063d67cfcd143506ef5afc526c97bc72ec29890ab03f07a60d201117348cb6d744cedbf9bc20b2951ff72d3f280ff3bd2dc3dcc7ef8cdb3447a0beef580eea5e99130be44d4afac787f14870b93b2629bc7b1d91fc16be96f8c16050747a465071ae7a27f6ff980ea5edb0af8685ce591693cde16c892c5eaf16b7e3105b455d7cf5a92d4fbaf4daf8210844169c56bbcab2803ec7409eebc8f5282fb22e71c6099d0b7cce09abdd0d5fa1c6ffdb49d2575bb72282c9a0ded501239ee060563ab5e9338ee868276543ee3fb098bf223d3b03f50525a0bca861bf5ca9119d6d1be08e93ec3552f2043a41149977d48a4ce42fac8f26525cc8dd7415d6cc4210fa37d1bf1d2b66864a6f1cd2da23a7bc81f1535ff91b5b0bc0d6e3f1c086db0c462a77078a30ff6ea840c5fcfb12a5638cd103720b6b274410bc7372dec7e4999016c32fcbec9a259e5dd0f584cb5a09ce01a4a51eac4390491ca71b8a05db5368ab6a7a4ac4d3259d14c25f0fb43209b611db4bab453c6ada65f34e6ad74bc42046c1999f4026e945141e8be473c9fde5700be859cc7e4e3536ecade9a2925667876ce021e4f20af6ca4a1ebb708e50dcaabb0d72a885b4e9fdf79c9efe6ba49edbc0f08b29e0e552b5d999ed40fbacfc205d2dbe7fef397929a8acf351241946b2523d33956012c9454150024bae6cc48f86bb65a91736634884517f31483eefb9b548a3bdec1dcb2726039316f30ad636cc5930caaa5628e8ff1cab1564800a306e8563ea0160e8a9dc1708397621a1c47269883af4f34a798d70ff83f57716d4c285ecc03c86a26be7fcea09b42ba7a72d7ed490a3a84878c400f4e377aea61565ccb6c6f9e978dbee37a12e1993685d520bbe6212ef9375172f23ea67713860cccc4a74c623ec783359c61d32e354558482ae05ef33bbed1b6df4df41793e456bf720303da06ddf7bd5e13d8cb60c3e49961c12850f324f253fe058a2213831d7ffc0afacf98d601c2e6b257365f065f598910e60ec9729e9378edce603a6c47528b449a089bba888e5cc6ba38d916b3d1c95602f564afbcbc758d2999b1a6be8147384b4fb8917667e9d5689977fcc6494a1ae3cd6de334171c6e04941f396853576e766a9764b296b569c921e0bf820933e4f15e8b16eeec9617c51a2d2e2f12e46e8122df3a2462e7094598bc67cd58ad3d94706751d1830b10d6f3838cfa0415c1d63f381cb415a73e44c5b5fd9180e0ab34caa89bc723a2e29de7c85bb07313eedb894c114af61f8e2e717187b5c7f3b83935f7fdb815831484bea4a33ba5057dfac8c021ce4c74846b64981021760fec0b79fc7e8aa2d72ef13fc16d82e314f69ac33f542860d1a56366d39dbdd45bce125e5e262610c6b94e33c4c06d7468e222436fb3407a5c7b7f3fca38712b00e6b7acc6fd74a7773c026258a5e4a228c9fc10f845fee13d8d25b624e825c125bc602adb0c5cb1133f75942323cfb37d318ff283134bdf9d63be9589b6c1e0f3d977a1465ac774c14a0f91cd4216f08ea443b1b8230dbaa486b3a2a3a82dce92c462d9aeef9b39aae63820ff0aa2a184a980143e7f2ebb797d6aa617c951d329058b9abcd4c248f59a580b6184590e86c9aee4be2f942a45d04d68901e1539e02558ac181022e9cbefd7189ab7247ebd8a35e9df39294f2f08c3b2b4b16246e0ab33d669aba564546c1d1053acec3b50777eeb4aa7d37160ac334a2b891e44511f83e157ae3200b79992ba3369978b6815efb2a6817cdaff4407f99eae33795b0aaf968c20b0071dfe9fe0e3f80eb72deef1059ccd0bd03558a687b529872e24f221baad0909bfad24aa480a613a06c689edaed495689c2a7178bc170104aad76240186572247190921dbb51aa02c25c6e4973f5e07b860516e5606d3e91379adf74775962e964edd05e0160dd4d3116266f1da8b72cd5efd0553a5ee9151b95f3259e34e140e2ed67d7e2de01059d1d38c574942163d30f26301393087a9ff225bb569cf71131b8deee26731f114c982cb53f622608c68ea0deb3b3a6a70bd6fd9e6739ad449a75bd0d94c83e5987b08ba548b9ce03f793c6c7e267c884a76b043799b50ac1654d8d9bf68566c5958ddbff5542223cae472154685778f9bad9c1ecb4b51670da67d40012529f3dc056a72a2fa4299b33d138eb0c2abdee8e48bd267fe4da3a41ec1da3b0d5f2a94e34748e9e88eb09cd5a93f69789a04b69df7e4ec3e75d05e103edee9ab966f1884ecc936996716cc50abbdbd21b27f894c68eca4869a8bb03d5ce4897a404fdb6cd36a15a75c2ae6308370482895cdd57267504d610c142ef8947196e3fd3b520d83b2037cee6b5ef7d8fd7727a47e3f927b9623584b284ed48e1cae831db020d986178c948e66bb1904cbe6997eff0c4f0e44e2c6e8367453a22c1cd2224cac7343311d88cc9b6f16af5202e885cedfeaa7e2f85763ad53e869467e5bcb7f794d536542c419780f63212648af496c3f07c0d6d0643e1b52155bf24f7a49b6fbda3f4a78c1059b009112cf44583a658e28f1b70787e7fee36ce2a61cd85d81c89c5f473c1a1162e722fca3727de93961c0a2f9fa2ce1d6ac51a5d842d0577e44264be21949bd6e279b37495f8ad6564e516d2644edcc2101660e0f7e0cc7fb12ea7db17caa7a1b466c6b2767f9724a987db8a26425076c871c93c20ae83f86a97b7d2bf2e6c808c808f0d428545d94f4880e24e47d1417a1d7df8695ed2eaf7c3bb2b8087937a5210370c61d25f8c3d712e5f4225072c0e63a39c39ba605e40fbdc6fc19cc398ee5ee5383c2e8c435b490c8b6ba49b3e6d8b63b0f788d65b2c864225ec36a5e148b2c21739617408911a43ed318c35807ddde6bd0d91dbeaa5ae14d5681de05d4854f633c132c0e2c72afa0dfda47cf827a0544be29d181293b97b079d191d14d78ba8143d6a18dae5c35a7435b519b0541ed5e0de7435dbdcf09e44f3f2040fdba1004013d123f6d32b8ba94387b3b0ea9d8f0669ddd94d699ba613d26f3c553ddc2741ad2f8a4079aab4348de2f3fed366ad44eba1ac712202bafda25a6eeee685459f714cf4c0c08afd9e7d8e81a4f5c15522cc88584eef6c0389cb7941e3bde381e0c9f00a7d8e118f6e795204aa3af5b029745a82ecb923a83fb5955e3ba940048e1ce2747fcd89922cebf82516884ce5e04cdfd454666dd2a7c8756cfe94e2f630d1ebd9ce63382d613a468bf2c90c1cd0badff68de093a94a6de3143465127e4f52d3e2733a678994ce05de46e47e7f7f2721909f0ddc54af0aa5fee60418c47206623675385dce4d0ffcc818c1ea3377fc6e4993d792fc5e0984d11c583cf121555f7edc4764231465f5ef72489863409f8ec97025fbc8e0d04836dc4bc62de5a79461b04ec2b07238b6fb5b61cf35607a49b93ede61e1bcc9b9d430c4fd9f4464c788fa34c09eeef00995dcf4d9d161f367c106ec0a6e7a5a9e541fac2b70c8f4c19ac2e3a61511f5b465fbe9fc60cb74af88cf363f98a3edc15db1e996c7f9c04a400e42bc3c61af7f12c228810a2464eab7a1a44787bee9e898ef6486cd5e2e2a22e839493c688734453999b0f6f62be0f5841e6c6253b6dcace00545aa7fa728e757b0973daee399a56725d04dc83159eb818cf452eabc65428db51a85e4940d37648fec66ba2c78db54b22b3623dd1d419fd6287e0c624a02fc5a4c86165ba1bc15be91df14cb978e082907da8e99f39ee7e5500f4012559337dd24d79c66ac1b7426ced14426be678c73ad6191cda5aa5f9fb42c0f344c9e4627ea9dfe1bf6ff89adea64d2a7b70de77665f2b4dff90e11ed9bfe002ef8ca2f1fe603c5e4460e5b3c2fbf47b5492a211c76b58038b87205b84fac9b6921c0fcac5f2e782866f0f2bce30b2bb73b63434c2ad37c40aa7d42e6165f684d8f28b5b89f499f4e1c4e56134f6f0417566253eec774315f96d8d060393ff04309a9602aec7ac2c031d0902bbb145c3c62cf5ce996bf25fe452bb70fff73bab159eb07ea8fe96ae56d1da6ea6f21ba8e27516327dfdde283801dffdab2244e004597b1dfd0c01e2597dea33ab2bfa7756c91728feaf6f0580d56b1a898793599965567f3f62467e879ba8c02ce16aa59fb379009fe31d5e3b47fd563fb9bf6e213cc300d4b3fcc96d95a6b2a094d4ba29aeac67d64b61b8e3f4071f221b1194586a514151539d59780654799ac8d12b812521bd365ae49c074408f3d53e42729b5871bf49d3a0a5436842939fefd88042a1897f34741e8e01d28362cd85ca7f66a1b4e902b69f433c25f18f149c634ecace442c652967f58009f6fa7fa4021136b09b4d206ee1a9dee9d1ca9d30f9ed95e5d2532d0d6968fe64e4196ffb81dea80f855a278f204fb80e73d49e6014f340a2c47200728b6ed96dcb4e130ee24e273903ae9c79d3bb341e484bac8c4ce6376f9b07940b565dadaf2d070d507bd630b7a6a8d3c16462ff93df8e2c17fa3d06b6b6923c3a42ebe78389e2b362e71d50f5eed781f86add57099a2aa1b5a57e1b02a7908d81e9601395525fb9a89c7a148e3cc90b814f90f6da188fa1c7e71000fdfe80fc74b270be5f26dc64b40472d7eb20ebf4ee9b144bafdb4bb0e1379944e32bf1fd752684544b67f768f7c79e27873bbec2b2c5ddb1d542ed33740f80536ca0522525ce1151d4a62f1af65e62800cddcff9506863e5f4efc2ce02e75ba8f50c2ff7e901be43a551e21f2221568dc6878dfd59fb3d4489428ad5005781d216bfe9ea4179d1b6180bceca2dc8e08d5ed9776331e6c059fceba3dd1ec8995b3c4c2e70b18ef205b73433c05bada72b30441abf6ab39392ea4b8c6a90b318a0f0215c2fdbc9a5df0d5bbf865e5800c3e547f666870a3d8bbbc2c2f218bf764fbce0017c02b2538e74f2d08088408403e86588fcf92314a0fc11d608194648c40d08ace9d8c181b0a88a05437c0fb757a41d50f743c6cf8f2599440114dff68a6afbbcfdc07fc6d1f291cc339c1e012bb2efdcc9f94da482b2c98b919df5061f4149b02c5c65896efd9a93f58ae3f81c9f5d8af98c205a384e331b2e072dfe0f4a6334fa0eeb4fe424150b0daafa1296c3d6ea0a6ef7572c3266714af2c354b6c0e8a9fb4aa980de00818fc08ee8c726caec8881243b01bb19c43c5ce38d90b25f3a8d84a208d2b90d70a0c2a908bc490f1ed4d25e5400816eeccae85bc5389e7fe96e4aa781ac01b562cc888c02387a1aee5d924fead9fbac40bb71ce12c2c79d75ba91cdbc8344a2c881869a4de23688cb9125ab57d4a64c406c9daceeb5ba525ff11e8711eefe30226e517644301aa3470e20e333a70de99c7ca08ac188031908b035561a459ae7f0c15d829da87324e1230879f6b78eee956a4eea23b02e6c20666acd4e2da754c4492f51b2c1ec781a8e30e2299cc5d5db93dd4d9dd498c60782436f161dbfe10d642b661c02e307538e5ebe44bd3f29cfa7f027885bdeb15ea2438e1a8c21274c80f62241e2036d3cd1d660c09f5774f2150bfa8bcc6ca86624efdcb3ff9792024e0438bcf5aa1436c73c7c35c9ab21d349a559109ccf35eeb8accd8afe6fbbbf29c9fbf5a46396c1fcf5530ca2a6daf3d440a5af4372c438ac0ec2f7ff360ed382dbfe7474bc5f7ed19597cdd0d6eac4336272c056f3ede49d8a6fa37876f60007aeb2c1fd00f8bdf391bce1dac7ebd4f58f32ec5dcf1d62fba425e6009f1b9516b6ab6693fddd1fb18e34f116d648a6892b889bbe60cd3444f088581e3afa334e886acadfff8714b9cf92641b9eaba96ccbc6470f6597f917d3f97227c6ec4afd9853674782812d7aea47d35f9d6f5e1ee49e86a729e7f1d2d31bbcb3cf9c4cd +Digest: f0eeffbe2f70c9b7dec83bc21a29d1e44800b73ddc032a482df095f01d433afaf6b892064aea31db5901b3721ca79f38ae3a71036b6d278546f74e4db3ef9dd1 +Test: Verify +Comment: length 55472 +Message: 49ed6bdc39c62135ff4282dbf6e3538bb962bae82da45c12c2e9c27bf54701f61a579a11582e9fa5f58e17abd35ea4513b58634eda02147209df7b8152e605412f33afd214fd243eb0c8255171db2eab46f55713a83c780edb7690b0717b68b311ea73c6761cf927ba567474d5433bbf61a15de0a03ad00fbf16cbb25cef707347e5ae96857366899ba2ccbd097c11b514c43f5dc8e4649c3e27f22c1b2866aa598b28e94aeab28cd912f5d41470f8b6e7c6c3312a227bdedf11cec9b410927fd043a868cb6a2757fe10b660fe053aea630fb204cedd5efd2a3c272e318e3b1b3277f8bb12d90b139203d90acf251e780f07d380bafb5620a711c5069989aaa50a8ede892721a7e71b53247990b7eb887317f04bf866a96fdff66ff7f5eb2846ddf0237a102843fc2367605549a3ea4418a5cf0d90049f135954efa94c9bfb2635048f37d7d8277a31a9554800d163d2851b396f88bf82349d940bc6a6816b6c9934e96884179a88ce80caf8bf299d5a42dff618ea7e98f9341c8cf30c85c24192e8fbb51dcfe54e8054880d8d92e205d85bceb2be292b8ba55639da848f46cca7868bc4ace751f5d28e583073f778facef589e20aa7811278a8dc231987413660776240384724a549940009773da862ac17ee52d8e2e2b5367c3b76d055f9a6452348cfcad7a6856fcf483fa44dba65fb28c7aa2fc1989c66392079b3e1b745dff20419697f21becba7fa7bff0ff62a4290da91182ceaf0904751d7c913c23ab54d60c71d27db77e585dc64926ba4da09b6f0b0990b1fd93c0e96361ad464ae4f9a2281eeb71dd946cfb8a3644a0b9cd904d0afbd46807ef3f6b93faf0ae3c9364213eee5172f0c75ef54df7d92749938e1443589c655083c6780998f9f88b2f1aefbb7092f5937fa4b78c1e62d27f9b1b512ea0771e69ea0c9b5ecc2799b920845a28463e7e3835e4deef0a6016ce3c9e903783e307a69a6841ee251826490046ecffcf9281417285b7d15c5f88b7f0ae3df8436ec5a91d600842143a02ad56c934cc7d5d8361ce0dfecd84cf9cbf6fb0c6eb9f88bcf3db8a5ae51a0bd3789c81bdf8effe18fb90f4004e042eb767024cc77bc8bf71f95d5dc661b71c0d1d2a16e51f97d2968173ce68dd6afb8d2140e8cc438f71692c2b40b7227bd9141db7df469af599a085def394f619b47280b40b21bd345d272ecdd9c9b1c8c18cfcae715f1599b1bb9b4b0a1112a0f80bf7d42a845357c11053ad9f5a9a2e63dc2c86439af9e4993c14408869dd9124be1919dd40a07a4bd95d52f806463d4e864fc7ec86d276dec69347e50b915ad90d46fd8a031f1c6bd68e567a394045d01fb8fbc2af19b0e0df9ad9b672e86e737e1407b73849ae8f9c6910ac800308a70d0a8a6c703a335deb9d6e533c3d5c828502c0fb4c9ab1559f9019f56718d621d2b70c5076de7e947f0d8e61d42aa584c695a1bcdc9cb52c5485eaeb5afc3edf0530fa053f60e3230e8da268b71aca08974f327254ca3a925fad0bf4c827b33d292acc01165c11881e7052ce61a84a7c8b81ebb241adb2161587e5b85b25d3da92e6fabab83a7a4223680809703da75f27e046032fa1ac261aa9109c70610125f7081eb871869ddfb1d74aa04f55513ed0ecc9db7b508950e3830527b473dbadaa00a080fecaeccf5e3093297b79d88a3b09ffb1b134ea14e4984bd073d8b3e04063188a9c61f77f6d266a1b7135bdcfaaca501c6dc94ef0a26b5d2d4b0a3a5c3ea1ff5bf6f63e8e730b47fcbcf3718dc49053721d881852b18ea194a682cf70193fcd6b8b02327b1461a523db4d84330d0e82592cfbe6d97654b1bd12ccf3ca54aefb4fc4f073a3a5cc1a4748ae765de8975548288f3af3855015fd2c6347d97572016f314b62b6cbad1fcd8190b87cdbcd54b5accc751f432346db3fc02c2bf02b88405c9d9022ea771e3d128edafe7b12f928063e25db5420bcede97e1110593df869a3417c5676dc9e0c78134e813b0acb25e15edda62cfaf09b95f7b745151bca51a1f197e0152027b22ea8937390074325aaa90d1e31f48a6ae1b75f28b857868ed508734e39f443c4a2c94a642eaae9adee97249207afd2e24957a939b773a587b8f08f0f59bb6aca80ffc3c14b68373519b3c4a002af62883933060696f2bfb2ca644b91f908152a25a6a0198ac1a431b8895dd6e765c1c32de3f60ddb573dc695be49749c4ccb6a1d785feb6139c95a47826084fa557929b3e509ce0903980987890925b80c0610e4cf63a573530ee533397d58c000e13257a0b1a584aa57123c3efb33d0c85da4f8264bd6158ffd892808f4c0dcfaa26385c17e42f29e1367005aa01d8b042a9ce417890bec530dac929b674ba5a52543caa1d024b761257e905688412b42057f150daba54c4ec7d5ef4b5557be82f24992dc47a9678635cf48dd245d45f466b227931430d9c5b47baaa34f739c2691eb8adb556f679facefb63904b07fbdc6dc8822534cf97a4c24513da63da3127cafff2979e55bfff356550499f91ce0ce64a34609484fbf07667f650a0487b91b1d7c313589a939b179a1ca5475c21fc5d1257876b131166ea891c3eb669e8d05aa9e9d18ead3df5fe028f4e4d4e3bd45a87b345c264212fa6114e4aae27c20c4ddb2d7847760537710571e9b85166bd65110f3fa05f73723269521f8f694f6c13d755b08cdc3386f90b8921914ce8df071835200dec4e5817f7f0636116d9193303292364ca0e0d1d7ca09bdf260a61c704eb8e11f3fc09dc25f2bf2c18a63b35c97377d725dff165c07e02aac9146b2e3efa31b55cc3ac095a1edaf956fef9a290f954edd6ee5d593febfcfb1c4e27c32c2ab3000fec6926fd3e5dcfb82b7b01bf8463afc583778261af31d907ffbb0e3742b9fbf4be69bc7818efb72674eadac0dc4b24dae667678f914b4c72714f97c70ceeacf483d452327539b888206eb6fac9b554fe5e56902f5bef5c45ea0ce7454ef71df581d271931ce2dac6782e1bd513494817356c86abd3c71268b3198517d17f56e00289a003d79325c9c45394b981ae070eb1d0d069c27b75c4149ff9a75d2c5d9e4c2467ea6cf4a2774c04a60edd8d99cc1babf6d3efb38d3f54c6cc5cbaa63c16a7c94eb0a4ac58b9576adb3ced8d0738bb24814f241663c2bdb5859daf96fb2f5da1debd476450782eacbaab7a575839d864f847274cfe369595acd405a4a0d3b5d39e7a1dc3909a1af4cbc44b9294b9bb92e322c1fe6781258dc968847735e9f687174ded722208616797ed2ae7c49fadd7cb48bad4a48db5c665c1f4b8c15869e7cf9f81180dab4b2fa58fddfeefd3f45b3621da75bf408d6807471d0e4d0a561850d99f5e5a6a22747d132d7e1d3cd845af15e98abf84f49a3862c722e0e60545226110ec102c2c5da8dfe21056c4a3bdbb8caebaad4034847f7ab99c82d4bd94cba19c6937dbb313ad5dc45ba3529bede4eef2ae905c934f64f7bc233bbcc72dd5ff0a7ed85efdbe14f49a080bcf0afbb1a37d0d70bf5a236f41985f14866b39c8e524d2fa9d5284660b2ebe9721360faa1317805653d02729c015f9141bf1e02abab00ea580fc902a0c46264e31685258a688af48ff3f8419dcfa994461a14985e677d9e1ef4208e85eabe738e7e7eb42c5974151abed61c8fe11e6aa41c39d60d141dcb7d26b15296925aa5d2bfd03f1d60edf763f23e7bc8c208950a39e0344e3d6be2e11c0de73957c17c6e6f0c2eb43b330c1a4293e7ff0f0293e707ba4b884fd284f94898c514a77d57afe094fba724fdd39c0478d9990496f7b8ea2a8441c80c221430e4648f0df8d815d90d3e5cda98de67cc5fc90d6f3030fe75b3670132533ac079635e2ef7ce6e4e9cd75f5ba8be9d1c1eab5ee29b58c0262ee76c5d1b524f8c66a80a6af1689aa8c075e71a3bb98017500dd3af058b35ce6a291cabef73c0e6ad3511c99751ddb2d88b5e1ef02437e814d9ffd95a51f265dc1af0842b524f5d917cdcd13604b80b496a3ce06289251ce1a21be7f617868ae91f705c6b583b5fd7e1e4086a1bb9f087a50bf50f52c8143ae8b0516576828c15b924bb0c00257bc526cfd5bfe1443137ce33c3531ba16c753065bc24e95707e66a8626a9e49e100d9de8df840ff71bce385cd1da3e319444fba46eb0da747cdfc60d05a17ff5eb05d9d77c72f2333ebf95dfb70145091a1ebce50f95d47b69663e21feaf3ccd3b424d0432e9229908804944d964ca986c66f6a0154061dc3c1e457d681f95a4af476a07a9732b8917c4d514cf71395019b23b8e064d0d07936c7e77e86f24eca579d35a369d8793cad1cbd7efb31bc08074edd75928309dddd54b99e63a7535cc7e0b6460c4a139b04b9006d0b6dc7a6f53a044844e66ff99ed3f6be7fdd0f072c864cece8512fb6696b41a18d905ee04a2d53e2e3c2abd4628bc567425f2ad36cd81e1c65b47593c57ba8a1eb6228c0ef70f2cad8df64760fc54f1f14f44dc8701e555eeb3d8c3cfe315ef58babce4dcc4b0a888a0543e88fc9bb715d6320ef20a0183ae2b21db9fed58b25d733f78fc905c3a560fcef31c8df32e285754a4f64a59039b2dccf10abaf56b935c24c8fcfe844a8c48b1159a44fdcfcf4f274f02577e4e2c3834b4bef07e83a0f1f7554c43ab6191d7c51690a60e04613a245db495c3dbd7d6f3972b1246930cc1319e692444081d2955668e15b6748484c6617ba9dc35349673f8bd94f0021d466e04e1f4e0b664d9fc95e1388988bfcba7eac5e819d2b8d3408a04ed0d5978fe0749355a03f53f5615153872f9c9698b236a31f52f4ceb29e3ab8faef111965487abd1a8103cd32a5975025989af182fd3603e456efc2216d7edcc4f4dc30be689dd5583b7f5e6c31435cd50bbb25246325d494d7b79141697b1394265d62020683e2f614dc8d0bcefc807fcf27b9e5abab1f191b73c2795ada6552cebd3a99ebd4ecdc5542e277446ac30b2d05352c9f71eb5a6b4cde330742dae634233debdf39fcf245d8e6195b362d616d7d2263051f403f0e6a6cd6395c7b39a0b8f560aa5918202ec72057db08c66ad7b907f1a65d26b04ef4f4cab8d04f315aa4e96113de4b4e5636199a8b87970cb2de6c3e4ad1a6957113ff764c455eb7a90ea154e36d9a64064e574b345ca7304817d9b2b826c7d6c0ee1444bd63b1b4d71ea6a3e2b10f4a863764d09e2ffebfdf8ad7b5ba02925c83aebb9bd2d34f0e2afe7fb4d84fb1e81e18c89391a7a59fc05fedaf160e0d0d027a7ce3543d40afebd3b4f18df28826161909fad56ca3ba33bfa40895f142d2847be0850c488d7d61c8cec1c9409dedb564b16f312700f67fd28328ff53399453d86ee7bf9d3d62d602548b53e1f723451e48596f80c53deebf12771cdef939b5baaf7238e4584590acceb9f47e9eb20c725420551ef976c6afd95eb4388aaaf349298e3ec4e70dd8ecc4b274bf9b8053865f2bacaaa48950c961438e09f4d054ac66a498e5f1a4f6eabfde9b4bf5776182f0e43bcbce5dd436318f73fa3f92220cee1a0ff07ef132d047a530cbb47e808f90b2cc2a80dc9a1dd1ab2bb274d7a390475a6b8d97dcd4c3e26ffde6e17cf6d5c5fd256ec2ede9a7cafd7eda9b892161fbca7463424d23ed1aa4c845835b0c7b1a2e0f409a780bfba3ef341aba8fe2a692d4f11b892c687676ac5a8fa2020aa914ab524812664643e4e81419dbd12f8892dfac5c7461ec867eef7b6d465938893dddb62d319de3a41650e78005374f2f85526bcf0ad5f443bbd6f2877848dd401c2c0398ff062948c08e75f641a98cc2f297f71c536ecbd8b4c789843fb743f939010030858962576a0c8624960f2c6a621518ea5715b86bf12b060da48eb0da1dc2769eca0fd4f89c31e2b20c51784e5c3495e11fb30225fb6b32c9aeb56d0b4fd92e89d67ec954df655047ab57b897685c38aab22ef22d59edd5616514c2b557aced9ab2c08793ba109a8b7c09346c0ef5c7ed1870d0ac931bb77cd194f600bea57e7965bb56dcb69a8628865033f6d7670b515a5fe4c9325c9fc3fb1b53130b2aa8cdf7598057596cddc3d112ff5c4a1bcc7f7fe575adbd1757ddea921f17c6a5323e71804c2e2eec66076639dec7f077d21f8fe9cc7fbcb6a574a6e2a333787de576da1a0186ba83eb994cab195f4fe4e4d893523268b8a0522d38f12790a81a891a3a0ee88a879932248b52f74bf1cbcc52910aed90383d26b2a7a9f355dee4e6d59a44495f1c97054e2c14c2b45e92503694f8451ec4f5e8abfbf14eaba243c34c01a46c3001e32abf36dbc0c11ca3392ca104843ae43062bf3db082ba7d9fe92a77169823bfe76920b18e3b9bb5644edbc216f00e21565a9774d0d5a9f660211504821660dd0a8c19a6157969b13f59ecfe16d3bf02cf99dba83890a196ee31b5b1d02f10e3b359511c58c354969b20065eec73781003e732e1d0fac9e3b1e1b485e8285b594c9a711b3e6084eedf6dd2e881195fd15b0b4428805d4a6712fbb789b24c68c83c1520abb19a20407506f8a6bb0c9ccf3dcfba8430ff4baa774569c317e260b8eb9307d599b75115c4b31fa08396589212f93cfec82af53349896f3dfd316aafc1dbcea0dc003ef4343eefddc2fdbba04352719d3024708af18d74ff4e82af3726b71c1563bd10652d6d12655e8aec8336a202695135e337d51a1e0ff01d57d782ed993a1636eef0170a2d40418514c355b1966a11a776c25ff71577cd4a89183d46ee19ddb2011e5adbeb7751365ae60746d6a959c053b4f6ee023fcb516d80bf8ac3baa17b70765ea9f11078e4e776b32b6a2d12ca9f9501c58d6dd4792c997081bf2348d764818c3bea169cd9e2fbc326f9fe220b85ebea455d0bcf0ceeebb9f28b5ebc0f05c54a5b7c8ea75b74fb9e002b2573cc2b4018361b20a350dafc00a7cf73e36a7acc01cf4f8280b3c500ac81aaa9eb54b91bf3606eb53a8e1957ae663268a732ec1e1a600cf90f29fc9155701b9274ed5805e38affd17b0dd2812cf85c47efad8241fbd65bfc3c044237019629e9f5dd3085507e767c4e172e03e125f618a22565bf0ef9e392ef8ebe7818bc7ab5556d6823a2027abe9bf2556634b4a8e1aae0bc20ba914dc3100d99df02a8b6fe7ee5286741dfb3a04ae76e328f6f19acee27b0ea6665409787cafaf1272386cc578d9ada96ddca29443ea2ed591cf280564169a77c3e65173c0d0a38f0f49228c8ace30307c367626f3f1821f984da66ca780ede63e4644a181ef03bc3e58119b98c2e6afd5b3151b432f955d96f7a643212c818831fe4390144d58209bcfba81273a198e16bd100fc5e6c1260a57a857658bedc44b78deae0c8e1962b42aadcbbaa641419bcee772d0c9adff6ed81ce7f9219b20e7309679ef23bfe8f3f33bd9d79a0660f1631bd3084aa440310374933080022491cfdb8210a0c429f7b41539e277d17294042d9ee0ec5c9efd745fd7b019cb55d7a14e353587bebc2bd7aa7a7fe22aed104c8d64ef213f7230753f240c714f2b255f4f21b24b1805fce86c0a144b8b36e286cb93777bb55056b083168a09162b07545ec60b5d689e0770ea6724266af6775d58c93e6e66cfeca0dc1dcd53b8bc0a2b0da0c54118eac7eba620440552926b3ab574987bbc277eb09aa85ad39f748a3dcc306498a182bab31fb3d86aca912aa982041a263e1d697a5f54a72b42eb24173af36dc6aaec5c81c79075b94b7932142f1637f0551849689a9126ad3b664441aa78455d9d9e29b22e5490935dc11e251d19766ca98eab05ccec7dfbf19c8747bb1d8fbfe20eaeeec46ebd6b69ff4b36ec9c59eda406fadc76d50179fdf44983ed81a17020b458721a4d40b4089a55d41dfd5705cd17a54718c955b9c8e427a0b2132f10c225b2e6a07eeeffa218aa8711daf2478d1756e03367ef2deb029e0889608d145ee95ad6f7820cc0def0c5ba78b3b0258cac7c32470f3268ccc6193603e85ffd5f659cbd7fe52e8a07b93408a3062512143d81b7d44dc3dcf6b525b39218fc2e3c2104f4ba26c8ddc4e881dc3140a5bfec5103eb5b92180ce1464ffbc480f6497db2302726b5701e9ef51bbf93f1c6615d7d7f475d7aa37b24fff4990baee2b1ac8f8acf561f98ceee658e2d5ba81bb8e01950465a75faaa2a48bff5d7f12609411f9157b8c3b7813bc0459fe8c1fa292cbb2372c302920c79c70eacda0654a2c3f8d04adf5050b82f8bcea1dbde06249be9655737beee348be16d28624ce330bd91b4233a3408f6022ea5bda56ab45da61a926e18e98394e93e57f3013346159670d98b49ed24ad8c2f575dc5d67916d3c54711f730d6b01a246b87476811d3d72cacbd8efa5850f614500ccddfe8f2cd8fd00d43237c088739f46fa549cafdf81baa6489da087308642c451db57873dbc0e99a9d1fc820c8e59f269b56d5f681c45f0acb0aa9a61ba548914615ac1c870ed05465a46f7b47cdd8269a1dc7500cbd370ab31ad04ca84e316bd76ef84f67d040c52d4fc69a9c492bea421d138ce17ccefee27900e956c5734f323fe1aee6ab9757648061e12eedf70bf3c34f1fb8798351d9a3b00e7fa18ab5e6f6fc9d9bf760a59bd4c5f18822e5e65fbede9aea49f0adf929522ebb78e43a7622adadf05a291a43bb573e309e6513c64e46510f44a36dc1888bbc62a21c37604189527c3a4d3fecb2ba49a0b6e11ec8202b04901ff80bd33fc15a3dc3af5725e1f41da81e69810739638660e30661e5a2d11805327b22aecd776a8533f9f447728271fc8cfa7813ddc786e9c93187af64ecfde702b92ca4a0227fd199a8a94571c901f1ec7cafa31e6acdb3cffeea75d4e338ae271e946556570cbb6b17e0907e1c2020e36c723569c1cd477dcb24e971385ac31637e4515e8983ab0ee434b8e6106ef1d8467a3b4e60f82d3932a16ad870d6ee3681b709374e97191b8a003f482a30ed51a722353adcf0cda8a1fa8a69112f682e7866fd6efa999e0765ed9422ee388bd5eb04a3cd7a29b142a58ab8a18de6c964a88e9e64321d9269245747f4c0c855db9e9c1764ed15708db9fc86106b7f9a5f8e987cc56995aea731d7db3c4672c3e94e42f09f8a3673e06baa73442e6c5395971f08f125943b481ae9be67e3ca6e7556a3dfebf62f43e1172ef0ab4b2f7d9d5e8cc375da8bd0d24c0772161d31be06643935c8a542591668f48ec4465b70ed415c5cd21d0f07bc41ab86b5773b2b22d37d82b40c323be6bd95ce1da462f5ebec1815745170388c98507cd486593e4140eb473cbf5154d8a18d0f15e9c8454fbb4a8e0b1c61fbc9bc90c4e1af2e7fe818fd13d123324c62a134f24b8b0e175f3b6e36d4d246b9ea2ae6ef6b660d689de83d490fdc478b2b2937f83d0ca6c4b0f8fda08017b10b647fcd6cd04f7870c92b2687574f238998c6008158e314d5db50634b8b511358cf07aebdcec01230f05e433f35f038d011f4293e3db2fad334ee59986513003a907f1562a57c4d11a9fe1dd12a6409e74d301c8f39d0ab45643f2b378bd1ea294f229bebf2b89bab6c8700fda32f1947910644e4fbe0b894dfaf62799e12339d51beacca45298056ae85b7154e95e96993e34ceff247a55a0ddb8a0eea589f0f5e8fc28e0b239dbbf6768aa87b4cecd5ac539ef09b99f3fd85302c481f296f07bc326797b35b4643cad60637c7c8b60470e3b5a7763c1707cc39a3b59ae9461ef1331677ec250c769220a433927db78e57f02b6510c2a0f149749ae7ec3c96bda3fe69cf040572dce2f30f3c89e +Digest: e202d8dedd8fa4163fece1923fe167fe49a9a83b0295f96889166b46f79d8b4532c1be2145973e68a139501a12a98d2850d9fdec40b66b9b42dd6c309bb9266c +Test: Verify +Comment: length 56056 +Message: 3d22c266a267e08cf07ed25018eb1febfe4ef79f7189c6f56121094a4ce76189fad7e53a6a40bdbc0c25edce31e36e55bf15835929b54a509e84919f81abec5e1aa2045b8b51326205754dbc3b46c0f61757dfe4acbd7be46d73b3679cfd0eae054cc7d2ebe2680743369a21205a3c586fdbb248e4e9803c34b717ab8525ee03229dd5a6743a87322e307e06c7680b022d6aa58db88082dd5c186473246bb6e4db5cd7df0ca3b66c2e2a9f7218b7547cbbcc60bc0fcca8514e5e43c561168bda975374869d631d3cabeea56dfb91404f7fc98addd3131b1f71515bab2470976cbf4855a20ec3e52a0d423900583cf702e328cbf6eb9e02cf2cb9552c55bf0222b904223b470b36bebcef03311701a01d4db3cd113fb586e9e95dd850dc4cf484ee4f825a3083378120bdaa0a2028632827303535b79fcff60f068d20a15f941bc6f01d05b17311faa173d7935bf969acd868ae6b3ba6047e067c1ba38c400a6eaab19c47b222ebb2a8db31d3b1bcda31c823debab3104d0735872ce286367f050058a7251bd9ee2f9bbb61d208b8de3d5f296d2a0726d31b06ef65e3758a1b6931aee5a9d4e042fbe4dc0e984a369b5a054104c31f30be41e07b70b043850521a67bffdac57f0e9ee906e12e5d7e3c0f22354b8ee37636022bf5f551d66c66b5c6879cc0d7fe7a9e1400819b2bd8e7e41ecbe9923c3f62e450239bcc188a65aef8996564f0a4b085cc9498e79a8cc56261cc87d710d56a71b5cd0b2bef262b93a67b02cdf9bad5da7888cb1b94e1fd1053ffcc66497e7731c3bded764587dfec37f31a03db88142682a5c43d0020b7775d2e6146cd83b1abe2bae8b301f6aa4213ca550f7c5693f051b32b58c5921d1de51fed7f862c3f677b8ba4ec0bbbb41ba2c85df8c66c7ac04d7aa771cd7c548c559b191a5ac049edf4f9ca284b1e24024bb4d7c6a011f21edec1e192ff29874c136a8d1e3389f9c6b7cc0270a967227c79576e82f18f23936c5281c243e0dce38954f093f8cd75792accf3cb0dddd813917ac833a32c34a65ff32e0a81e87bdb1d21ea8291d5e58eb7c046415fc96c4efce38de19d314de01f6d9070a18a8dbc399825f2e5e9728dc572a2da877306b5225b6694c7e698c8148850ff8c0e3a0c448346ebde5044ffbba8b09f6d23cfd16ba9fb5509923ae6a70b16bc28bca955a6a8f8756354826c032b1897f921ee294097f32b4b7e5ec23ec089b15edb031ec6cfe1995d3b545a04c381ca14b48c4607ebf61f75f32ae5436d52e517b56ff00ec2a95eb24ee35326379341a426d1ae2a6eae386f37c6d61cdb196039901652e548f9cd4bd557ded151f70392bde4eb0fe8c07e21925b1d33d2852badb520ccb32879ec1018d8846dd75518c7c2ee852021d7f9744e1143ee1a3e4d5c6cb4e6e12bd0c5e95e8ccb629254892a7c1602c3e099b24eb20fcfb77aedce2dfdfa29d519a660bff19e3e194a9d5da23585ec62efaeb099057e49f5bb3ab707af1b1cf8baa5c378173462f8c7d89c193362ca6414bffb3b9085390fa5cc0fd4cb3f48b2d573f8fe1977c168d0ac4f76c0d6253118749c1e9b4d286f004cde7b998d336c34b807373f8ee2d22fc17da122098431c2749a286dfe9e7c94612ce4612e678c9d1df60dd0a14d9caac02e81a1226fccdc68fd4350bf219e29b402f76b4a6c7cd949cf6716da8b300a516a00874a6e6a2cf7ce568ab83b3d86ec679cfe08c8a2b0e69a2c575f23f4161b3a051aa80a737cca1448641273c174b264bb64900568e9995d46dc589d5298c7a579a465ca4f9288d70326f55193bbae003ce30baa354e0c229cedee82b156fcb4426ba8376636da1f6e18885e1923874307c4a14070a5e7f016d14858781a636e49b89ad7203268f57182f421bc74e635044f794e83b7d1d09cd290aa11aaa4db76d26235e64dd960f4ab6023e47572df1ccbbc5cd54c73c81636ebfde3ce6603b2032ad61e4ed669dfdcf5eafaefd448358291f3ce2c75e36c4683db565051efe391174432fe06171a5ddb0064aab37838ba219ad61e7e26874a80cbd2f70ea6f2c55306882512728e7639ed8c6eb8780ebc93d955eb369b4d8a0a56bf8a4530c8e706a48a8ba182216f3737d8038b4f9dd01038b35b4749a74d470285d29d964b3f57a69ef75c50bc8fff68b230d305cf3dc040583656387ddd625a8c97bfdf65146f952e32eae3481fb60781be38a38b4dca78ad440e71b88081e33da05313fdb076f9a105f543ab67879dad766430b8465768184d14fb3e7fcd27feb7003bfb5993585f352279cfaf98b19e1dfcb440718e99021813def9226dad38a26e5d4658ee3cd08d1b8c9a3f11cbbb7eab380a169892d46eb123d0b089fd542a4684c8f5b02c5cd48884f65e1b746e6017c2fe7d9cdbf41796d1aa734ba0b81730b5687701b16bd1106aca56de321f8ae85d04edc3fdccdb6bf071b1d91dce31d3fa0e280852654d5c45fe6d819034c5c70e04b0357fc282d8890cb35bfcfd40d85aa24eee97b210141d79ec2c1316d95cdfe60c19e940d384a263c1fac6ac0be6de0d32da08bae2dffa251b09452d8e4ed7924a97c4ad9718465e22dd02455ba68c351cf52ee58b65e5e9413dade1ac45fef1b1d99771963b7ae5202e382ff8c06e035367909cd24fe5ada7f3d39bfaeb5de98b04eaf4989648e00112f0d2aadb8c5f2157b64581450359965140c141e5fb631e43469d65d1b7370eb3b396399fec32cced294a5eee46d6547f7bbd49dee148b4bc31d6c493cfd28f3908e36cb698629d53701132f3b60a29a60cf5da7c157e939735077f849999cccc78210cc598d9dcae1304c4fb5bde5fee7cd3bc67a1ef03fdda965c4d1c750c928ab8e177f27dd1299b89deaf3e3a3d7e52bdb6488c814e16a7ec2496614c99b6c610b371b038c4e98f0a46b766070a7f161d92c7df1ebb0924719e066e08b95eb4914a5edaf1fc1977eec5badb2b0f18515a168ba1ad91ffd98d94464d8fb5b3dda46ee47690c2dfdc9d2361a69094728adc0b3dda16191f4fa9ccfe06cbd5dcc8afe6ab8efc5e63447f2853ce1ce0b4490b388493419b920d2b10d59fa26001fd1c7b5c291f18ce3afc9c385bb93d07164f6709d3165e7f9b7d267322fea04c0551f59f50e03748437c46ba564ef1937a105e74a27dac0f8205d68196c6dbe367b81c1b0a2705f8e967ef7fc6c3457ffcb6e66c085ecb69492deaa704e25aeeabb7b7795fdcc807b3255f2fb30081f425a9c7990ea104b7785c288c733965965ab8906057e8c99d291e5e7325eced197b51c9a4bb2e9f1e98f95ad9ebb54302fb226d79fb3150e0d4bab4f32571d1178817b43518ede4c8306e4635753d3e5c165d176c52a0a5fb3b622856ba767415d4614ff32bc61bddc822b54917ba9cc933d156e0641d0f14e77c8444ede41f3ce5986387fea28b84e87d6ebddb12a673dbe6f17e3a91d7545e728e67c5a11ab44525b89899677de619e73b38c92ea4829504b2eddbe246e22aaa0f644a96ada47c6e16cf02ff392be2c8e262e8f6de1eea935fd54ffaa2e7d28ecee684ab203410dd45d44350077acc882ce440529b6d61fbc1e09fbf338adf8495937cc9ba8e8bd90c4e64442ffb5e8fe166d92b259a82a4a0b4d21b43f4d8f62a1339d6c4d775c935e66bc2f8d82046c98fbc67c2cbd5f6c4f9f0f5184c454b560fc3bb863a5417864362b1ac369a13ab08f0f0bb29e35af4580234fbbbafebe12f236148ddb22ac80e50fb9140555f51787dac58db3336fa780fc234699d3e931a60af52e8166ac2ee3e87ef1bd89381886c85e0094df39c031f860b7d97ac3479828ceb84093f3e8c333d10f2ab1504e0c4629dddbafaa39e3b68c81f259d8bf392e25dd91211028f37053beb574fa2278d2ad57d01b2d6f36950b279d07961319698ee0eb948d8a052c7b72e63a72206cfc7d111aa82ffaab32612b01fa87eda9996e74b864c86678d6bcde457874e249320d9c23ed4e46b21d230ef9b92aa97a0c490ba0286d48befd9c535bc56ec2ae01d34b7440f4fddba3d545cca9fad10b50a3080b45c8cb581fae748187cc5bfbfa62c1a449a06a8864dc61f36384eecdf5010c82437748c4ab47a46f661a18c37a30710c6dfd1758debcd6167c356d4277e79b8db8056b952f0c856db6d483850fc0ec353457aecd800b34ae4aa8e6f937cb178609df8e3a19717a15108816c129a895b7234c7b46e72be013553bb662e3200313bf822b3408fb04fdf9a15d08663c0ffac148276572b37afe228a860fd88b00bf5f79ed036c2db870e8bcd0bb340fad8884e71d99c11667b738f1c060a67082d150433e48b16e07164436fc6a219810e8e485d86440e928e71f2de005cb54fc02386a894477506366b2ac3a859d79bc8466b0d245709040f64b8b7f5fb5cceeba8e5c68a73c696feaba8935ae260912e391f4b5cdee90527d2496f8df042cdd72b88556e17f1d8f0ab26a583459eab6aeecdddd6df98dbfe450dce71425193ab34d91de739dd1435f30ac2cc887830a1eddb8c3965fdcebb446c9c49f96f6a904b3fe59ee37492f40bbeb2ddb5d56afebfb3202d7500288758cea0bc1e8698aef922773b1c9d99567ca83d5dd39f9fa6ebbb615c19892f89079ba373b77d662cc5ea9965ed407383cc322bf5ebbd18c4f95d176b58802deadc3b6d16cf3c1c33380014c45c4666a286c3434c04171d7e720009053bcd68d15c16c64c6bab02ead8caaf017495bbdc2fc24e0b2695f5fcdd0b00d0c8592967119476bd95b2607a30b134c43a16ba58519915d9591fea67c2e8c474090ab7d3821e441254397d0ac51e69b4b8b1aa3f73af5d5fa69d42e7a9fe1d9a06c95c3e371af9f3b128a2c32177187af54fd5b81e6cf14414f746a31bb5d3eac67f5ed0b9f25d07b26717cdcb2507bef9d681ecd9389831ac153ec49f75ad0b511206b08f0c38f762de244f4b91ff27cd30f7022c7b19ce75df7271bea674a6af6c9c0741d2526ac67611712a22c75d78437f239f9d3dc2773e29d3ffb0f062e97368fc58aa7309e815255def3f290902f96077bb06ccb6ba18ad12eafce9e80511b1b85bfe627ccfa4a9382252ebd37438e425071f8e514757445507f027df0e2dc163d235e86a830ce52d4bc2d662d5ea51560c4e4a3c25e137c4dff571f009aede2445b7cd7c0d332161f3f7b25f2df6f03150fcca1e5ca0ce89f97491c3007e51233decd9597403a5ffa1594771844409df5d92d4a0f57a50c9ddd34dfffa846289423cd3a9c063b82dde505c41e3bce487bb76316af75907af147c6e4c00a8587eda0f8516f93aa4133144bb765146c852f012a9236a24396025d5bc5419d27d298fcdb5462872afdb229d2ab9d7caff6886cd037356c32f079848febc4dea17b3e8de2ce155f222aa39c372b27c30cff0050e0904c41d31caf63bfe2fa4d86f436daab29086a245abff1e5b0848608112f33f817bbb1c86d1c61882532784cd02a79a0ffbc56a5f03fb16ac6443425cf8dac7348344a77845904653d0ddd778181d140ac91932baddb6142f6d76bfaac7410eeac266a64d4edd2d394fcfb7baac57816ca28be29c5fb67eaacce8bdb1aab17c6ae029024e133335fb78030dd9e6de4afd3021624eb185bee628a125bbc7b1797e8695a1c3bd1dc663f283c21eef39d58518e59a18fcab3aab2aaae00e46c96dec5cb36cf4732048376657bcd1eff08ccc05df734168ae5cc07a0ad5f25081c07d098a4b285ec623407b85e53a0d8cd6999d16d3131c188befbfc9ebb10d62daf9362227a9a696bf46da1724a172941ab68892a4d441702efea1f00c92a4f323288a84e6bd721885112a14604d4690c2e96f5bcccdfe3fafb6ca861fdc3dbc04d2aeb772adead5db6814858387b00935fbfa7a35467c0c75dfdf930bd80246e3be49c3b1c138542a1440717497d886dbb4d0f6c586e25fe8418b20bace191829b504b18d40811ddbde55e01bc5e78f1cdb9ad766d759c070a374331305aabb3f7f8788ed74f0b9548bfcdb605905ac603aff25ff7f09b875cf42d7fec7deb58be47950b8a3aaafffe6dc682b9a59660f97a8e977c719ce5f8b9e11635adc9077ac8212d816da8743b69e9264d10c4491bb3c2bb8f7b28b96a030eb2a07cdd36a9e4bd53415a6ca87c2e95ef34645cf4e6e64f1a957fb7682d69f6c3c16d907cc837ca1b4e736ff35d366d6c0412d8daf77c845322f1d178cf4939c7fcf27b30423bd7e40d6b3aeb4b1bc01b40aec081aa00f2e3bc63ff61ac4b684dc7ae05f7c46b475c02845606c2494e7b5e8a9c8f8afe2b5ac658a9c960cad2b3b5e2b949bb40c8d1c26139bc5f49691ac258d53b26de8e06d5426906695239a85c431d8c9346bcf3c1846ea27e869068207bf33aea2cab967db3a5af427bed7a0f41ab66e907a41094605d2facab64e1dd767f056162f488042ee83a68a26ec76360db3f28ee0ed69f779dda660247267dcaf101190c094a1d06b92e68504e0eed23259bef745db4575ca9293735c794760bd1d46da25a5b3ced90f1be100bcef0fb22f3892531286061f7929ca056ba4a9b99f5fba05839c846082ac66c1876337b5bdc929b09a12f3a01bd12fc8516800cc1cc3f90837463a267403dcf0493190628cd982047bd38477fff1684d327aad1e1eda5fd7c89738566d870b340b4163e223d167f8bdb000c9aef33e3b16c2f8d62c0cb31a3e79c516f3a0bb36d47bf75d0a179e336990b1c1ae3d793b0528291ccfc1bf78a1d32b8e90b6b39eacc796faca15ef5e875ddd848939e1f40894871a8d61499afa8cb0e8cb31bc139b0d86e1ea3224211dfecd3dc64d3d0f26ee5bf5f1541a28508e9d492c7a9e3daa35103bf2d50323355bc912eee35733681eedd88002fac9acc03adb3cf721c5e0277c306b68560dd65c182b8862f509d40c85e9c4d4b025150acec682110c5346cb12e7dc52e38609e904b11c32e03875a16b50443006e59354a3328730298ee2091a89cdfb7337d5ead3cc33bbe06950c3e636887fc2b12e86ff46d1bd3e1fbecadb3dc6cbcdc84247cea35464bd446f5b40c3192aad30ef892b2aea1e14ade2f49e2c502abbe058e83d5f07973e70d952bf1e7e978f0bdd436f075abd73e15471ab7df280032720b56827d4bc2c96968eac703f3030ea019d1205a70123631e274a5935356e47a197962444394f5daff94fe0e55c5773617f5e4b5b51ebda4800c3e8a0b1c4e5e374117ede776f6e2b7aef97f782ce5107d29902fd1794efd8e35d51bb5ccdacef361f5c2ade547012f8d5bcfd0c5b2afb7c0c5116bae749d8b761bd0e9f5041ccc309e6b1d7c50c6c5d4a787f61c7a74367ff612da2a9914f66175322e0174f82051746fac88cea429094f306e9d96fe979b959ca37a56e46d7c73c7e88e87c1ae290a18e1a6fb19b79fb54190c5b2bf59c846276e0a289c4f2b99faa008c709b44be22f336370a8000c9c4413213826db7a6a4b7086789d19f35a52fafcbd40d12e7eeb382ac9cf80d446a05c3cb1d5bb268461814bd1775c6827694fc6c5079345430566895100b88b66fed2749a3c67512711e6d6cdbb94fe9396151398be6914d0e624fbb0dc15965fa81c656bdb7e7ec4c537b3c7ca422b2171f15f82e5c1319b0619fe73c23689a344a09b91335f23e003ea6f5a33f28253755af72e0e3a1023fdabfdf44389d9c44cf563c4c487d4fb467575ef7914789c28b896f4a84234ee356196bcf09e1b5539816a510f871689157f44021a26828df490ab714468246c35c1455829c1a2b892eb2bd094eb4d1bf95e763c87a7448b7189a11e532a4320874186407fb32470d18904cdd512fd265a9968f95225132717fa146654e725ad9268d5f062e0f5108de1a1a340acab3ab1c6b8c2fa1e92e3607871f3da4d4055ffbdc0f263b9b91a109b7eeb77f6ebbba75cc2140ff22832e36b561153cb37dc27a6b3c102cbc4e0120ce910dba0133ba3c23186d44e67b809791d7941cf508292ca3ad6c095cd24fabc9ccdfc36c63d3fad73760791c5c55af8448634e84efbc97ec2ce1d86263b4330f65d5a098932b355047c1a6ac6fd408f77b2ada467aa545af7f17a3b64a583f0824965b6c0bed78f60f37d17dfc2629503990c625f009be526fb77140cf62571cd3cbfccf123f4831596b04794b729af94a3d1c089b13883fc4694be839fb03b3381b89abf2492f69eb054687a3e1e45876dae4d6c1e82ddc46d43896d24acc351d2f0ce7f134b4068eaca08f4e9b8ed7850f2479abb33593bda14032e078390a48ae8c6b582860700a08187a92c720dc3e83e6d8a19a26cbf0776ba4acacd39a8141121f6f4cb90f27c2b92eb88d22d16adf31dbeac58aeba8ffc2d47e0f204e9290a5eb7dc9494cad82889407161d1dd1ca0e6ad05de85dade14caa9ec9aa8c42424db7ccc7988d63ef8f94c98a99283bed836d998ac988c7c4110f5301f9bd5800126ba26d2c3b12b2d51744111c5a70ef9bcc8e73b4d4be501ae9e6df934a9d71fdef48e38fbf82736203c2d1301b377a5b6ff74131a9592e6e229f8c0299d93e152b0652497f7bd93f4289f55cd35a33cd3f1c1bc86f610615a0c630ce14d30e630723e2e0e5c58c73bae1a329ea9fc4f822442a028e9f7f184da3f27d22558aed6ce9bade582735065514031dc8cfd5e401b996666ed8427e0f7efb992a255abd409e03cb3f6b7c01f9693fc2d5b20d9ac5c1867d78d7f74fd09e73aa960c25db6d8be42d0457086b90277ca07a0f152154a522cd12634594774c8136cdd2934dd9f8868e0eb4824c0197e53d1daf948198ad94e0a543d454ecd04dc7373f4d1d6e2c1075c54991ac34019f23285b33c37820013e9a404d97177200e43c1bfb531271ab6b91e0de9411add5da01d99aeedb48946d57225865e07ac216442d45f5af0d7ff7da3f100b80e2ade812f1700aab6b72f746b19cc72f2fbae3b73ed10d2c49b3a1082fd01a69e94fd7c16d5e20cfd2c664ceb4c2c4ecda11d6fd164aa2716d70f18378c6c8b40ae42f78140b362fc5b63a56f57165ffc3ee747e7d56bd66c1dd70b4e2991d498d94769ead2057b38b6a03483a52b150327a47a33b9d65f38d23a50135f22110ba86369a014488436e0b460b4c0db0c76fddd6d217c8a200186918d33878ddf2d9e3f6d6d820d3c7b4c18c07f3496a4dc13ea974db7f7c75abd85293b4d458d531d23fb9f95b3f27a6b35ca4f6aee8c872c549f24d69fc3a8e98daa772ad9aa30b7c98ab2e9ed44b8c0a3e4a1fe53122c89c3db2362f293709d0387937acac42af0989143d919b1baeedba6134964d410ce80d1e5d790c5564a8f56fce79959c65a09a5defdb9b8053855951fe69450f85d4429d8ceeab7ae64998f3febb5d97756954ec0c25dd60c5faa282450420727d8563968936108fd8dba96c8e1a0d1d268d3e2a5c1667a54a731e5dd112e6543a26f8731dfa437d8285b1424740ac15c234e17fa65743352b18534869399f9c05dd899b10e24a2a2c7037dcf1d242668f85c354b48f79fab012cbacd721543226d29f762a952f801ec4c3a4547bd8fad6a96e0f4c670fda20890ef2e1730dfee52fc16c33bcfa669fa8dd0137e174b8dec86a1a37870fbfc5a4a28050d7d0e78a1978e5f2feb1c3f9440e5b63ac2188f1083ddb3d968090e58c11c0ebf4a7d85cba4b4930045e8172c1dd1ba185e452559471bc253d6b35c969e3187c7399b6a43ac200b57508875347d3a7b714c7fe53928e23b923d795b9629ef2c9fbae6aabc1657249fab8bde4fd76686d00d175332b1a7abff1cc9afc9fccb59c35efdcb676bd08b43b750b6c0c51c68df10a9d3d869f28004e532bdc49f4c9bbc963f41081 +Digest: 61dfe89880b6d59998d665a690588916ea60177ccb16932e653ba6a5774a46a7c9cd1e5fb82961bbf1439a051c95ea4b53887eaf592d17c1644758c8fdc3e63f +Test: Verify +Comment: length 56640 +Message: d7e6aa79e77cd08a6ef770bbe4bedf61557ea632b42d78637149670d4d6157d56ed7b2ccaee45d9439dcebc557b4118e86c15aa0ccc21c474b21abda1676cc56434d6d46422993e66dc99387dfa985358accf69884b9dd18a2c4d044488e78757fcf43ae485358c73143d0cb25a6239e8827e0e38419a21c9db83f138cb2427a4ae69cce6b6b9681add40a57d1b2d311a95b824973ea529d65875f0f89e912accb18e06c5178345a0a03a9f48ad67dd515ef4391f935d7e121b89700e83bd0542bf07751a2821a9b7058156af8190933f36b8a85bf011831fad451ad50b064ba91f3c9450792308b065cb781c4835f736b58c1eb6d56fdd41862f4df6a51b72626ab3e1027ae5e74f596f501961c68dda73d4f8cab3c6e14a2eae85ede25afe0129f3f79ace18c9c648f38b115ed0ab8cca29c301fbc5337c1f594f25334352f7c5732493b30a24c7ccde95aeafd2e4e050f109e74dd94869c0a62637187325d8c5c81487fa588cc65da6ec4bd54bde5780d13a050a81a495cb1b978e1258cb06c35923e1d472664463e31b735fb9dc64d230dfc5c23cbc8287201fa4b162d71416acff3c01e645c477f98fbfaf9b839adda667b3f58904a29d6a3b25663fbe736849f2f0e332bfb92270d57b556f485c0b986e5a14f521986640565ab13e05c700a69b9af8d618b4cbef7950e1b3bf4ad48d5022c0ff77b68a590def22ec3161a84975a4c34f052a0cabe7bac4f74cc9d0fbc9a86a068b9f71face4d2bd8b5e5a7a90da8d31be99b4d5c9d238fa8756b797a174570a8e1a5a5cc23ef3c7227c5875bc01198bb5a7b066826159245bda2467ed59485550e8bae438b5fe546fb83efd8396994abcc6bd0650f2b8d6daa00b070911008a95693e3d78119b6d5a5a31984d63b477ba3c033b9b4bfc18ebef95005b6428b147e70ff1e81a7118cba95bd0822e13199952a990cc35cef07611e9d94d1a68d04da85488f297295faaeee42c8ac05d384050d78a4978d668644c311a46fa67f18ff53688fd526a4adf72f434cde13bdc977eb7b37bdcbb879be9924caecdce1bf515dd7b7011dde0537ab171b458550e86236e92ca292655042f36f6ec5b4457675270e8b59d2a29ec51466aa5ef52d5f58927af9f26bedb876845a06a6c72accdf2185833bef82d933ed9a7096cdb3accf60893609c2c200ddae6d28fc800220f3efc52523beff5318893b149989744f3b339c57754172c7ccf4215c33695c1157e455e7adeb888ac789b0fcb3b2ffb5208e3cd4a132808be8d81f06e80d992c7fa1a04136dfbeeee561a49f91d4a67d23c2e3443a407bbb95ccaecf86c769c0ef9a4cd85b15f30dd6a37e83a05919159994181c8ce5b4d5786458fcac311e7d0c50a4039728d5563fb1b73f5bdab80d065453c4358ccc77e521c644a4c557cf7a475e695782d656752ed72940b423c20e961ee1b0b0430180774f0e1d1e76269df0d45028ae669d0b8d66e7eb8fbce2f6dbe1eb8afa8900cee78bdf71872a110bdf9e7e97260678873feee1b8c803de7398354820c63f0424f4d52f5eb9c42d2886254b0f6446a76cb8c7ad34e79912f94d918e1e9da57a2721e3741100d4c99866f12c1df3a77820aa89a0ec88dd3eec8e8f33d0fb8cd149e11f5454f6ec74c0149ab82f4e99894767cd734c0650a0e1bd76cfe47a35a801c4e13687267bcd33f17a75dfffad494592db8adffa93e76d6cf0c8c574307ce35fe19113f9f321689028cb9c614346af9e6c6e14d00770e40f7594f0742dbe62e498faa80bf31fc2632e4fd13e0beff9fcd87397112bebea378ddb02145dfb05256fe9afb6ec16f60ce3693ac067c39920a851b35881a6e457920156bf71915e84eee497955eb577dff0be2592d76011cc648f05f0a94067023a9e7affd93fb3758e51fc11cb69ac6ecea52e4fdb34083295621b83f336e6a9e008fb302554c889d6d849d6a2b2183be5b4b13203bdc105a391408d0ff8f7b11ad7340ac65ee23450de0d3e750d4fc9ce635b03b16bf0b8279331764004feda438fd1da3cdcb50774e9b2c3c2f9b78af147881f94dcfbcc89ce5aca43f9706812a94149095c9575bb61d7011d05f411e6c7c4fffe6f66a552c919138c35010cd0b9feb1bc3d27f1acfce670d39069d1277aae1f8ec1a5f50b1a18cc7946051b361886beb61cd12dc2117d8d9747ad5b3bb68018a6425e1e2b17c66f9bbb11259b6b65ca976a156c8325e8d1d89a13028c21f755d58fe3933b68ae7783f299ae7919186fc0b3894078d0c4c807e65f89a1438061acf8daf6a4733d6e928b233867b81b08d277913c0b78adeaa5dad733037197c69d2ba8ab0eddffcf77f33235efbeea404d24c1d1c393f0b442e60eb13b52c9ff1686d142c2ef622484b93b396994028081499f8439c929af6f768a66a16d8375b998e930795e00e8494bc2b56dddf0541f648ed5c68ed5567c2aced5ee0840b4e6d055068a70589546295d3c8503403587f42449023b70240961407179d9ae473edba9378eece5a60be06f21179a5e9f5b86d450657576a287c883ebcd4818a722096a45ef1a14b4faff7d25ce09b81bfa7b238e78b3755c87af0d8760ea1c5f20f7fca4338e722c93e50b9cf0e7f915f56fa645a48be8bc89b341e6cd2625d9bc05e4e4f4c09a87872f9f0928ab7e27ccd2b12881554d3cfe43d58c7a82c19173d1c78a9b46da50153dbbfcedcad3cbf132e8a987a61f6855ff1ceae1867c20b8e9f907af87de10fe9dc6dab8dc766d02fec14b3ff4dbd931339c74aab7b2022b9d1dee9a1a023483de54450246f2a562c4cf8012d81eda108fe8dc2e8d0fb02c899aa1f363d345456df8ae6290c4efa0f357da98b6351564726663f58ce1b53c2de3b443fbedddc3cb0889425059b63e291ecd4a25cb05bd79a9be981de48beb08ada7f448ae488f84286839fc4d939ad478da9f8d5d157c04373e7ed6649ea9984cff8ce0911ff917bccda1fb0d026763fa85117347df30b08386224d0e78185b462d864a32eea0f45a1c22d3147d0476185f387e27cd7bfd03081ac82ea287d02db478fc001f07b874f6352af08df27956cb8ce4896aae485a56d0fe61a898756816cd6c854badc291ce41592d9fc1fc3a4c876cd9315830edd4dd5623e4cae989d70c123edef3a12516eff4383cf35d3764a07d83abfa253214a84602019f7b0777ad83994389d2c35289728ceff73ad2a6607d354514c3cb88ca64786966c8657b3a473133d0e5e123b65aa8135e13908460025a97286b1ec3ac27f396e14038543ac3731a594902ecef13166188660570f793601cb5a9a037d61700147f70d485178eeb51938aad30ac42643516a0861ecfb6e2403cfdf467c0a82a5ca1e8dea05910168400195471765efe187951a6c030d35dac3ed68fd60451def9e906cb1887ed612c3f737d21c5cf60863107fc17c37f3eab3bd1d70509aa9a56b5590e602c7d77b492279be4132a27f8ce21da88001101d7a46e7e675928e90db76e3d09af56b6a7b8b4351b06e5a10ab13de6837f4f43bc191aca9f6b4347894fa4cb9798ff9a801397ed58e98888168aca94bc897070c2fa456fffc8903253ee9b2e7c71debfe823410900638939b6ab365975b72b2576d89cb31af98645e824cffa3ab28a831a685e3cb3dd7e3265a33fc951a0e5be62248f5863669bdec082a1a354d37980c1633decd5efce0eadf31558d2bf26c7ff7e7ba48ba847798778bebe5d6d223567a46e8e08f30f2afa2b758c7b6a64beb947004bd6272fb2877775afb6e81b1d679c7eb4af8fa813c4bcced8ae4b362f2a0eaba2f57bab064b2f74fbe3ccdaa55bcbdce54c3e2f55a8179fc20dca0175bc45ec4e4c0e4fd16cd12b277693d769beb3079461570b6d1ecc56dcfc7f5d4f0a7d30a25c6784c0473d16b6f1c5a7d70ad28d368192d2c6935b828e0cd3b0077f251733991ff04f74a3a62eb7eaa289caaaec601f4a0bfe9045a169b15f902b94ce1e96a48018cb7fa588036b7b7dde68bc93a5bd152d81b00b41d47c8b7447e5e8954fe14044e0c2c30ab97ee090518f88215bcd6c9ddc5d2cd262d0dfe2d8dcf539a3e1c92b1be88cccc554c2609f898e0406d2b8f38b022ad1a960d5425b04847a47289321d94b533ccb9f8984f4f14eba3b6f92c4fa4975ddfc8f04494ad716c5ae2826dfa585c6d910b1ae741e413ab26de68268c69d9e45f0cdd53e24df1caa4d530c9b1d024830593dc9946813e29b22f9f0756c6914a80a9fc0b785871696b95bad0a8c5b67c0f986438c5ec3d6c2defc756148467982ce976f3bc9698529568490a48feb9609664da4c28eeb77c8167079c306b02d54a12739317cf0f8c0c9705fef945d637843d675bd64f556294df886011430b09c26d1a74f2ca7d1fb66915342460b50ac06c33ef37d7be25509f712a1fd4293c7c42941db3508b147d28a2342f18fde03238658fb34e9acd9beeeb83c2e605775fd90916c429e172481ad387843556c2c2eb25c4b27b93635f161ef1624046c15579a0e88b1d2641fe89d1b4897f6ab758cc9d149c274fed835d31fe67ab9523466b811a72f4028989bbc343a8bedec7dc22f20ad91a7676ef0c4d3239ef9aa418f8d534df751f53d0f9d2bc48b95dfa36364f2bd11cb1038b6a991440d4fc4cb466c4bf3c6922a6bb8a26a8d0398d594e50da01edf5a89e3fc13e2ce522642302fd7542f098b68b32b8e68faa0616eb0cb7bb13936c024ef35763028ea07932ea07114563ca81091dc93bf73de8a1b959b51be92c4b671c8f76311fa517e48055cabf50fdc72b2864064c6af1a7d6c91b90220c2158810efb64d00a904f4c15298fa8ec26565df0f0b7426f2e0a5c253c91f703d85cf52f1f69674bb9105afa509ef3a04641bf6aa724448f5cdadcd5a200c356bb1e6e84e3cf1e6b8622b636b03fc9f5c54ef89d72947b50e3dffddf3725ad8e3168921730dc1ef1614c07d133ba52720b46b1923a510e3d2ce1684de147de32a10009efecda8f65b157f5d4c056b59f80f0914fe5a126db9da8c4278ab07dca75af7c14010f9950dd0c2a463e5d1b048d1641de5ccdebb49ffbba7319a6b3de143d938f55c462384f304b2f9715ab2a987e6847881c844f9ba4f23b7672a8f7e672f567d24015a86e8e0398b2c78e980bf1af9050d81a34f7691386895c839c53164ba45fcdd825a2edf78877baebd64c37bec39b47d4ec1d13c65d3aab6d56c3f03c4fe3b1d3395314d207ce38eb6dc5183ce753b3dbfe736ab2c771a98dac9ec9716e4835306be9cc3a1d9f87b6e4dc5cd1055f6256f2633580cc169c0c264c69910c75a11443ccddd7d3d2f073c3fbca2624a79d6e51533ed77411cd114c3598452e523da94a650f53304fbb4b93892ce34c13ab4ba1ad4b60c84a84c5a7c21e35dec75017071a2a533cfe3065daee48b0858bd6146dd825c2cfa9094fbe59c20823bc24860354f58200c897ea2391e633d8f764f23a3c94a69117a3d819644d670619ff1dc47c398583933701f3dcd0174c3f9e0c92415fb4177a9b88414988f98dc62a04d4f8be07ce4959d3d436cd02ea4bcc8bfc4f509368bc3986bd723867c2abed64bb324caee7d045874d07a49db903369601ce2dec8cc3c5fb15452858adb18f65ff90ab22d8124346e7b81e8fc15023562726bf668c79870ed22c1f7555be5a2e2a7ca20ca9f59b3828af03800a18ddf2f9bfceaa6fc4c7e87b8ee466c2bb94e8c45dfb14606394849a551b1a9d45aa93fc02225f3d8eccb098d240d2fc9186ba539b7ce107437753c5122d0281bdd361ba55822effbedf8fb262fb610c2678cd619eee1ca57c8ccc304f03e3be6a9f83ba21b7bfbc3c48ad50a5ddbcf964b24875cd186c43f81b18637263635d32582284cf8ab97cf04f31fa03ae8bcb327b541892c47ae89e6c5ee6e5162a65ff4465a1c5c0c547c23c4438e435758a771d19d054b8ee9c56c7c7420ee4e1deb8ad75986d248a269a560d93b03b233f1ddebe287cbd6f6708737bfe579430d045d979f12e7db12060e6b592cf883df20b076ca5709ba5529cb9a1a227f0be448e119a356f92e13efc3463beaae46aa929df4ad1991a3964fbe161b6e5be34417a9c00eb9a2cc3875688409da717526e5fb081335f02d3a60b33e4c3fbc739d0f3c4d29b1613fe03562a74b92fe89e4895c038532b1a1a1eb5f65251d0d376f8e1cf39cd4b0f3bbae561269aab20f640b35998ba632bb7d6e274d3e6ccaa93c12a065c0aa1e822b5e9777ec68187015ca1c1c9ef71fd51d678f38d0c57133733b7b164d980655afb4bb2a5c71be568a64740f27abb58912461bcab4ad9d70a57701878c350508c94f45bc325df02d2268e203be4ab041fca83175328babeb6343d82c14f796f5f89cbb9ff6637a6e8e35ca7cdb4a7c8a2d0c84bae2f6290e0d207396605638b7ce1b71682148a9852e59b1fd072196ec33c16a2e3e63a15323ab483906d766b8aa4a2b874b63fa1b73431ce6ba768bc291857621ad6a81554732ea967101bd932da73e8fcd5c089c0d908fdc7dafc7b7c6c72d47d851557ee855bf21275b89b1c8c12ee42f8741814db06f30c933d72663e4f40317deaa4a77925a8ba24b77aefc266126fa7c3155c4215fa615a936b8d98d6ee61468dc42756731186a67e3e5482599cab6b154a3f161c58eeb8662c9981ef253366687f17242c779f8277aff2d6d2d31dcad27d66600256dc341e7f3302822fcf67e19d1fec3a202c40089472c5ba01ee4e62777828b13c5357232a032177525ed162e5e6b5845556699bb77b57f76c457f2e001e7410527aa7ddf5b0e8b6d7082a52201587f25d458497deb695725c4be49ce0004e07df7aaeb5aae35f2706f4fc1916536a6c82201964d2ca86131b280515dec5bd7e2d7bf4110f438db3264bce1f8f4967da0a10b06a5b6033c3f0036a02c315ca5d82a4005aee797a40813429cb539f85243e3cd2104020a26822049cc9579a7b8c271d5af90d2c2eb75dd8948729fccd3366cd06c04bb1ddebfa5522d462f9daf4640f8a543405b201035f97bbdb0845edcaead5e242bcec35c01b8489acddef7b80a218d52dab0d04bbf0bacd2f6cf73bb1bcc6dceee8d52dbc814b52fcecc10ac5fd8de3bfc847aaccb38626eed0eb06656a611717dea2ba35acfe961cce588a794971e5b10169da80d1822ee0db28342c1d2efb85465bc675c725bcd22cbce1e5ad4a45cc00797c1d72374dcc36b6ae4ffdb6f1ffc70638c2f8482ee7aef6f95152a26ad86d8277ecbd2bec7b899d5d1531805f4f09adf86567f05323fb0cb8055f00bc9def89b535dbe871b67be528c8e214ae3bb557eda63ea4934dbc090848fdeda3e22f981d40f4f64643b497f6ae37fb478c730d01cca2ed562f98f2d06454f08771d5b697542fdbd1eaddbbb11159bc9009ead61b21bd52048f38d1f89f8b91d01088ec0bbab4217c759e5740376fdff37cc3ba23ebb75b053643ad6742cb58e688f04161bbac4faeaa9e758b69a2edd7aba5c10273b890c2ec628f07943bce32a0b6bd819d3feece53861c7aee1a6da46039f49e01e77aa1783d7ebfdf047a1a22826854a894854636fd55f510fee7c161275ae0dc6ca00ba47b8277694de407d4fb4bc026d49c7d1cac27e41576e3987616fbb04e708a6936c5a3177c3f956280ca6dae5d26bcdbcc3a9a2f46acea9069aee0f79d1bc121f7c2ea885e021491ec97d60796b36bc81050b6beebc583110198109b1294cc9daf1b5eb057bde9fee1098fb119a234acae9684794cec3783057c9386f504334326770878b1989d0f26c89f962e1c9cef6fb30b49b0478d4f3e01729e8e927f7d237feec8b2bcb72e857d0e9d1d492df91b50531461fe0ddb74d0b4cd246737b270db1a89a451bfc2c4d0e5ad2d506e337a1465c4a53a3f906e9161fa01aae349d33294a1cd7e3e33ac682bb0a85ae70353a8483fc523acd6f6eb820d6b840cac152c62fa766cbbe805eee88dd48e21d270b3046f08e0db16d2861eedab1d3942fe728e7be643be4b9709242cfa15a30997dea23ab89a54b6cb0b3d84099cf27355ac200b672acfc32962e8756116f50e91d1298a1b78a020a922e7b9cc29bfa7e4821e943f4977b885a03b5053baa04b2633a1467ba346ba347225743eee2946719a92fdb7c93d92716c26a516292b261dad13561e42ceee34a4fe9da510b7b8c59f832e17d2aabab66eb05cf38a1e0940e686a24d7ec123705f7b1d4abaf266a837fa0ea78b45961c4de15d3205025b558702114f7fa6c0b14ca3da751260b6e10afe87af1d968f6ab2c1901bc45e8425378f8d6e6c052fbf137ebd6e408b113ac1978076b0250e6a4459ddf6ecbaec789f36fef06d67d7625b14ae7c6dfbe07904cde2456a7b79e2acb02d0aa89efb1666fe4a1eac522062cc6e96e8c13689677aa99364761f399b91ce66a01e9319c635f05a404e5172860f935bfb63c676cccc327c1bfa99b75d9cbc72007620ae51b412169e7ee93597cc8be7fa7c330d70a27185b21f725aef75813772d9ce22808a6e667f62a4d15eaa5f20303303b81aa26c97700c31891bc3259f3e6f24dd19600c332d2209afa05216f0e4b1c0de94772d989eea5eaea72eb191ab5faa47e4ddf263eee7a035286cb83e5d1df1e6a4c7bc7284e081305c602cf402d2e8c8abaa2ae00bd9f2ccbd9f4ef1e4a01f3a133b1f0b6a17237702fe9eb28cef67c9346ebc90cc1f86dc2693def3c162d141a87a604d98b6cbeb61b310b28edfaeb048d2ae5d78e2e4ce2cf1732b3c8a8f632d2d871e55e602f4402488dc53c945e7af7e0a2e59499508976112819d41e20868fb9a68ebcf4ffa69fc111822d6b5d43119d8eab57d20f42f8ac5dd2bae5098238da312a0983a65a2e1b04e422d85e1964b1e7bd5a50df9bb1593272ffa637b248aa904bd6a4b9db47c6f66fcf83d75a5bee6c801eae57e05a98547f14ca31a349bb526896c0b0a67745548985c66f7271737b980742fedd3efa126b9cd97db1a68ce604ec7011482716add5e8387d1e5011a369c6a73adee8ff1aacfa4c727a098fc9a52a2b624cf1db70b9595286aa42295279bf43a261e307dbc7afbbb678cd347bcdf26b0a0141d43bb87b9d12a2f22b374c63c0ac02a7a4b4504f7fc01a7c3b8ae3b7a79f21a1c17d67a180b794daa790665676ee3dc17662bb3c2115fb90e5658aec89980a9c03942b7da5dbfc562f1c3c0a0ebf7faacd358d08482e78a5c2aa2823596b489b1b3e98626506460f122941e0d0b644de49bb2a264d803e1563a75fdebfaf581988db12e246bd0e6001461c9d655929d64c723738b9a1a87a390b769124caa5a1dcd84f9fe366c1f36d013072451eab2d75f928921509345ec34520cd1153ddce77d492dd9399ed23c5d90211f88d253e369e62e4d82d8e1d92c2c2f51dc15cf9fa4e813e0fdcfc9b9c3c25fee81b34a30ef09a737b9502311822f19ba299afbec4b48f3380968ca560b9008bac4f65d67f8e23f087c63d53d3e421433853428777953150ce5cf9ebb3ce166aada0155308d593de85479bd04664c66e4764b1de836f0c0821a6e0d8f5e9fbfe74a3ef932b556e8fec8faa50f043758f68647a3e68a073ec22facde7a7ab15c989c13131678c18a73604e53061fea32913d9082197e81d5f5acf0db2696ff85e659ea6983de82696ea4de8f8fc04d3cdc228e822a1944ce431aa4ca38bd7181f9082ac522f082cd181d102355ee48be00bdaa6ac1643971d3ff2f745bf4ef9af8313bed9bb5a70099524dd5feb1c3ff25964a0485654805cee6f9a1354561160b5d85a99535da4918cbfe6f3311a6487136d8161f265ad45b546a186eb7af3e5c1270c3b97904efbd1189b79b17d9e10f24ba6936af5524a3d3eaa3af52c15a10db6401ae880b3bb2ab5876dfca441225e85ac57306233eceeae108a01f7fb2523dc92d1c6bd9751c21d173a633d023 +Digest: b09c9f68183d97d9f1cbbde53856bbb98ec3f9285814e0c414dba1d6824572c5dad7e1d88e4052686ba506c12f3050c56cdd0cb492fbd9afe46bfaddd2042a42 +Test: Verify +Comment: length 57224 +Message: f297a2420dd860c0a70cfe74202087cc7f10d6c813fc58ae5a7d13ff2139e7a9edb5147e9a6bfde5421d2cd0606895ee359c1f216bcb6032f920a8c4467242869119f6ad9001d2a257fd2bf77c5ddea079c2db605131e581776793c8eb6c9ba8a66b4fb638c1685db05403d3bc26e94b112a136d0d566e039bf9dbf5584f7a77f4522881dad4467f13cbbd4b67ec3e58c67bcf30e76183202f7f8831d442675b427788f6be61f57149095f46c7d6662d605d1591277aac40f9a0a366a86debbc598277fd2b91fb9a1ab7f4ae220de834a77aef7814cb72cbc305337b1df98d02021afe7e6b8ce2614d7d816ac1b84cd4637764cdf7795c2953554058790ed69503e72361c4793130ac021062ec001b745bff7c7818aff3c27139d3e504d34dde2493f08e7f80716efdefa87eeb0ddc7e58b84061bf93bdffe759f20a08717a432fc36dede3cb298209eb52a605061759224ab770344d44467c5ca8afcb10e52dea21a1673a7fe1d6989f15c28313556d815eea8ebe061000f7ebfabc96d617051f5594e2cac722d172b3f9baad5e1c223d9cdfa1a7e6a79621adf219b1ee973194074e47ddc972db5ece0676cb0cf7e01daba0923514936ec24b97ae647eed1b12ded87fb9ad5c5c259845de25486b0fea34354ab1b95cf2a26cf163f7afa22960823971a69c65bc8fbbbddb033802176cdea4b063fc888988b90921b1a83dc5489c7904eebe176464dc7653ac0443606b52f7ab9206a19a3dd9e6cedc92465690d4a122d83af9ba6ca6793069d5b652af37362587fe2f8f8a759054be94454401d1b7b2ab3893276fbecd5882d3e456ff3667058b0db8cf353510999fd7c3f6633cc69bb0e26e1434cf7ab53f2554d225f79433e45bc6c206c06d87c98248d67ebcd3c72f5e11e7847f892de7f48e30e721c496da0fe0d0c7bfaf0583be5a4b19fae81d6fd4040a277601aac4671bd60e5c0018b7528f613ed9dffa14b383bdfe9d0c85ba6dd0e3e55dea131ca7822e62524fa0c14b59dd34b70450c5884a94f34e48e75650fcdc86dc4d5038db4b9eaaa8b9174223c9ac720126eede663739c1b5a32b8ca7105bd19a3148602cff90b009466380016436bd5e4dbca774d3123079253aa49795ca8f409ee5dcc2256b3a1bff6dc40eb4e4e07682a267dba5880743d6fae64a129088759c0ef3c445971186eb1d5571401ca1f2cc8868c2360410babf549ae80f1584e234abee5ae87cfdf3125c7d539047ca7a3456f0520cec1187e730079814c14b2f6da515ae9582c50a7d1082dc2dce21b5c1f448b2b1a9d35156777683aafca40350e2b0e5d41133723322ad339e176f4c7b4ab80cada41ec1150f2fd1582e5906e34b072a2d910dd43c7b46816b8c7be66a4187858644b97f2be27aa9a7bf30e130c862a3296a1cd7a10195ed1d940f2c97bfff47c6f06e32a0d79f331e17f23c3f4208784f042824699ee1a03b96f1c609ad667af41203827dd5e599459e67be169f42d227c7f9629c3974c24dfcea5bc8f4054599114119c9c69600a4bd5610bfc958d93a1c563a43ba947adb2dc293dd7a24d13c55f09c8c91f892c4da88da42a692b40f69085465088af06e9141184f290b466546d8b6ce1e54772c5fc6c3a520378c2f17d8570a0d9e4d8d902f8f26e801cb9d4cc00d9855f1d764b2d673f21e9188208f8bec3ab017b9c19253a36b9e4f886acf7249f11e19d9f53d80933187e6d16c38ecbafed93f5b91ff76fa25353ea65737b413e26112a566668ecb68457f8e9a79c26a5d705c5c853f603c5c94144de9ec4f13720625643f97c6c2a13fa4e833bcd4a3605eb7e325bad91218a319a4aa560bf0a9f59a3e0937f221e35d9d07be68eb0e0e899819fad9a924624a97d421ddaf528f16b95a4aaed88f3787b112c3e5cf526fda46268b0297194171d404d6ea05e32d51c9e18d6341b5a3a52931cb9a48188b390b31609e6d99be00195d52e3d3488a8f14fa57c0f43a329f4d8e5df11e086b8f2d620216f14ee0dfae071c32e22caeb6e0ce322cbbc8e95d654e015118c916c2f5e2f8d0ecddaff7db29bc3dfa35a2b07685a50f5c04d2c8b99c3f22000494bcabd9ca3625f1332ee8ecbb6ee20b6d631e4639d2a098f4c6919ea0cd9c60ee63976f01af6630756d1c77a02c645717b9203974db4f2c5740347cabb8b5862ba101ca24a275427c9dc1f3f3de46c1a999c387e1933167041feb5fe94c121d535d3015bb791bd050a41d873dee51f02aea505805620df20249fe6fe0f17dce6f7f6d764f9b2082fa6c785c04c34d8da2960fd36ab1ad7459a8b5d31a10bc4185ee001567704cff81db1c99d3c5023f1a84482197e6d796122357b41f0f981da094311b8b6067f0eddb50672f5c38af989c4369146b540034a12e397558d90bc55848b043d338fc47535beea2f0b68527c647d46aa6ec59c70c808ba65147b2fe228cfb183188cc962a8655b3e94568ccea9e8a2001664ad44b96d13a64a9bb52da462591e21f07e24a19c5ebafad0091f08eb2bee28c7a6146b834b7f8c9cdca69be55374ec556339a5c65d0aab6f67dc06075ccb3249279e52edca7746d916cb53cb490de42619202965eec4327f298435cfad3dbf73921103ff091425eae42a7086a26f85dcf066a11d7c7e0ca9beb5fc96a5bc2cd1863af3498fec964cd5427699e8106df4998ba13f9e7eb659a7dfdf1ecead06ed646aa55fe75714696a81ea979276e91764fdae5ebd6cac19657061aa90a6da11cd2e9ea477ea2ceb048720e22a29a38ff33b3cfd61ce7a6387f608dc842012f9210543b9ea1c4c2c43c0de1c17af09f8b4c2b18e23fa8dc28fff592721af4e1df07d49029673feb798ad5698035da8dc3a32b0a36c9772a0ddfab70cf1bae7dacc04f3010577c11783cb4f0855dbec94e3f9cebfb42bb5990256c7106cc98cba041ae647cfae1fc695a91bcf879061cd62864045830db3158db1fdb40b618956494da7495d6d773f2ea53160212194e00676d9d761d417a0e08acf7a45f97a19fc1baa88275c740bef6e446cbaf5f2776039dfe7d9054fc59b5fa0d5b517eb8face35476c5f172973852b947ad8406fe004de6e94127c7fe2e9f3658c1433a21dc5359b7a1a31f7baa01048371624ede5731737e32a21ca50ac7e46602e2027afada1ead5307b723a4e7ba92cef736a2e57309f9360aba64c0683faff29ab0f598f607da4295f619c9754007eed95ae63b810efcc3c83db7e00ebc7908d3e21c2725c9c108b438d878383955898f3812b9ea16eb5470f318da19cf63be04026925e7c8f41e091bfa41bf1b0e077f3ab2e12ca667708b87022f27fce2aac19e7735ca89d5eafb0bd9b6684993e12fef3151b731d3907e65fe4f97c99827830290b72c80f8f81084f136c25979bf17d2288c284dc24cd02c77cc07c9d6ecdefb702abc52dfedd013fb436bdf41f9dd6002e0ee6eb60e17270914f65241432bd58010c853fd04b035427cb32f6f19d7355b0077f9214cba022ccac21749c2f02d3b09ff18d3053765514346ee63a79bae9b5b538196914f2a5d5e196d52f4c27f1b66bf15f447ec20b2277570c21ba1584e621fac78643d2c053f6ae91f512927abc786efc34534f3efa9ed7afcfe7ebedeb52abe693e0a73deef14fef1508ac3669cf4ead295b86b544b0d5186b88a3ed6b5034bcba74d9e24fdc6336b7b7ddec66777bba4b1ccd3aa7b638901e25a74c0f247e922186d0781ebed1af05a58e665a78db6bc1208d93cbb7ea5d10475ed27ed570aff09ef3c602a081a2245c256aeedb5807b4ef2f8959bbd2c768753046606bf15d5044ac96a4895b563f640cc1caa7d9d84b0f19e4f9cbd8184f3885725fefebe2690163aeac8147157c43a93395e44524af0ab56c52ede496ec17c51c21684587625c7ed7c1912d2503836687f79a863407686ae90d2bde8b689a580d4edee79463de66d98bbff5cffdabaa879ad283507caf9f22d18dae3dea49a70d8f59b951960d837cb415875b9244dcf9239424c03669bee0471a3df59bad18e48ce2a20521743d88e19bcb11e9d566a63de651cb5c1d2eeb17da71faa24d1459ec808dfa2c98fdc4bc58aa392be6af568ed2f2ba1654570be8d5339628b10435573c5f76e00329f9ed540a1a7f001fd0be5fefd58e95a10862146c0f55624e40771d01c2643c2bef1c97d5fd0eaa1ede76953064e96874a92e9e02ae50e75c42f12b5b26e1cb696ef02af12a006c14465e7d9eaf525538b7f47bdfbb42c89403706e55e97f394d3e111448e97cce69d11d1e1ffeefe555fb5bb4e97e528e604a9aefd855650c3d26285dc082aa5985475c819c98e89f333a0c500a3ea9c027e117b5cab0bccfa3f0dd0e433cb394d170c2acfec6660c3a3faf5729456ee6508e90c81543ab07e662d72db861bf07b314f8a92bd091b2d3d1ebd22dd9ca89451aad319f565b3e6e45bfc50637f53b94faa5800dfe901b64b768c80043e5306d4d15f75231f4fba3603cdb17077eb7ddeb72378b978ccf57bacf4189cbe66330ee7122141b9dc7ed7df779d2188203f4af06d88ce5ac5412a2c845b0b8f6aaf6c768bbcf5e7e29b46297a61fb428a8430e0b6afa2e1934ff37fadd5d543c8e279ea3c86a40c0a960d8c56be621982d30d026f6bcbbfaf784400e1078e5e1962b3cc954cd0a8bcf59a729cf0fa8fb1a25bc0183bad478230b87abe7e9b40c4b6b698364e003062407976ada839179f8899b4419dcc1bb42fbd27a689809e6334dec79028b755a2fd37031942824394ec43597c00ac9eadbbcea239d6e2c97d83a8f5235b6a6ae7823f92506e7a964a43e52a0812c352d77b6974d8e516446c29b18b70649df2b8860fbef37a96721835eba0a632a4dae9d51a0a0422afa1b77d6504f7b2c68f9e6f33f362f54a799718e347b6fec5992d5f5cfc6c1e2363f8155ffc39f47893f1a428aa3f7d1b1f3f8368a9bac5aa104a80aea64135f60da687eedba77828a26adb7a7de9609cd58a0bc8214225d6d2a9cf8ba25418bc013b2bbe1dd0dc6b2d526b95c8e14e343f0f089e58bd9db042c3b2707ae514d9e13e973a5d468f94b740daf735b7a465ae270057aabdabdaf330dff99aa4e8c4102940dff4690059b2deb03b2efcf1c5b57a8980b192cecb66799e937bf3d32f2073cf3b8db8ed0eb26471ce2ef1b4c8e7621ab5e80d74f61ef674bab952826f94a688c983c69448287a962cb0666be3b6862a43d86e4cdf7f3ff8ebbd516509ef4a04066112948aa79993d34dab95aaa54f3ed6ed35a50c29dea1b30271098292d6d77ec01d7c3a924a015e6131b0823635decb91041bf0813af59d1321de6e11c5599f0b5799fc8af4552aa5a95b0edbd270be8e5a101127dd6af689f45220feae20e3bd51ac34f42115c46572e3a5189d9b1c1f983002804e787bb159034fbbe9c3f9508bf1786078b9c82b1ee8e97f0fc450ef5eea392d06b48943d0704edc10a92c5f67283b4233b782810dd94071917319580ebd29708ea59b9bfb17b2d1bb47095483aef23c1a959fe1e0435e82cb2dc1f43817580d4ea24f242977f02f32242cba6204319075ea8ce806a57845355ae73e6b875955df510096ebff9b671dd6e30b72a67df1de1cb5ee117e321b4890f5b1098b81ecb9285c4ed33d28fbf6c5e8c246243bd2cba2c76e714c20877d5679d692a2763464aebed64fbf0d6025778a794d0c0fa5c7231e03a68da81c5c21e029a75aaacf5a3ab4a7e1d3dd265272648b07bc4e0d4904463831b15d3c6d79c524b812a4000272ba4e1a3a0cd0d63cf39206b38b5bd9cccc66a365a48a19c4a5523578d68905ed4c23594000d2593da408ba805c23e1e31d296c090267f998ed2cbfebd6ccdcf0e6e23f947dbd33fb1269a3b114f809fda4fb0c1a1b68757d193eb7ea094de02426e52d95c7f3ff0bbb2f42b46a4aba731055f427440e25d7c5e2ae02027eb7fd68b6c3c2741932d60ae41808b08e6bc9dbb4c49f10cb733f5fc302b246f1ecf348d162b9069f47f08e02b42c7c55968863b1fe100612f62a635a66793b29d79c23cfaac7f3e8c6d1b12587ae4212d32544b7f0f89897271f5d0349d57399005ea60c0cadc09837f010a7030c9658aa270b414dd74caa7e84c9781d4574c20fb13c0108a8f12013d23911c6a5ed89741403d8752a96df650125036147b3374e4a42590f680a12d30e76e04328bc47d962db0807611b9882fafc4fa65ab35b6480757eb1598fe2fdfb66bcf8f386f632aa0d4a65292f885108bbb76d0cf9b0bada31ec7efbd7130d2f94e258a4d227283ff70a2ed157015780efd525ccfae9d9de042cd8dd841589216e0b029b225d22bb34d1b50836b5ef1a051351293b3949f268aa4f6d2b7cea677e9157650c0aaaa2533ba81c22f8b02a980c7f804f5183cddbff432911bbb968231ff790d3b2286bce9278abc04c2349153b11908bb4ffa6da9674affb546eba17f1439d2dd6449df39097257342b0dc08f9b7a884c64643f10a34503cc982c3b9cfcbe88f0957af8e909427d06f0179eff2c256df17dffb9bc502b84a9d8e1b751601015bae0a26ec2ce0115c136da946a0d219df2c355447517056c952f937f64e83863846b48a98c01b707ae28dd0897e67602975ded4902a0daa2d6c5c9fa9d3b3d58955ef4110f496d3b15eba8634f5e2d8328734f2e2c92b20eb4c10b90c60227de37e22f0e124f2a983eaac30e5a1d4c07ec2f045dbb959598794be1a9a5e4fedcb01f7f085fbaf608708bb76f80ccde782cb7933c77538c286b8dd4ad048acb39493c6f67bc33d973f4b60af08913e8bd3033843527719ea6d4ac6b04a99b96df4a618493f262dcbf135447f83c9974be40cc60ae959ad4fafad32f175cc065b5fbb848f4c9ee06d5128df3ee62078963a4a9ad118774340c2628a64ce7a142a3a36642f20880609d3c88983cc3043094a3f4f6c5c6a7c9c49fd35a0c11e534918c96faf679bff0ffd86ebd492739703986d2c0321adc980baffdd3c0a1354467fc6ef966e254c0e42d66eb7d564d513a966d95c04abbabc79cce97ce6038780d3c16c6ac0ce6d8328499a94017e9db7f18edfcd720eb09e2af6d30a01697da6c94b7e92ebf1e3ed3252f7ffa34b517f0577a7edf6215ba423003269c8af9726a4b79eb56c2a4fcad584ff51373580c769a3aa240d9e0c7d167b7ff2c860746f0ab83538bdf1f1aaa652194f39d7bc2f72858f0624df537759bb245b7d06961e7fafea934dc379eb193cee3037ac5425c4afaf0ae86fb1218161b7fa531c6c835811176bb829592a92c7e6ba9d1df938e48492b8a4b9b60a11e1b365d71c685c488e5408799e1fd7c7658b24e6b70bd746a6c285f657d2af8fcdaf14958129e7a57a19200e9c2e811ba85425b1121c9f5f88b6f969d487805f87f38d0ae521e41356ef18e39e15a503f2da336899abefb39d08995b9a450b05933935a3a2d0a006c74e79953e65b214f765b499b82a46d7661fdc6813bbce1691d8b4fc54c6c9f42dafb89fd78f36c308bf4fb11828432f7665390bfb2c3806e66a71817574b0500c9b6c6003f2b192b92f6b3b24165340408145a39b46d75b135701bf8f5b01ced689eb824e50a1088b4e7db45684f5ae56ec78eb8e7c3a87ab36dc130cea2cb53e03dc8300f993a8f1851da939e4a8ce1c2f49304f3cc0111072672868b29fa78581b5cee67df7d88e7bb18648c5fb2412923d1e5819169bd5b2397c4d44d91a5f9bede2495e4c2ba48aefd7fd995b54ecdddb0233918c6c7d4ed96b050177922ebb0b49b41b0f26e64b1f1ae2ef57b4dd6a99885c26b02779c0bd913a88e98375579481b124cf3ec624c5cb73385ed896c10f1d5c5920315db05c6b484bbd72c5f9f006cb0bfaf7c6b07a6638f4ff349b59923d9e993b3e9b864c75d8aa41e4833ac4655c4110c66a76b377aeb5b76d4dccc965ad778f83b5cae43d4655356d5f628819ff64af4f13dff77c4eeaf5c730731b21f3649bc52ef6ea2e2bbd06519d3991812ed734e66564bcf0941558f6e5f51e0f2af0ce67798294b4f3521355df08975765294020d19d8a5108b55f50d0bb38699eacb5ef27f69a8e37a50ade8757fff93ccb3f72eaf2d62a275b5789833df0edd8e8d0c0bcdb520663365b4048b041e3104da17113fd36f87a77fff56015ede86435bd80aaa961b9f076634f75a9f3a17a11049fef2503287c8bb71909bb7605cb33caa363d9301579f5d140a09d8bb0e4c5e753cf02e1569806fb88e2972fa2784386ad8af343b56a2513c85c0370adeadca831460f47ff779a5bb98d41816ae5e57003827012f64b94b93b0a9458d4f6b5f5cce6a2bd8f7586462f6c3301bbaeaa2549ece8346498c5203d2e989ad282f22e6b2385a8732c8b595ef20427113cf204e52cc41e8ccc26e7435ab8bd233a01d0a07ef09f6706f9e3ccc10d68081b6d9d79b48c37eb703a7cc1f15d465366757b117bac18c79f52a3fd6bd75afcc47d6d5c36a926ed0f906f4d94febccfa2bd8c128bf08b114035e86524fa668bb291e32105c3522e04a92d4ab8258714795a924832669cd0b4144fa8beef2131705b9d4cb433400ae9e5454dcd6a4bae54dd1c0701869482456e381c8c0e016a882b0a53b4a1872049e525db67256119bfa587f36bd928b28eb430450f0f8da36490a8baa9668dfa8f196d57f7ff6dd324447471f3c6bfcdea76d6c6ca4c2c78901cf705e52acaf634028a680240d8673d5a50271bd7c041033689f6405c7466853083ba0a46d49fd330eb6018a227423527a97756a4e0c84363c87803a8ebd9de7bcd4b8b431173e7152ef4ad8bd0e0d66ceee7369687a0359f20b086b9f95ee64f323eeab8380eea3fc37a23766bef8b7aaefb3e252b75544911243c283372473b50f8ab1e8ecd470127853cfa6ecabed15827cfe952c429e21867a64c10907bb0b82d3edeac3b9819e99a3c704feefb1188f18e4b840920fab4ef57ce1755ee5fc641288106e657da782db48095d8cabbafecdbe435a0c413552fc306ce2f398919b90aae253a00d361b42793b714a8203b7e4b1bfe47ad9ca7ad7a8e9b88c7dd1109279e9db32d9524c228325a2f1defba2a4e7b345a2826faecd0de05ef23bc4ab6320ac6ee28803fdc18d4c594869aba85788a7e54ce22ed62787d93eed7b72554ac5b47579c3511669c03afc18c81aaf43bb232c42a10eda2e3d5dbf44e5e4f48e918756c031457f604476f529a650a0b2a9b0824b6818a22758f349c120217178abaf7b7c7be620ee4088aa43a95664ea7ad54f2edf52165dff24442ad531b5503bb44a78483de15ddcf9852e7933e134551bfbb4adc61f175b771848ab1da75e6b1c2d7b4150abf3424fecb1bfef01d76209eea57a7ca39c94742ee34bec2ee961718b4c0e2964fa971549962393ab1dcb2790c9f07a8b35d1a3ecc35ca6343b453accb456d0f6b806d003a34c26c74cb5fd4ae7b5cac02a3a8dbbaf8754a09a4000577bc14b4776b40a82a1e3b03cad4a1482c9717429c3f9b9047074fc5a4f7a4a9669f9a4417bcc4a2e578f3af488b2f3a135cd7ead4833af2dcecaa949a11aa0f045a3e3cb1174196f8ff9cad625152210f470f2360013f8a091326057da488acdd96a0ecc7ed4fead0fc96bcacb9a2a36ce04d7ab34be1bc381532b6b412e9195ebf32f2e0b168150a0a622b8c369927a8a2e36f32c5fa00066d6116d1df13cb144e94dd8005f2ac00a38f98856abe246f29816f8301c10be07621b46b7bc1487acf271b2a5da82651528f722c988a301ccea7fa1881df2642da04fdc57b5a080ebb6a2a441ac10a8891e246f67275c12e1cb7ad67b8bce5ca037b71844046804c8dfe8961e005cef2dc1895577b195e3f9e40d7f528e2d0d28d05be2c8d2f47c0c124b7082fcefa3caba2dbd404dd6dbdcdd4385564d95df8d1341232947cd4e7ff9d41ab6c8502d28b019900b24a862515d21ceccf1913a96a773c1b08a7ae4e93c8a7c028d07f30f4c53b4205e92e0210cb143ffa1a6860d35f9a6a5c483a51283767fad739d5f4736e513c7221dbd1494facc36865e2bb8 +Digest: 13ab8732618fea55ba6050a10ae4ad35122e5a79ea998bbe5c45d780509d2dc9290d3629b88c8b842dc761c8d01e7b41131f7408adc69c7a9b442c6bf4f6a100 +Test: Verify +Comment: length 57808 +Message: 9a25e23e5f8fb5d5acaf7c4357126690952ce5f01aecfaf58193b204edc5f106f1e06e5fad8eff243a96178849f88c9806389e2943fa360ed2cf6b8e324f4a156f68d72943f54fa08192b010b3af7b8802e4b97d57843c07c075274e153fb13edb62258368ed2db1484c51c2e062bbc651d83dd6a0b4954a132def2cdebdabecfe796154669e22bf596c01861737d2bcbbbb321b64b0c83d939eca10d4f3c284a1539286832fb5327a99c9449f564ad00835a134eca05d4a0771c0e240077d6f8a98c00008c86f72747bafe4c1e8ab6cfff0910880addcd8394dd98a6a21641582f1f3aa3d93d7e70fbbbe4fc5157bf76a910a8167ffce4eefdb1ef09a6a00de5006346c69b575fa1201fb6bf30444d90fc31486ebbdbb16f2c396fc1809d833be7e8a2ed559d11147f4702192de8d79b62cb800520f29970aac49972b27757a9201fed8caa57496743d245aeccadf412974fdd5e51ea239fe3e40a71dec5d1d953997528ec1e5ef62841ffc47f1c1982f44eceeec12ad6498228215347f1a828fcb5d8469d6ac86d9706af0ec7bbbe68f448b33af13d3809e0017cab909341348625857a50c52c1a1a90c1f238f5594121be48c75479af5d97f08adf3b1313687a491b1898a5e0a81d80d70345518088071ffe288d98d2c11485ca52ca09b5516390f7c5c7958c842a576ca66f68baba1f0e21b2eef318b0e031b9caafdf9d7bbcada9e6700c862acb74e17029a37e53c3e9721b0b2107b97574e79b7f1d4243ffffb01f248374287b79d3e5068a21f1b0326da5649b16576ecfc2499a4b3a4697f798b44792dcf9b4c6b27988956bf04e8953067dc9caf716b2d84983d1ebf03f35c26a7ba3071b01fc1ba2225db2fc094ee0a2d955ac3517ce983fee59dddd302adb96133ca908dd7a6df3563b7d517b1394fee9a7207ddc6390811c3b966a355732bbb0d8294fb1d237e1b6b741bd0e47ce9f3136ce5dff224fc1b00f9c23993b666fd70e0e6c2993f7f1a669968b5d7c1bf8429d1c41da7b34562c3e6595d657e516f836decaaf202ca7b7caf238c320fb9e803270b618eedcc2f350693d973d4d4596fb00f7bd1744786d43db61e9c6fbf69cbf924714fda79c97de4d97464bfd7025b32b7fcdd9edf8297cb8833bee7b94da6cc76159182357ac50591f5e14842b370794df6bf8778b9ece2019340828fddbe2a6917fceee68832f325259176fdb4d60f37311e37fb71fc098905c9452a613b9a653e3925753cee35fbcc1d51f14db47cdf75a3b751f3eec88852013a702145a5d251f02fcbde21537db22ce104c63246ab8af60e6087eba7664292684a6402d11819c815ceb6f2d5119e672f1f667af70537be4412741b2f8b9d21d7a0749da99f5e6ade680b8a44215975422b76b1165445a3624e04a5e7602b59905b973cb2d0e77e928027112814ac00220e3e022c007d4f6ffb7db2574bb4df9a61160876117eab3afe50ae07525cadd8b20693c071a4677303286908b5ff5efd9c39287ccbe999dcc9cf896b4334266bfd168c5a0e8596774d4df38107d57cc2f347c44c67f1f183cbeccbdb4ffb13e3d9b5168341e78281c134774aa7fee1f04d8a066f4b5e5b34ebee9ce0de781b492d2d59c17291d39c47241eecff42368f9448146ce1f87ef9111f23015874e7a4e1c47c9f074c32cdc76710ee756923a8afca16cb908703d925c589c625b71ffcdcc3a7a269e0471e294374d8733a4f4186583515bfd291dd1029f5b7ad096a59087204540015b99655017233607e6365013998d1d8a2d10bb893905d583270c44c18b83c34b3303d34e83486a4fd061908b7698742bf6b6d064a823f8ff9da4490feeee26e81561cac42df59a77fe1678318cdbf65f1060be298f2e5b82850e2bc6dcccf1448d03aa6559e35d0cc9c565aa5ee02a9004aeb35c308d83d8579a5b9ab7a8a90d049a00b6b97a089abdeee75a6f4d776b3e117e514ee9f84d9fe956d00219b48e16754c1caf2243ae64f38bc6307c734d37097dcd3c9c2f7eb86bac1b6e98ba643d260b2bad8494943983b18234d594b28a2710048c4cafc85ba1d9d14f9e110bd33cbc48571961f8b61006f30f115237a1caf3bbb043efd6d42c5ea617a25f019329ee172e4932485518dabd01983249189597473b4a6616cc5ba8ee693e0ad1d76e0f0c85ac8c0fb11ecb24cee2cb7358f7593b9fa8b904aec0573eb6d99af92a899d9d0fabe5cb349256eec9797422dd60d7fd5fe73f2cf5ead7fb72fd85e3f6fd284d2edfc5e77a03ec5f73c4c2f420728220fe9e9efc3c3ba9c94022522ee7492d9155a0a300dbe41a1b707d4e43ccacf63aee372efedc535b1c80e0963655fe1c0e36a71383d4c35e9721eb6cbe3c6092afc13985a160a25a69c7a0b896dd7c7218244b8e0d1f2238571a97a4afea4de5f3fa2e298063a9263586fb4fcce844de43b12678f8f57125cfcd1a9cb570b56ebc0b8d81185fe84cf44148a24500f7af156f907ac41240a585abdcab5b4a47ab4c77b032d5bfe04d4a892176abb2057301b231fa1ad001460d5976570de1751a39c16ea554fe11959cb10e334d65eea89d2b837d59c94365db38402649d0be3a086af16ef2b4fcc47f6b774eb6a723de5c2dfd7b0d5887a353dae2af9b8293994ce6f0d65b5f2248471af54f83f03582a34c1889a2283e8d1bb3d6497f9185a65bd7d591db66f29f9841f0bc11dba41427086d1fb492d8719755939a626804efd99028181f571e38e772f1fb0cc3f0213be553b3b132f5ff5b228308e080b1e42aa250ef73c9e5b2c91091a2c1339a38766564dc24831784ebcd5d1b7675fd11e3a0f87e9519e98b91bd2849cbc512a85afb38ff9b0dadb0ad986a4890b246f788fe774befd1aa21e5db5e36a8d2ea1f4e391894612d38f135264326dbb030137f2d65ede08ba82449fd8c1fd4f790fbe481bc41238c39c4f6f9602c941a38e45ab04ccb13a253f122963a5bdc9d97dca2676c7c6e8530ba877449c0663ae1e890298469f5b04e16f427f1812c5f7f200c7cd1ac8eb2be305b498898deac9baeb3fba541032fe71453454a164097a76487246468209f22c4d6cb850c59d9e6853a9947f6c88bcf57b4509c81b5f0b118a6e09d25a0951ee6ae8cc791546d532a9894b4e1b25e578f9bec6159f8d52ccae043f46bab5ef324370fd8de7ab1620d5270a4a85d122ffa7e7b511595bf6ae9c7c102b09d375ffc04b7213a2960839c0cbf7f912541b946d07fb43af93a0c03d1ea307af2c8a5ec9c35593adcd538550bd3ae52b75773e3367c3330afbf709773121651488d756461ecb957218a00c6e44fc9636fddf06e150336ad35da49133ffb1caa0af03ef1fa5fea2584197d703aa65939db5faf25f08736f707f4e605ace7cc0bb68b7313da01641c70edfedf5359c64c662710d95d7acca4b299e7fd2e7aacecd7c9b2586573afb274921562e2eca911bcfeb5c6b070604ca253bf58592627d3eb456d2e3119357e1b8041b94dd16a202c311e9cadfa8a4573acfca5917cc5376d691413c1849dd5b2431431189a920e5058bbb98a6bb32592fff0638bd11daddaaf3787ab28315fe544fd68c7baa932b5e00dabfa5663738cd75b209cd599adbfa258183286988321207ddecfc42813c96184f2524d23a5bdcd9d6b48fcb1ad98cce6441c225bd6024015e1b52997480757c21b46a26c32c24d278204b90e23d2997279bc7dc3cee53e46400c5d6f35fc3d45852c18b5a126c09a23749cf7a719928d47881b98e466758f4839f22874147c7fde96f2988757e265be0d0b16bdba42872c236e13ace2807188c26a4b68ecafe1660bd27d4bd20d0ac032a5e3be512400a602f7fc8f05e96d703a4850bae1421ae9ff3aec7531baf9b899dfd75f6aa17a33ab4b9c113d0b03ad05fec0b09edd7ca8e59e5e79d366c335872b79e75355645380cb7ac9e47fb47dca00240071dc8741537f5bf043baf7959f1b340cc7ca4f84281a211fb8b1f080daeee31116b9db31cd405d4f1f01f7774611ae26244aac54059a2789164c5854cd3d9668da0fe908b793eb0ca1f6534920c130d9f580fb31addde6ac89a95c58255eb68e58492114a6ec8daf88e29b89938c748eb7f7ccbb8557f6e08f436d0957d4bbe7fdf024141fbcadae406120c732e5d1bae8099140209ac0db93b51ae6f9322f0c579f52559686c39f54ec8370636fe0e50240d96e1408ece43378d68f6df97871d1a14c778fcd87e9230f4413c97d2aa393381593b444d390fb0930414a8d30af189072e8700333125723e33fb9b0076d2759c66fa5b10d6836e0a8db038fe01a88f75626fbca8da15dd4d142d88b1fb81b107c404ceff2e08389b08b1d53ff4aaf4076c16785c02ca39caecb9a70cbfafb1697b43e544c807d8ee7f01c8be6c5f806453667c7a30ac4e5cc387403a4cc53b6b949de7042ce614aaf98759a4f12ffa341f460f28ed23e3aca27f9b622a2918b516fc1e6ae30fb5777f2bcf1909822c21d89d7b8ec097c2619089ffaddf4510ee0947d09b74e883ff18d574443ec0dcd1875506d63170b124968db643f580eabe756646c267db45e7cc6d8e4e1751d3ec3455f925c816799dbb73064bf44170cf6340c805454ec5daa3db665e1c9dd91be5859ca60ef1e273072338ed62f268c6dabf9d8c95abc97ea607449dd60db606a4cd367e8a69b34f82859353c9fa9b4ee3ca0f80df591a7bdcda6f33cc073154781511d8c5e7b6d8358261a2b0c1d10d85496409acc0807a4e3a314786f413ad6a4573da45d1b1b72700e805a0afd1abc825e54e8248c2230210d0018d3d24bb8045a5ac94916d9360e872a2202c65d1b444da78ec59aa1d0245958a68482c23c4fdef773a8db215e92345a1b8a05327528f8bae6f5bfe1156bfc80a9f7ff3903e569863bd2f47e5c998a92bf0736454a9ee3f1995b687a60468b1a8bb4940a8f536ea97a7def6aa082ee868510d6001c14a40e1e5d20d851627988d430ddd13f1872b3c7f01850cafcf497f62d60fd5a389d42de718585593e3c4e1bf35907a3a2fa479ce02bdb5c5621398ab3739795695442524ee2fbf84867ecbb8282285d9189d771b48664a52ce8fddb596a594e254d8f323bd5b6bf0f70e73b54e5bdbd5285d5dee3b48765ffd0574075c1ccf50b0d7bc6ceea500df1ebc023e0f022536492e54cf432adff2d6bc852af266d2a7908bab88e7d2275ae3d0a0dbd3e10a0462568447c8d62d1641fe39a4be4b44efdb3ae5fe12ad87672e91741502be33485a1e14dd321209d02611b7ff2a93cd317b2d9556d6fdc911e748a7730462470a1bce2d1ae9a71b2a6d3e28c29d05167457ace1199a89945df63d607e4195ef508caef685555d0a2bffcdb4767f6ac7c057fef1cec81a915543b8c8bc221ed324950698a6dffb7edbc20682a2378a881d636deefdc7786700b70107b70dc79a8d1e1d3a05ed4b21439f31bbce2f2dff94633f002fff6bbf66385f44f76b56ed940f3c052be913986a7e958683ce1bd72c3fbd4eead8bb4190af1ca802a594733f50ab219f391c8e59487b0c477c1bb6eedf2f01b9ba2f9485057e5a622149d598cab2b5e9472ea916e32b75a5a1f745e02cdd40210d91614d20ce829f493dbaa76399e992791191ab39ede822a5752b0c0c0e34ac39a74ff1ea534a3f8437cb7304a7e621398cef1f31098d48f15e107a680c05e1a63a07784a57d8cc3901b0049625d41eee686b7bb2c68d9eeb799e31291dda48bc1130ea272054ced2611062ff5bdb11ff6dacc6a66e10acfc907b39358adb6ae4f673506bf7e7cbb620939629912183d6635b08f4473dfb8c694f9a769b32ce84af78b1fd24b94d4d06e2a7fa0fd1fcda121f4a849a3d1204cec35cd39704fd0605e615c5eff1dbffdaa59d5c1c11027342a1933eae3879ca857e8833c87c7dd0c06684aba0b7fe346683803602091f09ba89eb0acd55b9485629268074bfd84ca89f07977e353c547025596f07e3da04437e5ad03dbc59e50b6c3ca1e4f895e0843aa571d29020c7c1332ff174c4bbcda528e9784796e1086aeed47e604d3df61ede6721e4f32ff521540ba391d64bcaa8309fea330bda1b3d58f5ff2fe657f53c34538ffc84f3475730f46da5411164133e850e4942cb854a51a80c9bec6b45a7e374a4626bf3232d70f237fa2d9603b0f9a1ccd1643cae5a82f48dea87024e2794cf465dd1b7f269bc0de9d6c16010450afd0d1298b5fe3493e16a65dea37784ef6e5e37dec81dd4bb4e6c8225f9f19b18a1b75507bfdda22b778b541ad62a859b58d536b9ad0a3616bca64682e9107acc93b4e2d8e1b36af2bfd8ff6223cff3419591a38bee23577560806900b6d4aaceddea0134a4e85592c03aaddf13cc96882e7cc67b14cffe7e40e235c6eaa4f2c58743fa438fe42bb08297a8b92d8a36192a7de6b2a675f5dc66b5f0fd0cea1b5a97a6142c2a0fb4f70ed93617f9719b9b917b4c572c7f0235dadfe3cca50dee3417fa9818fdd2b70c6be6a02100ea8cb76b6041932e54ee32a24a565c3c7530fc0e29ce2e9193fe9aa1a82e01c95bd315c1130b8e355c807ac8dc90d4598aac59851afe976dbb4f47b90527dcdd2d365c9a7cf26fc8ff82b6547fdb5d85b329f483b5707a19b373bbbae7d5ddc2c97e35ff83405f70a5ba8d4c1a7d1f465b6e7410e26c001ee2329fac357e2902957347f7103b85b4b6f2a8ba95bf4127e744823489395103af539b98d76beb25fbdc3b8a0b2d0a1c9af0aea5d8e9ecadc073c6f89220945084a05685b4e449b16282b8c05c5c1530b97d4816ca4347624ec3e763e569f28ec8df797bb6306b30322e67a2eb11cf797c601e1455157bcdf9fc8e7e6b5c9244e2d9ab82c4997a29d2a6ef37a0935f7e4963d7a760a6af762ae562500a409dfa3c5695a3c6659e25acb2fa88642ceec7894c1bd7d43f0ce647470ce1ab5f3a383d1edfe5a5ddfeab271c2d9b1d22a4dda5e494ad9728baa4baea333937ff92874df830514749c343abab327ab5bea84703f3e83092a9e038e99680619469cc6ed4ad30ed95f11475a026b12d1248238d0d41bf69ad0aa62b3e139a60ace511763a0688c3771c1aca6f5651ba1e083c382a95c25ed19235041f282b3e65ba8925e8c8e0dbd614fdc97e03bb2bbf451ccfc1b89819e48ab54bf69fd803a9325b0644bedf3b981fe4fb36f49788df49eada3c73eaa2cf3a4e892a3e4bb85f93b09eb7af2eeda786f7e6fff38cd7655acfe2028c60ff7bea264423ce2c656f26af77aa6275f9e991601442c6422239c1f36e7bcba13acfe2680749162210c033811883a05b654887440d6536627043c67d060ffa565bb2693a5704e0d6c33c024d09ac31883babb2ce57d20b94ca6bb0963226df26680ec9c4bebcf2f085cada3cd38bdda583f958237cef0d7f3799c9657b2844ba6bca482fc3d915175f520576fd8a6c5a431cc26e042604ccbfb55713687defb96bce2fa3efc311f357bdc9220f0fa54e85fb38d575deb7226aa7a3c7828da8cc7102c647c8e2ae2d78f16f689184512a507e0180597eef2a4157f5aa4fc1399b844e5444d89fb46dc7d73e710c503895ad8d67983770748c4bad95e4597f69cdac9a23c2a760ea5a4e57806508db2238a210b045981b0eef9092ca9c2830ff0bf1ce79e8bb8e199d145a7b6c0b8dd7ba3aef25ae03e785fb19ecddfa423dc4fc5cd29fde9e9209de21c679ac9fce1ec57a120efc003ca059eda51627310c8049f48eddcdd8d282c47e85c0504b06c1fe6c62b356178228b114a3bd4b7d07fa99c2ea7addefb84cf7327d987e989d860f17c55be5d121e6aa97d01a8dac95fc95cccfc0356dab2e2045984b5e0cfb36a0832450d1b5819fed7d127516481d4ce51c23f5feda12f2e7c0bc201a31889958b968d8414c0b1e22ce53150ed909b330bad0625fbc575ef3aad35ed78fad76e0c0773c5d1c252af0937a439ce5c0f91eacbc4f819de13bed0bc44ec0acd096dfa03bc44faf388affd36f47e8f6aae658fcd1038b0418507ceb7738fa125bc2fe629bb73c8dad07f8961a691b932f4286b2f5c8a67a64674953d464b049b4c0e50d7e5f4f3cea6983e463f15d45b7d450d412e4fa862d46fb4ac31908d745583ba9ce02ad46597847c63226d592aa655c6c0fa0aeb0dbb63bd92ca02a467454a93f72e9813361fbed436f51ac0570bd5581d444eb80d67fb107f7413f1eab7bd6d5525cf18969bc1c6402ba092371a4e11c4918d87f876904dc0c446fe551946b7656a225d2db817d30d3a9157616e2a84456649e34543cdd6053f1e125cd680f27660546951e13b8afca66f885c53e5301e36f6427a6bfe39cb590be6589bf6bf26acb7c5b9a3a74e9d038d9d8e7828a5bd88253e1e6bbbf9718682d2eec6026de4a3deeabb7bd59e7cb69e0f8e574f45b1de593e97af9185966c257075e15e9f3eea3c50ddd6610b0a53f376c25dd3a089ae04bc7cc3e97eb85e6647847a45c3a3e45280974fb414c440303bc1184046b38bba3044255e4545f1c7b0910d626ba236a4028e44594c492fc6f711033f98addbdc4274605a69cdaacc4431f73f07c835c35f1950caf1f7574a01289b0c16f722fd6b83f1585cce0dd68addd43618648612eedf0183d65d7b1c127e6c40522e0590040954e2beb58f98fd0b20d22e258c253a25b30e49e9ffcf8388e376da90d836b46af783d0129466032079bda989dc7cd9a3f1e4cd3b59d6dcee9d1a00ee3f53f52f75b66173d0d045d42b332aefdb7c45d05a81e0c01dc4a705f5a475949f6a3ecd4be4c337b95a3d9cd1ed22e62dc5f711397024f6a01b4a75899099026d0bf9dae6a9760cb28632c0ea4611fb37cc760d3b29fa6db53d5fa3c578fbd64c9bcecee28f0a3150c6fe06f0c888ad8e024b2abc39e18391bd5f1735c80e7ea2ac262fabeff06418aed7d5620ee76b8509ded0590a6ad6da2dc1465708517a03bf8853bf46b9038ea06892da63ceb3d135a9b48e3606e5f2d11ec7b5b46546e4387e01994dc49e074e18e5b6719f24e738443dc827462f7079c001be46aa63c8c97f8fd64fc3a2270a713482b2e91d3b6436e293589921e77a6d8aed59a15f25c4f574d2e706ae7257fa15cba22d2b525bea397c64704bac457fd9df47daa78fcd78473b8e3e115dc92bfffdb9ebdda081e6a8efb58c2b437d6f64f0abc6cb6b45807d5cbfba895dd07f599584a592ba78a4b769e61d4f5184c4b2bdefe6495cbfa69dd2e60c6507007cb92f7cdae90492bcfb7750d4064afe0859b3aec98fb8be431f1abbb432dddbaca5281d0c4f238297db9490110e843bb2b05e42d12d13a3fe77b08b428136b477941bdfaa437baabdee4e1e84c6b1d04c5d3a56ada00213213e20ef27cec63d760c875f4554918d978a10768fad486e4dc6c454bf66f88e63e8e851e479f0d91084d6f65df0e9adcd6568129240bc483f7388c777005b682efe735df9214b19ef83a74f64b7087dc7d6d18d4d1f71f089e9f429750acf52faf55e5de64339725b8f54c4fa0562900f74c94110a82e19b59092e529c4b8b1505405fc3c5e4074fd1e8bf17e6a7c671ca5dbd87d6935066b1de19515ec9c15b79106935bd0f4844ca7995f6254da75781065bdf3d13b68e2d86cb3c9d10df2a932dccdc559ca32b2b129596662f14d9a1b135c147e8593e566a0cba62072da9dcff50619473602c7d1a899cb035541fb4c514d3fdfb829cb2f0a473b496f301dbefbc6c837cc77147f937b30c47b15242aac0c0663478d0cb815a109ba578591863daa428a01f1f11166781814d719ad1c7012e8a7b85032986f7391f1c05da1cc470b28dc5b26164dbe3ae172fdd1eeb869fc672b9ef5d5265449549e3e2ab6e7b473dbad4c65dc6af72e3d6d53d07174e612f25d4ff05d08806cd20e357f697ee27eeb5b6a43bc2fadbc8c728d97cde881011abb6fd242b550888ac02ace01d87d76d88519424dd25e704f10ef8a6c69a74160d4531e1e936116ff62928938aad21613b8fdd40a1965e405d70e4ad59ed55e4526be2659492e82a0541143765c7cb73d457c9b695b608231137e3b81fe97b23820f5ad7b3d05660e230b8f3373f9e4a5d909eaf41edac5617493eef9ff6ae7ca619df60cf5a23b993e05cf0877c628fdd24a5522ea4148077903d7b617db596 +Digest: b7740e79c299ad0f5e741ed2db715b7383cc07bdb8da2af0a865623ab66120673518f9f667a1abbb6b348a14b6a9c9ff64cd1f39aa06a1c8ba70e4f207f24608 +Test: Verify +Comment: length 58392 +Message: 24d8068eeb64f92af9d611d752f1951389c6dc26d97d05057252e87611de4b75d3985ad64b9b512dd2aa7ceb1e7161c9170d3c6ae5cfab3b4e3dab9f3f5ac349a8287fe88d6a200a5bae923a788b9e6c1d28619c68fdfdb1adde8ea70e3560ed4b8f5f0cdb5ace8a3bec3c0e86c8b4c4461d35038990612e383b79d8a5f6892b63d5e08a5af2c3751a6c63ad70af0c9937f69ee9710f4179975e55782d25a8c99803eca934ba6893a235ed605fc90cb39bbb86944802045b714f08d0cd4b2490941f6ab3913a23ab794ec46f7b9c1dda1872d44d35f2129c6e147c28aeef6548fc3441ee98fb5d8747c2ce22ebb2a8d55625705c6066d30437b797c8f799d3b97b475ba372847fedb596f5c1d893136dfedb4109f2e6af5a744043f7d1d1d6aab7629f19465defa66ad41f9369c5c76ab89d319c13fa0e68ccb567fe6420d6e5588cf59a3d0f177a0f8436e1c7d22d942b72275cea2b58f4e820eb25d70d3b3007ce456c7f215e304cac21f31942acb200620c93a000f5c77088b6b452216d546c2f77d8331b2b92c856c811889bab8edf75c6875c024da90bf6b2f3ffe2d4192eb774268286e8662c8913833c6794ee6eb43e8047b7c8626171c62a04dad846f56e229e93e8fc751f4eea905c2dce9b58265cc889a9cfb91b01daa08991e2a56b5d6a888fcccf874aac35821076c15d43d309a64960c877e1aed79eb78e58fc368b342b9db7c96455abdc9f82c9d5fbd8c42b61af631d645a81a36cb559a414fe0069d0e63352d3e753c730d7ae723fbe00ab42e53a34482f812752ac7a2cb56cc5efbf91c7d29da8addf7c3aad00ef9d8f7291106d77eb08b74b98c4795aa627e1b040c7fcb18a42c00acdd14fe7d41f7a67965b844c158b29f88524df95b1d85c939bb05857625a943169c41b8fb6eac87198ec081d8d63e11462f534449c273f7f1773652ced9b323d993c9a615da6817ae1eb81511c36e788775efed130bb915efd39ab99f3aaa114a56152c390fcae69b78175508aad413d0c88c7a3353d5a179529b1043b32e9a0d55acd1e1993562663d66e829f6ff91a699b16227354a292276cffd68ed913c7715093dbbe1581982c11f34f22251706d6be74b6b2a972b7fb291d78b4472673c06a2a60482737a95c5a8d1fdd76a1eb9a1968c7b9e4d16e5989945075252a8b0bd11c177e7381403adbc25a960ba1b0fed57abd51acc89f88b4eac8991b28f79aacf1662aa166450db91d68168b1e3d4a1a320042a95e32d1d1aa47e7d0269fb5242fb71259efa11e1f23b1259f217ac60f19f854849b0f7c08593428ed2f6ba4616071ff42233ab5335e9e8aefb14fb9ddb60e4ee5871ed18381f924194843ae8a0bfcba040af9191d55950f22d6a46dab91a8fa732b481767a9fda3fd7b0f1dc7b9c00848acc6940690ff7ae0986128a233301ed78e7398df5aa86d41cfb73742f125b4b6128a6c16984594d3006e33ea230c83b9b8889a101b62498c4d2345203b9384f5432bea74f4cd25a115b3d6aae9a6f1bfb270662574930186fb3b8e8c1f7242ae479356492c01f5f2e018580b0e64309483114444eda35bd8e3e85cac262ab48827a8f8bcc948cb6f6786033419b007de33557b960ffb202a0d10f5a8d723a32cea5417f6520971bfb4e31d4d92f13f46cb235542610118237f9ca2a9bbc5d641987efd1e4faead8bcf19ef80028ea073526218706c1e0a6c4375abd7587917703a0ef05d489e487bbe0ec1f3f0f1f20ed0fc0d4ab6babfad6181585939a52c61d6eb39dbc6410a368bacdbcee481fdbe4ed87cf5c93e008ddfaaf158e3b3debb77ff20bf50ffba653ed9843a66a6892cd2dead9c2d1093b4c7d7bdfbe009f5262231ec326f4022afdd7f055fffc85dff67f6e765689a40cb21f0056bb611394ce169e75baa6c08bd7285a664364f42e0120874780443d17af3dc11cff03172d2bb8f576389eb353604d3af7194a40077ddfc9afe89720c684785295013d36763b98c8571942571c39c5168b0a02d5f6bcfbaa21f7d91bb3e24d29516a95ee1a5e146b9ae5483830c41e71947e2532765f02bd4026a07a4a393ab9c483a3aa8403da63b41506b35b8fb7d095ee27e1f0c493577d0d73c90409af8880e4cce84ddd594525310464d70d2fb811e29171009e1c1d5b04d9846bd44a19f9169843d24aff9470c1d7d94dbcf49c9ae3e84c203c1b834cb538390c1968f2af918c39abcd5bb6293fe76d2a2f94f2937a92ffda3ef00dd49716534f49aa8706ee2f4644e4fc4eb113b9bcf6c59f6e9e1f37e8991758318512fa6fbff57d5bb174d7d638123fa2aad5d5352e2f52450d3a3db2d745b272c0b16aead8ad5ff511ce3c75ffe5b476790eb0525acd7c2a73641adb2f4a7d663a0ade5123c1d0c7ba62c3a206cff92e9e16d1b0e7107b93631555ce1ba637703387cb4f1be36e681ddaf3e6d7415c3f9c96cfcd6d98bef45ed6850806e96f255fa0c8114b72873abe8f43c10bea7c1df706f10458e6d4e1c9201f057b8492fa10fe4b541d0fc9d41ef839acff1bc76e3fdfebf2235b5bd0347a9a6303e83152f9f8db941b1b94a8a1ce5c273b55dc94d99a171377969234134e7dad1ab4c8e46d18df4dc016764cf95a11ac4b491a2646be18e4aff936a1f8243f203a5ac822fcd6ecdd9690fd258823f0c899360e9719c457e24723a79e55945578ed4acd733bcb7ae0290b77c6d0c47ff8cfdd286bc5356a98d786738dbe076713ae2537698c6f1fe1d1f6a4a565b425b9398f0628db99a784cb9218f48405da8cf74aa47a612a324f3bd2d245a96b887670cc1632cf69b512bdf706676a083651435b732a7c9558a4c130af2c3e52fedd0024d72e031e19df08f5ca5ab296e0ed2ca8420e1129097f0c8089cd77131f495229d78f392f2c56473ee343003a80dd1de19f79d16dab3a6852f0adf6245048013b85bab42582f4f332dfb4d55b9c8d9177ca123fcbe4637f2882522e0f485577ea60551699b45797722e3494727a9b21db704bbedc1b86cb61ad3ea12c4dfe30a705c2c2e416ea9e6d3d26e037c162399d20aad116d720b7aeefd7d203f7bec601d4a86bad411a9284ab102ae3f79f633d39a408f49dadce50a8c2433edbf3a27b5b6a535dc983fe68f694e73f939f192c49bbe90dd59a9a078662773551494084187d2c6df6a34c8a8e09a7831bedd5facf76d3bb25838524075ce07ffe3c3abc8a7559567ef4f759f002ee56f708141949596b94f3d52a4689f6117739290b752fd76cbfb8f5a967cb051e33cb7a7e1835d80313c71bf3eface27cd3a8bc0d5e8717d9024b21bd245d74c9a1efb15e6813775cc025d47c7fde9694fdb341eac90ebb10b68c05cd2045f67319fa494f9970bbbb22868b2e87ad86fc5def771e554535c655221e33dc02fead0471aecc2cbc19b0a36f9c74878838158cc3b80273c91c4c5673d78bc822f1da19dc5e5e827415dfcb57a4f90ffd2e72f2b67141b4f8e3154317de5f7514748c9290e4714b37349b22c52136718ade87486e5f5689530ed3a3747f195355fb273735bd9ed7640a75123e9d876c9fcce4c621cebb716603f9e0104633f365fa4c50415641c788ebe0422a769641ca7dfe14974beb0db076ea8181d049c5d2f66e763a5b048c147d7f1b2f48dda1996645bc25535faeb0bc38203f89c55b1b840021871851a5a513a405a380b80c7b1a4e256271a3e4e5686514afff3113ae07a3eace3ab3a4a962f1aa3dbacfd2ee1e99c8b5233230dceff407699d07901905bc2a662e94f99fcfea7144538fa560c79b4ec3e49522f5d75740e2dfc340db12cb78e5509014f6dee0e35de771e481b9d50fe542372bcea32189a2540eb67293644ed26d1fa75d048788e0f30120bf79d994bfa8b2cbd5c7c52a2e8624615e2be92493c0adf130c550ca83e2d7da786c1b65a994728399d9c4aafde2aec21c20fc92dff7c5b2f0b5af30ad5340825b251cfb39a200d3894da2a486f628692b370101ed7ee14d3b4a2543c3a0e5b8c62940edf63de84c2297d17f603d0bb719c288fa62c29b206ef7458c7d7831de47ed399655e4934e044cf3b40023e34c564806f4c66f6ded1a4172632125af635ed5698cdf228c699cd16beaed4729996f5c0d898ed1b403abbd4e805555d9088996534a08645e1f6ac9bc8c8e13491ed3630f1132a607f4c1df3c3c9075290e46948946484662efdcaa67f17924ec4d10f17e344838f430cb0bce1058f02a1524546e2a4535454b80d7e0e224d86db4a68bfd5b4616e36845d766a41573569d915a943e55bd7fc2f5e6d9b717ba67e60296ef0e92dc7febb0d6b8605c6b29081c1b7e1b104b6ce69a6b94f8d8574541c3b6d5c6d4d6043b9a6e15bda4443bf5232b9e48fb6bb716ecbab51fdd1b90685840440c82b01ae871121144739ae9e554ef67408d9ac8e46b78bca49c93c3ba3ed7ac4802d74e62c3773d7d50dbcd491feb8b7a3d552ccfa50a1e1fad4c79c7f5e19121fbd8094b0ff1ecc0a29350a0e2b45d8e81275d4908034bf975920d120c0274f2d42ec601c506c1d71f3e1e7d5bbe7fd5ff9dd4d132d8e8ba8c210818ff9eda6302481f17714a3ef8fd48814ed98e34f91f051e08841f56eb6765f54d2f3b33db2ca07f0c9320c6dee35f1385ea884f505609b35f9a3b29048ddd5f4f394c13c3a9e46041a92efbc157ce5fc31d5111743b281f36d3b0d18e65f3a06f9c65ecc510705d6731c94078c132c086d05d1dfd44cccc3edf14d2e18645535ed70d3157d6d0e0edbb84274dc608e031a220d733f98444c80adbcfc6754ef26d67a693e493827535b4e432b8ccdd39541130efb0cfcb0372e57a0a75a97d084bccb656f3ad1194dfac6dd5524c0c267e9c019a0c4e2d92bffd7425a7a95c0f5a84d12d2da9eaba5c008591a2ca324211a117989eeb188d1fc15ea3b4db78721a0e7b78cb008a703b5fcffa12dddc16bdcee74e012d183d12cfae0725d63ecb2af819bc84478d30ee28b1613afd661eb383f54cab8aa92d2986c6b283202b94dda0407ac1f54f96f4e9be89738f6cc4c35ec5f7169a47f7c4654d48552fdb49c2b564360c805dfce0115bb5652a5c934dcdddefdac271178409b64b047baa647a960970dc7f44ed104e2d878844b224c34fb18960a9b0f6e8e2760d299a356f65c0a4bdba5880d235ee8872456509d3b452c57620a68420536e21312ce1f8e504d3da6f1e928e66a17110f82511c03a91759e18c34f672e642b3c499709514fd83dff1781b3e9f4f3844babbfc171b40b36b003a10ad66b9b981ba8e076fb1a606d97597c4310179c869cef7e0aaafa52048f99527f6e825a4363e1a19142df3df1477776b69d491cf67945d833b858366da17c40037bed20ab9986530ec508b1577423f984ee03e562854166f3467808e07a1ef23d9b169f3f21096d35fe217b0e91d18d348ec29639356492cfb1b449eb9de401945899268c9eed68bd5aa3eb9544f2aa5bfc2f90190e11f40fa6978a1d717dd69e20ef46f26794cdeb671a9379f219c951b285735073ec035971bc49c4995ee9b17083813f1fa21566affff32b2db972cc4e7eb09e0b653933cf7cf99f79d9c384e3e055912b97c7b591ce9b375c542f022c75c84038f01e050c7429fc97a0ec7ee79044b71fe86d4ec900fc0d026c66b9d8f53ae5911f1a63b51c4b7a7726ed05f81ddf0f71166e989221864ab484a259e097790c8864c6c645efee879cfe1db081e37508a3945429a9cada4ee71f7a58bfb7131393439bb35b5983a27d791715318ba7413c04b6885c4758a81eaf573ce2ee89a9564e11a152039b599d3a619a7360f637bec9fe2b463191d4cfb6b17cd6a85d1c25f6b116c658962b70a485c6c41de25a8066a388d40406537eb8119f276f0e0aa6a0028a34d32486ac69dc10b02cec38455d3f37a25936b2b046102a41cd0ce33d0c8e820a0d96f984dd0d0ea3e8844f623039ae1d8b9360e8c305a4a22cda447d7ead84c2629e02ae9071172c0b4b0e5b622b52c225bcecacc19a74e519069cdc98f818fa6c7a209df6a0d0b4ff9103b5857ccc2cb213c450c42731771c125adecde6952ea5ebd1b7a234b1eb2ff6bdf4eca680b9bb2876994d3450d4a08e1cf89001afbb8943a4a01575311b26fc9b9e3a4106f5ab7b71cabf5a698a30ba41be71c1cf4d911207dbb31ae4e17f132b15e0d4d56cfd7d5489acf1d2046757679505bf5a3157e779cf1d6e33ba92cafaf062ca628c3bbe8d4aa8b320df9ec5fd10ae52f723383488eec717a422fc9479b252aa34dfe0bf8a8204e6dc78518680b5ee151c8fdc79a3df128fcca736f035d012ecc2e486e0eac474357b6b2a3980f9477e40c39f375904b23f03a3bc7e9dde261aa31698c30c8668f77434732f8c5f4d16fa8b0aee16f408bdefc5079040412ebc4bf280e69e4c45d55d40e708e15c6147a032aa1e7c21a884e777a2c59b8d8f3a2414e9cbee8aad37ad3cd0264e8516b8e856f748e711f41c9138088f2e27ba1cd1da3dd39bc60196da64d938224defc329646cedf6598dfd6382c37d66b441eccbdef7ae1482e58b6b756c9eeb3b5efee9e7857e084cc89fe4e44de0d397b922787fa1abe755cb8de6cb04cb27b1e6d4a05ceb89bb70568c8bd9128a036682567e58c66d92931606c2f22c5d666619ecf330d9918e789a4bceedbba964852fd133e6c06394df679e86775dc605bc5a9049100a15efaa2646247ea3ff7598345b3f963a1e6caf42adb7b71385a4193b671856e7975da95d04331855dcb504123d08039dfe986709cccd5de82cb0214ef9f781ec9656dad12e61576bc1b15d5bff13ab66a496bb5f643dc8461bc858d7a15d3d938369d314fd3598305ee9087429e8fa1e70e600a61c8f82b7e34b2497f5bfc676ef15068b2936775e04da99ed45fe7c401414cb605e4919a803b718f27fa5d90149e709b60ada513f43f48649cbdaae55ee91902091e0f9a10d9aaa699795c1cd243e41384a97d27eacc551fc33f40cda60eae3696ffdbf3d61745d7fe6063d24fea94154410567769fcb818706e124482b8f39ad30e5b6d79fc2a6a7e38d97b349a68ecc86997cd1ad85997ccd086129af0d075e9d3f8cfa29142a7408826df285c48df393caaefa56720e3ffef05fe95bd2d11ffd61ae3f8dd73d56dd8b1c6d4371c35bf12f6a5b1b2f6463053f8d11b28f2b43ea02a6f24e8a63e2cb1e4f8df33cc378171e3b9e6bfc1068882c553d63807a7ceb88e3ccdbac428a699263cf258402da8e4d9f1ee986b6c2e06d64c6bf55432d6a6b0129c5cb3dc031ae05cb5af615f5bf040176e45dac04a6791848567c29c7ef3f7b939d55da26abc781ecf3f1514c31f80f111ccf84a062b60c3ca97372ff026caf84b2da8c10306574be910459508f801487c37ab5188dcaad0e28c9c3151c793987a6c7e83f780e5abaa2bda2b51032ce35a8edd1ff801d674764edaebcc5eb962709bc62e6eb28a05bb97ba1cc6c9678c51d775fa7f234e772ee6d7a58674a41bd2c2680b8f25af22c35ccfb091d11b09091c5b2b45c979a1b15b7da7aa90bb8e4be74b628360bacb6b83ff31d7a3b1232c6477fa717bbfb9a8b5b3385e3b68828114597b72eb15c65b1334e5c3c88fa25fb8b1ae2bc28889bafd60a1cafc13be1c50799d834f26db3a1455167ac71f4e4c1ff1919d243cd7903a6e2b185b220bc5a49312de1357d4b18f4a0a2728c8ef9ba11fe9ec2b436cd174c41b6de0fe3124169020acbf0f78678afb09f074f14cf44623ff435f061026b34abcf4140ff8e0b1561015dcb58e0510505dfd32042efd17e51bc847eb8a3700e855d27ebd28a17ace2a40f1b3df3226314d77ea685d611b4d85a36b5ba4ab62862d32a77188117be0b55686703397d68620862585a1c65a4484fd53bf242be20c8d3a1591e1d6bb75fb7e235451db27371f5169c3c2d5ddb061fe887dd35e8762bd125287fb98427342e151c703a7222c9201418a8735ab7b65cd91ff79ed597105e3e6b99e0019c4d3a697310fa3cd4dc1bd3242b98ecc8bd593f6abde7f601fadd5579192b5474ef6f67efa3e763283f3aec653208a49cafc7740ebc9bda555fc0f2f759e60d4fbf2f98d8a58c959b471fc842584cf291e21a2f626044e2ffc3bbaf5cf8ca9c9b111d64c4a254348c984cef420ad0574718b3ba0c355dc06fab3fd320622372d5a99b643a06d8d09ab724c9fad63d533aa836bc62c850c3339a9016d8229b308ddd3c0fbf5f74ea44083a00c326de76db1515af1c85c88bd9f68ed2eab68c46222071dfbb28c2f1f7201efc31994e22a6e3d2fa8ffa1f8ac1637eafee9a91344117df4cb3df4d8842832644dc8a06e72c98f1374391e0309855d2063a4b248b5927c6ef400f7f0db4a602431a959344eaa8e2ddcde9952dbd323b6e7444c0abe8d4db3fd615c202abfd15af72286dcc5f983a66856db8d2aead1d512313f0166ea39ea6ecaed0f7b71cd2c289df10ee09eb6a5a00aac5bfeb1afa46bd353d6b591863cd0a27065d5479ec24b816071a6816f530d60d3646010044c7a935031b36a7cd0a951aecc41298b45e8369cad1f8af6d736c11a5157ef1af4c7d7fdb9695e65cf843f6feac5ffdbdd88246d6b53a2925aa39647caec3637c5db082317de538760e6d47b676cb1d7b1b2b39a534baf8d04dd45237626cda4e73d8f8af31a322cac597899ec3b28c7eaee4bed0c0e9a2dfc6b3876fe0d9da98175d2faf326e49ada649393213c4af3afc4542c3fa44cbb6bd5d50809a98c8dbb0c3b3bc209501913908d2fad7600a229bd36209316ac7e78a486a04003839abe89311406cb5df37f63ce3639f1331d80605991b16ba1c04c5fb2084b226b16b2741b4f6875f56e4567be6f6cb6c9addb35254740ab15c70e8ec006d10e2a4abf5663b28f0effd48e24c5a4efccac9862c50309e9deefdde7ba1a637ad0aa7e0bb57006249e626b81214c9b693bc2263f9759a0540d1748ff6a27e6f06fd1fac11caa12ce2e087c47e6b91d830cf5a1973490d5284074507d264f59d8f38905071079a036c4d84e07fb76f2e5462b4f9522116e0d7df03f8a76fa82dd65b9e8051b4576036bba2beae9e9e236f14e7a5eeb4333adce725b4de3902ba5cc49ece5c4765dde28965918377cb51e1645681d168deead3ae3eeeff4791ad8302056cc93741d6f055421b86d963247bbf861f82c5965b8c9293e97321e181f992871e411a87e5d09ddcbf2139e2356eb4faf17b40e6174842d946e23e5ec2210488455c57848513c179ff0b2fe4ef6ab3299a33613aa8972d7379c513760889c68d647384d42f2a7ebe5d7d11d7bcd058966c43bd208a09c107148447d3af94670b0e1f09036e95141e4d2f9637483003c5fa14ab2436108be889a821d431f15495a4b77a7eadd4302e506b13800c1a433cc63eb1b2273c0cac5bb9581439f11d91cae55fc26778314309e8104e62ffa57f531a6756f7fcc1d70d3050f022442093e3210f5b45f1b610dc0f12fef74098e21340429f02c329ed10958314754b1c207fe32fc5b3c12d0c4958a21e338dac199948c9d6e23fc342f86184edbd765eac13b4378e2b671489c44d3438a2573d9a678c73ab00b32c9d472cccd8756666ab210c9d112763fb3def555fbabe1debc8e083b68808dda4406f4fd181179bd2b22a64e6eb32484f8d3d296b210142354996e7290a451fe8c0e34329641e771145b2459b98d6849ffc00020d17f67488711cff418e5fea58b345bf3afe1498a0ca4b3731967e895b0f0aa7bbec181573f3c56476a0b3cd828bf91c9cbb74611fd447b22f60a4f70f3aaf62de39e0c57636428f5ecdeb59e4bf9fd3a528d870dce84a3f1b93f43e2b0350cc0a7ddad51dbcf708608260effdc28c8d0ac29b38667ac5465c8cc6cf4cfda15bc71480e4c8fc5548025aaf203c495191342537384b004b5088c7974ad38e139a7aba5d7506790fc6daa3307b3e988198a7ad56f1091d3ef616d100016d3929f0bbcbdb0664b7791d40189f5163448f0bdbd764e31f26329f8d457bb358934706f0c583f9423c13b3e917465348d1fc53474fdb9f0bbfa8c5627184a144011d35c033e2fe4d7b72132c2bcff16dd53c07805335753d4e14002cf1958bbe16ff1590936265e4fa16c38fc286ac30a2d0b10dae0d16525606c8435238b305597f2ee8609cc0973c743d8a7814f43fef5cb8459ccce2b96be3865c0fd8b7d82d1fda3e27fcbed2c70cf9b2b8f559f9ff32b5decbef7af1045cd2cd77101aa52 +Digest: 1c0c86f99e9262e28d3403a87b0fc4fd3983f37bdff3f1cdb4413852a502b558ed81c4c5e8f1d584119cc8a4619c7e81e02d0eb1bdf7e6f038023ae29cb5ff8d +Test: Verify +Comment: length 58976 +Message: 27c74d76ffc8ecf7a69970c8584f294b04ee9a485e302bd630821e7ff050c49f9882f10db247adfdb2112c2589e1011f77c48e0f219dbf85e326f8a567324b857735efd60f05edc7b7e21d260fb551c8ac95d02c228f065b62a77912471aff236be62f193f8c151b5b152a131253820f4a6948e78a8e6820550d8b10b79048431d9f981e6a648bc246b13a33b944fdbafa49de8781204d9b636115e5df1d8eab3467142cb613b98421be37cf2d0f2991633b7a562ecf1d9535aafedae848392459478b8c4e2305289445082f963c6d5e2e4a049aba2240d673f03037fa9ab1763445e387581cd978464c959b1b5333e7027b649c4da11e26c43b92443c9a5f696c6c0563fd849c3ae0dec65be4dde2f588d882a40dd51f4dd0940c49d7d0a9c5aac1d96864e5b637090083b61a62e150676846f92545ac124002868df3c4f851954e47e0b6c68f376abcb4f6e5689ac0483399e5bb7a2b3ebc8ee859b6ffb5d6d61a38111ab08f02ab1941616c79740dd34261aef8fa0699eb3f1af54b08461c142d9244b92a1e5f73201240d81cd7feaf9c889d034fa3eb761d05a9d86715ebf8903fc2babca4176ad70fda50da2b5d8549f4fa05006cfc04308fbd86a5880b2a4a25d046ee89f239482179fd39d9f0fc528f0d2596c7943e81a1787c49094351632eb9854935b8887b2e6307c34780bdbe3f1d8c981e7acc172423e3dbff5d15e441c39e541031fe761fe19500ded46f95ee74618ed87755fafe06e2e3d21f20d44538ba9783254443dd3bcf7706b6bbe08358cd015d5381331969a2eae952173b245e009bf45b02ea4fb9deb028ec49a6e612f87815d6fac95b944a77aebea521c57e99e7cc9cdf715ca3ea33aa3fc0efffea097b68c765c4aece0313882a708f10dfac0474b083e2ee401a89f677c9c3b6272892bef06d2df961f545df5f208cedcb6278525f9744ecd99739725c0b2bf3137f467f17b80b249347951c265e214488e3cdd071c3a03db689cb88b52f2e9ef4331e1305ee6616ad228ba545d255fd5f568a55adaefdcb1f17c79f4cdcd59f136fa3e282b846b9f6adb0e38423300098e33848dc01637d5c69b61ee7bb27deb8595b5556beb4f4b8118b3eadf9ba357bb45e13c663db3bb4a8206f4f732c432b19d0d248a7b7af3975a51f86fefc8550ee841d337d6bed71fc8bf94cadecb7b3d88ac2211b58d2c30284ecd9d8fdd65ebc33ceebf71e7bd98c8124a611702099be108ea9c49e469cdfb20f6c2fc512ee44f18eb578f9ce358189582446bf6826f2e99ca84791f10c36b7ee07ac5d1f48ae49c55ba806cccc022cfd8ff5e1759f9da056e64f39bc5d2c19f374f6cce7b423c0dba3304c5ee838f07bafc5df314fe6ba232a829f8fd5eb62847ab61a507acbe03856b8d36dcf4b603b4c5fc0827df6c16a3e88ca53be9b190be0945044e1cd30453ce7a4dfca6201a32e6a8c5270f43d95e80ac2ee5e63c7ef6f3775aa325138681c66c69e21a55d1c1c8f4b887109b40bf1b0904afe6cf398ef489169b681810abfdc41901c3dfb0fe076060cc85db03421213b4ee5de256e286ead6bb2839294eef21e9f035263e240c6c5c6bd17b8783f06cbe15de0e6d9e152cf97717ff36c6f5064b21d0b1eff05288e9e9860553f150649edac9abc41e49c02d53a9e2dfc0a9d1bb0b391b3ccf7436b7ca05f0df169cabc591b35320ef7f34b0d5407c7ab89824b830d0caab3ddc063481e3d6bf604f92c0df2d9cda8e3ffb42708e449e0b2a6fd1273a38c1a80467eea5a21f4b6ae3ca1f079ad17776f69440c9e5a3c054fb239452d7edf6ba97ec54a9c34329a2e3b24ecf8da97e465d903a25e932781264d050482c62e0d1e0f3f502c9dac084e9dbce8b687d5558bf6fad28fb792bc00206b37bca3fe68a8a3f5e55185ea69d40b72cdfcdd5a33ab6930857bed051ea4d272c6213cd9e40edfedef55147526892c4d811204ade78bd9ada1685e090fdc0c2299faba46e91a6d31577e71d4a535a955ed402356d7f4ef7a0f9f3225f76e7684998e44cedf92f5c90615c58f50a02992f9ce63de6dad539eb86890e23e23b79fac2703f72e3f1ebbe361372f8e91550d8e03ebcc1080ac21830aa0c74cc3787cbb0b1f4c3ee99111d5acf03bc6d2d5cd9228e4a82733a30c57cf8c5c89166021af83bf527857f6d3c63c183b622950daef8575fb1c8fdf661efd79295ee318986ed70b934253f4079d5bd6b7c95f6e3d8b62c74b565c0937bfdd91b731f447e9e24f2c9605a333b7424f5238633cd8fd500701233d62c88822b7fc8d6b0f961af1334ae32a105cea9c60b5459887362224bb4c083968c5602fd3e23375fdad3585ca8c03176217a995d82767d00a2fb5f1c8d084b238a7c7ce786a32b5863341855d1b7d36610bfb14fdcf25738b6cbc9e74b41e109817c5e7f0bc119571d147d9341fd9eed5e1e80219d607e9d395421308215fbb51bd63628101587c882e4e6997bfa0a6854078457263959aaa514c38cb3ecd1c2b40a827746190d291f35e1dce2359c83ad1b4c6509f58efd748e4f50734f299ed499d1e110340fe55c77fdd20748cbbbc3ca36dfdb2d74e24231132022a569b617f48309f10f06a9c53ba91d7dac1e7d3284d23c0c39a20578adcd706497f8b4d8bb34368af287d2e3e1621397c81b4473dbbcee0fa2ace39244bcc59b8f7cf7a14e640b209719fd2319c758f83538adf24f457a6800ebe929a69f943a046d1b0c3e710c646523852d453752016c0d1648500a75a7dce5a2a933b460e29f2f7b640c099ec8d54b074ce430a365e4ff19f07e8a54418f309c8b8cb9c007a85ab563279c56b06fd7001c8741a178388525553b338ab7a043236b120e163bc87545641187b8ddad8dec069ef8e0cacf35c5111694ad9cb893f3a2542ff7d167e597f16a7a398316a637b5abb4f5d0119785ae813c214320b979dbd3adc97b1f42499592d24d5323d68f842e04452ab810c3780b887a5d711a226200f62f8b5701c6cb2b3e88c06d85300ca675433d2b382b1826083d4e323c89ff6c977ea497ba9bfc740d605d4c38d5b9a5769479d38409096139de87ec971cee97105b3959c335c43dcd687c5877fd159b86ad73597b09c63dabd2bcf8c057d9f0df39cc25b2209cc8fd05b01ab902aaf923e2bc258389c92bccbe3fff3ec72c0a829edf840df8f0a62accaafb7272d46eecf8b6b04425acac2b05935878e76f5478fee5ed4d0b6a75c521af833aea4c3d3043f5822359cb4f352d59ace5450e6f40de71d9e5e454886ab9303a88c55d14ac58eb23a792bf8579a9e5652a4ca3ab68b1f5c26f10697e69d7ff99e2908165afac2a1d476cf3df670fe909be7aa9996f1df44f5f2bf3c871124019bed873a0b8b214c79944f2bd9bd3b712f86b9ad9a276ffd92c739df6ef0cc44294099e66561f4dcb03b756b07679e2098e7bf1bcc1517ae85da3c27a520bde9cf8a05c27162827802d307a588586fc55e74848e34a41f80579290bc338b3f191633947536771549f6c4ce806576f68a0794cfacd9bace9a8f56fc4720179cfc84a30ea8bc89f377147692a5a5ab7b951dae691dc3406d24b590497074ae1ab9a3423b020c7e6529e4511bbc50de450e282c1b8afa1f444852a73fde38370379fb79e22c2d40b387efbe306c6ff79d1eae75ab9b873d9b2ced03a63a749a9d6312aecdcd27b525babc239b5d08ddcbed39f1e1f77184baf80e0c462b2ebf31a0724ac28e03c703ead3e92238267a17a250088747c0dbe8d53d2ae75a708e0657a3b68a17c85d943ebd798ea5ceb5c8657c2263327c296feb03c5506e41ef66b12b59ed0f7e5e21df0139a64b0a76286043a73f61ae589561e7454a10aaca97d6949ab21e2eb4f2f5279334d3e1a57db830ffe17b5e4fa35f72129de8b107e2ed66e3a3eddf464fa7b8eefee45c2b1098c892112992f6e00f2a94119d618e8f1e279b862499fc801d3bb2ce2781ee292695c999135435969799336dd8bf47e6936129246b64becc8038466a445ad7108a1e0a40e0abf40b1f47587b40d51a2f719bf7456849747df837149ae2efce0cedebbecd39a01b89d0bb69017eaaf0b1e35e6cb0c64f06d9acc18328a946bc6677854e09c5399256d17dd0c83946afb50f31f02f2b7f5c29c55dfbda436987674f7320bc2d8041ba4b15f3981ab241831d9ceb8840df5fb46a94e47a556019549e3d9ead187d11ff660c3c39c9f58c633627c584ac7af5c4c4eda7ce8a3158788b6c2fa62f37e86b49e81272ed177a9d825be7eb1755079ffbf0aa9f87e62e1a3f873a6d1ab6b0481d34dc0c2e21f27828bfb7852b7a7e8e362556b4f7878281e11629cc80024fdc097504d0361adb3d50dc9e1a8df040d99d1513d7801a3bf69aa163880924af703635f183aa0a1f3524380571e8bf37c859474acecaa943c192b1506c5e23b64bccfb0bf035f9a5a5c95d5253e2f049a3924361627e3b812af0cd583f27074eb7f250bade7df055d86ad3ef88238960b16f92c25b44d9dd79dd7ee3c80bd85efad0bb66142af617152d2042d85495633b19bbd381c38a3ff5804b59d0b39fcd5d8fc4775be514d3a33aceb50b1d193a89b846fe9ca4568fe702bc221fc764852857f3557b565171cbba65aee8251fcde373bcaa738e45b5978a59a67dee2d6da34fd1683c24b5d9d5d56b973815ae049172a43ecf2a609a4d41ab4eb2d0046d16a0e51966f748f409b26ad7c394cfc7dade86247820ae24514e39808516f06dc871b7cec07913a8ae7ae9d6514b89fe08dfeac33617373ceada8ba5c068fa5502ebd0f013501dde0e5471fcaae2e491619c5983d1b804cb620d2a26296d280d0c36b7e827246e7f6f6989b19500e8682e3e5bcc10aa1cb7ff0e9d6989ce847e2e79f41dc49e0f711ae1b95ddc4d9e6bb6ec7606bc9588ea0a066cd8a733168eb0dd10f6b265079e57e3896845730d8343cf34999d234e4aca1c20da4d42e526d98992ddb8225eec6e97823a99173d961b0f1cee7bfa78c1897940d641a6f92ff2a50239a07d1d45a6262b3b9fe4378d87d3b66b1ec20d368d4454364c055a8f435be971301d4b9048b80cd4217f0251cf438b794e24169020a6e5613608113014d1ceef31abf0b59c74ae6be593a6c93b882281d2c79ab988c77abfc75624f8ad2f391a6ace159bea83986ab5c62cdc13ca03e97355a1980dce9bb8c7989ed1559eb25aa52fc02c7a0d523757c09b749e30b71af9733415f9e4d0b4fd7584a25646c217a876fc4f9339653c932afb7825e3c57d2ccb59189230a21b3296e053f64ef0b93c4aceec7f2f58df33ac55cff00bb579d3051a8922db98552ea2b9cb7edec5a8295340ec8418b38afdedb06347ce1075b8c97f50ef0c3bcab94218f43620c84d373a5935eb1cffa4bb96141b72575ddba1bd8f5642ec11e39b1e04b5653a810e2ea721b0fc62c395334e89dfb8cc2412578c528162a3a4069bdd85f654547854d541a145fe1387c42ebe18976356ee82a2dcd0ba99587c9c8327a39f4c973688f5b1e0dd3b56d49b738ec82bb91c4193495612ea2d331f0e19a66799932a4210569ee65ef9543081cc65a2840347a8ad16a11ff7675d17c226ffd8ca71362456c0b1bcb2813426deffebac8888fea838cf65ffcb8ffeec2271ddff1b30e365c0fb9269bf1b1f3b1bd5c9f020926acb9c3d4cbb4ced3d2495c4e6e27417588cb8cee8f56f0e3df99e16a7763567b2984128fc5a64c8434982e5c28bbe6dbe21a5035c69a8a4b5e7d08a2c44ad50009790581de4fa6a38e2539d1a02df7b3cacef6095cc5423b08d19f8016472957951ef945862f51943786fb4964dc189fbb6fdae3c265ad45574e22acede6a7e474dc7a555db3f1e8c923ef2dd764ade23c639b4f880a2ffcd2391e63ab87f5392138154bb57bfc13cb8281f988564c4db650a3c72e114ec3f2290f5edfc985b812c836732de5d497b7395026e80f6814b1ad80c515198e2d4fa451f90b29cdf3d1f37a6647901007049ed640871e85e9c6d0cee3ed8162bb4321a2bcbe07527ee7404dbf62f932c44c4980d0d5f22a3f6e60ca7e17f760d065275e345900a7bbab451cc9309fb161e6cfec526538b98800e4102e14da0d1f3e3c00da7c94323cc668842e10d210627c88854fb540d85636c13c6e74b7cbea26c6272989408664a1210058845ee4387609c81336a8fb1c689ebba9a7ff31e3b75c3dac1f8418e5d4151dd31b9481765bca415779dfa65d2eb2fa8a3f3eb37e8864b0dc9fdd6e12c79b392847019c8e96506d96ef634e9af1c4956a9af4d53cf2862d25aabafa8e0459eeb2872479f3de22c92c17c268584a49f8c55b902b818e270f2190bb52aa02a7ab2c6c7bbe486bb7c0b1738b88179099b144f1bf1aeec3ddd36b024ceb195b2afad05785edfef79600b1930d324b8d5a3b53edd017f73c01163c7fee383e664a5a58e8b17d89da33f596f6e5db7668f2136ca051c71d4f3754405a2dde9bcc8c461080bcd16bbc180bec0fa4082aec07c609c9d29ce385e6fa01317a22b3f6775ab1cfd6ae26f5b8d02b4da62cdb6ef1cfb5cac0fdcc68a683e98651c9196c81e49726bd584e1facdedf418ade0a6a469cfb23bb8e4a7fec9e73d953163ea742904b15cf6443b25a84628bc0702a768cba344510b2d0242f863aaaecbe862f1fca481d9b569a26586d7f8cc5a7de1c1aa40bdf6f00100df5f7a86b8d16927c901f18ce9fa3d4041cf660a528d977b3a6e6fc3324fa6c95c64f47abc2b2e60839eb37794ad063d41ebbc095588999d587ff6fe0e1065844171982dc0c17f36a83db1ede2b60dc1ed43a19bde33cb71a5459d18911c865917ed2f48cf7ba4d1bf45b494dcfd9af3ce3ddd68f476741ca8292eb6c459517164408172ee41e458501e8414896bf5fb6b4237199f39ddc9e9916f83adb00ef4b3d1565427fb89f4e42fe916f2e665024cbb7856e7644f9ef1e62a245609040a890a76958191d9cc02e2ab421d573330fa0e68c6d5df10c347912544c74d7cd97052a9de05eb1d09329e913f14a7a8acfca5cf127092686173f829890762be8cef11b6d7b9f19cd2fccc64b6dfbc0a9fdae675e2c165a1a0fe85fd9b1d3212498fb06627a78ca050e9d2ec4e8480a1301d3b22dcce4102a76f9f6b2314a4c038d6958177d7a26faa8019f1b00ddab7884c0b9daba10cd29f4ead39c9f19f0f834e29cf6e4f1c520949093b8381b192ceefbdaff542b05aaf24193034be0d494f7fd417b519e39195cd0a9170e9ef7b2b8fbb2063b713e200774a180d83d5b4c7f0ff23f33dde74759385bd1f4c7bbac7b36cb89c0a1fb1bad2a8b9fb46df98102910b9d1c1f443d224e08537b23d97c9e3383e4943ba1104ba9bdaa711133f55b271a2f7af0f45d30685b261241d5a59a7877c1168ce4806b98b45b8eb59f0bc1488a60c0e16c3a1c3da0c44a8034aa188c1389d83429fe956e0c0d7dd99f26dd6bf8cb9e7f00563e3495a8949d7b0c60d4e3b949bfe5ed51a0214acedbb8e91807d1ea541875342ec3966d70c81d4f3bf974d9fb9eacdf18b5a09de25a70c509a29227824c2f5666812f6d7fbe9fe4e24023566e4ee3466334e66168d45b4d1ad2d61dc998932f6de3bd3301df876ffc6f8bd9024f2da5b9a47f5fb2c7ecd3d40f0a377a6c4541bd71ec58b7a94832f2de2abc681de08f946ae7c360a38a1bbdcdaaff1565ba1fcda2293901ba66f06df26c8af049a0668c1e9c46e2f5c767408534ff3ae3762c26faf07e6071780ab662edcf4b40e1ccf9362954ca4d395904cc34925b83ede941e2de73646cdff474a60af3c9a239256427fb678708346363092662e7b595f9b7004fc27e1b2340111260830bcbfaf2758aaf1999b56d18e3d286eb7ff712bfeec9d0e62dfad660245e7b17724cbbc675d4a0c572e337dc1faee29674d6c8be61b5ee58e48a5de716d0a70bada300141d7c6d05c300193f7f04a5fe76c34c77b83b048542584e57712f90ea1e4d4c6db5088054da9aa5b57a5a5d7de64af27e4aefc005c7d31c13cbb1b53d34ca1535d4ff773d5a1151d0aa3685af53ec7f34a24a8d64d5894bae7f0d806f91a7eeff05d7be19a212a213872f9b0d4016372d46b1e8fd0be951aa13a98f1ba5452e4bc017c194430d1ae0798c2a122b56aedab0dc4f68cb81c27911fc3dabf040778e8c362e17cd7f20ea29f29f58762c6acf69204d22a4d112be029c18ab03184f49c2b9602ea1d75872f0f9873ad115ef7de8045ea51865c6cb5e0fbc934e4b1a002c27e44350a4262d76e76e439ca1a168b61ee07aa69e53339cbd75ef32476c33f0f836e05a642e7c1462b10d693e25024bc69f1dc0195c79372be1396f9bba67e9a0d4a04fa5b5d161e1fbf2a769eefd21a1d7090535272ec5d19aec56b6892e5ec859ed80d760efd7fbab9dd7a3639bc02724c6e69057a6c154ef8278365cd9c8c513329e77c409ff064c598a792770bfcd04c1d4a97283a21c7b965489a9fcc02dbd1a091533c23f985ad03069bf0e6909f3a46feeec47f09eab926c3f0529dd78a3fe412e54ab2228537c59e37ee764747dc908ef496625621bf13fa4d2d3692c5479e7218b174f4cc2c86784fb7e2a830faa4018fe50c8fd395d4f79b77c0bbf6af76bad6bb90f6c253f09acc94533cc35e295fa9fba53c670110c2c07962db844013f106ae2fb1cf76a90e94cdf18966cfc8b0291e54e547cc6f61a67b4579d7c21e1f90d378ab5c5b59dc91aae319821429fdf7974113dabe9bde33c4901d57fd3e4c5b72946ecfcba90aa973527480f6f34dfbae954d889e3940519e6c4f6cb91c8151d3aa82928e40a2c66f6520c63dcfa91daa781cb936f490e74f01987ebd60c6593de36d0b6cc8abcfe745a7beb1641845d51107d54c71d5dc20767ff5d2b1215bfa67b9a42de62eac231991cf195ba25b75899644a95b171a59f48d39c0b79c40505dedc4984432456b0a64603f5b4f47d307516f15585f8842a248b24f1b3eee88ed92d2778abf820740aadbe90d28f137b4c1bc5710b40e23a93ac846850f4ee9412f389060dd4b3ee2eaa7e0183441e8b86d94392d1e944330ebe46f9c1848bd7e4c5dab6c95885a19ad2cec267c20303add608154a502eb60e26c900960c54acf72a99259ee21a10c7ad2d4dc067455629a86f82f52406361a7ca7274efabda5a27840ccdf1fe5ce4d90162e4dc27a0592b7066662c37f35ac264dd83cee4b347f656e070a507d2c852215ce6061f5947188493a13bcde373bca499e104561dbf6487d7ec12254de16e9a8b898a46c854ea2c468788eb7ad61bf16d3499eb62eafb7fb9e6403e1356b4d4b776728235a628cf49c01a7a01a86ab222259689c9ef42a74e09383b6d50ad38a855c6bde7685ad462f5fa60c0142e51805b021a99f6c1655dfa0105a3f7df2c25cd8cde27c009a55ace2e87ff3ff1354f7fe5851b290122b064a382fd72d419f886cecd3dd6bca9f8f2c0d506543ac6573848b297ae89470ded279cc3ea1468e729937271d3fb48060ab7341c79926c602f328954ade13a3d3d943a3c86257fbb5ee4b50adf4eea4abd1c8b8bd6808f310babf29c4f926508fdf244b16f91c83bccc87e52213ef78eb4f6c199958c979375bbd5b5bb232f35d549a16acce0a9311c47b58fc252d798964dc08fdb3eec4e156b1ae81a1cff8e6ca23bafc6988c63f569420ae913f3300c2a6fb5d31ff62a92c2a97d94063fd96b04f9c88543d89b00370d0bbf07b120be94b652a2b61eef95c86abc506856df7978c3fc3068f59fe5b8feda6cb87a2f53937daf738bca64c58646ed77caac683f058195f0904b374bf4febe17aeb724742fac156c276352cb03235730b4a93c65b31bd9ec42422ddaf4f301e96fcec8c8712ccab51152814e48eb43a4afb522928a7a114d0642483bbfc7e9098529e3f860e31677d1feb9f75b84f9fb4238e36e9384843a64b34f165d60bf9f782e3dab04ba43daf0cec26e46d8c15cf69a47a2d5227cdce5fd0b12d7a8cad5ce479d8a66999805f52c635a11cde3ef524316d6583d3f5a108844d8348554d111dbcc3c8d695c21687f6663c24da6dede9b18b125bb16dd6ebcc1107ce1a3bbc851936a8110d855d22e9132633f544e220b15dc4386498d85024c61b8a300bc7c13b8bc4b7854cabaa3ad6ffb8a3369a7f9d4ffba842091e0c0ab73efb3b3fcb48803d9f28717a7a84581c293188c57f4ce1ec1939fe312045fa7ef29f904a2f8183e6a7e276b15247cd7d132d0a64091f3bbcad5bdd9377b48087d6e5c3bd6d02b2f16f83f963cb7b07547e09acb4b07ce73c388c84b29cce296c4c7c79fc2c529a08667b7e143e84924caa55e41a0ddc90e54b5a781 +Digest: 00c128539a58423e5d6290f7aebd26eca08e6e5da7b93f151293af186fdea066759c47da8e57c9de526bcd63348326cdddd28f1e9a3ebc08dac6321599a783c3 +Test: Verify diff --git a/unikernel/duniverse/digestif/test/test.ml b/unikernel/duniverse/digestif/test/test.ml new file mode 100644 index 00000000..c8d5cdf8 --- /dev/null +++ b/unikernel/duniverse/digestif/test/test.ml @@ -0,0 +1,751 @@ +type _ s = Bytes : Bytes.t s | String : String.t s | Bigstring : bigstring s + +and bigstring = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +let title : + type a k. + [ `HMAC | `HMAC_feed | `Digest ] -> k Digestif.hash -> a s -> string = + fun computation hash input -> + let pp_computation ppf = function + | `HMAC -> Fmt.string ppf "hmac" + | `HMAC_feed -> Fmt.string ppf "hmac_feed" + | `Digest -> Fmt.string ppf "digest" in + let pp_hash : type k. k Digestif.hash Fmt.t = + fun ppf -> function + | Digestif.MD5 -> Fmt.string ppf "md5" + | Digestif.SHA1 -> Fmt.string ppf "sha1" + | Digestif.RMD160 -> Fmt.string ppf "rmd160" + | Digestif.SHA224 -> Fmt.string ppf "sha224" + | Digestif.SHA256 -> Fmt.string ppf "sha256" + | Digestif.SHA384 -> Fmt.string ppf "sha384" + | Digestif.SHA512 -> Fmt.string ppf "sha512" + | Digestif.SHA3_224 -> Fmt.string ppf "sha3_224" + | Digestif.SHA3_256 -> Fmt.string ppf "sha3_256" + | Digestif.KECCAK_256 -> Fmt.string ppf "keccak_256" + | Digestif.SHA3_384 -> Fmt.string ppf "sha3_384" + | Digestif.SHA3_512 -> Fmt.string ppf "sha3_512" + | Digestif.WHIRLPOOL -> Fmt.string ppf "whirlpool" + | Digestif.BLAKE2B -> Fmt.string ppf "blake2b" + | Digestif.BLAKE2S -> Fmt.string ppf "blake2s" in + let pp_input : type a. a s Fmt.t = + fun ppf -> function + | Bytes -> Fmt.string ppf "bytes" + | String -> Fmt.string ppf "string" + | Bigstring -> Fmt.string ppf "bigstring" in + Fmt.str "%a:%a:%a" pp_computation computation pp_hash hash pp_input input + +let bytes = Bytes +let string = String +let bigstring = Bigstring + +let test_hmac : + type k a. a s -> k Digestif.hash -> string -> a -> k Digestif.t -> unit = + fun kind hash key input expect -> + let title = title `HMAC hash kind in + let test_hash = Alcotest.testable (Digestif.pp hash) (Digestif.equal hash) in + match kind with + | Bytes -> + let result = Digestif.hmaci_bytes hash ~key (fun f -> f input) in + Alcotest.(check test_hash) title expect result + | String -> + let result = Digestif.hmaci_string hash ~key (fun f -> f input) in + Alcotest.(check test_hash) title expect result + | Bigstring -> + let result = Digestif.hmaci_bigstring hash ~key (fun f -> f input) in + Alcotest.(check test_hash) title expect result + +let test_hmac_feed : + type k a. a s -> k Digestif.hash -> string -> a -> k -> unit = + fun kind hash key input expect -> + let title = title `HMAC_feed hash kind in + let module H = (val Digestif.module_of hash) in + let test_hash = Alcotest.testable H.pp H.equal in + let hmac_ctx = H.hmac_init ~key in + let total_len = + match kind with + | Bytes -> Bytes.length input + | String -> String.length input + | Bigstring -> Bigarray.Array1.dim input in + let rec loop hmac_ctx off = + if off = total_len + then hmac_ctx + else + let len = min (total_len - off) 16 in + let hmac_ctx = + match kind with + | Bytes -> H.hmac_feed_bytes hmac_ctx ~off ~len input + | String -> H.hmac_feed_string hmac_ctx ~off ~len input + | Bigstring -> H.hmac_feed_bigstring hmac_ctx ~off ~len input in + loop hmac_ctx (off + len) in + Alcotest.check test_hash title expect (H.hmac_get (loop hmac_ctx 0)) + +let test_digest : type k a. a s -> k Digestif.hash -> a -> k Digestif.t -> unit + = + fun kind hash input expect -> + let title = title `Digest hash kind in + let test_hash = Alcotest.testable (Digestif.pp hash) (Digestif.equal hash) in + match kind with + | Bytes -> + let result = Digestif.digesti_bytes hash (fun f -> f input) in + Alcotest.(check test_hash) title expect result + | String -> + let result = Digestif.digesti_string hash (fun f -> f input) in + Alcotest.(check test_hash) title expect result + | Bigstring -> + let result = Digestif.digesti_bigstring hash (fun f -> f input) in + Alcotest.(check test_hash) title expect result + +let make_hmac : + type a k. + name:string -> + a s -> + k Digestif.hash -> + string -> + a -> + k Digestif.t -> + unit Alcotest.test_case = + fun ~name kind hash key input expect -> + (name, `Quick, fun () -> test_hmac kind hash key input expect) + +let make_hmac_feed : + type a k. + name:string -> + a s -> + k Digestif.hash -> + string -> + a -> + k -> + unit Alcotest.test_case = + fun ~name kind hash key input expect -> + (name, `Quick, fun () -> test_hmac_feed kind hash key input expect) + +let make_digest : + type a k. + name:string -> + a s -> + k Digestif.hash -> + a -> + k Digestif.t -> + unit Alcotest.test_case = + fun ~name kind hash input expect -> + (name, `Quick, fun () -> test_digest kind hash input expect) + +let combine a b c = + let rec aux r a b c = + match (a, b, c) with + | xa :: ra, xb :: rb, xc :: rc -> aux ((xa, xb, xc) :: r) ra rb rc + | [], [], [] -> List.rev r + | _ -> raise (Invalid_argument "combine") in + aux [] a b c + +let makes ~name kind hash keys inputs expects = + List.map + (fun (key, input, expect) -> make_hmac ~name kind hash key input expect) + (combine keys inputs expects) + +let makes' ~name kind hash keys inputs expects = + List.map + (fun (key, input, expect) -> + make_hmac_feed ~name kind hash key input expect) + (combine keys inputs expects) + +let to_bigstring s = + let ln = Bytes.length s in + let bi = Bigarray.Array1.create Bigarray.Char Bigarray.c_layout ln in + for i = 0 to ln - 1 do + bi.{i} <- Bytes.get s i + done ; + bi + +let split3 lst = + let rec go (ax, ay, az) = function + | (x, y, z) :: r -> go (x :: ax, y :: ay, z :: az) r + | [] -> (List.rev ax, List.rev ay, List.rev az) in + go ([], [], []) lst + +let keys_by, keys_st, keys_bi = + [ + "Salut"; "Jefe"; "Lorenzo"; "Le son qui fait plaiz'"; + "La c'est un peu chaud en vrai"; + ] + |> List.map (fun s -> + (Bytes.unsafe_of_string s, s, to_bigstring (Bytes.unsafe_of_string s))) + |> split3 + +let inputs_by, inputs_st, inputs_bi = + [ + "Hi There"; "what do ya want for nothing?"; + "C'est Lolo je bois de l'Ice Tea quand j'suis fonsde"; + "Mes pecs dansent le flamenco, Lolo l'empereur du sale, dans le deal on \ + m'surnomme Joe La Crapule"; + "Y'a un pack de douze a cote du cadavre dans le coffre. Pourquoi t'etais \ + Charlie mais t'etais pas Jean-Pierre Coffe. Ca sniffe tellement la coke, \ + mes crottes de nez c'est d'la MD. J'deteste juste les keufs, j'aime bien \ + les obeses et les pedes. Mamene finira dans le dico'. J'ai qu'un reuf: le \ + poto Rico. Ca rotte-ca l'argent des clodos. C'est moi qu'ecrit tous les \ + pornos. Cite-moi en controle de philo'. Toutes les miss grimpent aux \ + rideaux."; + ] + |> List.map (fun s -> + (Bytes.unsafe_of_string s, s, to_bigstring (Bytes.unsafe_of_string s))) + |> split3 + +let results_md5 = + [ + "689e721d493b6eeea482947be736c808"; "750c783e6ab0b503eaa86e310a5db738"; + "1cdd24eef6163afee7adc7c53dd6c9df"; "0316ebcad933675e84a81850e24d55b2"; + "9ee938a2659d546ccc2e5993601964eb"; + ] + |> List.map (Digestif.of_hex Digestif.md5) + +let results_sha1 = + [ + "b0a6490a6fcb9479a7aa2306ecb56730d6225dba"; + "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"; + "d80589525b1cc9f5e5ffd48ffd73d710ac89a3f1"; + "0a5212b295e11a1de5c71873e70ce54f45119516"; + "deaf6465e5945a0d04cba439c628ee9f47b95aef"; + ] + |> List.map (Digestif.of_hex Digestif.sha1) + +let results_sha224 = + [ + "9a26f1380aae8c580441676891765c8a647ddf16a7d12fa427090901"; + "a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44"; + "b94a09654fc749ae6cb21c7765bf4938ff9af03e13d83fbf23342ce7"; + "7c66e4c7297a22ca80e2e1db9774afea64b1e086be366d2da3e6bc83"; + "438dc3311243cd54cc7ee24c9aac8528a1750abc595f06e68a331d2a"; + ] + |> List.map (Digestif.of_hex Digestif.sha224) + +let results_sha256, results_sha256' = + let raw_results_sha256 = + [ + "2178f5f21b4311607bf9347bcde5f6552edb9ec5aa13b954d53de2fbfd8b75de"; + "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843"; + "aa36cd61caddefe26b07ba1d3d07ea978ed575c9d1f921837dff9f73e019713e"; + "a7c8b53d68678a8e6e4d403c6b97cf0f82c4ef7b835c41039c0a73aa4d627d05"; + "b2a83b628f7e0da71c3879b81075775072d0d35935c62cc6c5a79b337ccccca1"; + ] in + ( List.map (Digestif.of_hex Digestif.sha256) raw_results_sha256, + List.map Digestif.SHA256.of_hex raw_results_sha256 ) + +let results_sha384 = + [ + "43e75797c1d875c5e5e7e90d0525061703d6b95b6137461566c2d067304458e62c144bbe12c0b741dcfaa38f7d41575e"; + "af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649"; + "bd3b5c82edcd0f206aadff7aa89dbbc3a7655844ffc9f8f9fa17c90eb36b13ec7828fba7252c3f5d90cff666ea44d557"; + "16461c2a44877c69fb38e4dce2edc822d68517917fc84d252de64132bd43c7cbe3310b7e8661741b7728000e8abf51e0"; + "2c3751d1dc792344514928fad94672a256cf2f66344e4df96b0cc4cc3f6800aa5a628e9becf5f65672e1acf013284893"; + ] + |> List.map (Digestif.of_hex Digestif.sha384) + +let results_sha512 = + [ + "5f26752be4a1282646ed8c6a611d4c621e22e3fa96e9e6bc9e19a86deaacf0315151c46f779c3184632ab5793e2ddcb2ff87ca11cc886130f033364b08aef4e2"; + "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737"; + "c2f2077f538171d7c6cbee0c94948f82987117a50229fb0b48a534e3c63553a9a9704cdb460c597c8b46b631e49c22a9d2d46bded40f8a77652f754ec725e351"; + "89d7284e89642ec195f7a8ef098ef4e411fa3df17a07724cf13033bc6b7863968aad449cee973df9b92800d803ba3e14244231a86253cfacd1de882a542e945f"; + "f6ecfca37d2abcff4b362f1919629e784c4b618af77e1061bb992c11d7f518716f5df5978b0a1455d68ceeb10ced9251306d2f26181407be76a219d48c36b592"; + ] + |> List.map (Digestif.of_hex Digestif.sha512) + +let results_sha3_224 = + [ + "27d199d761adfa5530313acdf7e1680fbdea09236ac6395b43c4a0e6"; + "7fdb8dd88bd2f60d1b798634ad386811c2cfc85bfaf5d52bbace5e66"; + "179895b711ca2bebf420a2e7255564d4cb2217ea3ac8b2d45f29d127"; + "5bc718d440729ba7d857543eed04cbec3374eb835da33e99f8e0561f"; + "0f44044cd2cb5a02ec3b7dff4367c54a1ace6cb7d602e005684aee7c"; + ] + |> List.map (Digestif.of_hex Digestif.sha3_224) + +let results_sha3_256 = + [ + "bb25b6f7672dab6734313c8c63aab800b2c451c81833509c1afdb986be9bdea3"; + "c7d4072e788877ae3596bbb0da73b887c9171f93095b294ae857fbe2645e1ba5"; + "f58a4c9641f87ead6c16525906857f5fce149bb822c4fe7a2abcaebe823d9e0f"; + "1dcc5f9bcfb9fa35349d51c40672b2bd971afc32f9cf5e478ec442d6d90be4ce"; + "8d1de07fd2312402f94d061a88b02dc1e0173e9d89750284b78d2bb004e9d3c1"; + ] + |> List.map (Digestif.of_hex Digestif.sha3_256) + +let results_keccak_256 = + [ + "0dbf49d1c2d4625f87592309b3c7ceb2c1a2194dc866bb21be7ac6abb733f0f1"; + "aa9aed448c7abc8b5e326ffa6a01cdedf7b4b831881468c044ba8dd4566369a1"; + "7fce3f69adac930d657ce6998d6ad5ee102b5e7560e6690b4ca855e5d4c268a0"; + "c6cf40deda9a1028823641235499c9b1891c6e2ab7d2bfa9db06890ce8bc855e"; + "8af5e3a5ebc1a9927d43765c85ca455de007e357ea250ae3ed65b55765d3252a"; + ] + |> List.map (Digestif.of_hex Digestif.keccak_256) + +let results_sha3_384 = + [ + "fddae4c273e970a5f530cc737b15c1f0546caf0900e29fdf0ce57512a4c6898ca38931d1d3d9827cf16712c52da814e6"; + "f1101f8cbf9766fd6764d2ed61903f21ca9b18f57cf3e1a23ca13508a93243ce48c045dc007f26a21b3f5e0e9df4c20a"; + "ba546a5edbd7cdf49f2669553241e9867af842eb508432e8191d64282a9bb6e856311be49c8e673d72f212d446d0bee9"; + "f8d65fe91fe24a009263e9aee0267c48cafbe422b899a76763eb7ec095b6f0293033a504925a345ec70a3d984f98540d"; + "2485a07f2b1585572d492db2dcfffcc30a35e019ad6490af3bef94e514b66f90913fb11a9a365e42d2d03e3cad28b847"; + ] + |> List.map (Digestif.of_hex Digestif.sha3_384) + +let results_sha3_512 = + [ + "c2f4417c4dbc86cea2054beb755029c29c8dbed7781595fc9d5222214538a6975afc23f2f9e96683d33f547ea0df897bd1ca766fbb2c4ea674b9b9484e9e782a"; + "5a4bfeab6166427c7a3647b747292b8384537cdb89afb3bf5665e4c5e709350b287baec921fd7ca0ee7a0c31d022a95e1fc92ba9d77df883960275beb4e62024"; + "967c75d948f8b1efc263c4581287186500bf38daecda304fe68f34dacd622f299218ad47a4a112db5eedd5c8a30b03fefa17d20ddc3a735848f08fdc2d7ae592"; + "ba3d37e455183ac5a9af109512d97bcc5e34daa5e10796625db8661519a4027b2cf89d282302bd8a620b8813ee98f781a9388e4f479e189899d820c1dcd50b8c"; + "ce4a9d6e2b98b7fbb9ea668cd21b18c361d1d929fc6914192069b8c2672682a36ece8a6de07b17d4448afbc701b460264994ae9c79f26cfdd14a8fdc108d62a1"; + ] + |> List.map (Digestif.of_hex Digestif.sha3_512) + +let results_whirlpool = + [ + "1174a4781245c2c78435b68bd0eb5e462f66a455ccfde94f61be594f9db841e7f4e85ba740f31dfd89186724f953cbd454451e987c608958dc9b563fd9594776"; + "3d595ccd1d4f4cfd045af53ba7d5c8283fee6ded6eaf1269071b6b4ea64800056b5077c6a942cfa1221bd4e5aed791276e5dd46a407d2b8007163d3e7cd1de66"; + "7af46cc6bb193d7958bd55a91509c99570cbd233d48a8fbf05207017040e27671024a21fad3877ecd2a309fc13c403ea8e83c6423ab8d695b654dbf6a1d2e8ee"; + "a8646f7e371a1f9de1169d21de9a59ff2a32c73617c9b73708a226081b9316e81442e793e094c41a89e79705f1832c22e0cd3ac93d3b68a6842ddf35169908ae"; + "b80dc14932e92fda0ba7f09e1db20d514633d15c2b89ad96a96198f4f751f2acf34e4fe0c9e2d13c4efaf7082c0871584b8dde7a367703d6fdf4f400a52f9432"; + ] + |> List.map (Digestif.of_hex Digestif.whirlpool) + +let results_blake2b = + [ + "aba2eef053923ba3a671b54244580ca7c8dfa9c487431c3437e1a8504e166ed894778045a5c6a314fadee110a5254f6f370e9db1d3093a62e0448a5e91b1d4c6"; + "6ff884f8ddc2a6586b3c98a4cd6ebdf14ec10204b6710073eb5865ade37a2643b8807c1335d107ecdb9ffeaeb6828c4625ba172c66379efcd222c2de11727ab4"; + "42aadab231ff4edbdad29a18262bbb6ba74cf0850f40b64a92dc62a92608a65f06af850aa1988cd1e379cf9cc9a8f64d61125d7b3def292ae57e537bc202e812"; + "4abf562dc64f4062ea59ae9b4e2061a7a6c1a75af74b3663fd05aa4437420b8deea657e395a7dbac02aef7b7d70dc8b8a8db99aa8db028961a5ee66bac22b0f0"; + "69f9e4236cd0c50204e4f8b86dc1751d37cc195835e9db25c9b366f41e1d86cdeec6a8702dfed1bc0ed0d6a1e2c5af275c331ec91f884c979021fb64021915de"; + ] + |> List.map (Digestif.of_hex Digestif.blake2b) + +let results_rmd160 = + [ + "65b3cb3360881842a0d454bd6e7bc1bfe838b384"; + "dda6c0213a485a9e24f4742064a7f033b43c4069"; + "f071dcd2514fd89de78a5a2db1128dfa3e54d503"; + "bda5511e63389385218a8d902a70f2d8dc4dc074"; + "6c2486f169432281b6d71ae5b6765239c3cc1ea6"; + ] + |> List.map (Digestif.of_hex Digestif.rmd160) + +let results_blake2s = + [ + "5bb23bbe41678b23e6d38881d2515fdf5df253dd2e9a80075ea759c93e1bca3a"; + "90b6281e2f3038c9056af0b4a7e763cae6fe5d9eb4386a0ec95237890c104ff0"; + "5d0064cb2848ab5dc948876a6be3e5685301a744735c25858c0bd283a7940eb7"; + "6903efd2383b13adaa985d00ca271ccb420ab8f953841081c9c15a2dfebf866c"; + "b8e167de23a5f136dc26bf06da0d724ebf7310903c2f702403b66810a230d622"; + ] + |> List.map (Digestif.of_hex Digestif.blake2s) + +module BLAKE2 = struct + let input_blake2b_file = "../blake2b.test" + let input_blake2s_file = "../blake2s.test" + + let fold_s f a s = + let r = ref a in + String.iter (fun x -> r := f !r x) s ; + !r + + let of_hex len hex = + let code x = + match x with + | '0' .. '9' -> Char.code x - 48 + | 'A' .. 'F' -> Char.code x - 55 + | 'a' .. 'z' -> Char.code x - 87 + | _ -> raise (Invalid_argument "of_hex") in + let wsp = function ' ' | '\t' | '\r' | '\n' -> true | _ -> false in + fold_s + (fun (res, i, acc) -> function + | chr when wsp chr -> (res, i, acc) + | chr -> + match (acc, code chr) with + | None, x -> (res, i, Some (x lsl 4)) + | Some y, x -> + Bytes.set res i (Char.unsafe_chr (x lor y)) ; + (res, succ i, None)) + (Bytes.create len, 0, None) + hex + |> (function + | _, _, Some _ -> invalid_arg "of_hex" + | res, i, _ -> + if i = len + then res + else ( + for i = i to len - 1 do + Bytes.set res i '\000' + done ; + res)) + |> Bytes.unsafe_to_string + + let parse kind ic = + ignore @@ input_line ic ; + ignore @@ input_line ic ; + let rec loop state acc = + match (state, input_line ic) with + | `In, line -> + let i = ref "" in + Scanf.sscanf line "in:\t%s" (fun v -> + i := of_hex (String.length v / 2) v) ; + loop (`Key !i) acc + | `Key i, line -> ( + let k = ref None in + Scanf.sscanf line "key:\t%s" (fun v -> + k := Some (Digestif.to_raw_string kind (Digestif.of_hex kind v))) ; + match !k with + | Some k -> loop (`Hash (i, (k :> string))) acc + | None -> loop `In acc) + | `Hash (i, k), line -> ( + let h = ref None in + Scanf.sscanf line "hash:\t%s" (fun v -> + h := Some (Digestif.of_hex kind v)) ; + match !h with + | Some h -> loop (`Res (i, k, h)) acc + | None -> loop `In acc) + | `Res v, "" -> loop `In (v :: acc) + | `Res v, _ -> + (* avoid malformed line *) + loop (`Res v) acc + | exception End_of_file -> List.rev acc in + loop `In [] + + let test_mac : + type k a. + a s -> + k Digestif.hash -> + (module Digestif.MAC) -> + string -> + a -> + k Digestif.t -> + unit = + fun kind hash (module Mac) key input expect -> + let title = title `HMAC hash kind in + let check (result : Mac.t) = + Alcotest.(check string) + title + (Digestif.to_raw_string hash expect) + (Obj.magic result) + (* XXX(dinosaure): ok, this is really bad but I'm lazy to keep type + equality on [Mac] - extend interface and play with [with type t = t] + anywhere. *) in + match kind with + | Bytes -> check @@ Mac.maci_bytes ~key (fun f -> f input) + | String -> check @@ Mac.maci_string ~key (fun f -> f input) + | Bigstring -> check @@ Mac.maci_bigstring ~key (fun f -> f input) + + let make_keyed_blake m ~name kind hash key input expect = + (name, `Quick, fun () -> test_mac kind hash m key input expect) + + let tests m kind filename = + let ic = open_in filename in + let tests = parse kind ic in + close_in ic ; + List.map + (fun (input, key, expect) -> + make_keyed_blake m ~name:"blake2{b,s}" string kind key input expect) + tests + + let tests_blake2s = + tests (module Digestif.BLAKE2S.Keyed) Digestif.blake2s input_blake2s_file + + let tests_blake2b = + tests (module Digestif.BLAKE2B.Keyed) Digestif.blake2b input_blake2b_file +end + +module RMD160 = struct + let inputs = + [ + ""; "a"; "abc"; "message digest"; "abcdefghijklmnopqrstuvwxyz"; + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"; + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"; + "12345678901234567890123456789012345678901234567890123456789012345678901234567890"; + ] + + let expects = + [ + "9c1185a5c5e9fc54612808977ee8f548b2258d31"; + "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe"; + "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc"; + "5d0689ef49d2fae572b881b123a85ffa21595f36"; + "f71c27109c692c1b56bbdceb5b9d2865b3708dbc"; + "12a053384a9c0c88e405a06c27dcf49ada62eb2b"; + "b0e20b6e3116640286ed3a87a5713079b21f5189"; + "9b752e45573d4b39f4dbd3323cab82bf63326bfb"; + ] + + let million : expect:Digestif.RMD160.t Digestif.t -> unit Alcotest.test_case = + fun ~expect -> + let iter n f = + let rec go = function + | 0 -> () + | n -> + f "a" ; + go (n - 1) in + go n in + let result = Digestif.digesti_string Digestif.rmd160 (iter 1_000_000) in + let test_hash = + Alcotest.testable Digestif.(pp rmd160) Digestif.(equal rmd160) in + ( "give me a million", + `Slow, + fun () -> Alcotest.(check test_hash) "rmd160" expect result ) + + let tests = + let expect_million = + Digestif.of_hex Digestif.rmd160 "52783243c1697bdbe16d37f97f68f08325dc1528" + in + List.map + (fun (input, expect) -> + make_digest ~name:"rmd160" string Digestif.rmd160 input expect) + (List.combine inputs (List.map Digestif.(of_hex rmd160) expects)) + @ [ million ~expect:expect_million ] +end + +let str = Alcotest.testable (fun ppf -> Fmt.pf ppf "%S") String.equal + +let blake2s_spe digest_size = + Alcotest.test_case (Fmt.str "BLAKE2S (digest-size: %d)" digest_size) `Quick + @@ fun () -> + let module Hash = Digestif.Make_BLAKE2S (struct + let digest_size = digest_size + end) in + Fmt.epr ">>> Use digest_string\n%!" ; + let hash0 = Hash.digest_string "" in + Fmt.epr ">>> Use feed_string\n%!" ; + let hash1 = Hash.get (Hash.feed_string Hash.empty "") in + let raw_hash0 = Hash.to_raw_string hash0 in + let raw_hash1 = Hash.to_raw_string hash1 in + Alcotest.(check int) "raw length" digest_size (String.length raw_hash0) ; + Alcotest.(check int) "raw length" digest_size (String.length raw_hash1) ; + let hash = Alcotest.testable Hash.pp Hash.equal in + Alcotest.(check hash) "hash" hash0 hash1 ; + Alcotest.(check str) "raw hash" raw_hash0 raw_hash1 + +let blake2b_spe digest_size = + Alcotest.test_case (Fmt.str "BLAKE2B (digest-size: %d)" digest_size) `Quick + @@ fun () -> + let module Hash = Digestif.Make_BLAKE2B (struct + let digest_size = digest_size + end) in + let hash0 = Hash.digest_string "" in + let hash1 = Hash.get (Hash.feed_string Hash.empty "") in + let raw_hash0 = Hash.to_raw_string hash0 in + let raw_hash1 = Hash.to_raw_string hash1 in + Alcotest.(check int) "raw length" digest_size (String.length raw_hash0) ; + Alcotest.(check int) "raw length" digest_size (String.length raw_hash1) ; + let hash = Alcotest.testable Hash.pp Hash.equal in + Alcotest.(check hash) "hash" hash0 hash1 ; + Alcotest.(check str) "raw hash" raw_hash0 raw_hash1 + +type kind = V : 'a Digestif.hash -> kind + +let ( <.> ) f g x = f (g x) + +let code x = + match x with + | '0' .. '9' -> Char.code x - Char.code '0' + | 'A' .. 'F' -> Char.code x - Char.code 'A' + 10 + | 'a' .. 'f' -> Char.code x - Char.code 'a' + 10 + | _ -> Fmt.invalid_arg "of_hex: %02X" (Char.code x) + +let decode chr1 chr2 = Char.chr ((code chr1 lsl 4) lor code chr2) + +let of_hex hex = + let offset = ref 0 in + let rec go have_first idx = + if !offset + idx >= String.length hex + then '\x00' + else + match hex.[!offset + idx] with + | ' ' | '\t' | '\r' | '\n' -> + incr offset ; + go have_first idx + | chr2 when have_first -> chr2 + | chr1 -> + incr offset ; + let chr2 = go true idx in + if chr2 <> '\x00' + then decode chr1 chr2 + else invalid_arg "of_hex: odd number of hex characters" in + String.init (String.length hex / 2) (go false) + +let sha3_of_name str = + match Astring.String.cut ~sep:":" str with + | None -> Fmt.invalid_arg "Invalid line: %S" str + | Some (_name, value) -> ( + let value = Astring.String.trim value in + match value with + | "SHA3-224" -> V Digestif.sha3_224 + | "SHA3-256" -> V Digestif.sha3_256 + | "SHA3-384" -> V Digestif.sha3_384 + | "SHA3-512" -> V Digestif.sha3_512 + | v -> Fmt.invalid_arg "Invalid kind of hash: %s" v) + +let parse_field str = + match Astring.String.cut ~sep:":" str with + | Some (_key, v) -> Astring.String.trim v + | None -> Fmt.invalid_arg "Invalid line: %S" str + +let empty = "\"\"" + +let sha3_vector_tests filename = + Alcotest.test_case filename `Quick @@ fun () -> + let ic = open_in filename in + let _algorithm_type = input_line ic in + let _source = input_line ic in + let (V hash) = sha3_of_name (input_line ic) in + let rec go () = + try + let comment = parse_field (input_line ic) in + let message = parse_field (input_line ic) in + Fmt.epr ">>> %S.\n%!" comment ; + Fmt.epr ">>> %S.\n%!" (if message = empty then "" else of_hex message) ; + let digest = (Digestif.of_hex hash <.> parse_field <.> input_line) ic in + let _verify = input_line ic in + let result = + if message = empty + then Digestif.digest_string hash "" + else Digestif.digest_string hash (of_hex message) in + Alcotest.(check (testable (Digestif.pp hash) (Digestif.equal hash))) + comment digest result ; + go () + with End_of_file -> () in + go () ; + close_in ic + +let keccak_vector_tests filename = + Alcotest.test_case filename `Quick @@ fun () -> + let ic = open_in filename in + let _algorithm_type = input_line ic in + let _name = input_line ic in + let hash = Digestif.keccak_256 in + let rec go () = + try + let comment = parse_field (input_line ic) in + let message = parse_field (input_line ic) in + let digest = (Digestif.of_hex hash <.> parse_field <.> input_line) ic in + let _verify = input_line ic in + let result = + if message = empty + then Digestif.digest_string hash "" + else Digestif.digest_string hash (of_hex message) in + Alcotest.(check (testable (Digestif.pp hash) (Digestif.equal hash))) + comment digest result ; + go () + with End_of_file -> () in + go () ; + close_in ic + +let tests () = + Alcotest.run "digestif" + [ + ("md5", makes ~name:"md5" bytes Digestif.md5 keys_st inputs_by results_md5); + ( "md5 (bigstring)", + makes ~name:"md5" bigstring Digestif.md5 keys_st inputs_bi results_md5 + ); + ( "sha1", + makes ~name:"sha1" bytes Digestif.sha1 keys_st inputs_by results_sha1 ); + ( "sha1 (bigstring)", + makes ~name:"sha1" bigstring Digestif.sha1 keys_st inputs_bi + results_sha1 ); + ( "sha224", + makes ~name:"sha224" bytes Digestif.sha224 keys_st inputs_by + results_sha224 ); + ( "sha224 (bigstring)", + makes ~name:"sha224" bigstring Digestif.sha224 keys_st inputs_bi + results_sha224 ); + ( "sha256", + makes ~name:"sha256" bytes Digestif.sha256 keys_st inputs_by + results_sha256 ); + ( "sha256 (bigstring)", + makes ~name:"sha256" bigstring Digestif.sha256 keys_st inputs_bi + results_sha256 ); + ( "sha256 (feed bytes)", + makes' ~name:"sha256" bytes Digestif.sha256 keys_st inputs_by + results_sha256' ); + ( "sha384", + makes ~name:"sha384" bytes Digestif.sha384 keys_st inputs_by + results_sha384 ); + ( "sha384 (bigstring)", + makes ~name:"sha384" bigstring Digestif.sha384 keys_st inputs_bi + results_sha384 ); + ( "sha512", + makes ~name:"sha512" bytes Digestif.sha512 keys_st inputs_by + results_sha512 ); + ( "sha512 (bigstring)", + makes ~name:"sha512" bigstring Digestif.sha512 keys_st inputs_bi + results_sha512 ); + ( "sha3_224", + makes ~name:"sha3_224" bytes Digestif.sha3_224 keys_st inputs_by + results_sha3_224 ); + ( "sha3_224 (bigstring)", + makes ~name:"sha3_224" bigstring Digestif.sha3_224 keys_st inputs_bi + results_sha3_224 ); + ( "sha3_256", + makes ~name:"sha3_256" bytes Digestif.sha3_256 keys_st inputs_by + results_sha3_256 ); + ( "sha3_256 (bigstring)", + makes ~name:"sha3_256" bigstring Digestif.sha3_256 keys_st inputs_bi + results_sha3_256 ); + ( "keccak_256", + makes ~name:"keccak_256" bytes Digestif.keccak_256 keys_st inputs_by + results_keccak_256 ); + ( "keccak_256 (bigstring)", + makes ~name:"keccak_256" bigstring Digestif.keccak_256 keys_st inputs_bi + results_keccak_256 ); + ( "sha3_384", + makes ~name:"sha3_384" bytes Digestif.sha3_384 keys_st inputs_by + results_sha3_384 ); + ( "sha3_384 (bigstring)", + makes ~name:"sha3_384" bigstring Digestif.sha3_384 keys_st inputs_bi + results_sha3_384 ); + ( "sha3_512", + makes ~name:"sha3_512" bytes Digestif.sha3_512 keys_st inputs_by + results_sha3_512 ); + ( "sha3_512 (bigstring)", + makes ~name:"sha3_512" bigstring Digestif.sha3_512 keys_st inputs_bi + results_sha3_512 ); + ( "whirlpool", + makes ~name:"whirlpool" bytes Digestif.whirlpool keys_st inputs_by + results_whirlpool ); + ( "whirlpool (bigstring)", + makes ~name:"whirlpool" bigstring Digestif.whirlpool keys_st inputs_bi + results_whirlpool ); + ( "blake2b", + makes ~name:"blake2b" bytes Digestif.blake2b keys_st inputs_by + results_blake2b ); + ( "blake2b (bigstring)", + makes ~name:"blake2b" bigstring Digestif.blake2b keys_st inputs_bi + results_blake2b ); + ( "rmd160", + makes ~name:"rmd160" bytes Digestif.rmd160 keys_st inputs_by + results_rmd160 ); + ( "rmd160 (bigstring)", + makes ~name:"rmd160" bigstring Digestif.rmd160 keys_st inputs_bi + results_rmd160 ); + ( "blake2s", + makes ~name:"blake2s" bytes Digestif.blake2s keys_st inputs_by + results_blake2s ); + ( "blake2s (bigstring)", + makes ~name:"blake2s" bigstring Digestif.blake2s keys_st inputs_bi + results_blake2s ); + ("blake2s (keyed, input file)", BLAKE2.tests_blake2s); + ("blake2b (keyed, input file)", BLAKE2.tests_blake2b); + ( "blake2s (specialization)", + [ blake2s_spe 32; blake2s_spe 8; blake2s_spe 16 ] ); + ( "blake2b (specialization)", + [ blake2b_spe 32; blake2b_spe 64; blake2b_spe 16 ] ); + ("ripemd160", RMD160.tests); + ( "sha3 (vector tests)", + [ + sha3_vector_tests "../sha3_224_fips_202.txt"; + sha3_vector_tests "../sha3_256_fips_202.txt"; + sha3_vector_tests "../sha3_384_fips_202.txt"; + sha3_vector_tests "../sha3_512_fips_202.txt"; + keccak_vector_tests "../keccak_256.txt"; + ] ); + ] + +let () = tests () diff --git a/unikernel/duniverse/digestif/test/test_cve.ml b/unikernel/duniverse/digestif/test/test_cve.ml new file mode 100644 index 00000000..bcdba2ee --- /dev/null +++ b/unikernel/duniverse/digestif/test/test_cve.ml @@ -0,0 +1,66 @@ +external unsafe_set_uint8 : + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> + int -> + int -> + unit = "%caml_ba_set_1" + +external unsafe_set_uint32 : + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> + int -> + int32 -> + unit = "%caml_bigstring_set32" + +let fill ba chr = + let len = Bigarray.Array1.dim ba in + let len0 = len land 3 in + let len1 = len asr 2 in + let v0 = Char.code chr in + let v1 = Int32.of_int v0 in + + for i = 0 to len1 - 1 do + let i = i * 4 in + unsafe_set_uint32 ba i v1 + done ; + + for i = 0 to len0 - 1 do + let i = (len1 * 4) + i in + unsafe_set_uint8 ba i v0 + done + +let sha3_cve_2022_37454_0 = + Alcotest.test_case "buffer overflow" `Slow @@ fun () -> + Gc.full_major () ; + let a = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 1 in + let b = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 4294967295 in + fill a '\x00' ; + fill b '\x00' ; + let ctx = Digestif.SHA3_224.empty in + let ctx = Digestif.SHA3_224.feed_bigstring ctx a in + let ctx = Digestif.SHA3_224.feed_bigstring ctx b in + let hash = Digestif.SHA3_224.get ctx in + Alcotest.(check (testable Digestif.SHA3_224.pp Digestif.SHA3_224.equal)) + "result" hash + (Digestif.SHA3_224.of_hex + "c5bcc3bc73b5ef45e91d2d7c70b64f196fac08eee4e4acf6e6571ebe") + +let sha3_cve_2022_37454_1 = + Alcotest.test_case "infinite loop" `Slow @@ fun () -> + Gc.full_major () ; + let a = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 1 in + let b = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 4294967296 in + fill a '\x00' ; + fill b '\x00' ; + let ctx = Digestif.SHA3_224.empty in + let ctx = Digestif.SHA3_224.feed_bigstring ctx a in + let ctx = Digestif.SHA3_224.feed_bigstring ctx b in + let hash = Digestif.SHA3_224.get ctx in + Alcotest.(check (testable Digestif.SHA3_224.pp Digestif.SHA3_224.equal)) + "result" hash + (Digestif.SHA3_224.of_hex + "bdd5167212d2dc69665f5a8875ab87f23d5ce7849132f56371a19096") + +let () = + Alcotest.run "digestif (CVE)" + [ + ("sha3 (CVE-2022-37454)", [ sha3_cve_2022_37454_0; sha3_cve_2022_37454_1 ]); + ] diff --git a/unikernel/duniverse/digestif/test/test_runes.ml b/unikernel/duniverse/digestif/test/test_runes.ml new file mode 100644 index 00000000..05371883 --- /dev/null +++ b/unikernel/duniverse/digestif/test/test_runes.ml @@ -0,0 +1,155 @@ +#use "topfind" + +#require "astring" + +#require "fpath" + +#require "bos" + +open Rresult + +let is_opt x = String.length x > 1 && x.[0] = '-' + +let parse_opt_arg x = + let l = String.length x in + if x.[1] <> '-' + then + if l = 2 + then (x, None) + else (String.sub x 0 2, Some (String.sub x 2 (l - 2))) + else + try + let i = String.index x '=' in + (String.sub x 0 i, Some (String.sub x (i + 1) (l - i - 1))) + with Not_found -> (x, None) + +type arg = + | Path of Fpath.t + | Library of [ `Abs of Fpath.t | `Rel of Fpath.t | `Name of string ] + +let parse_lL_value name value = + match name with + | "-L" -> ( + match Fpath.of_string value with + | Ok v when Fpath.is_dir_path v && Sys.is_directory value -> R.ok (Path v) + | Ok v when Sys.is_directory value -> R.ok (Path (Fpath.to_dir_path v)) + | Ok v -> R.error_msgf "Directory <%a> does not exist" Fpath.pp v + | Error err -> Error err) + | "-l" -> ( + match Astring.String.cut ~sep:":" value with + | Some ("", path) -> ( + match Fpath.of_string path with + | Ok v when Fpath.is_abs v && Sys.file_exists path -> + Ok (Library (`Abs v)) + | Ok v when Fpath.is_rel v -> Ok (Library (`Rel v)) + | Ok v -> R.error_msgf "Library <%a> does not exist" Fpath.pp v + | Error err -> Error err) + | Some (_, _) -> R.error_msgf "Invalid %S" value + | None -> + match Fpath.of_string value with + | Ok v when Fpath.is_file_path v && Fpath.filename v = value -> + Ok (Library (`Name value)) + | Ok v -> R.error_msgf "Invalid library name <%a>" Fpath.pp v + | Error err -> Error err) + | _ -> Fmt.failwith "Invalid argument name %S" name + +let parse_lL_args args = + let rec go lL_args = function + | [] | "--" :: _ -> R.ok (List.rev lL_args) + | x :: args -> ( + if not (is_opt x) + then go lL_args args + else + let name, value = parse_opt_arg x in + match name with + | "-L" | "-l" -> ( + match value with + | Some value -> + parse_lL_value name value >>= fun v -> go (v :: lL_args) args + | None -> + match args with + | [] -> R.error_msgf "%s must have a value." name + | value :: args -> + if is_opt value + then R.error_msgf "%s must have a value." name + else + parse_lL_value name value >>= fun v -> + go (v :: lL_args) args) + | _ -> go lL_args args) in + go [] args + +let is_path = function Path _ -> true | Library _ -> false +let prj_path = function Path x -> x | _ -> assert false +let prj_libraries = function Library x -> x | _ -> assert false + +let libraries_exist args = + let paths, libraries = List.partition is_path args in + let paths = List.map prj_path paths in + let libraries = List.map prj_libraries libraries in + let rec go = function + | [] -> R.ok () + | `Rel library :: libraries -> + let rec check = function + | [] -> R.error_msgf "Library <:%a> does not exist." Fpath.pp library + | p0 :: ps -> ( + let path = Fpath.(p0 // library) in + Bos.OS.Path.exists path >>= function + | true -> go libraries + | false -> check ps) in + check paths + | `Name library :: libraries -> + let lib = Fmt.str "lib%s.a" library in + let rec check = function + | [] -> R.error_msgf "Library lib%s.a does not exist." library + | p0 :: ps -> ( + let path = Fpath.(p0 / lib) in + Bos.OS.Path.exists path >>= function + | true -> go libraries + | false -> check ps) in + check paths + | `Abs path :: libraries -> ( + Bos.OS.Path.exists path >>= function + | true -> go libraries + | false -> R.error_msgf "Library <%a> does not exist." Fpath.pp path) + in + go libraries + +let exists lib = + let open Bos in + let command = Cmd.(v "ocamlfind" % "query" % lib) in + OS.Cmd.run_out command |> OS.Cmd.out_null >>= function + | (), (_, `Exited 0) -> R.ok true + | _ -> R.ok false + +let query target lib = + let open Bos in + let format = Fmt.str "-L%%d %%(%s_linkopts)" target in + let command = Cmd.(v "ocamlfind" % "query" % "-format" % format % lib) in + OS.Cmd.run_out command + |> OS.Cmd.out_lines + >>= (function + | output, (_, `Exited 0) -> R.ok output + | _ -> R.error_msgf " does not properly exit.") + >>| String.concat " " + >>| Astring.String.cuts ~sep:" " ~empty:false + +let run () = + (exists "mirage-xen-posix" >>= function + | true -> query "xen" "digestif" >>= parse_lL_args >>= libraries_exist + | false -> R.ok ()) + >>= fun () -> + (exists "ocaml-freestanding" >>= function + | true -> + query "freestanding" "digestif" >>= parse_lL_args >>= libraries_exist + | false -> R.ok ()) + >>= fun () -> R.ok () + +let exit_success = 0 +let exit_failure = 1 + +let () = + match run () with + | Ok () -> exit exit_success + | Error (`Msg err) -> + Fmt.epr "%s\n%!" err ; + exit exit_failure diff --git a/unikernel/duniverse/domain-name/.gitignore b/unikernel/duniverse/domain-name/.gitignore new file mode 100644 index 00000000..4e66100e --- /dev/null +++ b/unikernel/duniverse/domain-name/.gitignore @@ -0,0 +1,3 @@ +_build/ +*.install +.merlin diff --git a/unikernel/duniverse/domain-name/CHANGES.md b/unikernel/duniverse/domain-name/CHANGES.md new file mode 100644 index 00000000..f01d33bc --- /dev/null +++ b/unikernel/duniverse/domain-name/CHANGES.md @@ -0,0 +1,61 @@ +## v0.5.0 (2025-10-13) + +* Disallow trailing hyphen (-) in host labels (#15 @hannes, fixes #14) + +## v0.4.1 (2025-02-17) + +* handle root specially for encoding and decoding (#12 @reynir, fixes #10) + +## v0.4.0 (2022-01-07) + +* compare: conform to canonical DNS name order (RFC 4034, Section 6.1) + +## v0.3.1 (2021-10-27) + +* remove fmt and astring dependency + +## v0.3.0 (2019-07-08) + +* all optional ?back arguments are now ?rev +* compare_sub is now compare_label +* new function: equal_label : ?case_sensitive:bool -> string -> string -> bool +* new function: find_label : ?rev:bool -> 'a t -> (string -> bool) -> int option + which searches for the predicate (3rd argument) in t (2nd arguments) + +## v0.2.1 (2019-06-30) + +* getter functions for labels: + get_label : 'a t -> int -> (string, [> `Msg of string ]) result + get_label_exn : 'a t -> int -> string +* count_labels : 'a t -> int + +## v0.2.0 (2019-06-25) + +* type t is now a phantom type 'a t, where 'a carries whether it is a hostname, + a service name or a raw domain name. this lead to removal of various + ?hostname:bool arguments +* val host : 'a t -> ([`host] t, [> `Msg of string ]) result +* analog host_exn, service, service_exn, raw +* removed is_service, is_hostname +* new submodules Host_set, Host_map, Service_set, Service_map +* new function: append : 'a t -> 'b t -> ([`raw] t, [> `Msg of string ]) result +* renamed: drop_labels{,_exn} is now drop_label{,_exn} +* renamed: prepend{,_exn} is now prepend_label{,_exn} + +## 0.1.2 (2019-02-16) + +* `is_service` accepts numeric service names, used for ports in TLSA records (#1 by @cfcs) +* port to dune + +## 0.1.1 (2018-07-07) + +* `to_string` and `to_strings` now have an optional labeled `trailing` argument + of type bool +* support for FQDN with trailing dot: `of_string "example.com."` now returns + `Ok`, and is equal to `of_string "example.com"` +* fix and add tests for `drop_labels` and `drop_labels_exn`, where the semantics + of the labeled `back` argument was inversed. + +## 0.1.0 (2018-06-26) + +* Initial release diff --git a/unikernel/duniverse/domain-name/LICENSE.md b/unikernel/duniverse/domain-name/LICENSE.md new file mode 100644 index 00000000..dc97c8bd --- /dev/null +++ b/unikernel/duniverse/domain-name/LICENSE.md @@ -0,0 +1,16 @@ +(* + * Copyright (c) 2017 2018 Hannes Mehnert + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) diff --git a/unikernel/duniverse/domain-name/README.md b/unikernel/duniverse/domain-name/README.md new file mode 100644 index 00000000..62c0d03a --- /dev/null +++ b/unikernel/duniverse/domain-name/README.md @@ -0,0 +1,27 @@ +## Domain-name - [RFC 1035](https://tools.ietf.org/html/rfc1035) Internet domain names + +v0.5.0 + +A domain name is a sequence of labels separated by dots, such as `foo.example`. +Each label may contain any bytes. The length of each label may not exceed 63 +charactes. The total length of a domain name is limited to 253 (byte +representation is 255), but other protocols (such as SMTP) may apply even +smaller limits. A domain name label is case preserving, comparison is done in a +case insensitive manner. + +The invariants on the length of domain names are preserved throughout the +module. + +## Documentation + +[![Build Status](https://travis-ci.org/hannesm/domain-name.svg?branch=master)](https://travis-ci.org/hannesm/domain-name) + +[API documentation](https://hannesm.github.io/domain-name/doc/) is available online. + +## Installation + +You need [opam](https://opam.ocaml.org) installed on your system. The command + +`opam install domain-name` + +will install this library. diff --git a/unikernel/duniverse/domain-name/domain-name.opam b/unikernel/duniverse/domain-name/domain-name.opam new file mode 100644 index 00000000..acb71cfc --- /dev/null +++ b/unikernel/duniverse/domain-name/domain-name.opam @@ -0,0 +1,29 @@ +version: "0.5.0" +opam-version: "2.0" +maintainer: "Hannes Mehnert " +authors: "Hannes Mehnert " +license: "ISC" +homepage: "https://github.com/hannesm/domain-name" +doc: "https://hannesm.github.io/domain-name/doc" +bug-reports: "https://github.com/hannesm/domain-name/issues" +depends: [ + "ocaml" {>= "4.04.2"} + "dune" {>= "1.0"} + "alcotest" {with-test} +] +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +dev-repo: "git+https://github.com/hannesm/domain-name.git" +synopsis: "RFC 1035 Internet domain names" +description: """ +A domain name is a sequence of labels separated by dots, such as `foo.example`. +Each label may contain any bytes. The length of each label may not exceed 63 +charactes. The total length of a domain name is limited to 253 (byte +representation is 255), but other protocols (such as SMTP) may apply even +smaller limits. A domain name label is case preserving, comparison is done in a +case insensitive manner. +""" +x-maintenance-intent: [ "(latest)" ] \ No newline at end of file diff --git a/unikernel/duniverse/domain-name/domain_name.ml b/unikernel/duniverse/domain-name/domain_name.ml new file mode 100644 index 00000000..b7c556bf --- /dev/null +++ b/unikernel/duniverse/domain-name/domain_name.ml @@ -0,0 +1,284 @@ +(* (c) 2017 Hannes Mehnert, all rights reserved *) + +type 'a s = string array + +let root = Array.make 0 "" + +let [@inline always] is_letter = function + | 'a'..'z' | 'A'..'Z' -> true + | _ -> false + +let [@inline always] is_ldh = function + | '0'..'9' | 'a'..'z' | 'A'..'Z' | '-' -> true + | _ -> false + +(* from OCaml 4.13 bytes.ml *) +let for_all p s = + let n = String.length s in + let rec loop i = + if i = n then true + else if p (String.unsafe_get s i) then loop (succ i) + else false in + loop 0 + +let exists p s = + let n = String.length s in + let rec loop i = + if i = n then false + else if p (String.unsafe_get s i) then true + else loop (succ i) in + loop 0 + +let [@inline always] check_host_label s = + String.get s 0 <> '-' && (* leading may not be '-' *) + String.get s (String.length s - 1) <> '-' && (* trailing may not be '-' *) + for_all is_ldh s (* only LDH (letters, digits, hyphen)! *) + +let host_exn t = + (* TLD should not be all-numeric! *) + if + (if Array.length t > 0 then + exists is_letter (Array.get t 0) + else true) && + Array.for_all check_host_label t + then + t + else + invalid_arg "invalid host name" + +let host t = + try Ok (host_exn t) with + | Invalid_argument e -> Error (`Msg e) + +let check_service_label s = + if String.length s > 0 && String.unsafe_get s 0 = '_' then + let srv = String.sub s 1 (String.length s - 1) in + let slen = String.length srv in + (* service label: 1-15 characters; LDH; hyphen _not_ at begin nor end; no hyphen following a hyphen *) + slen > 0 && slen <= 15 && + for_all is_ldh srv && + String.unsafe_get srv 0 <> '-' && + String.unsafe_get srv (slen - 1) <> '-' && + List.for_all (fun l -> l <> "") + (String.split_on_char '-' srv) + else + false + +let [@inline always] is_proto s = + s = "_tcp" || s = "_udp" || s = "_sctp" + +let [@inline always] check_label_length s = + let l = String.length s in + l < 64 && l > 0 + +let [@inline always] check_total_length t = + Array.fold_left (fun acc s -> acc + 1 + String.length s) 1 t <= 255 + +let service_exn t = + let l = Array.length t in + if + if l > 2 then + let name = Array.sub t 0 (l - 2) in + check_service_label (Array.get t (l - 1)) && + is_proto (Array.get t (l - 2)) && + Array.for_all check_label_length name && + check_total_length t && + match host name with Ok _ -> true | Error _ -> false + else + false + then + t + else + invalid_arg "invalid service name" + +let service t = + try Ok (service_exn t) with + | Invalid_argument e -> Error (`Msg e) + +let raw t = t + +let [@inline always] check t = + Array.for_all check_label_length t && + check_total_length t + +let get_label_exn ?(rev = false) xs idx = + let idx' = if rev then idx else pred (Array.length xs) - idx in + try Array.get xs idx' with + | Invalid_argument _ -> invalid_arg "bad index for domain name" + +let get_label ?rev xs idx = + try Ok (get_label_exn ?rev xs idx) with + | Invalid_argument e -> Error (`Msg e) + +let find_label_exn ?(rev = false) xs p = + let l = pred (Array.length xs) in + let check x = x >= 0 && x <= l in + let rec go next idx = + if check idx then + if p (Array.get xs idx) then + idx + else + go next (next idx) + else + invalid_arg "label not found" + in + let next, start = if rev then (succ, 0) else (pred, l) in + let r = go next start in + l - r + +let find_label ?rev xs p = + try Some (find_label_exn ?rev xs p) with + | Invalid_argument _ -> None + +let count_labels xs = Array.length xs + +let prepend_label_exn xs lbl = + let n = Array.make 1 lbl in + let n = Array.append xs n in + if check_label_length lbl && check_total_length n then n + else invalid_arg "invalid domain name" + +let prepend_label xs lbl = + try Ok (prepend_label_exn xs lbl) with + | Invalid_argument e -> Error (`Msg e) + +let drop_label_exn ?(rev = false) ?(amount = 1) t = + let len = Array.length t - amount + and start = if rev then amount else 0 + in + Array.sub t start len + +let drop_label ?rev ?amount t = + try Ok (drop_label_exn ?rev ?amount t) with + | Invalid_argument _ -> Error (`Msg "couldn't drop labels") + +let append_exn pre post = + let r = Array.append post pre in + if check_total_length r then r else invalid_arg "invalid domain name" + +let append pre post = + try Ok (append_exn pre post) with + | Invalid_argument _ -> Error (`Msg "couldn't concatenate domain names") + +let of_strings_exn xs = + let labels = + (* we support both example.com. and example.com *) + match List.rev xs with + | ""::rst -> rst + | rst -> rst + in + let t = Array.of_list labels in + if check t then t + else invalid_arg "invalid domain name" + +let of_strings xs = + try Ok (of_strings_exn xs) with + | Invalid_argument e -> Error (`Msg e) + +let of_string_exn = function + | "." -> root + | s -> of_strings_exn (String.split_on_char '.' s) + +let of_string s = + try Ok (of_string_exn s) with + | Invalid_argument e -> Error (`Msg e) + +let of_array a = a + +let to_array a = a + +let to_strings ?(trailing = false) dn = + let labels = Array.to_list dn in + List.rev (if trailing then "" :: labels else labels) + +let to_string ?trailing dn = + match to_strings ?trailing dn with + | [""] -> "." + | labels -> String.concat "." labels + +let canonical t = + let str = to_string t in + of_string_exn (String.lowercase_ascii str) + +let pp ppf xs = Format.pp_print_string ppf (to_string xs) + +let compare_label a b = + String.compare (String.lowercase_ascii a) (String.lowercase_ascii b) + +let compare_domain cmp_sub a b = + let al = Array.length a and bl = Array.length b in + let rec cmp idx = + if al = bl && al = idx then 0 + else if al = idx then -1 + else if bl = idx then 1 + else + match cmp_sub (Array.get a idx) (Array.get b idx) with + | 0 -> cmp (succ idx) + | x -> x + in + cmp 0 + +let compare = compare_domain compare_label + +let equal_label ?(case_sensitive = false) a b = + let cmp = if case_sensitive then String.compare else compare_label in + cmp a b = 0 + +let equal ?(case_sensitive = false) a b = + let cmp = if case_sensitive then String.compare else compare_label in + compare_domain cmp a b = 0 + +let is_subdomain ~subdomain ~domain = + let supl = Array.length domain in + let rec cmp idx = + if idx = supl then + true + else + compare_label (Array.get domain idx) (Array.get subdomain idx) = 0 && + cmp (succ idx) + in + if Array.length subdomain < supl then + false + else + cmp 0 + +module Ordered = struct + type t = [ `raw ] s + let compare = compare_domain compare_label +end + +module Host_ordered = struct + type t = [ `host ] s + let compare = compare_domain compare_label +end + +module Service_ordered = struct + type t = [ `service ] s + let compare = compare_domain compare_label +end + +type 'a t = 'a s + +module Host_map = struct + include Map.Make(Host_ordered) + + let find k m = try Some (find k m) with Not_found -> None +end + +module Host_set = Set.Make(Host_ordered) + +module Service_map = struct + include Map.Make(Service_ordered) + + let find k m = try Some (find k m) with Not_found -> None +end + +module Service_set = Set.Make(Service_ordered) + +module Map = struct + include Map.Make(Ordered) + + let find k m = try Some (find k m) with Not_found -> None +end + +module Set = Set.Make(Ordered) diff --git a/unikernel/duniverse/domain-name/domain_name.mli b/unikernel/duniverse/domain-name/domain_name.mli new file mode 100644 index 00000000..56a73356 --- /dev/null +++ b/unikernel/duniverse/domain-name/domain_name.mli @@ -0,0 +1,249 @@ +(* (c) 2017 Hannes Mehnert, all rights reserved *) + +type 'a t +(** The type of a domain name, a sequence of labels separated by dots. Each + label may contain any bytes. The length of each label may not exceed 63 + characters. The total length of a domain name is limited to 253 (its byte + representation is 255), but other protocols (such as SMTP) may apply even + smaller limits. A domain name label is case preserving, comparison is done + in a case insensitive manner. Every [t] is a fully qualified domain name, + its last label is the [root] label. The specification of domain names + originates from {{:https://tools.ietf.org/html/rfc1035}RFC 1035}. + + The invariants on the length of domain names are preserved throughout the + module - no [t] will exist which violates these. + + Phantom types are used for further name restrictions, {!host} checks for + host names ([`host t]): only letters, digits, and hyphen allowed, hyphen not + first or last character of a label, the last label must contain at least one letter. + {!service} checks for a service name ([`service t]): its first label is a + service name: 1-15 characters, no double-hyphen, hyphen not first or last + charactes, only letters, digits and hyphen allowed, and the second label is a + protocol ([_tcp] or [_udp] or [_sctp]). + + When a [t] is constructed (either from a string, etc.), it is a [`raw t]. + Subsequent modifications, such as adding or removing labels, appending, of + any kind of name also result in a [`raw t], which needs to be checked for + [`host t] (using {!host}) or [`service t] (using {!service}) if desired. + + Constructing a [t] (via {!of_string}, {!of_string_exn}, {!of_strings} etc.) + does not require a trailing dot. + + + {e v0.5.0 - {{:https://github.com/hannesm/domain-name }homepage}} *) + +(** {2 Constructor} *) + +val root : [ `raw ] t +(** [root] is the root domain ("."), the empty label. *) + +(** {2 String representation} *) + +val of_string : string -> ([ `raw ] t, [> `Msg of string ]) result +(** [of_string name] is either [t], the domain name, or an error if the provided + [name] is not a valid domain name. A trailing dot is not requred. *) + +val of_string_exn : string -> [ `raw ] t +(** [of_string_exn name] is [t], the domain name. A trailing dot is not + required. + + @raise Invalid_argument if [name] is not a valid domain name. *) + +val to_string : ?trailing:bool -> 'a t -> string +(** [to_string ~trailing t] is [String.concat ~sep:"." (to_strings t)], a + human-readable representation of [t]. If [trailing] is provided and + [true] (defaults to [false]), the resulting string will contain a trailing + dot. *) + +(** {2 Predicates and basic operations} *) + +val canonical : 'a t -> 'a t +(** [canonical t] is [t'], the canonical domain name, as specified in RFC 4034 + (and 2535): all characters are lowercase. *) + +val host : 'a t -> ([ `host ] t, [> `Msg of string ]) result +(** [host t] is a [`host t] if [t] is a hostname: the contents of the domain + name is limited: each label may start with a digit or letter, followed by + digits, letters, or hyphens. *) + +val host_exn : 'a t -> [ `host ] t +(** [host_exn t] is a [`host t] if [t] is a hostname: the contents of the domain + name is limited: each label may start with a digit or letter, followed by + digits, letters, or hyphens. + + @raise Invalid_argument if [t] is not a hostname. *) + +val service : 'a t -> ([ `service ] t, [> `Msg of string ]) result +(** [service t] is [`service t] if [t] contains a service name, the following + conditions have to be met: + The first label is a service name (or port number); an underscore preceding + 1-15 characters from the set [- a-z A-Z 0-9]. + The service name may not contain a hyphen ([-]) following another hyphen; + no hyphen at the beginning or end. + + The second label is the protocol, one of [_tcp], [_udp], or [_sctp]. + The remaining labels must form a valid hostname. + + This function can be used to validate RR's of the types SRV (RFC 2782) + and TLSA (RFC 7671). *) + +val service_exn : 'a t -> [ `service ] t +(** [service_exn t] is [`service t] if [t] is a service name (see {!service}). + + @raise Invalid_argument if [t] is not a service names. *) + +val raw : 'a t -> [ `raw ] t +(** [raw t] is the [`raw t]. *) + +val count_labels : 'a t -> int +(** [count_labels name] returns the amount of labels in [name]. *) + +val is_subdomain : subdomain:'a t -> domain:'b t -> bool +(** [is_subdomain ~subdomain ~domain] is [true] if [subdomain] contains any + labels prepended to [domain]: [foo.bar.com] is a subdomain of [bar.com] and + of [com], [sub ~subdomain:x ~domain:root] is true for all [x]. *) + +val get_label : ?rev:bool -> 'a t -> int -> (string, [> `Msg of string ]) result +(** [get_label ~rev name idx] retrieves the label at index [idx] from [name]. If + [idx] is out of bounds, an Error is returned. If [rev] is provided and [true] + (defaults to [false]), [idx] is from the end instead of the beginning. *) + +val get_label_exn : ?rev:bool -> 'a t -> int -> string +(** [get_label_exn ~rev name idx] is the label at index [idx] in [name]. + + @raise Invalid_argument if [idx] is out of bounds in [name]. *) + +val find_label : ?rev:bool -> 'a t -> (string -> bool) -> int option +(** [find_label ~rev name p] returns the first position where [p lbl] is [true] + in [name], if it exists, otherwise [None]. If [rev] is provided and [true] + (defaults to [false]), the [name] is traversed from the end instead of the + beginning. *) + +val find_label_exn : ?rev:bool -> 'a t -> (string -> bool) -> int +(** [find_label_exn ~rev name p], see {!find_label}. + + @raise Invalid_argument if [p] does not return [true] in [name]. *) + +(** {2 Label addition and removal} *) +val prepend_label : 'a t -> string -> ([ `raw ] t, [> `Msg of string ]) result +(** [prepend_label name pre] is either [t], the new domain name, or an error. *) + +val prepend_label_exn : 'a t -> string -> [ `raw ] t +(** [prepend_label_exn name pre] is [t], the new domain name. + + @raise Invalid_argument if [pre] is not a valid domain name. *) + +val drop_label : ?rev:bool -> ?amount:int -> 'a t -> + ([ `raw ] t, [> `Msg of string ]) result +(** [drop_label ~rev ~amount t] is either [t], a domain name with [amount] + (defaults to [1]) labels dropped from the beginning - if [rev] is provided + and [true] (defaults to [false]) labels are dropped from the end. + [drop_label (of_string_exn "foo.com") = Ok (of_string_exn "com")], + [drop_label ~rev:true (of_string_exn "foo.com") = Ok (of_string_exn "foo")]. +*) + +val drop_label_exn : ?rev:bool -> ?amount:int -> 'a t -> [ `raw ] t +(** [drop_label_exn ~rev ~amount t], see {!drop_label}. Instead of a [result], + the value is returned directly. + + @raise Invalid_argument if there are not sufficient labels. *) + +val append : 'a t -> 'b t -> ([ `raw ] t, [> `Msg of string ]) result +(** [append pre post] is [pre ^ "." ^ post]. *) + +val append_exn : 'a t -> 'b t -> [ `raw ] t +(** [append_exn pre post] is [pre ^ "." ^ post]. + + @raise Invalid_argument if the result would violate length restrictions. *) + +(** {2 Comparison} *) + +val equal : ?case_sensitive:bool -> 'a t -> 'b t -> bool +(** [equal ~case_sensitive t t'] is [true] if all labels of [t] and [t'] are + equal. If [case_sensitive] is provided and [true], the cases of the labels + are respected (defaults to [false]). *) + +val compare : 'a t -> 'b t -> int +(** [compare t t'] compares the domain names [t] and [t'] using a case + insensitive string comparison. This conforms to the canonical DNS name + order, as described in RFC 4034, Section 6.1. *) + +val equal_label : ?case_sensitive:bool -> string -> string -> bool +(** [equal_label ~case_sensitive a b] is [true] if [a] and [b] are equal + ignoring casing. If [case_sensitive] is provided and [true] (defaults to + [false]), the casing is respected. *) + +val compare_label : string -> string -> int +(** [compare_label t t'] compares the labels [t] and [t'] using a case + insensitive string comparison. *) + +(** {2 Collections} *) + +module Host_map : sig + include Map.S with type key = [ `host ] t + + (** [find key t] is [Some a] where a is the binding of [key] in [t]. [None] if + the [key] is not present. *) + val find : key -> 'a t -> 'a option +end +(** The module of a host name map *) + +module Host_set : Set.S with type elt = [ `host ] t +(** The module of a host name set *) + +module Service_map : sig + include Map.S with type key = [ `service ] t + + (** [find key t] is [Some a] where a is the binding of [key] in [t]. [None] if + the [key] is not present. *) + val find : key -> 'a t -> 'a option +end +(** The module of a service name map *) + +module Service_set : Set.S with type elt = [ `service ] t +(** The module of a service name set *) + +module Map : sig + include Map.S with type key = [ `raw ] t + + (** [find key t] is [Some a] where a is the binding of [key] in [t]. [None] if + the [key] is not present. *) + val find : key -> 'a t -> 'a option +end +(** The module of a domain name map *) + +module Set : Set.S with type elt = [ `raw ] t +(** The module of a domain name set *) + +(** {2 String list representation} *) + +val of_strings : string list -> ([ `raw ] t, [> `Msg of string ]) result +(** [of_strings labels] is either [t], a domain name, or an error if + the provided [labels] violate domain name constraints. A trailing empty + label is not required. *) + +val of_strings_exn : string list -> [ `raw ] t +(** [of_strings_exn labels] is [t], a domain name. A trailing empty + label is not required. + + @raise Invalid_argument if [labels] are not a valid domain name. *) + +val to_strings : ?trailing:bool -> 'a t -> string list +(** [to_strings ~trailing t] is the list of labels of [t]. If [trailing] is + provided and [true] (defaults to [false]), the resulting list will contain + a trailing empty label. *) + +(** {2 Pretty printer} *) + +val pp : Format.formatter -> 'a t -> unit +(** [pp ppf t] pretty prints the domain name [t] on [ppf]. *) + +(**/**) +(* exposing internal structure, used by udns (but could as well use Obj.magic *) + +val of_array : string array -> [ `raw ] t +(** [of_array a] is [t], a domain name from [a], an array containing a reversed + domain name. *) + +val to_array : 'a t -> string array +(** [to_array t] is [a], an array containing the reversed domain name of [t]. *) diff --git a/unikernel/duniverse/domain-name/dune b/unikernel/duniverse/domain-name/dune new file mode 100644 index 00000000..031592f6 --- /dev/null +++ b/unikernel/duniverse/domain-name/dune @@ -0,0 +1,9 @@ +(library + (name domain_name) + (public_name domain-name) + (modules domain_name)) + +(test + (name tests) + (modules tests) + (libraries alcotest domain-name)) diff --git a/unikernel/duniverse/domain-name/dune-project b/unikernel/duniverse/domain-name/dune-project new file mode 100644 index 00000000..a54baf1a --- /dev/null +++ b/unikernel/duniverse/domain-name/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.0) +(name domain-name) +(version v0.5.0) diff --git a/unikernel/duniverse/domain-name/tests.ml b/unikernel/duniverse/domain-name/tests.ml new file mode 100644 index 00000000..9fb46813 --- /dev/null +++ b/unikernel/duniverse/domain-name/tests.ml @@ -0,0 +1,305 @@ +let n_of_s = Domain_name.of_string_exn + +let raw = + let module M = struct + type t = [ `raw ] Domain_name.t + let pp = Domain_name.pp + let equal = Domain_name.equal ~case_sensitive:false + end in (module M: Alcotest.TESTABLE with type t = M.t) + +let host = + let module M = struct + type t = [ `host ] Domain_name.t + let pp = Domain_name.pp + let equal = Domain_name.equal ~case_sensitive:false + end in (module M: Alcotest.TESTABLE with type t = M.t) + +let service = + let module M = struct + type t = [ `service ] Domain_name.t + let pp = Domain_name.pp + let equal = Domain_name.equal ~case_sensitive:false + end in (module M: Alcotest.TESTABLE with type t = M.t) + +let p_msg = + let module M = struct + type t = [ `Msg of string ] + let pp ppf (`Msg m) = Fmt.string ppf m + let equal (`Msg _) (`Msg _) = true + end in (module M: Alcotest.TESTABLE with type t = M.t) + +let is_domain x = match Domain_name.of_string x with + | Ok _ -> true | Error _ -> false + +let is_host x = match Domain_name.host x with + | Ok _ -> true | Error _ -> false + +let is_service x = match Domain_name.service x with + | Ok _ -> true | Error _ -> false + +let longest_label = "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijk" +let longest_prefix = + let d a b = a ^ "." ^ b in + d longest_label (d longest_label longest_label) + +let basic_preds () = + Alcotest.(check bool "root is_hostname" true (is_host Domain_name.root)) ; + Alcotest.(check bool "foo is a hostname" true (is_host (n_of_s "foo"))) ; + Alcotest.(check bool ".foo is no domain" false (is_domain ".foo")) ; + Alcotest.(check bool "bar is a hostname" true (is_host (n_of_s "bar"))) ; + Alcotest.(check bool "foo.bar is a hostname" true (is_host (n_of_s "foo.bar"))) ; + Alcotest.(check bool "longest label is domain name" true (is_domain longest_label)) ; + Alcotest.(check bool "longest label + a is not domain name" false (is_domain (longest_label ^ "a"))) ; + Alcotest.(check bool "ll.ll.ll.ll[:-2] is domain name" true + (is_domain (longest_prefix ^ "." ^ (String.sub longest_label 0 61)))) ; + Alcotest.(check bool "ll.ll.ll.ll[:-1] is not a domain name" false + (is_domain (longest_prefix ^ "." ^ (String.sub longest_label 0 62)))) ; + Alcotest.(check bool "foo._bar is not a hostname" false (is_host (n_of_s "foo._bar"))) ; + Alcotest.(check bool "2foo.bar is a hostname" true (is_host (n_of_s "2foo.bar"))) ; + Alcotest.(check bool "f2.bar is a hostname" true (is_host (n_of_s "f2.bar"))) ; + Alcotest.(check bool "-f2.bar is not a hostname" false (is_host (n_of_s "-f2.bar"))) ; + Alcotest.(check bool "f2.23 is not a hostname" false (is_host (n_of_s "f2.23"))) ; + Alcotest.(check bool "42.23b is a hostname" true (is_host (n_of_s "42.23b"))) ; + Alcotest.(check bool "'bar.foo is not a hostname" false (is_host (n_of_s "'bar.foo"))) ; + Alcotest.(check bool "-foo.bar is not a hostname" false (is_host (n_of_s "'-foo.bar"))) ; + Alcotest.(check bool "foo-.bar is not a hostname" false (is_host (n_of_s "foo-.bar"))) ; + Alcotest.(check bool "f-o-o.bar is a hostname" true (is_host (n_of_s "f-o-o.bar"))) ; + Alcotest.(check bool "2f.b3 is a hostname" true (is_host (n_of_s "2f.b3"))) ; + Alcotest.(check bool "2f3.2b3 is a hostname" true (is_host (n_of_s "2f3.2b3"))) ; + Alcotest.(check bool "root is no service" false (is_service Domain_name.root)) ; + Alcotest.(check bool "_tcp.foo is no service" false + (is_service (n_of_s "_tcp.foo"))) ; + Alcotest.(check bool "_._tcp.foo is no service" false + (is_service (n_of_s "_._tcp.foo"))) ; + Alcotest.(check bool "foo._tcp.foo is no service" false + (is_service (n_of_s "foo._tcp.foo"))) ; + Alcotest.(check bool "f_oo._tcp.foo is no service" false + (is_service (n_of_s "f_oo._tcp.foo"))) ; + Alcotest.(check bool "foo_._tcp.foo is no service" false + (is_service (n_of_s "foo_._tcp.foo"))) ; + Alcotest.(check bool "_xmpp-server._tcp.foo is a service" true + (is_service (n_of_s "_xmpp-server._tcp.foo"))) ; + Alcotest.(check bool "_xmpp-server._tcp2.foo is no service" false + (is_service (n_of_s "_xmpp-server._tcp2.foo"))) ; + Alcotest.(check bool "_xmpp_server._tcp.foo is no service" false + (is_service (n_of_s "_xmpp_server._tcp.foo"))) ; + Alcotest.(check bool "_xmpp-server-server._tcp.foo is no service" false + (is_service (n_of_s "_xmpp-server-server._tcp.foo"))) ; + Alcotest.(check bool "_443._tcp.foo is a service" true + (is_service (n_of_s "_443._tcp.foo"))) ; + let foo = n_of_s "foo" in + Alcotest.(check bool "foo is no subdomain of foo.bar" false + (Domain_name.is_subdomain ~subdomain:foo ~domain:(n_of_s "foo.bar"))) ; + Alcotest.(check bool "foo is a subdomain of foo" true + (Domain_name.is_subdomain ~subdomain:foo ~domain:foo)) ; + Alcotest.(check bool "bar.foo is a subdomain of foo" true + (Domain_name.is_subdomain ~subdomain:(n_of_s "bar.foo") ~domain:foo)) + +let case () = + Alcotest.(check bool "foo123.com and Foo123.com are equal" true + (Domain_name.equal (n_of_s "foo123.com") (n_of_s "Foo123.com"))) ; + Alcotest.(check bool "foo123.com and Foo123.com are not equal if case" false + (Domain_name.equal ~case_sensitive:true + (n_of_s "foo123.com") (n_of_s "Foo123.com"))) ; + Alcotest.(check bool "foo-123.com and com are not equal" false + (Domain_name.equal (n_of_s "foo-123.com") (n_of_s "com"))) ; + Alcotest.(check bool "foo123.com and Foo123.com are equal if case _and_ canonical used on second" + true + Domain_name.(equal ~case_sensitive:true + (n_of_s "foo123.com") (canonical (n_of_s "Foo123.com")))) ; + Alcotest.(check bool "foo123.com and Foo123.com are not equal if case _and_ canonical used on first" + false + Domain_name.(equal ~case_sensitive:true + (canonical (n_of_s "foo123.com")) (n_of_s "Foo123.com"))) ; + Alcotest.(check bool "foo123.com and Foo123.com are equal if case _and_ canonical used on both" + true + Domain_name.(equal ~case_sensitive:true + (canonical (n_of_s "foo123.com")) (canonical (n_of_s "Foo123.com")))) + +let p_name = Alcotest.testable Domain_name.pp Domain_name.equal + +let basic_name () = + let lll = String.sub longest_label 0 61 + and llt = String.sub longest_label 0 62 + in + Alcotest.(check bool "prepend '_foo' to root is not valid hostname" + false (is_host (Domain_name.prepend_label_exn Domain_name.root "_foo"))) ; + Alcotest.(check bool "host (of_strings [ '_foo' ; 'bar' ]) is not valid" + false (is_host (Domain_name.of_strings_exn [ "_foo" ; "bar" ]))) ; + Alcotest.(check (result p_name p_msg) "of_string 'foo.bar' is valid" + (Ok (n_of_s "foo.bar")) (Domain_name.of_string "foo.bar")) ; + Alcotest.(check bool "host (of_string 'foo.bar') is valid" + true (is_host (Domain_name.of_string_exn "foo.bar"))) ; + Alcotest.(check p_name "of_array 'foo.bar' is good" + (n_of_s "foo.bar") (Domain_name.of_array [| "bar" ; "foo" |])) ; + Alcotest.(check bool "host (of_array 'foo.bar') is good" + true (is_host (Domain_name.of_array [| "bar" ; "foo" |]))) ; + Alcotest.(check bool "host (prepend (ll[:-2]) (ll ^ ll ^ ll)) is valid" + true (is_host (Domain_name.prepend_label_exn (n_of_s longest_prefix) lll))) ; + Alcotest.(check (result p_name p_msg) "prepend '' root is invalid" + (Error (`Msg "")) (Domain_name.prepend_label Domain_name.root "")) ; + Alcotest.(check (result p_name p_msg) "prepend ll^a root is invalid" + (Error (`Msg "")) (Domain_name.prepend_label Domain_name.root (longest_label ^ "a"))) ; + Alcotest.(check (result p_name p_msg) "prepend ll (ll ^ ll ^ ll) is invalid" + (Error (`Msg "")) (Domain_name.prepend_label (n_of_s longest_prefix) longest_label)) ; + Alcotest.(check (result p_name p_msg) "prepend ll[:-1] (ll ^ ll ^ ll) is invalid" + (Error (`Msg "")) (Domain_name.prepend_label (n_of_s longest_prefix) llt)) ; + Alcotest.(check (result p_name p_msg) "concat 'foo.bar' 'baz.barf' is good" + (Ok (n_of_s "foo.bar.baz.barf")) + (Domain_name.append (n_of_s "foo.bar") (n_of_s "baz.barf"))) ; + let r = Domain_name.prepend_label_exn (n_of_s longest_prefix) lll in + Alcotest.(check (result p_name p_msg) "concat ll[:-2] lp is good" + (Ok r) + (Domain_name.append (n_of_s lll) (n_of_s longest_prefix))) ; + Alcotest.(check (result p_name p_msg) "concat ll[:-1] lp is bad" + (Error (`Msg "")) + (Domain_name.append (n_of_s llt) (n_of_s longest_prefix))) + +let fqdn () = + Alcotest.(check bool "of_string_exn example.com = of_string_exn example.com." + true + (Domain_name.equal (n_of_s "example.com") (n_of_s "example.com."))) ; + Alcotest.(check bool "of_strings_exn ['example' ; 'com'] = of_strings_exn ['example' ; 'com' ; '']" + true + Domain_name.(equal + (of_strings_exn [ "example" ; "com" ]) + (of_strings_exn [ "example" ; "com" ; "" ]))); + try + Alcotest.(check bool {|of_string_exn "" = of_string_exn "."|}) + true + Domain_name.(equal (n_of_s "") (n_of_s ".")) + with Invalid_argument _ -> Alcotest.fail "invalid domain name for root" + +let fqdn_around () = + let d = n_of_s "foo.com." in + Alcotest.(check bool "of_string (to_string (of_string 'foo.com.')) works" + true Domain_name.(equal d (of_string_exn (to_string d)))) ; + Alcotest.(check bool "of_string (to_string ~trailing:true (of_string 'foo.com.')) works" + true Domain_name.(equal d (of_string_exn (to_string ~trailing:true d)))); + try + Alcotest.(check bool "of_string (to_string ~trailing:true (of_string '.')) works") + true + Domain_name.(equal root (of_string_exn (to_string ~trailing:true root))) + with Invalid_argument _ -> Alcotest.fail "invalid domain name for root" + + +let drop_labels () = + let res = n_of_s "foo.com" in + Alcotest.(check p_name "dropping 1 label from www.foo.com is foo.com" + res + (Domain_name.drop_label_exn (Domain_name.of_string_exn "www.foo.com"))) ; + Alcotest.(check p_name "dropping 2 labels from www.bar.foo.com is foo.com" + res + (Domain_name.drop_label_exn ~amount:2 (Domain_name.of_string_exn "www.bar.foo.com"))) ; + Alcotest.(check p_name "dropping 1 label from the back www.foo.com is www.foo" + (Domain_name.of_string_exn "www.foo") + (Domain_name.drop_label_exn ~rev:true (Domain_name.of_string_exn "www.foo.com"))) ; + Alcotest.(check p_name "prepending 1 and dropping 1 label from foo.com is foo.com" + res + (Domain_name.drop_label_exn (Domain_name.prepend_label_exn (Domain_name.of_string_exn "foo.com") "www"))) ; + Alcotest.(check p_name "prepending 1 and dropping 1 label from foo.com is foo.com" + res + (Domain_name.drop_label_exn (Domain_name.prepend_label_exn (Domain_name.of_string_exn "foo.com") "www"))) ; + Alcotest.(check (result p_name p_msg) + "dropping 10 labels from foo.com leads to error" + (Error (`Msg "")) + (Domain_name.drop_label ~amount:10 (Domain_name.of_string_exn "foo.com"))) + +let get_and_count_and_find_label () = + Alcotest.(check int "count labels of root is 0" 0 + Domain_name.(count_labels root)); + Alcotest.(check (result string p_msg) "get_label 0 of root is Error" + (Error (`Msg "")) + Domain_name.(get_label root 0)); + Alcotest.(check (result string p_msg) "get_label 1 of root is Error" + (Error (`Msg "")) + Domain_name.(get_label root 1)); + Alcotest.(check (result string p_msg) "get_label 2 of root is Error" + (Error (`Msg "")) + Domain_name.(get_label root 2)); + Alcotest.(check (result string p_msg) "get_label -1 of root is Error" + (Error (`Msg "")) + Domain_name.(get_label root (-1))); + Alcotest.(check (option int) "find_label root '' is none" + None Domain_name.(find_label root (fun _ -> true))); + Alcotest.(check (option int) "find_label root 'a' is none" + None Domain_name.(find_label root (equal_label "a"))); + let n = n_of_s "www.example.com" in + Alcotest.(check int "count labels of www.example.com is 3" 3 + (Domain_name.count_labels n)); + Alcotest.(check (result string p_msg) "get_label 0 of n is Ok www" + (Ok "www") + (Domain_name.get_label n 0)); + Alcotest.(check (result string p_msg) "get_label 1 of n is Ok example" + (Ok "example") + (Domain_name.get_label n 1)); + Alcotest.(check (result string p_msg) "get_label 2 of n is Ok com" + (Ok "com") + (Domain_name.get_label n 2)); + Alcotest.(check (result string p_msg) "get_label 3 of n is Error" + (Error (`Msg "")) + (Domain_name.get_label n 3)); + Alcotest.(check (result string p_msg) "get_label ~rev:true 0 of n is Ok com" + (Ok "com") + (Domain_name.get_label ~rev:true n 0)); + Alcotest.(check (result string p_msg) "get_label ~rev:true 1 of n is Ok example" + (Ok "example") + (Domain_name.get_label ~rev:true n 1)); + Alcotest.(check (result string p_msg) "get_label ~rev:true 2 of n is Ok www" + (Ok "www") + (Domain_name.get_label ~rev:true n 2)); + Alcotest.(check (result string p_msg) "get_label ~rev:true 3 of n is Error" + (Error (`Msg "")) + (Domain_name.get_label ~rev:true n 3)); + Alcotest.(check (option int) "find_label www.example.com is Some 0" + (Some 0) Domain_name.(find_label n (fun _ -> true))); + Alcotest.(check (option int) "find_label www.example.com 'a' is none" + None Domain_name.(find_label n (equal_label "a"))); + Alcotest.(check (option int) "find_label www.example.com 'w' is none" + None Domain_name.(find_label n (equal_label "w"))); + Alcotest.(check (option int) "find_label www.example.com 'www' is Some 0" + (Some 0) Domain_name.(find_label n (equal_label "www"))); + Alcotest.(check (option int) "find_label www.example.com 'WWW' is Some 0" + (Some 0) Domain_name.(find_label n (equal_label "WWW"))); + Alcotest.(check (option int) "find_label www.example.com 'WWW' is None (case)" + None + Domain_name.(find_label n (equal_label ~case_sensitive:true "WWW"))); + let n' = Domain_name.of_string_exn "www.www.www" in + Alcotest.(check (option int) "find_label www.www.www 'www' is 0" + (Some 0) Domain_name.(find_label n' (equal_label "www"))); + Alcotest.(check (option int) "find_label ~back:true www.www.www 'www' is 2" + (Some 2) Domain_name.(find_label ~rev:true n' (equal_label "www"))) + +let test_compare_canonical () = + (* from RFC 4034, 6.1 *) + let names = List.map n_of_s [ + "example" ; + "a.example" ; + "yljkjljk.a.example" ; + "Z.a.example" ; + "zABC.a.EXAMPLE" ; + "z.example" ; + "\001.z.example" ; + "*.z.example" ; + "\200.z.example" + ] in + let sorted_names = List.sort Domain_name.compare names in + Alcotest.(check (list raw) "compare fulfills canonical form and order" + names sorted_names) + +let tests = [ + "basic predicates", `Quick, basic_preds ; + "basic name stuff", `Quick, basic_name ; + "case", `Quick, case ; + "fqdn", `Quick, fqdn ; + "fqdn around", `Quick, fqdn_around ; + "drop labels", `Quick, drop_labels ; + "get and count and find labels", `Quick, get_and_count_and_find_label ; + "sorting", `Quick, test_compare_canonical ; +] + +let suites = [ + "domain names", tests ; +] + +let () = Alcotest.run "domain name tests" suites diff --git a/unikernel/duniverse/dune b/unikernel/duniverse/dune new file mode 100644 index 00000000..103658bf --- /dev/null +++ b/unikernel/duniverse/dune @@ -0,0 +1,4 @@ +; This file is generated by opam-monorepo. +; Be aware that it is likely to be overwritten by your next opam monorepo pull invocation. + +(vendored_dirs *) diff --git a/unikernel/duniverse/dune_/.devcontainer/devcontainer.json b/unikernel/duniverse/dune_/.devcontainer/devcontainer.json new file mode 100644 index 00000000..fa9e2311 --- /dev/null +++ b/unikernel/duniverse/dune_/.devcontainer/devcontainer.json @@ -0,0 +1,8 @@ +{ + "name": "OCaml", + "image": "mcr.microsoft.com/devcontainers/base:bullseye", + "features": { "ghcr.io/avsm/ocaml-devcontainers-feature/ocaml:latest": {} }, + "postCreateCommand": "opam init -ay --disable-sandboxing && sudo chown vscode _build && sudo apt-get update && make dev-switch && sudo apt install -y file npm", + "mounts": ["source=${localWorkspaceFolderBasename}-ocaml-build,target=${containerWorkspaceFolder}/_build,type=volume"], + "remoteUser": "vscode" +} diff --git a/unikernel/duniverse/dune_/.dockerignore b/unikernel/duniverse/dune_/.dockerignore new file mode 100644 index 00000000..9be6ec72 --- /dev/null +++ b/unikernel/duniverse/dune_/.dockerignore @@ -0,0 +1,5 @@ +_build +_boot +_opam +dune.exe +result diff --git a/unikernel/duniverse/dune_/.git-blame-ignore-revs b/unikernel/duniverse/dune_/.git-blame-ignore-revs new file mode 100644 index 00000000..476a1dd5 --- /dev/null +++ b/unikernel/duniverse/dune_/.git-blame-ignore-revs @@ -0,0 +1,12 @@ +# ocamlformat 0.20.1 +065466c955ca14d512ae50e844acfab1370f566e +# ocamlformat 0.25.1 +3f01f6f3694e48cb1868018121f3959f8d23baca +# ocamlformat 0.26.0 +14d199fa57d05692385342685f431cd3a6a8205c +# switch to janestreet profile +cb8f84e01a2eb4a2a2cf8d5bcfe5b2fc23e93d96 +# ocamlformat 0.26.1 +f739a11a7d407db219446757093c4bc913989378 +# ocamlformat 0.27.0 +197b0c84d2e51647892fe6c9a6842265b4866255 diff --git a/unikernel/duniverse/dune_/.gitattributes b/unikernel/duniverse/dune_/.gitattributes new file mode 100755 index 00000000..025c1206 --- /dev/null +++ b/unikernel/duniverse/dune_/.gitattributes @@ -0,0 +1,11 @@ +*.ml* text eol=lf linguist-language=OCaml +*.rst text eol=lf +*.c text eol=lf +*.t text eol=lf -linguist-detectable +*.sh text eol=lf +*.ps1 text working-tree-encoding=UTF-16 eol=crlf +dune text eol=lf +dune.inc text eol=lf +.gitignore text eol=lf +.gitattributes text eol=lf +.ocamlformat text eol=lf diff --git a/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/bug_report.md b/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/bug_report.md new file mode 100644 index 00000000..f4b51636 --- /dev/null +++ b/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/bug_report.md @@ -0,0 +1,39 @@ +--- +name: Bug report +about: File an issue to help us improve +title: '' +labels: '' +assignees: '' + +--- + + +## Expected Behavior + + +## Actual Behavior + + +## Reproduction + + + +- PR with a reproducing test: + + + +1. +1. +1. + +## Specifications + +- Version of `dune` (output of `dune --version`): +- Version of `ocaml` (output of `ocamlc --version`): +- Operating system (distribution and version): + + +## Additional information + +- Link to gist with verbose output (run `dune` with the `--verbose` flag): diff --git a/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/feature_request.md b/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/feature_request.md new file mode 100644 index 00000000..3ef5c63c --- /dev/null +++ b/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/feature_request.md @@ -0,0 +1,20 @@ +--- +name: Feature request +about: Suggest an idea to improve dune +title: '' +labels: '' +assignees: '' + +--- + + +## Desired Behavior + + + +## Example + + diff --git a/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/release.md b/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/release.md new file mode 100644 index 00000000..ba9b6396 --- /dev/null +++ b/unikernel/duniverse/dune_/.github/ISSUE_TEMPLATE/release.md @@ -0,0 +1,45 @@ +--- +name: Release +about: Open a release tracker issue +title: "X.Y.Z release tracker" +labels: ["release"] +assignees: '' +--- + + +## Preparation + +- Need backport: + - [link to PR to backport] +- Backports: + - [link to backport PR] + + +## Known blockers + +- [ ] Something is blocking the PR because of ... + + + +## Release + + + +- [ ] Update dune changelog to `X.Y.Z` on `X.Y` branch [link to dune PR] +- [ ] Open then pull request on `opam-repository` [link to OPAM PR] +- [ ] Triage (ensure it does not break anything) +- [ ] Update nix-overlays with the new version [link to nix-overlays PRs] + +## Post-release + +- [ ] Merge dune changelog in `main` [link to dune PR] +- [ ] Update ocaml.org changelog [link to ocaml.org PR] +- [ ] Write a post about the release on Discuss [link to post] +- [ ] Store the revdeps error file in the [logs](https://github.com/ocaml/dune/wiki/Reverse-dependencies-CI-logs) +- [ ] Create a next release milestone + + + +## Last stage + +- [ ] Close tracking issue diff --git a/unikernel/duniverse/dune_/.github/workflows/bench.yml b/unikernel/duniverse/dune_/.github/workflows/bench.yml new file mode 100644 index 00000000..4a6ad373 --- /dev/null +++ b/unikernel/duniverse/dune_/.github/workflows/bench.yml @@ -0,0 +1,171 @@ +name: Build time benchmarks + +# Do not run this workflow on pull request since this workflow has permission to modify contents. +on: + push: + branches: + - main + +permissions: + # deployments permission to deploy GitHub pages website + deployments: write + # contents permission to update benchmark contents in gh-pages branch + contents: write + +jobs: + build: + name: Build + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + ocaml-compiler: + - 5.1.x + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v4 + + - name: Use OCaml ${{ matrix.ocaml-compiler }} + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + opam-depext: false + + # dune doesn't have any additional dependencies so we can build it right + # away this makes it possible to see build errors as soon as possible + - run: opam exec -- make _boot/dune.exe + + - name: Install deps on Unix + run: | + opam install . --deps-only --with-test + opam exec -- make dev-deps + # Install hyperfine + wget https://github.com/sharkdp/hyperfine/releases/download/v1.14.0/hyperfine_1.14.0_amd64.deb + sudo dpkg -i hyperfine_1.14.0_amd64.deb + + - name: Create watch synthetic benchmark + working-directory: bench + run: opam exec -- ../_boot/dune.exe exec ./gen_synthetic_dune_watch.exe -- synthetic-watch + + - name: Run synthetic watch benchmark + working-directory: bench/synthetic-watch + run: ../gen-benchmark.sh 'opam exec -- ../run-synthetic-dune-watch.sh ../../_boot/dune.exe' 'opam exec -- ../../_boot/dune.exe build @all' 'synthetic watch build time (warm, ${{ runner.os }})' > synthetic-benchmark-result.json + + - name: Print synthetic watch benchmark results + working-directory: bench/synthetic-watch + run: | + cat bench.json + cat synthetic-benchmark-result.json + + - name: Store synthetic watch benchmark result + uses: benchmark-action/github-action-benchmark@v1 + with: + name: Synthetic Watch Benchmark + tool: "customSmallerIsBetter" + output-file-path: bench/synthetic-watch/synthetic-benchmark-result.json + github-token: ${{ secrets.GITHUB_TOKEN }} + auto-push: true + # Ratio indicating how worse the current benchmark result is. + # 175% means if last build took 40s and current takes >70s, it will trigger an alert + alert-threshold: "225%" + fail-on-alert: true + # Enable alert commit comment + comment-on-alert: true + # Mention @jchavarri in the commit comment + alert-comment-cc-users: '@jchavarri' + + - name: Clone pupilfirst fork + run: git clone --depth 1 https://github.com/jchavarri/pupilfirst.git + + - name: Install all deps + working-directory: pupilfirst + run: opam install -y . --deps-only + + - name: Run pupilfirst benchmark + working-directory: pupilfirst + run: ../bench/gen-benchmark.sh 'opam exec -- ../_boot/dune.exe build --root=. @main' 'opam exec -- ../_boot/dune.exe clean --root=.' 'pupilfirst build time (${{ runner.os }})' > melange-benchmark-result.json + + - name: Print pupilfirst benchmark results + working-directory: pupilfirst + run: | + cat bench.json + cat melange-benchmark-result.json + + - name: Store melange benchmark result + uses: benchmark-action/github-action-benchmark@v1 + with: + name: Melange Benchmark + tool: "customSmallerIsBetter" + output-file-path: pupilfirst/melange-benchmark-result.json + github-token: ${{ secrets.GITHUB_TOKEN }} + auto-push: true + # Ratio indicating how worse the current benchmark result is. + # 150% means if last build took 40s and current takes >60s, it will trigger an alert + alert-threshold: "225%" + fail-on-alert: true + # Enable alert commit comment + comment-on-alert: true + # Mention @jchavarri in the commit comment + alert-comment-cc-users: '@jchavarri' + + - name: Create synthetic benchmark + working-directory: bench + run: opam exec -- ../_boot/dune.exe exec ./gen_synthetic.exe -- -n 2000 synthetic + + - name: Run cold synthetic benchmark + working-directory: bench/synthetic + run: ../gen-benchmark.sh 'opam exec -- ../../_boot/dune.exe build @all' 'opam exec -- ../../_boot/dune.exe clean' 'synthetic build time (cold, ${{ runner.os }})' > synthetic-benchmark-result.json + + - name: Print cold synthetic benchmark results + working-directory: bench/synthetic + run: | + cat bench.json + cat synthetic-benchmark-result.json + + - name: Store cold synthetic benchmark result + uses: benchmark-action/github-action-benchmark@v1 + with: + name: Synthetic Benchmark + tool: "customSmallerIsBetter" + output-file-path: bench/synthetic/synthetic-benchmark-result.json + github-token: ${{ secrets.GITHUB_TOKEN }} + auto-push: true + # Ratio indicating how worse the current benchmark result is. + # 150% means if last build took 40s and current takes >60s, it will trigger an alert + alert-threshold: "225%" + fail-on-alert: true + # Enable alert commit comment + comment-on-alert: true + # Mention @jchavarri in the commit comment + alert-comment-cc-users: '@jchavarri' + + - name: Run warm synthetic benchmark + working-directory: bench/synthetic + run: ../gen-benchmark.sh 'opam exec -- ../../_boot/dune.exe build @all' 'true' 'synthetic build time (warm, ${{ runner.os }})' > synthetic-benchmark-result.json + + - name: Print warm synthetic benchmark results + working-directory: bench/synthetic + run: | + cat bench.json + cat synthetic-benchmark-result.json + + - name: Store warm synthetic benchmark result + uses: benchmark-action/github-action-benchmark@v1 + with: + name: Synthetic Benchmark + tool: "customSmallerIsBetter" + output-file-path: bench/synthetic/synthetic-benchmark-result.json + github-token: ${{ secrets.GITHUB_TOKEN }} + auto-push: true + # Ratio indicating how worse the current benchmark result is. + # 150% means if last build took 40s and current takes >60s, it will trigger an alert + alert-threshold: "225%" + fail-on-alert: true + # Enable alert commit comment + comment-on-alert: true + # Mention @jchavarri in the commit comment + alert-comment-cc-users: '@jchavarri' diff --git a/unikernel/duniverse/dune_/.github/workflows/binaries.yml b/unikernel/duniverse/dune_/.github/workflows/binaries.yml new file mode 100644 index 00000000..5939149b --- /dev/null +++ b/unikernel/duniverse/dune_/.github/workflows/binaries.yml @@ -0,0 +1,40 @@ +name: Binaries + +on: + workflow_dispatch: + +jobs: + binary: + name: Create + strategy: + fail-fast: false + matrix: + include: + - os: macos-13 + name: x86_64-apple-darwin + installable: .# + - os: macos-14 + name: aarch64-apple-darwin + installable: .# + - os: ubuntu-22.04 + name: x86_64-unknown-linux-musl + installable: .#dune-static + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v4 + with: + fetch-depth: 0 # for git describe + - uses: cachix/install-nix-action@v22 + - run: echo "(version $(git describe --always --dirty --abbrev=7))" >> dune-project + - run: nix build ${{ matrix.installable }} + - uses: actions/upload-artifact@v4 + with: + path: result/bin/dune + name: dune-${{ matrix.name }} + combine: + runs-on: ubuntu-latest + needs: binary + steps: + - uses: actions/upload-artifact/merge@v4 + with: + separate-directories: true diff --git a/unikernel/duniverse/dune_/.github/workflows/mirage.yml b/unikernel/duniverse/dune_/.github/workflows/mirage.yml new file mode 100644 index 00000000..2ee44ae1 --- /dev/null +++ b/unikernel/duniverse/dune_/.github/workflows/mirage.yml @@ -0,0 +1,27 @@ +name: Mirage + +on: + workflow_dispatch: + +jobs: + build: + name: Build caldav + runs-on: ubuntu-latest + steps: + - name: Clone caldav + uses: actions/checkout@v4 + with: + repository: roburio/caldav + ref: 51f0d150542348dc259b7c9f7bc70ee592243f7f + - name: Use OCaml ${{ matrix.ocaml-compiler }} + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: 4.14.x + opam-depext: false + - run: opam repo set-url default git+https://github.com/ocaml/opam-repository#dc24cade5f037058a4d86fcdd008159923152db5 + - run: sed -i s/1.3/2.7/ dune-project + - run: opam pin add -n dune.dev git+https://github.com/ocaml/dune#$GITHUB_SHA + - run: sudo apt install libseccomp-dev + - run: opam install mirage.4.4.2 opam-monorepo.0.3.6 + - run: cd mirage; opam exec -- mirage configure -f config.ml -t hvt + - run: cd mirage; opam exec -- make depend lock pull build diff --git a/unikernel/duniverse/dune_/.github/workflows/oxcaml.yml b/unikernel/duniverse/dune_/.github/workflows/oxcaml.yml new file mode 100644 index 00000000..7b28c9c8 --- /dev/null +++ b/unikernel/duniverse/dune_/.github/workflows/oxcaml.yml @@ -0,0 +1,38 @@ +name: OxCaml (experimental) + +on: + push: + branches: + - main + workflow_dispatch: + pull_request: + +permissions: + contents: read + +jobs: + oxcaml: + name: Building Dune with OxCaml + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + - name: Install OCaml + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: ocaml-variants.5.2.0+ox + # CR maiste: Update jst to not depend on a working commit anymore. It + # prevents non working commits to break the Dune CI + opam-repositories: | + oxcaml: "git+https://github.com/oxcaml/opam-repository.git" + default: "git+https://github.com/ocaml/opam-repository.git" + + - name: Install deps + run: | + opam install . --deps-only + + - name: Build dune + run: opam exec -- make bootstrap + + - name: Run OxCaml tests + run: opam exec -- ./dune.exe test ./test/blackbox-tests/test-cases/oxcaml diff --git a/unikernel/duniverse/dune_/.github/workflows/workflow.yml b/unikernel/duniverse/dune_/.github/workflows/workflow.yml new file mode 100644 index 00000000..4e247a60 --- /dev/null +++ b/unikernel/duniverse/dune_/.github/workflows/workflow.yml @@ -0,0 +1,300 @@ +name: CI + +on: + push: + branches: + - main + pull_request: + workflow_dispatch: + merge_group: + +concurrency: + group: "${{ github.workflow }} @ ${{ github.event.pull_request.head.label || github.head_ref || github.ref }}" + cancel-in-progress: true + +permissions: + contents: read + +jobs: + +# +# Stage 1 +# + + nix-build: + name: Nix Build + strategy: + fail-fast: false + matrix: + os: + - macos-latest + - ubuntu-latest + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v4 + - uses: cachix/install-nix-action@v31 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - run: nix build + + nix-test: + name: Nix Tests + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v4 + - uses: cachix/install-nix-action@v31 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - run: nix develop -i -c make test + + fmt: + name: Format + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: cachix/install-nix-action@v31 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - run: nix develop .#fmt -c make fmt + + doc: + name: Documentation + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: cachix/install-nix-action@v31 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - run: nix develop .#doc -c make doc + env: + LC_ALL: C + +# +# Stage 2 +# + + build: + name: Build + # we only start building our other jobs, once our main tests have passed + needs: nix-test + strategy: + fail-fast: false + matrix: + # Please keep the list in sync with the minimal version of OCaml in + # dune-project, dune.opam.template and bootstrap.ml + # + # We don't run tests on all versions of the Windows environment and on + # 4.02.x and 4.07.x in other environments + include: + # OCaml trunk: + - ocaml-compiler: ocaml-variants.5.4.0+trunk + os: ubuntu-latest + # OCaml 5: + ## ubuntu (x86) + - ocaml-compiler: 5.3.x + os: ubuntu-latest + run_tests: true + ## macos (Apple Silicon) + - ocaml-compiler: 5.3.x + os: macos-latest + run_tests: true + ## macos (x86) + - ocaml-compiler: 5.3.x + os: macos-13 + ## MSVC + - ocaml-compiler: ocaml-compiler.5.3.0,system-msvc + os: windows-latest + run_tests: true + ## mingw + - ocaml-compiler: ocaml-base-compiler.5.3.0,system-mingw + os: windows-latest + run_tests: true + # OCaml 4: + ## ubuntu (x86) + - ocaml-compiler: 4.14.x + os: ubuntu-latest + ## ubuntu (x86-32) + - ocaml-compiler: "ocaml-variants.4.14.2+options,ocaml-option-32bit" + os: ubuntu-latest + apt_update: true + ## macos (Apple Silicon) + - ocaml-compiler: 4.14.x + os: macos-latest + # OCaml 4.08: + ## ubuntu (x86) + - ocaml-compiler: 4.08.x + os: ubuntu-latest + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v4 + + # The 32 bit gcc/g++ packages are by default out-of-date so we need to + # manually update our package listing. + - name: Update apt package listing + if: ${{ matrix.apt_update == true }} + run: sudo apt update + + - name: Use OCaml ${{ matrix.ocaml-compiler }} + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + + # Install ocamlfind-secondary and ocaml-secondary-compiler, if needed + - run: opam install ./dune.opam --deps-only --with-test + + - name: Install system deps on macOS + run: brew install coreutils pkg-config file + if: ${{ matrix.os == 'macos-latest' }} + + # dune doesn't have any additional dependencies so we can build it right + # away this makes it possible to see build errors as soon as possible + - run: opam exec -- make release + + - name: Install deps + # CR-soon Alizter: Lwt 5.9.2 breaks on msvc so we pin it here. Remove + # this when https://github.com/ocsigen/lwt/issues/1071 is fixed. + run: | + opam pin add lwt 5.9.1 --no-action + opam install . --deps-only --with-test + opam exec -- make dev-deps + if: ${{ matrix.run_tests }} + + - name: Run test suite on Unix + run: opam exec -- make test + if: ${{ matrix.os != 'windows-latest' && matrix.run_tests }} + + - name: Run test suite on Win32 + run: opam exec -- make test-windows + if: ${{ matrix.os == 'windows-latest' && matrix.run_tests }} + + # We never build configurator + - name: Build configurator + run: opam install ./dune-configurator.opam + if: ${{ matrix.configurator == true }} + + coq: + name: Coq 8.16.1 + needs: nix-build + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: cachix/install-nix-action@v31 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - run: nix develop .#coq -c make test-coq + env: + # We disable the Dune cache when running the tests + DUNE_CACHE: disabled + + wasm: + name: Wasm_of_ocaml + needs: nix-build + runs-on: ubuntu-latest + steps: + - name: Install Node + uses: actions/setup-node@v4 + with: + node-version: latest + + - name: Set-up Binaryen + uses: Aandreba/setup-binaryen@v1.0.0 + with: + token: ${{ github.token }} + + - name: Checkout Code + uses: actions/checkout@v4 + + - name: Use OCaml 5.2.x + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: 5.2.x + + - name: Install faked binaryen-bin package + # The binaries have already been downloaded + run: opam install --fake binaryen-bin + + - name: Install Wasm_of_ocaml + run: opam install "wasm_of_ocaml-compiler>=6.1" + + - name: Set Git User + run: | + git config --global user.name github-actions[bot] + git config --global user.email github-actions[bot]@users.noreply.github.com + + - name: Run Tests + run: opam exec -- make test-wasm + + cygwin: + name: Cygwin Build + runs-on: windows-latest + steps: + - uses: actions/checkout@v4 + - name: Setup Cygwin + uses: cygwin/cygwin-install-action@v6 + with: + packages: ocaml gcc-core make + - name: Bootstrap Dune + run: make bootstrap + ## In order to build dune locally we need to have the re library + ## available. Even if we do, it is likely that our vendored blake3 rules + ## will miss cygwin support. So for now, we don't enable the rest. + + # - name: Build Dune + # run: _boot/dune build dune.install + + create-local-opam-switch: + name: Create local opam switch + needs: nix-build + strategy: + fail-fast: true + matrix: + os: + - macos-latest + - ubuntu-latest + ocaml-compiler: + - 5 + - 4.14 + runs-on: ${{ matrix.os }} + steps: + - name: Use OCaml ${{ matrix.ocaml-compiler }} + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + - uses: actions/checkout@v4 + - name: Create an empty switch + run: opam switch create . --empty + - name: Pin local packages to local dependencies + run: opam pin add . -n --with-version=dev + - name: Install external dependencies + run: opam install . + + build-microbench: + name: Build microbenchmarks + needs: nix-build + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: cachix/install-nix-action@v31 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - run: nix develop .#microbench -c make dune build bench/micro diff --git a/unikernel/duniverse/dune_/.gitignore b/unikernel/duniverse/dune_/.gitignore new file mode 100644 index 00000000..31ca195e --- /dev/null +++ b/unikernel/duniverse/dune_/.gitignore @@ -0,0 +1,29 @@ +_opam +_build +_boot +_test_boot +_perf +_coverage +__pycache__ +*.install + +# vim swap files +*.swp +*.swo + +# emacs lock files +.#* + +# vscode settings +.vscode + +# git-ps hooks +.git-ps + +.duneboot.* +Makefile.dev +src/dune_rules/setup.ml +result + +.DS_Store +nix/profiles/ diff --git a/unikernel/duniverse/dune_/.ocamlformat b/unikernel/duniverse/dune_/.ocamlformat new file mode 100644 index 00000000..20afd9fb --- /dev/null +++ b/unikernel/duniverse/dune_/.ocamlformat @@ -0,0 +1,3 @@ +version=0.27.0 +profile=janestreet +ocaml-version=4.08.0 diff --git a/unikernel/duniverse/dune_/.ocamlformat-ignore b/unikernel/duniverse/dune_/.ocamlformat-ignore new file mode 100644 index 00000000..6262f4a5 --- /dev/null +++ b/unikernel/duniverse/dune_/.ocamlformat-ignore @@ -0,0 +1,3 @@ +boot/libs.ml +src/dune_rules/assets.ml +src/dune_rules/setup.defaults.ml diff --git a/unikernel/duniverse/dune_/.ocp-indent b/unikernel/duniverse/dune_/.ocp-indent new file mode 100644 index 00000000..6c3f0387 --- /dev/null +++ b/unikernel/duniverse/dune_/.ocp-indent @@ -0,0 +1 @@ +JaneStreet diff --git a/unikernel/duniverse/dune_/.readthedocs.yaml b/unikernel/duniverse/dune_/.readthedocs.yaml new file mode 100644 index 00000000..83b03d03 --- /dev/null +++ b/unikernel/duniverse/dune_/.readthedocs.yaml @@ -0,0 +1,17 @@ +version: 2 + +build: + os: "ubuntu-22.04" + tools: + python: "3.10" + +sphinx: + configuration: doc/conf.py + +formats: + - pdf + - epub + +python: + install: + - requirements: doc/requirements.txt diff --git a/unikernel/duniverse/dune_/CHANGES.md b/unikernel/duniverse/dune_/CHANGES.md new file mode 100644 index 00000000..ed2e4c9f --- /dev/null +++ b/unikernel/duniverse/dune_/CHANGES.md @@ -0,0 +1,4880 @@ +3.20.2 (2025-09-02) +------------------- + +### Fixed + +- Fix jsoo separate compilation with modules_without_implementation. Regression + introduced in #10767. (#12320, fixes #12306 @hhugo) + +- Fix `runtest-js` mistakenly using wrong dependencies (#12324, @vouillon) + +- Remove empty `.cram.test.t` directory during the running of a cram test. + (#12329, fixes #12321, @Alizter) + +- Fix Cygwin bootstrap (#12325, fixes #12316, @Alizter) + +3.20.1 (2025-08-25) +------------------- + +### Fixed + +- Fix `runtest-js` mistakenly depending on `byte` (fixes #12243, #12242, + @vouillon and @Alizter) + +- Fix the interpretation of paths in `dune runtest` when running from within a + subdirectory. (#12251, fixes #12250, @Alizter) + +### Changed + +- Revert formatting change introduced in 3.20.0 making long lists in + s-expressions fill the line instead of formatting them in a vertical way + (#12245, reverts #10892, @nojb) + +3.20.0 (2025-08-18) +------------------- + +### Fixed + +- Stop re-running cram tests after promotion when it's not necessary (#11994, + @rgrinberg) + +- fix: `$ dune subst` should not fail when adding the version field in opam + files (#11801, fixes #11045, @btjorge) + +- Kill all processes in the process group after the main process has + terminated; in particular this avoids background processes in cram tests to + stick around after the test finished (#11841, fixes #11820, @Alizter, + @Leonidas-from-XIV) + +### Added + +- `(tests)` stanzas now generate aliases with the test name. To run + `(test (name a))` you can do `dune build @runtest-a`. (#11558, grants part of #10239, + @Alizter) + +- Inline test libraries now produce aliases `runtest-name_of_lib` + allowing users to run specific inline tests as `dune build + @runtest-name_of_lib`. (#11109, partially fixes #10239, @Alizter) + +- feature: `$ dune subst` use version from `dune-project` when no version + control repository has been detected (#11801, @btjorge) + +- Allow `dune exec` to run concurrently with another instance of dune in watch + mode (#11840, @gridbugs) + +- Introduce `%{os}`, `%{os_version}`, `%{os_distribution}`, and `%{os_family}` + percent forms. These have the same values as their opam counterparts. + (#11863, @rgrinberg) + +- Introduce option `(implicit_transitive_deps false-if-hidden-includes-supported)` + that is equivalent to `(implicit_transitive_deps false)` when `-H` is + supported by the compiler (OCaml >= 5.2) and equivalent to + `(implicit_transitive_deps true)` otherwise. (#11866, fixes #11212, @nojb) + +- Add `dune describe location` for printing the path to the executable that + would be run (#11905, @gridbugs) + +- `dune runtest` can now understand absolute paths as well as run tests in + specific build contexts (#11936, @Alizter). + +- Added 'empty' alias which contains no targets. (#11556 #11952 #11955 #11956, + grants #4161, @Alizter and @rgrinberg) + +- Allow `dune promote` to properly run while a watch mode server is running + (#12010, @ElectreAAS) + +- Add `--alias` and `--alias-rec` flags as an alternative to the `@@` and `@` + syntax in the command line (#12043, fixes #5775, @rgrinberg) + +- Added a `(timeout )` field to the `(cram)` stanza to specify per-test + time limits. Tests exceeding the timeout are terminated with an error. + (#12041, @Alizter) + +### Changed + +- Format long lists in s-expressions to fill the line instead of + formatting them in a vertical way (#10892, fixes #10860, @nojb) + +- Switch from MD5 to BLAKE3 for digesting targets and rules. BLAKE3 is both more + performant and difficult to break than MD5 (#11735, @rgrinberg, @Alizter) + +- Print a warning when `dune build` runs over RPC (#11833, @gridbugs) + +- Stop emitting empty module group wrapper `.js` file in `melange.emit` + (#11987, fixes #11986, @anmonteiro) + +3.19.1 (2025-06-11) +------------------ + +### Fixed + +- Revert changes in `dune exec` behaviour introduced in 3.19.0. (#11879, fixes + #11870, #11867 and #11881, @Alizter) + +3.19.0 (2025-05-21) +------------------- + +### Fixed + +- Fixed a bug that was causing cram tests attached to multiple aliases to be run multiple + times. (#11547, @Alizter) + +- Fix: pass pkg-config (extra) args in all pkgconfig invocations. A missing --personality + flag would result in pkgconf not finding libraries in some contexts. (#11619, @MisterDA) + +- Fix: Evaluate `enabled_if` when computing the stubs for stanzas such as + `foreign_library` (#11707, @Alizter, @rgrinberg) + +- Fix $ dune describe pp for libraries in the presence of `(include_subdirs + unqualified)` (#11729, fixes #10999, @rgrinberg) + +- Fix `$ dune subst` in sub directories of a git repository (#11760, fixes + #11045, @Richard-Degenne) + +- Fix a crash involving `Path.drop_prefix` when using Melange on Windows + (#11767, @nojb) + +### Added + +- Added detection and warning for common typos in package dependency + constraints (#11600, fixes #11575, @kemsguy7) + +- Added `(extra_objects)` field to `(foreign_library)` stanza with `(:include)` support. + (#11683, @Alizter) + +### Changed + +- Allow build RPC messages to be handled by dune's RPC server in eager watch + mode (#11622, @gridbugs) + +- Allow concurrent build with RPC server (#11712, @gridbugs) + +3.18.2 (2025-04-29) +------------------- + +### Fixed + +- fix compatibility with `ocaml.5.4.0` by avoiding shadowing sigwinch (@nojb, + #11639) + +3.18.1 (2025-04-15) +------------------- + +### Fixed + +- fix: pass pkg-config (extra) args in all `pkg-config` invocations. A missing + `--personality` flag would result in pkgconf not finding libraries in some + contexts. (#11619, @MisterDA) + +3.18.0 (2025-04-03) +------------------- + +### Fixed + +- Support HaikuOS: don't call `execve` since it's not allowed if other pthreads + have been created. The fact that Haiku can't call `execve` from other threads + than the principal thread of a process (a team in haiku jargon), is a + discrepancy to POSIX and hence there is a [bug about + it](https://dev.haiku-os.org/ticket/18665). (@Sylvain78, #10953) + +- Fix flag ordering in generated Merlin configurations (#11503, @voodoos, fixes + ocaml/merlin#1900, reported by @vouillon) + +### Added + +- Add `(format-dune-file )` action. It provides a replacement to + `dune format-dune-file` command. (#11166, @nojb) + +- Allow the `--prefix` flag when configuring dune with `ocaml configure.ml`. + This allows to set the prefix just like `$ dune install --prefix`. (#11172, + @rgrinberg) + +- Allow arguments starting with `+` in preprocessing definitions (starting with + `(lang dune 3.18)`). (@amonteiro, #11234) + +- Support for opam `(maintenance_intent ...)` in dune-project (#11274, @art-w) + +- Validate opam `maintenance_intent` (#11308, @art-w) + +- Support `not` in package dependencies constraints (#11404, @art-w, reported + by @hannesm) + +### Changed + +- Warn when failing to discover root due to reads failing. The previous + behavior was to abort. (@KoviRobi, #11173) + +- Use shorter path for inline-tests artifacts. (@hhugo, #11307) + +- Allow dash in `dune init` project name (#11402, @art-w, reported by @saroupille) + +- On Windows, under heavy load, file delete operations can sometimes fail due to + AV programs, etc. Guard against it by retrying the operation up to 30x with a + 1s waiting gap (#11437, fixes #11425, @MSoegtropIMC) + +- Cache: we now only store the executable permission bit for files (#11541, + fixes #11533, @ElectreAAS) + +- Display negative error codes on Windows in hex which is the more customary + way to display `NTSTATUS` codes (#11504, @MisterDA) + +3.17.2 (2025-01-23) +------------------- + +### Fixed + +- Fix a crash in the Melange rules that would prevent compiling public library +implementations of virtual libraries. (@anmonteiro, #11248) + +- Pass `melange.emit`'s `compile_flags` to the JS emission phase. (@anmonteiro, + #11252) + +- Disallow private implementations of public virtual libs in melange mode. + (@anmonteiro, #11253) + +- Wasm_of_ocaml: fix the execution of tests in a sandbox. (#11304, @vouillon) + +3.17.1 (2024-12-17) +------------------- + +### Fixed + +- When a library declares `(no_dynlink)`, then the `.cmxs` file for it + is no longer built. (#11176, @nojb) + +- Fix bug that could result in corrupted file copies by Dune, for example when + using the `copy_files#` stanza or the `copy#` action. (@nojb, #11194, fixes + #11193) + +- Remove useless error message when running `$ dune subst` in empty projects. + (@rgrinberg, #11204, fixes #11200) + +3.17.0 (2024-11-27) +------------------- + +### Fixed + +- Show the context name for errors happening in non-default contexts. + (#10414, fixes #10378, @jchavarri) + +- Correctly declare dependencies of indexes so that they are rebuilt when + needed. (#10623, @voodoos) + +- Don't depend on coq-stdlib being installed when expanding variables + of the `coq.version` family (#10631, fixes #10629, @gares) + +- Error out if no files are found when using `copy_files`. (#10649, @jchavarri) + +- Re_export dune-section private library in the dune-site library stanza, + in order to avoid failure when generating and building sites modules + with implicit_transitive_deps = false. (#10650, fixes #9661, @MA0100) + +- Expect test fixes: support multiple modes and fix dependencies when there is + a custom runner (#10671, @vouillon) + +- In a `(library)` stanza with `(extra_objects)` and `(foreign_stubs)`, avoid + double linking the extra object files in the final executable. + (#10783, fixes #10785, @nojb) + +- Map `(re_export)` library dependencies to the `exports` field in `META` files, + and vice-versa. This field was proposed in to + https://discuss.ocaml.org/t/proposal-a-new-exports-field-in-findlib-meta-files/13947. + The field is included in Dune-generated `META` files only when the Dune lang + version is >= 3.17. + (#10831, fixes #10830, @nojb) + +- Fix staged pps preprocessors on Windows (which were not working at all + previously) (#10869, fixes #10867, @nojb) + +- Fix `dune describe` when an executable is disabled with `enabled_if`. + (#10881, fixes #10779, @moyodiallo) + +- Fix an issue where C stubs would be rebuilt whenever the stderr of Dune was + redirected. (#10883, fixes #10882, @nojb) + +- Fix the URL opened by the command `dune ocaml doc`. (#10897, @gridbugs) + +- Fix the file referred to in the error/warning message displayed due to the + dune configuration version not supporting a particular configuration + stanza in use. (#10923, @H-ANSEN) + +- Fix `enabled_if` when it uses `env` variable. (#10936, fixes #10905, @moyodiallo) + +- Fix exec -w for relative paths with --root argument (#10982, @gridbugs) + +- Do not ignore the `(locks ..)` field in the `test` and `tests` stanza + (#11081, @rgrinberg) + +- Tolerate files without extension when generating merlin rules. + (#11128, @anmonteiro) + +### Added + +- Make Merlin/OCaml-LSP aware of "hidden" dependencies used by + `(implicit_transitive_deps false)` via the `-H` compiler flag. (#10535, @voodoos) + +- Add support for the -H flag (introduced in OCaml compiler 5.2) in dune + (requires lang versions 3.17). This adaptation gives + the correct semantics for `(implicit_transitive_deps false)`. + (#10644, fixes #9333, ocsigen/tyxml#274, #2733, #4963, @MA0100) + +- Add support for specifying Gitlab organization repositories in `source` + stanzas (#10766, fixes #6723, @H-ANSEN) + +- New option to control jsoo sourcemap generation in env and executable stanza + (#10777, fixes #10673, @hhugo) + +- One can now control jsoo compilation_mode inside an executable stanza + (#10777, fixes #10673, @hhugo) + +- Add support for specifying default values of the `authors`, `maintainers`, and + `license` stanzas of the `dune-project` file via the dune config file. Default + values are set using the `(project_defaults)` stanza (#10835, @H-ANSEN) + +- Add names to source tree events in performance traces (#10884, @jchavarri) + +- Add `codeberg` as an option for defining project sources in dune-project + files. For example, `(source (codeberg user/repo))`. (#10904, @nlordell) + +- `dune runtest` can now run individual tests with `dune runtest mytest.t` + (#11041, @Alizter). + +- Wasm_of_ocaml support (#11093, @vouillon) + +- Add a `coqdep_flags` field to the `coq` field of the `env` stanza, and to the + `coq.theory` stanza, allowing to configure `coqdep` flags. (#11094, + @rlepigre) + +### Changed + +- Remove all remnants of the experimental `patch-back-source-tree`. (#10771, + @rgrinberg) + +- Change the preset value for author and maintainer fields in the + `dune-project` file to encourage including emails. (#10848, @punchagan) + +- Tweak the preset value for tags in the `dune-project` file to hint at topics + not having a special meaning. (#10849, @punchagan) + +- Change some colors to improve readability in light-mode terminals + (#10890, @gridbugs) + +- Forward the linkall flag to jsoo in whole program compilation as well (#10935, @hhugo) + +- Configurator uses `pkgconf` as pkg-config implementation when available + and forwards it the `target` of `ocamlc -config`. (#10937, @pirbo) + +- Enable Dune cache by default. Add a new Dune cache setting + `enabled-except-user-rules`, which enables the Dune cache, but excludes + user-written rules from it. This is a conservative choice that can avoid + breaking rules whose dependencies are not correctly specified. This is the + current default. (#10944, #10710, @nojb, @ElectreAAS) + +- Do not add `dune` dependency in `dune-project` when creating projects with + `dune init proj`. The Dune dependency is implicitely added when generating + opam files (#11129, @Leonidas-from-XIV) + +3.16.1 (2024-10-30) +------------------- + +### Fixed + +- Call the C++ compiler with `-std=c++11` when using OCaml >= 5.0 + (#10962, @kit-ty-kate) + + +3.16.0 (2024-06-17) +------------------- + +### Added + +- allow libraries with the same `(name ..)` in projects as long as they don't + conflict during resolution (via `enabled_if`). (#10307, @anmonteiro, + @jchavarri) + +- `dune describe pp` now finds the exact module and the stanza it belongs to, + instead of guessing the name of the preprocessed file. (#10321, @anmonteiro) + +- Print the result of `dune describe pp` with the respective dialect printer. + (#10322, @anmonteiro) + +- Add new flag `--context` to `dune ocaml-merlin`, which allows to select a + Dune context when requesting Merlin config. Add `dune describe contexts` + subcommand. Introduce a field `generate_merlin_rules` for contexts declared + in the workspace, that allows to optionally produce Merlin rules for other + contexts besides the one selected for Merlin (#10324, @jchavarri) + +- melange: add include paths for private library `.cmj` files during JS + emission. (#10416, @anmonteiro) + +- `dune ocaml-merlin`: communicate additional directives `SOURCE_ROOT`, + `UNIT_NAME` (the actual name with wrapping) and `INDEX` with the paths to the + index(es). (#10422, @voodoos) + +- Add a new alias `@ocaml-index` that uses the `ocaml-index` binary to generate + indexes that can be read by tools such as Merlin to provide project-wide + references search. (#10422, @voodoos) + +- merlin: add optional `(merlin_reader CMD)` construct to `(dialect)` stanza to + configure a merlin reader (#8567, @andreypopp) + +### Changed + +- melange: treat private libraries with `(package ..)` as public libraries, + fixing an issue where `import` paths were wrongly emitted. (#10415, + @anmonteiro) + +- install `.glob` files for Coq theories too (#10602, @ejgallego) + +### Fixed + +- Don't try to document non-existent libraries in doc-new target (#10319, fixes + #10056, @jonludlam) + +- Make `dune-site`'s `load_all` function look for `META` files so that it + doesn't fail on empty directories in the plugin directory (#10458, fixes + #10457, @shym) + +- Fix incorrect warning for libraries defined inside non-existant directories + using `(subdir ..)` and used by executables using `dune-build-info` (#10525, + @rgrinberg) + +- Don't try to take build lock when running `coq top --no-build` (#10547, fixes + #7671, @lzy0505) + +- Make sure to truncate dune's lock file after locking and unlocking so that + users cannot observe incorrect pid's (#10575, @rgrinberg) + +- mdx: link mdx binary with `byte_complete`. This fixes `(libraries)` with + foreign archives on Linux. (#10586, fixes #10582, @anmonteiro) + +- virtual libraries: fix an issue where linking an executable involving several + virtual libries would cause an error. (#10581, fixes #10460, @rgrinberg) + +3.15.3 (2024-05-24) +------------------- + +### Fixed + +- Fix interpretation of `exists_if` predicate in `META` files of installed + libraries containing more than one element. (#10564, fixes #10563, @dbuenzli, + @nojb) + +- Fix TSAN warning in wait4 stubs (#10554, fixes #10553, @emillon) + +3.15.2 (2024-04-23) +------------------- + +### Fixed + +- If no directory targets are defined, then do not evaluate `enabled_if` + (#10442, @rgrinberg) + +- Fix a bug where Coq projects were being rebuilt from scratch each time the + dependency graph changed. (#10446, fixes #10149, @alizter) + +3.15.1 (2024-04-17) +------------------- + +### Fixed + +- Fix overflow in sendfile stubs (copy of large files could fail or end with + truncated files) (#10333, @tonyfettes) + +- Fix crash when a rule with a directory target is disabled with `enabled_if` + (#10382, fixes #10310, @gridbugs) + +- melange: remove all restrictions around virtual libraries in Melange. They + may be used as otherwise in libraries and executables. (#10412, @anmonteiro) + +- spawn: fix compatibility with RHEL7 (#10428, @emillon) + +3.15.0 (2024-04-03) +------------------- + +### Added + +- Add link flags to to `ocamlmklib` for ctypes stubs (#8784, @frejsoya) + +- Remove some unnecessary limitations in the expansions of percent forms in + install stanza. For example, the `%{env:..}` form can be used to select files + to be installed. (#10160, @rgrinberg) + +- Allow artifact expansion percent forms (`%{cma:..}`, `%{cmo:..}`, etc.) in + more contexts. Previously, they would be randomly forbidden in some fields. + (#10169, @rgrinberg) + +- Allow `%{inline_tests}` in more contexts (#10191, @rgrinberg) + +- Remove limitations on percent forms in the `(enabled_if ..)` field of + libraries (#10250, @rgrinberg) + +- Support dialects in `dune describe pp` (#10283, @emillon) + +- Allow defining executables or melange emit stanzas with the same name in the + same folder under different contexts. (#10220, @rgrinberg, @jchavarri) + +### Fixed + +- coq: Delay Coq rule setup checks so OCaml-only packages can build in hybrid + Coq/OCaml projects when `coqc` is not present. Thanks to @vzaliva for the + test case and report (#9845, fixes #9818, @rgrinberg, @ejgallego) + +- Fix conditional source selection with `select` on `bigarray` in OCaml 5 + (#10011, @moyodiallo) + +- melange: fix inconsistency in virtual library implementation. Concrete + modules within a virtual library can now refer to its virtual modules too + (#10051, fixes #7104, @anmonteiro) + +- melange: fix a bug that would cause stale `import` paths to be emitted when + moving source files within `(include_subdirs ..)` (#10286, fixes #9190, + @anmonteiro) + +- Dune file formatting: output utf8 if input is correctly encoded (#10113, + fixes #9728, @moyodiallo) + +- Fix expanding dependencies and locks specified in the cram stanza. + Previously, they would be installed in the context of the cram test, rather + than the cram stanza itself (#10165, @rgrinberg) + +- Fix bug with `dune exec --watch` where the working directory would always be + set to the project root rather than the directory where the command was run + (#10262, @gridbugs) + +- Regression fix: sign executables that are promoted into the source tree + (#10263, fixes #9272, @emillon) + +- Fix crash when decoding dune-package for libraries with `(include_subdirs + qualified)` (#10269, fixes #10264, @emillon) + +### Changed + +- Remove the `--react-to-insignificant-changes` option. (#10083, @rgrinberg) + +3.14.2 (2024-03-12) +------------------- + +### Fixed + +- fix compilation on non-glibc systems due to `signal.h` not being pulled in + spawn stubs. (#10256, @emillon) + +3.14.1 (2024-03-11) +------------------- + +### Fixed + +- When a directory is changed to a file, correctly remove it in subsequent + `dune build` runs. (#9327, fix #6575, @emillon) + +- Fix a problem with the doc-new target where transitive dependencies were + missed during compile. This leads to missing expansions in the output docs. + (#9955, @jonludlam) + +- coq: fix performance regression in coqdep unescaping (#10115, fixes #10088, + @ejgallego, thanks to Dan Christensen for the report) + +- coq: memoize coqdep parsing, this will reduce build times for Coq users, in + particular for those with many .v files (#10116, @ejgallego, see also #10088) + +- on Windows, use an unicode-aware version of `CreateProcess` to avoid crashes + when paths contains non-ascii characters. (#10212, fixes #10180, @emillon) + +3.14.0 (2024-02-12) +------------------- + +### Added + +- Introduce a `(dynamic_include ..)` stanza. This is like `(include foo)` but + allows `foo` to be the target of a rule. Currently, there are some + limitations on the stanzas that can be generated. For example, public + executables, libraries are currently forbidden. (#9913, @rgrinberg) + +- Introduce `$ dune promotion list` to print the list of available promotions. + (#9705, @moyodiallo) + +- If Sherlodoc is installed, add a search bar in generated HTML docs (#9772, + @EmileTrotignon) + +- Add `only_sources` field to `copy_files` stanza (#9827, fixes #9709, + @jchavarri) + +- The `(foreign_library)` stanza now supports the `(enabled_if)` field. (#9914, + @nojb) + +### Fixed + +- Fix `$ dune install -p` incorrectly recognizing packages that are supposed to + be filtered (#9879, fixes #4814, @rgrinberg) + +- subst: correctly handle opam files in opam/ subdirectory (#9895, fixes #9862, + @emillon) + +- Odoc private rules are not set up if a library is not available due to + `enabled_if` (#9897, @rgrinberg and @jchavarri) + +### Changed + +- When dune language 3.14 is enabled, resolve the binary in `(run %{bin:..} + ..)` from where the binary is built. (#9708, @rgrinberg) + +- boot: remove single-command bootstrap. This was an alternative bootstrap + strategy that was used in certain conditions. Removal makes the bootstrap a + bit slower on Linux when only a single core is available, but bootstrap is + now reproducible in all cases. (#9735, fixes #9507, @emillon) + +3.13.1 (2024-02-05) +------------------- + +- Fix performance regression for incremental builds (#9769, fixes #9738, + @rgrinberg) + +- Fix `dune ocaml top-module` to correctly handle absolute paths. (#8249, fixes + #7370, @Alizter) + +- subst: ignore broken symlinks when looking at source files (#9810, fixes + #9593, @emillon) + +- subst: do not fail on 32-bit systems when large files are encountered. Just + log a warning in this case. (#9811, fixes #9538, @emillon) + +- boot: sort directory entries in readdir. This makes the dune binary + reproducible in terms of filesystem order. (#9861, fixes #9794, @emillon) + +3.13.0 (2024-01-16) +------------------- + +### Added + +- Add command `dune cache clear` to completely delete all traces of the Dune + cache. (#8975, @nojb) + +- Allow to disable Coq 0.8 deprecation warning (#9439, @ejgallego) + +- Allow `OCAMLFIND_TOOLCHAIN` to be set per context in the workspace file + through the `env` stanza. (#9449, @rgrinberg) + +- Menhir: generate `.conflicts` file by default. Add new field to the + `(menhir)` stanza to control the generation of this file: `(explain )`. Introduce `(menhir (flags ...) (explain ...))` field in the + `(env)` stanza, delete `(menhir_flags)` field. All changes are guarded under + a new version of the Menhir extension, 3.0. (#9512, @nojb) + +- Directory targets can now be cached. (#9535, @rleshchinskiy) + +- It is now possible to use special forms such as `(:include)` and variables + `%{read-lines:}` in `(modules)` and similar fields. Note that the + dependencies introduced in this way (ie the files being read) must live in a + different directory than the stanza making use of them. (#9578, @nojb) + +- Remove warning 30 from default set for projects where dune lang is at least + 3.13 (#9568, @gasche) + +- Add `coqdoc_flags` field to `coq` field of `env` stanza allowing the setting + of workspace-wide defaults for `coqdoc_flags`. (#9280, fixes #9139, @Alizter) + +- ctypes: fix an error where `(ctypes)` with no `(function_description)` would + cause an error trying refer to a nonexistent `_stubs.a` dependency (#9302, + fix #9300, @emillon) + +### Changed + +- Check that package names in `(depends)` and related fields in `dune-project` + are well-formed. (#9472, fixes #9270, @ElectreAAS) + +### Fixed + +- Do not ignore `(formatting ..)` settings in context or workspace files + (#8447, @rgrinberg) + +- Fixed a bug where Dune was incorrectly parsing the output of coqdep when it + was escaped, as is the case on Windows. (#9231, fixes #9218, @Alizter) + +- Copying mode for sandboxes will now follow symbolic links (#9282, @rgrinberg) + +- Forbid the empty `(binaries ..)` field in the `env` stanza in the workspace + file unless language version is at least 3.2. (#9309, @rgrinberg) + +- [coq] Fix bug in computation of flags when composed with boot theories. + (#9347, fixes #7909, @ejgallego) + +- Fixed a bug where the `(select)` field of the `(libraries)` field of the + `(test)` stanza wasn't working properly. (#9387, fixes #9365, @Alizter) + +- Fix handling of the `PATH` argument to `dune init proj NAME PATH`. An + intermediate directory called `NAME` is no longer created if `PATH` is + supplied, so `dune init proj my_project .` will now initialize a project in + the current working directory. (#9447, fixes #9209, @shonfeder) + +- Experimental doc rules: Correctly handle the case when a package depends upon + its own sublibraries (#9461, fixes #9456, @jonludlam) + +- Resolve various public binaries to their build location, rather than to where + they're copied in the `_build/install` directory (#9496, fixes #7908, + @rgrinberg). + +- Correctly ignore warning flags in vendored projects (#9515, @rgrinberg) + +- Use watch exclusions in watch mode on MacOS (#9643, fixes #9517, + @PoorlyDefinedBehaviour) + +- Fix merlin configuration for `(include_subdirs qualified)` modules (#9659, + fixes #8297, @rgrinberg) + +- Fix handling of `enabled_if` in binary install stanzas. Previously, we'd + ignore the result of `enabled_if` when evaluating `%{bin:..}` (#9707, + @rgrinberg) + +3.12.2 (2024-01-05) +------------------- + +- Fix version check in `runtest_alias` for `cram` stanza (#9454, @emillon) + +- Fix stack overflow when a `(run)` action can not be parsed. (#9530, fixes + #9529, @gridbugs) + +3.12.1 (2023-11-29) +------------------- + +- Revert unintended inclusion of #9250 and #9280 (@emillon) + +3.12.0 (2023-11-28) +------------------- + +- Introduce `$ dune ocaml doc` to open and browse documentation. (#7262, fixes + #6831, @EmileTrotignon) + +- `dune cache trim` now accepts binary byte units: `KiB`, `MiB`, etc. (#8618, + @Alizter) + +- No longer force colors for OCaml 4.03 and 4.04 (#8778, @rgrinberg) + +- Introduce new experimental odoc rules (#8803, @jonjudlam) + +- Introduce the `runtest_alias` field to the `cram` stanza. This allows + removing default `runtest` alias from tests. (@rgrinberg, #8887) + +- Do not ignore libraries named `bigarray` when they are defined in conjunction + with OCaml 5.0 (#8902, fixes #8901, @rgrinberg) + +- Dependencies in the copying sandbox are now writeable (#8920, @rgrinberg) + +- Absent packages shouldn't prevent all rules from being loaded (#8948, fixes + #8630, @rgrinberg) + +- Correctly determine the stanza of menhir modules when `(include_subdirs + qualified)` is enabled (@rgrinberg, #8949, fixes #7610) + +- Display cache location in Dune log (#8974, @nojb) + +- Re-run actions whenever `(expand_aliases_in_sandbox)` changes (#8990, + @rgrinberg) + +- Rules that only use internal dune actions (`write-file`, `echo`, etc.) can + now be sandboxed. (#9041, fixes #8854, @rgrinberg) + +- Do not re-run rules when their location changes (#9052, @rgrinberg) + +- Correctly ignore `bigarray` on recent version of OCaml (#9076, @rgrinberg) + +- Add `test_` prefix to default test name in `dune init project` (#9257, fixes + #9131, @9sako6) + +- [coq rules] Be more tolerant when coqc --print-version / --config don't work + properly, and fallback to a reasonable default. This fixes problems when + building Coq projects with `(stdlib no)` and likely other cases. (#8966, fix + #8958, @Alizter, reported by Lasse Blaauwbroek) + +- Dune will now run at a lower framerate of 15 fps rather than 60 when + `INSIDE_EMACS`. (#8812, @Alizter) + +- dune-build-info: when `version=""` is found in a `META` file, we now return + `None` as a version string (#9177, @emillon) + +- Dune can now be built and installed on Haiku (#8795, fix #8551, @Alizter) + +- Mark installed directories in `dune-package` files. This fixes `(package)` + dependencies against packages that contain such directories. (#8953, fixes + #8915, @emillon) + +3.11.1 (2023-10-09) +------------------- + +- Fix `dune rpc` commands on Windows (#8806, fixes #8799, @nojb) + +- Fix `inline_tests` when the partition list is empty (#8849, fixes #8848, + @hhugo) + +3.11.0 (2023-09-22) +------------------- + +- `enabled_if` now supports `arch_sixtyfour` variable (#8023, fixes #7997, + @Alizter) + +- Use `posix_spawn` instead of `fork` on MacOS. This gives us a performance + boost and allows us to re-enable thread. (#8090, @rgrinberg) + +- Experimental: Added a `$ dune monitor` command that can connect to a running + `dune build` in watch mode and display the errors and progress. (#8152, + @Alizter) + +- The `progress` RPC procedure now has an extra field for the `In_progress` + constructor for the number of failed jobs. (#8212, @Alizter) + +- Add a `--preview` flag to `dune fmt` which causes it to print out the changes + it would make without applying them (#8289, @gridbugs) + +- Introduce `(source_trees ..)` to the install stanza to allow installing + entire source trees. (#8349, @rgrinberg) + +- Add `--stop-on-first-error` option to `dune build` which will terminate the + build when the first error is encountered. (#8400, @pmwhite and @Alizter) + +- Dune now displays the number of errors when waiting for changes in watch + mode. (#8408, fixes #6889, @Alizter) + +- Add `with_prefix` keyword for changing the prefix of the destination of + installed files matched by globs. (#8416, @gridbugs) + +- Added experimental `--display tui` option for Dune that opens an interactive + Terminal User Interface (TUI) when Dune is running. Press '?' to open up a + help screen when running for more information. (#8429, @Alizter and + @rgrinberg) + +- Add a `warnings` field to `dune-project` files as a unified mechanism to + enable or disable dune warnings (@rgrinberg, 8448) + +- `dune exec`: support syntax like `%{bin:program}`. This can appear anywhere + in the command line, so things like `dune exec time %{bin:program}` now work. + (#6035, #8474, fixes #2691, @emillon, @Leonidas-from-XIV) + +- Make copy sandbox support directory targets. (#8705, fixes #7724, @emillon) + +- Add a new alias `@doc-json` to build odoc documentation in JSON format. This + output can be consumed by external tools. (#8178, @emillon) + +- Modules that were declared in `(modules_without_implementation)`, + `(private_modules)` or `(virtual_modules)` but not declared in `(modules)` + will raise an error. (#7674, @Alizter) + +- No longer emit linkopts(javascript) in META files (#8168, @hhugo) + +- Deprecate install destination paths beginning with ".." to prevent packages + escaping their designated installation directories. (#8350, @gridbugs) + +- RPC message styles are now serialised meaning that RPC diagnostics keep their + Ansi styling. (#8516, fixes #6921, @Alizter) + +- Truncate output from actions that produce too much output (@tov, #8351) + +- Allow libraries to shadow OCaml builtin libraries. Previously, builtin + libraries would always take precedence. (@rgrinberg, #8558) + +- Remove warning against `.dune` files generated by pre dune 2.0 (#8611, + @rgrinberg) + +- `dune utop` no longer links `utop` in "custom" mode, which should make this + command considerably faster. (#8631, fixes #6894, @nojb) + +- Ensure that package names in `dune-project` are valid opam package names. + (#8331, @emillon) + +- init: check that module names are valid (#8644, fixes #8252, @emillon) + +- dune init: parse `--public` as a public name (#8603, fixes #7108, @emillon) + +- Stop signing source files with substitutions. Sign only binaries instead + (#8361, fixes #8360, @anmonteiro) + +- Remove versions 0.1 and 0.2 of the experimental ctypes extension. (#8293, + @emillon) + +3.10.0 (2023-07-31) +------------------- + +- Add `dune show rules` as alias of the `dune rules` command. (#8000, @Alizter) + +- Fix `%{deps}` to expand properly in `(cat ...)` when containing 2 or more + items. (#8196, @Alizter) + +- Add `dune show installed-libraries` as an alias of the `dune + installed-libraries` command. (#8135, @Alizter) + +- Fix the `severity` of error messages sent over RPC which was missing. (#8193, + @Alizter) + +- Add `dune build --dump-gc-stats FILE` argument to dump garbage collection + stats to a named file. (#8072, @Alizter) + +- Fix bug with ppx and Reason syntax due to missing dependency in sandboxed + action (#7932, fixes #7930, @Alizter) + +- Add `dune describe package-entries` to print all package entries (#7480, + @moyodiallo) + +- Improve `dune describe external-lib-deps` by adding the internal dependencies + for more information. (#7478, @moyodiallo) + +- Re-enable background file digests on Windows. The files are now open in a way + that prevents race condition around deletion. (#8262, fixes #8268, @emillon) + +3.9.3 (2023-07-31) +------------------ + +- Fix flushing when using `sendfile` fallback (#8288, fixes #8284, @alan-j-hu) + +3.9.2 (2023-07-25) +------------------ + +- Disable background digests on Windows. This prevents an issue where + unremovable files would make dune crash when the shared cache is enabled. + (#8243, fixes #8228, @emillon) + +- Fix permission errors when `sendfile` is not available (#8234, fixes #8210, + @emillon) + +3.9.1 (2023-07-06) +------------------ + +- Disable background operations and threaded console on MacOS and other Unixes + where we rely on fork. (#8100, #8121, fixes #8083, @rgrinberg, @emillon) + +- Initialize async IO thread lazily. (#8122, @emillon) + +3.9.0 (2023-06-28) +------------------ + +- Validate file extension for `$ dune ocaml top-module`. (#8005, fixes #8004, @3Rafal) + +- Include the time it takes to read/write state files when `--trace-file` is + enabled (#7960, @rgrinberg) + +- Add `dune show` command group which is an alias of `dune describe`. (#7946, + @Alizter) + +- Include source tree scans in the traces produced by `--trace-file` (#7937, + @rgrinberg) + +- Cinaps: The promotion rules for cinaps would only offer one file at a time no + matter how many promotions were available. Now we offer all the promotions at + once (#7901, @rgrinberg) + +- Do not re-run OCaml syntax files on every iteration of the watch mode. This + is too memory consuming. (#7894, fix #6900, @rgrinberg) + +- Add `--all` option to `dune rpc status` to show all Dune RPC servers running. + (#8011, fix #7902, @Alizter) + +- Remove some compatibility code for old version of dune that generated + `.merlin` files. Now dune will never remove `.merlin` files automatically + (#7562) + +- Add `dune show env` command and make `dune printenv` an alias of it. (#7985, + @Alizter) + +- Add additional metadata to the traces provided by `--trace-file` whenever + `--trace-extended` is passed (#7778, @rleshchinskiy) + +- Extensions used in `(dialect)` can contain periods (e.g., `cppo.ml`). (#7782, + fixes #7777, @nojb) + +- Allow `(include_subdirs qualified)` to be used when libraries define a + `(modules ...)` field (#7797, fixes #7597, @anmonteiro) + +- `$ dune describe` is now a command group, so arguments to subcommands must be + passed after subcommand itself. (#7919, @Alizter) + +- The `interface` and `implementation` fields of a `(dialect)` are now optional + (#7757, @gpetiot) + +- Add commands `dune show targets` and `dune show aliases` that display all the + available targets and aliases in a given directory respectively. (#7770, + grants #265, @Alizter) + +- Allow multiple globs in library's `(stdlib (internal_modules ..))` + (@anmonteiro, #7878) + +- Attach melange rules to the default alias (#7926, @haochenx) + +- In opam constraints, reject `(and)` and `(or)` with no arguments at parse + time (#7730, @emillon) + +- Compute digests and manage sandboxes in background threads (#7947, + @rgrinberg) + +- Add `(build_if)` to the `(test)` stanza. When it evaluates to false, the + executable is not built. (#7899, fixes #6938, @emillon) + +- Add necessary parentheses in generated opam constraints (#7682, fixes #3431, + @Lucccyo) + +3.8.3 (2023-06-27) +------------------ + +- Fix deadlock on Windows (#8044, @nojb) + +- When using `sendfile` to copy files on Linux, fall back to the portable + version if it fails at runtime for some reason (NFS, etc). + (#8049, fixes #8041, @emillon) + +3.8.2 (2023-06-16) +------------------ + +- Switch back to threaded console for all systems; fix unresponsive console on + Windows (#7906, @nojb) + +- Respect `-p` / `--only-packages` for `melange.emit` artifacts (#7849, + @anmonteiro) + +- Fix scanning of Coq installed files (@ejgallego, reported by + @palmskog, #7895 , fixes #7893) + +- Fix RPC buffer corruption issues due to multi threading. This issue was only + reproducible with large RPC payloads (#7418) + +- Fix printing errors from excerpts whenever character offsets span multiple + lines (#7950, fixes #7905, @rgrinberg) + +3.8.1 (2023-06-05) +------------------ + +- Fix a crash when using a version of Coq < 8.13 due to the native compiler + config variable being missing. We now explicitly default to `(mode vo)` for + these older versions of Coq. (#7847, fixes #7846, @Alizter) + +- Duplicate installed Coq theories are now allowed with the first appearing in + COQPATH being preferred. This is inline with Coq's loadpath semantics. This + fixes an issue with install layouts based on COQPATH such as those found in + nixpkgs. (#7790, @Alizter) + +- Revert #7415 and #7450 (Resolve `ppx_runtime_libraries` in the target context + when cross compiling) (#7887, fixes #7875, @emillon) + +3.8.0 (2023-05-23) +------------------ + +- Fix string quoting in the json file written by `--trace-file` (#7773, + @rleshchinskiy) + +- Read `pkg-config` arguments from the `PKG_CONFIG_ARGN` environment variable + (#1492, #7734, @anmonteiro) + +- Correctly set `MANPATH` in `dune exec`. Previously, we would use the `bin/` + directory of the context. (#7655, @rgrinberg) + +- Allow overriding the `ocaml` binary with findlib configuration (#7648, + @rgrinberg) + +- merlin: ignore instrumentation settings for preprocessing. (#7606, fixes + #7465, @Alizter) + +- When a rule's action is interrupted, delete any leftover directory targets. + This is consistent with how we treat file targets. (#7564, @rgrinberg) + +- Fix plugin loading with findlib. The functionality was broken in 3.7.0. + (#7556, @anmonteiro) + +- Introduce a `public_headers` field on libraries. This field is like + `install_c_headers`, but it allows to choose the extension and choose the + paths for the installed headers. (#7512, @rgrinberg) + +- Load the host context `findlib.conf` when cross-compiling (#7428, fixes + #1701, @rgrinberg, @anmonteiro) + +- Add a `coqdoc_flags` field to the `coq.theory` stanza allowing the user to + pass extra arguments to `coqdoc`. (#7676, fixes #7954 @Alizter) + +- Resolve `ppx_runtime_libraries` in the target context when cross compiling + (#7450, fixes #2794, @anmonteiro) + +- Use `$PKG_CONFIG`, when set, to find the `pkg-config` binary (#7469, fixes + #2572, @anmonteiro) + +- Modules that were declared in `(modules_without_implementation)`, + `(private_modules)` or `(virtual_modules)` but not declared in `(modules)` + will cause Dune to emit a warning which will become an error in 3.11. (#7608, + fixes #7026, @Alizter) + +- Preliminary support for Coq compiled intefaces (`.vos` files) enabled via + `(mode vos)` in `coq.theory` stanzas. This can be used in combination with + `dune coq top` to obtain fast re-building of dependencies (with no checking + of proofs) prior to stepping into a file. (#7406, @rlepigre) + +- Fix dune crashing on MacOS in watch mode whenever `$PATH` contains `$PWD` + (#7441, fixes #6907, @rgrinberg) + +- Fix `dune install` when cross compiling (#7410, fixes #6191, @anmonteiro, + @rizo) + +- Find `pps` dependencies in the host context when cross-compiling, (#7415, + fixes #4156, @anmonteiro) + +- Dune in watch mode no longer builds concurrent rules in serial (#7395 + @rgrinberg, @jchavarri) + +- Dune can now detect Coq theories from outside the workspace. This allows for + composition with installed theories (not necessarily installed with Dune). + (#7047, @Alizter, @ejgallego) + +- `dune coq top` now correctly respects the project root when called from a + subdirectory. However, absolute filenames passed to `dune coq top` are no + longer supported (due to being buggy) (#7357, fixes #7344, @rlepigre and + @Alizter) + +- Added a `--no-build` option to `dune coq top` for avoiding rebuilds (#7380, + fixes #7355, @Alizter) + +- RPC: Ignore SIGPIPE when clients suddenly disconnect (#7299, #7319, fixes + #6879, @rgrinberg) + +- Always clean up the UI on exit. (#7271, fixes #7142 @rgrinberg) + +- Bootstrap: remove reliance on shell. Previously, we'd use the shell to get + the number of processors. (#7274, @rgrinberg) + +- Bootstrap: correctly detect the number of processors by allowing `nproc` to be + looked up in `$PATH` (#7272, @Alizter) + +- Speed up file copying on macos by using `clonefile` when available + (@rgrinberg, #7210) + +- Adds support for loading plugins in toplevels (#6082, fixes #6081, + @ivg, @richardlford) + +- Support commands that output 8-bit and 24-bit colors in the terminal (#7188, + @Alizter) + +- Speed up rule generation for libraries and executables with many modules + (#7187, @jchavarri) + +- Add `--watch-exclusions` to Dune build options (#7216, @jonahbeckford) + +- Do not re-render UI on every frame if the UI doesn't change (#7186, fix + #7184, @rgrinberg) + +- Make coq_db creation in scope lazy (@ejgallego, #7133) + +- Non-user proccesses such as version control or config checking are now run + silently. (#6994, fixes #4066, @Alizter) + +- Add the `--display-separate-messages` flag to separate the error messages + produced by commands with a blank line. (#6823, fixes #6158, @esope) + +- Accept the Ordered Set Language for the `modes` field in `library` stanzas + (#6611, @anmonteiro). + +- dune install now respects --display quiet mode (#7116, fixes #4573, fixes + #7106, @Alizter) + +- Stub shared libraries (dllXXX_stubs.so) in Dune-installed libraries could not + be used as dependencies of libraries in the workspace (eg when compiling to + bytecode and/or Javascript). This is now fixed. (#7151, @nojb) + +- Allow the main module of a library with `(stdlib ...)` to depend on other + libraries (#7154, @anmonteiro). + +- Bytecode executables built for JSOO are linked with `-noautolink` and no + longer depend on the shared stubs of their dependent libraries (#7156, @nojb) + +- Added a new user action `(concurrent )` which is like `(progn )` but runs the + actions concurrently. (#6933, @Alizter) + +- Allow `(stdlib ...)` to be used with `(wrapped false)` in library stanzas + (#7139, @anmonteiro). + +- Allow parallel execution of inline tests partitions (#7012, @hhugo) + +- Support `(link_flags ...)` in `(cinaps ...)` stanza. (#7423, fixes #7416, + @nojb) + +- Allow `(package ...)` in any position within `(rule ...)` stanza (#7445, + @Leonidas-from-XIV) + +- Always include `opam` files in the generated `.install` file. Previously, it + would not be included whenever `(generate_opam_files true)` was set and the + `.install` file wasn't yet generated. (#7547, @rgrinberg) + +- Fix regression where Merlin was unable to handle filenames with uppercase + letters under Windows. (#7577, @nojb) + +- On nix+macos, pass `-f` to the codesign hook to avoid errors when the binary + is already signed (#7183, fixes #6265, @greedy) + +- Fix bug where RPC clients built with dune-rpc-lwt would crash when closing + their connection to the server (#7581, @gridbugs) + +- Introduce mdx stanza 0.4 requiring mdx >= 2.3.0 which updates the default + list of files to include `*.mld` files (#7582, @Leonidas-from-XIV) + +- Fix RPC server on Windows (used for OCaml-LSP). (#7666, @nojb) + +- Coq language versions less 0.8 are deprecated, and will be removed + in an upcoming Dune version. All users are required to migrate to + `(coq lang 0.8)` which provides the right semantics for theories + that have been globally installed, such as those coming from opam + (@ejgallego, @Alizter) + +- Bump minimum version of the dune language for the melange syntax extension + from 3.7 to 3.8 (#7665, @jchavarri) + +3.7.1 (2023-04-04) +------------------ + +- Fix segfault on MacOS when dune was being shutdown while in watch mode. + (#7312, fixes #6151, @gridbugs, @emillon) + +- Fix preludes not being recorded as dependencies in the `(mdx)` stanza (#7109, + fixes #7077, @emillon). + +- Pass correct flags when compiling `stdlib.ml`. (#7241, @emillon) + +- Handle "Too many links" errors when using Dune cache on Windows. The fix in + 3.7.0 for this same issue was not effective due to a typo. (#7472, @nojb) + +- In `(executable)`, `(public_name -)` is now equivalent to no `(public_name)`. + This is consistent with how `(executables)` handles this field. + (#7576 , fixes #5852, @emillon) + +- Change directory of odoc assets to `odoc.support` (was `_odoc_support`) so + that it works with Github Pages out of the box. (#7588, fixes #7364, + @emillon) + +3.7.0 (2023-02-17) +------------------ + +- Allow running `$ dune exec` in watch mode (with the `-w` flag). In watch mode, + `$ dune exec` the executed binary whenever it is recompiled. (#6966, + @gridbugs) + +- `coqdep` is now called once per theory, instead of one time per Coq + file. This should significantly speed up some builds, as `coqdep` + startup time is often heavy (#7048, @Alizter, @ejgallego) + +- Add `map_workspace_root` dune-project stanza to allow disabling of + mapping of workspace root to `/workspace_root`. (#6988, fixes #6929, + @richardlford) + +- Fix handling of support files generated by odoc. (#6913, @jonludlam) + +- Fix parsing of OCaml errors that contain code excerpts with `...` in them. + (#7008, @rgrinberg) + +- Pre-emptively clear screen in watch mode (#6987, fixes #6884, @rgrinberg) + +- Fix cross compilation configuration when a context with targets is itself a + host of another context (#6958, fixes #6843, @rgrinberg) + +- Fix parsing of the `<=` operator in *blang* expressions of `dune` files. + Previously, the operator would be interpreted as `<`. (#6928, @tatchi) + +- Fix `--trace-file` output. Dune now emits a single *complete* event for every + executed process. Unterminated *async* events are no longer written. (#6892, + @rgrinberg) + +- Fix preprocessing with `staged_pps` (#6748, fixes #6644, @rgrinberg) + +- Use colored output with MDX when Dune colors are enabled. + (#6462, @MisterDA) + +- Make `dune describe workspace` return consistent dependencies for + executables and for libraries. By default, compile-time dependencies + towards PPX-rewriters are from now not taken into account (but + runtime dependencies always are). Compile-time dependencies towards + PPX-rewriters can be taken into account by providing the + `--with-pps` flag. (#6727, fixes #6486, @esope) + +- Print missing newline after `$ dune exec`. (#6821, fixes #6700, @rgrinberg, + @Alizter) + +- Fix binary corruption when installing or promoting in parallel (#6669, fixes + #6668, @edwintorok) + +- Use colored output with GCC and Clang when compiling C stubs. The + flag `-fdiagnostics-color=always` is added to the `:standard` set of + flags. (#4083, @MisterDA) + +- Fix the parsing of decimal and hexadecimal escape literals in `dune`, + `dune-package`, and other dune s-expression based files (#6710, @shym) + +- Report an error if `dune init ...` would create a "dune" file in a location + which already contains a "dune" directory (#6705, @gridbugs) + +- Fix the parsing of alerts. They will now show up in diagnostics correctly. + (#6678, @rginberg) + +- Fix the compilation of modules generated at link time when + `implicit_transitive_deps` is enabled (#6642, @rgrinberg) + +- Allow `$ dune utop` to load libraries defined in data only directories + defined using `(subdir ..)` (#6631, @rgrinberg) + +- Format dune files when they are named `dune-file`. This occurs when we enable + the alternative file names project option. (#6566, @rgrinberg) + +- Move `$ dune ocaml-merlin -dump-config=$dir` to `$ dune ocaml merlin + dump-config $dir`. (#6547, @rgrinberg) + +- Allow compilation rules to be impacted by `(env ..)` stanzas that modify the + environment or set binaries. (#6527, @rgrinberg) + +- Coq native mode is now automatically detected by Dune starting with Coq lang + 0.7. `(mode native)` has been deprecated in favour of detection from the + configuration of Coq. (#6409, @Alizter) + +- Print "Leaving Directory" whenever "Entering Directory" is printed. (#6419, + fixes #138, @cpitclaudel, @rgrinberg) + +- Allow `$ dune ocaml dump-dot-merlin` to run in watch mode. Also this command + shouldn't print "Entering Directory" mesages. (#6497, @rgrinberg) + +- `dune clean` should no longer fail under Windows due to the inability to + remove the `.lock` file. Also, bring the implementation of the global lock + under Windows closer to that of Unix. (#6523, @nojb) + +- Remove "Entering Directory" messages for `$ dune install`. (#6513, + @rgrinberg) + +- Stop passing `-q` flag in `dune coq top`, which allows for `.coqrc` to be + loaded. (#6848, fixes #6847, @Alizter) + +- Fix missing dependencies when detecting the kind of C compiler we're using + (#6610, fixes #6415, @emillon) + +- Allow `(include_subdirs qualified)` for OCaml projects. (#6594, fixes #1084, + @rgrinberg) + +- Accurately determine merlin configuration for all sources selected with + `copy#` and `copy_files#`. The old heuristic of looking for a module in + parent directories is removed (#6594, @rgrinberg) + +- Fix inline tests with *js_of_ocaml* and whole program compilation mode + enabled (#6645, @hhugo) + +- Fix *js_of_ocaml* separate compilation rules when `--enable=effects` + ,`--enable=use-js-string` or `--toplevel` is used. (#6714, #6828, #6920, @hhugo) + +- Fix *js_of_ocaml* separate compilation in presence of linkall (#6832, #6916, @hhugo) + +- Remove spurious build dir created when running `dune init proj ...` (#6707, + fixes #5429, @gridbugs) + +- Allow `--sandbox` to affect `ocamldep` invocations. Previously, they were + wrongly marked as incompatible (#6749, @rgrinberg) + +- Validate the command line arguments for `$ dune ocaml top-module`. This + command requires one positional argument (#6796, fixes #6793, @rgrinberg) + +- Add a `dune cache size` command for displaying the size of the cache (#6638, + @Alizter) + +- Fix dependency cycle when installing files to the bin section with + `glob_files` (#6764, fixes #6708, @gridbugs) + +- Handle "Too many links" errors when using Dune cache on Windows (#6993, @nojb) + +- Allow the `cinaps` stanza to set a custom alias. By default, if the alias is + not set then the cinaps actions will be attached to both `@cinaps` and + `@runtest` (#6991, @rgrinberg) + +- Add `(using ctypes 0.3)`. When used, paths in `(ctypes)` are interpreted + relative to where the stanza is defined. (#6883, fixes #5325, @emillon) + +- Auto-detect `dune-workspace` files as `dune` files in Emacs (#7061, + @ilankri) + +- Add native support for polling mode on Windows (#7010, @yams-yams, @nojb) + +- Add `(bin_annot )` to `(env ...)` to specify whether to generate + `*.cmt*` files. (#7102, @nojb) + +3.6.2 (2022-12-21) +------------------ + +- Fix configurator when using the MSVC compiler (#6538, fixes #6537, @nojb) + +- Fix running the RPC server on windows (#6721 fixes #6720, @rgrinberg) + +3.6.1 (2022-11-24) +------------------ + +- Fix status line enabled when ANSI colors are forced. (#6503, @MisterDA) + +- Fix build with MSVC compiler (#6517, @nojb) + +- Do not shadow library interface modules (#6549, fixes #6545, @rgrinberg) + +3.6.0 (2022-11-14) +------------------ + +- Forbid multiple instances of dune running concurrently in the same workspace. + (#6360, fixes #236, @rgrinberg) + +- Allow promoting into source directories specified by `subdir` (#6404, fixes + #3502, @rgrinberg) + +- Make dune describe workspace return the correct root path + (#6380, fixes #6379, @esope) + +- Introduce a `$ dune ocaml top-module` subcommand to load modules directly + without sealing them behind the signature. (#5940, @rgrinberg) + +- [ctypes] do not mangle user written names in the ctypes field (#6374, fixes + #5561, @rgrinberg) + +- Support `CLICOLOR` and `CLICOLOR_FORCE` to enable/disable/force ANSI + colors. (#6340, fixes #6323, @MisterDA). + +- Forbid private libraries with `(package ..)` set from depending on private + libraries that don't belong to a package (#6385, fixes #6153, @rgrinberg) + +- Allow `Byte_complete` binaries to be installable (#4873, @AltGr, @rgrinberg) + +- Revive `$ dune external-lib-deps` under `$ dune describe external-lib-deps`. + (#6045, @moyodiallo) + +- Fix running inline tests in bytecode mode (#5622, fixes #5515, @dariusf) + +- [ctypes] always re-run `pkg-config` because we aren't tracking its external + dependencies (#6052, @rgrinberg) + +- [ctypes] remove dependency on configurator in the generated rules (#6052, + @rgrinberg) + +- Build progress status now shows number of failed jobs (#6242, @Alizter) + +- Allow absolute build directories to find public executables. For example, + those specified with `(deps %{bin:...})` (#6326, @anmonteiro) + +- Create a fake socket file `_build/.rpc/dune` on windows to allow rpc clients + to connect using the build directory. (#6329, @rgrinberg) + +- Prevent crash if absolute paths are used in the install stanza and in + recursive globs. These cases now result in a user error. (#6331, @gridbugs) + +- Add `(glob_files )` and `(glob_files_rec )` terms to the `files` + field of the `install` stanza (#6250, closes #6018, @gridbugs) + +- Allow `:standard` in the `(modules)` field of the `coq.pp` stanza (#6229, + fixes #2414, @Alizter) + +- Fix passing of flags to dune coq top (#6369, fixes #6366, @Alizter) + +- Extend the promotion CLI to a `dune promotion` group: `dune promote` is moved + to `dune promotion apply` (the former still works) and the new `dune promotion + diff` command can be used to just display the promotion without applying it. + (#6160, fixes #5368, @emillon) + +3.5.0 (2022-10-19) +------------------ + +- macOS: Handle unknown fsevents without crashing (#6217, @rgrinberg) + +- Enable file watching on MacOS SDK < 10.13. (#6218, @rgrinberg) + +- Sandbox running cinaps actions starting from cinaps 1.1 (#6176, @rgrinberg) + +- Add a `runtime_deps` field in the `cinaps` stanza to specify runtime + dependencies for running the cinaps preprocessing action (#6175, @rgrinberg) + +- Shadow alias module `Foo__` when building a library `Foo` (#6126, @rgrinberg) + +- Extend dune describe to include the root path of the workspace and the + relative path to the build directory. (#6136, @reubenrowe) + +- Allow dune describe workspace to accept directories as arguments. + The provided directories restrict the worskpace description to those + directories. (#6107, fixes #3893, @esope) + +- Add a terminal persistence mode that attempts to clear the terminal history. + It is enabled by setting terminal persistence to + `clear-on-rebuild-and-flush-history` (#6065, @rgrinberg) + +- Disallow generating targets in sub directories in inferred rules. The check to + forbid this was accidentally done only for manually specified targets (#6031, + @rgrinberg) + +- Do not ignore rules marked `(promote (until-clean))` when + `--ignore-promoted-rules` (or `-p`) is passed. (#6010, fixes #4401, @emillon) + +- Dune no longer considers .aux files as targets during Coq compilation. This + means that .aux files are no longer cached. (#6024, fixes #6004, @alizter) + +- Cinaps actions are now sandboxed by default (#6062, @rgrinberg) + +- Allow rules producing directory targets to be not sandboxed (#6056, + @rgrinberg) + +- Introduce a `dirs` field in the `install` stanza to install entire + directories (#5097, fixes #5059, @rgrinberg) + +- Menhir rules are now sandboxed by default (#6076, @rgrinberg) + +- Allow rules producing directory targets to create symlinks (#6077, fixes + #5945, @rgrinberg) + +- Inline tests are now sandboxed by default (#6079, @rgrinberg) + +- Fix build-info version when used with flambda (#6089, fixes #6075, @jberdine) + +- Add an `(include )` term to the `include_dirs` field for adding + directories to the include paths sourced from a file. (#6058, fixes #3993, + @gridbugs) + +- Support `(extra_objects ...)` field in `(executable ...)` and `(library + ...)` stanzas (#6084, fixes #4129, @gridbugs) + +- Fix compilation of Dune under esy on Windows (#6109, fixes #6098, @nojb) + +- Improve error message when parsing several licenses in `(license)` (#6114, + fixes #6103, @emillon) + +- odoc rules now about `ODOC_SYNTAX` and will rerun accordingly (#6010, fixes + #1117, @emillon) + +- dune install: copy files in an atomic way (#6150, @emillon) + +- Add `%{coq:...}` macro for accessing data about the configuration about Coq. + For instance `%{coq:version}` (#6049, @Alizter) + +- update vendored copy of cmdliner to 1.1.1. This improves the built-in + documentation for command groups such as `dune ocaml`. (#6038, @emillon, + #6169, @shonfeder) + +- The test suite for Coq now requires Coq >= 8.16 due to changes in the + plugin loading mechanism upstream (which now uses `Findlib`). + +- Starting with Coq build language 0.6, theories can be built without importing + Coq's standard library by including `(stdlib no)`. + (#6165 #6164, fixes #6163, @ejgallego @Alizter @LasseBlaauwbroek) + +- on macOS, sign executables produced by artifact substitution (#6137, #6231, + fixes #5650, fixes #6226, @emillon) + +- Added an (aliases ...) field to the (rules ...) stanza which allows the + specification of multiple aliases per rule (#6194, @Alizter) + +- The `(coq.theory ...)` stanza will now ensure that for each declared `(plugin + ...)`, the `META` file for it is built before calling `coqdep`. This enables + the use of the new `Findlib`-based loading method in Coq 8.16; however as of + Coq 8.16.0, Coq itself has some bugs preventing this to work yet. (#6167 , + workarounds #5767, @ejgallego) + +- Allow include statement in install stanza (#6139, fixes #256, @gridbugs) + +- Handle CSI n K code in ANSI escape codes from commands. (#6214, fixes #5528, + @emillon) + +- Add a new experimental feature `mode_specific_stubs` that allows the + specification of different flags and sources for foreign stubs depending on + the build mode (#5649, @voodoos) + +3.4.1 (26-07-2022) +------------------ + +- Fix build on cygwin/i686-w64-mingw32 (#6008, @kit-ty-kate) + +3.4.0 (20-07-2022) +------------------ + +- Do not ignore `C-c` when running `$ dune subst` (#5892, @rgrinberg) + +- Make `dune describe` correctly handle overlapping implementations + for virtual libraries (#5971, fixes #5747, @esope) + +- Building the `@check` alias should make sure the libraries and executables + don't have dependency cycles (#5892, @rgrinberg) + +- [ctypes] Add support for the `errno` parameter using the `errno_policy` field + in the ctypes settings. (#5827, @droyo) + +- Fix `dune coq top` when it is invoked on files from a subdirectory of the + directory containing the associated stanza (#5784, fixes #5552, @ejgallego, + @rlepigre, @Alizter) + +- Fix hint when an invalid module name is found. (#5922, fixes #5273, @emillon) + +- The `(cat)` action now supports several files. (#5928, fixes #5795, @emillon) + +- Dune no longer uses shimmed `META` files for OCaml 5.x, solely using the ones + installed by the compiler. (#5916, @dra27) + +- Fix handling of the `(deps)` field in `(test)` stanzas when there is an + `.expected` file. (#5952, #5951, fixes #5950, @emillon) + +- Ignore insignificant filesystem events. This stops RPC in watch mode from + flashing errors on insignificant file system events such as changes in the + `.git/` directory. (#5953, @rgrinberg) + +- Fix parsing more error messages emitted by the OCaml compiler. In + particular, messages where the excerpt line number started with a blank + character were skipped. (#5981, @rgrinberg) + +- env stanza: warn if some rules are ignored because they appear after a + wildcard rule. (#5898, fixes #5886, @emillon) + +- On Windows, XDG_CACHE_HOME is taken to be the `FOLDERID_InternetCache` if + unset, and XDG_CONFIG_HOME and XDG_DATA_HOME are both taken to be + `FOLDERID_LocalAppData` if unset. (#5943, fixes #5808, @nojb) + +3.3.1 (19-06-2022) +------------------ + +- Improve parsing of ocamlc errors. We now correctly strip excerpts and parse + alerts (#5879, @rgrinberg) + +- The `(libraries)` field of the `coq.theory` stanza has been renamed to + `(plugins)` and the Coq language version has been bumped to 0.5. + +3.3.0 (17-06-2022) +------------------ + +- Sandbox preprocessing, lint, and dialect rules by default. All these rules + now require precise dependency specifications (#5807, @rgrinberg) + +- Allow list expansion in the `pps` specification for preprocessing (#5820, + @Firobe) + +- Add warnings 67-69 to dune's default set of warnings. These are warnings of + the form "unused X.." (#5844, @rgrinbreg) + +- Introduce project "composition" for coq theories. Coq theories in separate + projects can now refer to each other when in the same workspace (#5784, + @Alizter, @rgrinberg) + +- Fix hint message for `data_only_dirs` that wrongly mentions the unknown + constructor `data_only` (#5803, @lambdaxdotx) + +- Fix creating sandbox directory trees by getting rid of buggy memoization + (@5794, @rgrinberg, @snowleopard) + +- Handle directory dependencies in sandboxed rules. Previously, the parents of + these directory dependencies weren't created. (#5754, @rgrinberg) + +- Set the exit code to 130 when dune is terminated with a signal (#5769, fixes + #5757) + +- Support new locations of unix, str, dynlink in OCaml >= 5.0 (#5582, @dra27) + +- The `coq.theory` stanza now produces rules for running `coqdoc`. Given a + theory named `mytheory`, the directory targets `mytheory.html/` and + `mytheory.tex/` or additionally the aliases `@doc` and `@doc-latex` will + build the HTML and LaTeX documentation respectively. (#5695, fixes #3760, + @Alizter) + +- Coq theories marked as `(boot)` cannot depend on other theories + (#5867, @ejgallego) + +- Ignore `bigarray` in `(libraries)` with OCaml >= 5.0. (#5526, fixes #5494, + @moyodiallo) + +- Start with :standard when building the ctypes generated foreign stubs so that + we include important compiler flags, such as -fPIC (#5816, fixes #5809). + +3.2.0 (17-05-2022) +------------------ + +- Fixed `dune describe workspace --with-deps` so that it correctly handles + Reason files, as well as files any other dialect. (#5701, @esope) + +- Disable alerts when compiling code in vendored directories (#5683, + @NathanReb) + +- Fixed `dune describe --with-deps`, that crashed when some preprocessing was + required in a dune file using `per_module`. (#5682, fixes #5680, @esope) + +- Add `$ dune describe pp` to print the preprocssed ast of sources. (#5615, + fixes #4470, @cannorin) + +- Report dune file evaluation errors concurrently. In the same way we report + build errors. (#5655, @rgrinberg) + +- Watch mode now default to clearing the terminal on rebuild (#5636, fixes, + #5216, @rgrinberg) + +- The output of jobs that finished but were cancelled is now omitted. (#5631, + fixes #5482, @rgrinberg) + +- Allows to configure all the default destination directories with `./configure` + (adds `bin`, `sbin`, `data`, `libexec`). Use `OPAM_SWITCH_PREFIX` instead of + calling the `opam` binaries in `dune install`. Fix handling of multiple + `libdir` in `./configure` for handling `/usr/lib/ocaml/` and + `/usr/local/lib/ocaml`. In `dune install` forbid relative directories in + `libdir`, `docdir` and others specific directory setting because their handling + was inconsistent (#5516, fixes #3978 and #5455, @bobot) + +- `--terminal-persistence=clear-on-rebuild` will no longer destroy scrollback + on some terminals (#5646, @rgrinberg) + +- Add a fmt command as a shortcut of `dune build @fmt --auto-promote` (#5574, + @tmattio) + +- Watch mode now tracks copied external files, external directories for + dependencies, dune files in OCaml syntax, files used by `include` stanzas, + dune-project, opam files, libraries builtin with compiler, and foreign + sources (#5627, #5645, #5652, #5656, #5672, #5691, #5722, fixes #5331, + @rgrinberg) + +- Improve metrics for cram tests. Include test names in the event and add a + category for cram tests (#5626, @rgrinberg) + +- Allow specifying multiple licenses in project file (#5579, fixes #5574, + @liyishuai) + +- Match `glob_files` only against files in external directories (#5614, fixes + #5540, @rgrinberg) + +- Add pid's to chrome trace output (#5617, @rgrinberg) + +- Fix race when creating local cache directory (#5613, fixes #5461, @rgrinberg) + +- Add `not` to boolean expressions (#5610, fix #5503, @rgrinberg) + +- Fix relative dependencies outside the workspace (#4035, fixes #5572, @bobot) + +- Allow to specify `--prefix` via the environment variable + `DUNE_INSTALL_PREFIX` (#5589, @vapourismo) + +- Dune-site.plugin: add support for `archive(native|byte, plugin)` used in the + wild before findlib documented `plugin(native|byte)` in 2015 (#5518, @bobot) + +- Fix a bug where Dune would not correctly interpret `META` files in alternative + layout (ie when the META file is named `META.$pkg`). The `Llvm` bindings were + affected by this issue. (#5619, fixes #5616, @nojb) + +- Support `(binaries)` in `(env)` in dune-workspace files (#5560, fix #5555, + @emillon) + +- (mdx) stanza: add support for (locks). (#5628, fixes #5489, @emillon) + +- (mdx) stanza: support including files in different directories using relative + paths, and provide better error messages when paths are invalid (#5703, #5704, + fixes #5596, @emillon) + +- Fix ctypes rules for external lib names which aren't valid ocaml names + (#5667, fixes #5511, @Khady) + +3.1.1 (19/04/2022) +------------------ + +- Fix build on Cygwin. (#5593, fixes 5577, @nojb) + +- Fix execution of `(system ..)` actions on Windows. (#5593, fixes #5523, + @nojb) + +3.1.0 (15/04/2022) +------------------ + +- Add `sourcehut` as an option for defining project sources in dune-project + files. For example, `(source (sourcehut user/repo))`. (#5564, @rgrinberg) + +- Add `dune coq top` command for running a Coq toplevel (#5457, @rlepigre) + +- Fix dune exec dumping database in wrong directory (#5544, @bobot) + +- Always output absolute paths for locations in RPC reported diagnostics + (#5539, @rgrinberg) + +- Add `(deps )` in ctype field (#5346, @bobot) + +- Add `(include )` constructor to dependency specifications. This can be + used to introduce dynamic dependencies (#5442, @anmonteiro) + +- Ensure that `dune describe` computes a transitively closed set of + libraries (#5395, @esope) + +- Add direct dependencies to $ dune describe output (#5412, @esope) + +- Show auto-detected concurrency on Windows too (#5502, @MisterDA) + +- Fix operations that remove folders with absolute path. This happens when + using esy (#5507, @EduardoRFS) + +- Dune will not fail if some directories are non-empty when uninstalling. + (#5543, fixes #5542, @nojb) + +- `coqdep` now depends only on the filesystem layout of the .v files, + and not on their contents (#5547, helps with #5100, @ejgallego) + +- The mdx stanza 0.2 can now be used with `(implicit_transitive_deps false)` + (#5558, fixes #5499, @emillon) + +- Fix missing parenthesis in printing of corresponding terminal command for + `(with-outputs-to )` (#5551, fixes #5546, @Alizter) + +3.0.3 (01/03/2022) +------------------ + +- Do not enable warnings 63-70 by default (#5476, fixes #5464, @rgrinberg) + +- Allow %{read-lines} to introduce dynamic dependencies like %{read}. (#5440, + @anmonteiro) + +- Look up `gmake` before `make` (#5474, fixes #5470, @rgrinberg) + +- Handle empty output from `getconf` (#5473 fixes #5471, @mndrix) + +- Depend on any provided `foreign_archives` for ctypes stub generation (#5475, + @mbacarella) + +3.0.2 (17/02/2022) +------------------ + +- Fix digest computation bug introduced in 3.0.1 (#5451, @rgrinberg) + +3.0.1 (17/02/2022) +------------------ + +- Fix compilation on MacOS SDK < 10.13. The native watch mode is disabled in + such instances (#5431 fix #5430, @rgrinberg) + +- Do no add workspace_root to `BUILD_PATH_PREFIX_MAP` for projects before 3.0 + (5448, @rgrinberg) + +- Fix performance regression in incremental builds (#5439, @snowleopard) + +3.0.0 (11/02/2022) +------------------ + +- Remove `uchar` and `seq` dummy ocamlfind libraries from dune's builtin + library database (#5260, @kit-ty-kate) + +- Add a `DUNE_DIFF_COMMAND` environment variable to match `--diff-command` + command-line parameter (@raphael-proust, fix #5369, #5375) + +- Add support for odoc-link rules (#5045, @jonludlam, @lubegasimon) + +- Dune will no longer generate documentation for hidden modules (#5045, + @jonludlam, @lubegasimon) + +- Parse the `native_pack_linker` field of `ocamlc -config` (#5281, @TheLortex) + +- Fix plugins with dot in the name (#5182, @bobot, review @rgrinberg) + +- Don't generate the dune-site build part when not needed (#4861, @bobot, + review @kit-ty-kate) + +- Fix installation of implementations of virtual libraries (#5150, fix #3636, + @rgrinberg) + +- Run tests in all modes defined. Previously, jsoo was excluded. (@hhugo, + #5049, fix #4951) + +- Allow to configure the alias to run the jsoo tests (@hhugo, #5049, #4999) + +- Set jsoo compilation flags in the `env` stanza (@hhugo, #5049, #1613) + +- Allow to configure jsoo separate compilation in the `env` stanza. Previously, + it was hard coded to always be enabled in the `dev` profile. (@hhugo, #5049, + fix #970) + +- Fix build-info version in jsoo executables (@hhugo, #5049, fix #4444) + +- Pass `-no-check-prims` when building bytecode for jsoo (@hhugo, #5049, #4027) + +- Fix jsoo builds when dynamically linked foreign archives are disabled + (@hhugo, #5049) + +- Disallow empty packages starting from 3.0. Empty packages may be + re-enabled by adding the `(allow_empty)` to the package stanza in + the dune-project file. (#4867, fix #2882, @kit-ty-kate, @rgrinberg) + +- Add `link_flags` field to the `executable` field of `inline_tests` (#5088, + fix #1530, @jvillard) + +- In watch mode, use fsevents instead of fswatch on OSX (#4937, #4990, fixes + #4896 @rgrinberg) + +- Remove `inotifywait` watch mode backend on Linux. We now use the inotify API + exclusively (#4941, @rgrinberg) + +- Report cycles between virtual libraries and their implementation (#5050, + fixes #2896, @rgrinberg) + +- Warn when lang versions have an ignored suffix. `(lang dune 2.3.4)` or `(lang + dune 2.3suffix)` were silently parsed as `2.3` and we know suggest to remove + the prefix. (#5040, @emillon) + +- Allow users to specify dynamic dependencies in rules. For example `(deps + %{read:foo.gen})` (#4662, fixes #4089, @jeremiedimino) + +- Sandbox infer rules for menhir. Fixes possible "inconsistent assumptions" + errors (#5015, @rgrinberg) + +- Experimental support for ctypes stubs (#3905, fixes #135, @mbacarella) + +- Fix interpretation of `binaries` defined in the `env stanza`. Binaries + defined in `x/dune` wouldn't be visible in `x/*/**/dune. (#4975, fixes #4976, + @Leonidas-from-XIV, @rgrinberg) + +- Do not list private libraries in package listings (#4945, fixes #4799, + @rgrinberg) + +- Allow spaces in cram test paths (#4980, fixes #4162, @rgrinberg) + +- Improve error handling of misbehaving cram scripts. (#4981, fix #4230, + @rgrinberg) + +- Fix `foreign_stubs` inside a `tests` stanza. Previously, dune would crash + when this field was present (#4942, fix #4946, @rgrinberg) + +- Add the `enabled_if` field to `inline_tests` within the `library` stanza. + This allows us to disable executing the inline tests while still allowing for + compilation (#4939, @rgrinberg) + +- Generate a `dune-project` when initializing projects with `dune init proj ...` + (#4881, closes #4367, @shonfeder) + +- Allow spaces in the directory argument of the `subdir` stanza (#4943, fixes + #4907, @rgrinberg) + +- Add a `%{toolchain}` expansion variable (#4899, fixes #3949, @rgrinberg) + +- Include dependencies of executables when creating toplevels (either `dune + top` or `dune utop`) (#4882, fixes #4872, @Gopiancode) + +- Fixes `opam` META file requires entry for private libs (#4841, fixes #4839, @toots) + +- Fixes `dune exec` not adding .exe on Windows (#4371, fixes #3322, @MisterDA) + +- Allow multiple cinaps stanzas in the same directory (#4460, @rgrinberg) + +- Fix `$ dune subst` in empty git repositories (#4441, fixes #3619, @rgrinberg) + +- Improve interpretation of ansi escape sequence when spawning processes (#4408, + fixes #2665, @rgrinberg) + +- Allow `(package pkg)` in dependencies even if `pkg` is an installed package + (#4170, @bobot) + +- Allow `%{version:pkg}` to work for external packages (#4104, @kit-ty-kate) + +- Add `(glob_files_rec /)` for globbing files recursively (#4176, + @jeremiedimino) + +- Automatically generate empty `.mli` files for executables and tests (#3768, + fixes #3745, @CraigFe) + +- Add `ocaml` command subgroup for OCaml related commands such as `utop`, `top`, + and `merlin` (#3936, @rgrinberg). + +- Detect unknown variables more eagerly (#4184, @jeremiedimino) + +- Improve location of variables and macros in error messages (#4205, + @jeremiedimino) + +- Auto-detect `dune-project` files as `dune` files in Emacs (#4222, @shonfeder) + +- Dune no longer automatically create or edit `dune-project` files + (#4239, fixes #4108, @jeremiedimino) + +- Warn if `dune-project` is not found (fatal in release mode) (#5343, @emillon) + +- Cleanup temporary files after running `$ dune exec`. (#4260, fixes #4243, + @rgrinberg) + +- Add a new subcommand `dune ocaml dump-dot-merlin` that prints a mix of all the + merlin configuration of a directory (defaulting to the current directory) in + the Merlin configuration syntax. (#4250, @voodoos) + +- Enable cram tests by default (#4262, @rgrinberg) + +- Drop support for opam 1.x (#4280, @jeremiedimino) + +- Stop calling `ocamlfind` to determine the library search path or + library installation directory. This makes the behavior of Dune + simpler and more reproducible (#4281, @jeremiedimino) + +- Remove the `external-lib-deps` command. This command was only + approximative and the cost of maintenance was getting too high. We + removed it to make room for new more important features (#4298, + @jeremiedimino) + +- It is now possible to define action dependencies through a chain + of aliases. (#4303, @aalekseyev) + +- If an .ml file is not used by an executable, Dune no longer report + parsing error in this file (#4330, @jeremiedimino) + +- Add support for sandboxing using hard links (#4360, Andrey Mokhov) + +- Fix dune crash when `subdir` is an absolute path (#4366, @anmonteiro) + +- Changed the implementation of actions attached to aliases, as in + `(rule (alias runtest) (action (run ./test)))`. A visible result for + users is that such actions are now memoized for longer. For + instance: + ``` + $ echo '(rule (alias runtest) (action (echo "X=%{env:X=0}\n")))` > dune + $ X=1 dune runtest + X=1 + $ X=2 dune runtest + X=2 + $ X=1 dune runtest + ``` + Previously, Dune would have re-executed the action again at the last + line. Now it remembers the result of the first execution. + +- Fix a bug where dune would always re-run all actions that produce symlinks, + even if their dependencies did not change. (#4405, @aalekseyev) + +- Fix a bug that was causing Dune to re-hash generated files more + often than necessary (#4419, @jeremiedimino) + +- Fields allowed in the config file are now also allowed in the + workspace file (#4426, @jeremiedimino) + +- Add CLI flags `--action--on-success ...` (where `` is + `stdout` or `stderr`) to control how Dune should handle `stdout` and `stderr` of + actions when they succeed. It is now possible to ask Dune to ignore the `stdout` + of actions when they succeed or to request that the `stderr` of actions must be + empty. It is also possible to set these options in the `config` and/or + `dune-workspace` files with `(action__on_success ...)`. This feature + allows you to reduce the noise of large builds (#4422, #4515, @jeremiedimino) + +- The `@all` alias no longer depends directly on copies of files from the source + directory (#4461, @nojb) + +- Allow dune-file as an alternative file name for dune files (needs to be + enabled in the dune-project file) (#4428, @nojb) + +- Drop support for upgrading jbuilder projects (#4473, @jeremiedimino) + +- Extend the environment variable `BUILD_PATH_PREFIX_MAP` to rewrite + the root of the build dir (or sandbox) to `/workspace_root` (#4466, + @jeremiedimino) + +- Simplify the implementation of build cache. We stop using the cache daemon to + access the cache and instead write to and read from it directly. The new cache + implementation is based on Jenga's cache library, which was thoroughly tested + on large-scale builds. Using Jenga's cache library will also make it easier + for us to port Jenga's cloud cache to Dune. (#4443, #4465, Andrey Mokhov) + +- More informative error message when Dune can't read a target that's supposed + to be produced by the action. Old message is still produced on ENOENT, but other + errors deserve a more detailed report. (#4501, @aalekseyev) + +- Fixed a bug where a sandboxed action would fail if it declares no dependencies in + its initial working directory or any directory it `chdir`s into. (#4509, @aalekseyev) + +- Fix a crash when clearing temporary directories (#4489, #4529, Andrey Mokhov) + +- Dune now memoizes all errors when running in the file-watching mode. This + speeds up incremental rebuilds but may be inconvenient in rare cases, e.g. if + a build action fails due to a spurious error, such as running out of memory. + Right now, the only way to force such actions to be rebuilt is to restart + Dune, which clears all memoized errors. In future, we would like to provide a + way to rerun all actions failed due to errors without restarting the build, + e.g. via a Dune RPC call. (#4522, Andrey Mokhov) + +- Remove `dune compute`. It was broken and unused (#4540, + @jeremiedimino) + +- No longer generate an approximate merlin files when computing the + ocaml flags fails, for instance because they include the contents of + a file that failed to build. This was a niche feature and it was + getting in the way of making Dune's core better. (#4607, @jeremiedimino) + +- Make Dune display the progress indicator in all output modes except quiet + (#4618, @aalekseyev) + +- Report accurate process timing information in trace mode (enabled with + `--trace-file`) (#4517, @rgrinberg) + +- Do not log `live_words` and `free_words` in trace file. This allows using + `Gc.quick_stat` which does not scan the heap. (#4643, @emillon) + +- Don't let command run by Dune observe the environment variable + `INSIDE_EMACS` in order to improve reproducibility (#4680, + @jeremiedimino) + +- Fix `root_module` when used in public libraries (#4685, fixes #4684, + @rgrinberg, @CraigFe) + +- Fix `root_module` when used with preprocessing (#4683, fixes #4682, + @rgrinberg, @CraigFe) + +- Display Coq profile flags in `dune printenv` (#4767, @ejgallego) + +- Introduce mdx stanza 0.2, requiring mdx >= 1.9.0, with a new generic `deps` + field and the possibility to statically link `libraries` in the test + executable. (#3956, #5391, fixes #3955) + +- Improve lookup of optional or disabled binaries. Previously, we'd treat every + executable with missing libraries as optional. Now, we treat make sure to + look at the library's optional or enabled_if status (#4786). + +- Always use 7 char hash prefix in build info version (#4857, @jberdine, fixes + #4855) + +- Allow to explicitly disable/enable the use of `dune subst` by adding a + new `(subst )` stanza to the `dune-project` file. + (#4864, @kit-ty-kate) + +- Simplify the way `dune` discovers the root of the workspace. It now + stops at the first `dune-workspace` file it encounters, and fails if + it finds neither a `dune-workspace` nor a `dune-project` file + (#4921, fixes #4459, @jeremiedimino) + +- Dune no longer reads installed META files for libraries distributed with the + compiler, instead using its own internal database. (#4946, @nojb) + +- Add support for `(empty_module_interface_if_absent)` in executable and library + stanzas. (#4955, @nojb) + +- Add support for `%{bin-available:...}` (#4995, @jeremiedimino) + +- Make sure running `git` or `hg` in a sandboxed action, such as a + cram test cannot escape the sandbox and pick up some random git or + mercurial repository on the file system (#4996, @jeremiedimino) + +- Allow `%{read:...}` in more places such as `(enabled_if ...)` + (#4994, @jeremiedimino) + +- Run each action in its own process group so that we don't leave + stray processes behind when killing actions (#4998, @jeremiedimino) + +- Add an option `expand_aliases_in_sandbox` (#5003, @jeremiedimino) + +- Allow to cancel the initial scan via Control+C (#4460, fixes #4364 + @jeremiedimino) + +- Add experimental support for directory targets (#3316, #5025, Andrey Mokhov), + enabled via `(using directory-targets 0.1)` in `dune-project`. + +- Delete old `promote-into`, `promote-until-clean` and `promote-until-clean-into` + syntax (#5091, Andrey Mokhov). + +- Add link_flags in the env stanza (#5215) + +- Bootstrap: ignore errors when trying to remove generated files. (#5407, + @damiendoligez) + +2.9.4 (unreleased) +------------------ + +- Do not generate META information for `bigarray` library in OCaml >= 5.0 + (#5421, @nojb) + +- Support new locations of unix, str, dynlink in OCaml >= 5.0 + (#5582, @dra27) + +2.9.3 (26/01/2022) +------------------ + +- Disable warning for deprecated Toploop functions used in dune files written in + OCaml syntax. Restores 4.02 compatibility. (#5381, @nojb) + +2.9.2 (23/01/2022) +------------------ + +- Fix missing -linkall flag when linking library dune-sites.plugin + ( #4348, @kakadu, @bobot, reported by @kakadu) + +- No longer reference deprecated Toploop functions when using dune files in + OCaml syntax. (#4834, fixes #4830, @nojb) + +- Use the stag format API to be compatible with OCaml 5.0 (#5351, @emillon). + +- Fix post-processing of dune-package (fix #4389, @strub) + +2.9.1 (07/09/2021) +------------------ + +- Don't use `subst --root` in Opam files (#4806, @MisterDA) + +- Fix compilation on Haiku (#4885, @Sylvain78) + +- Allow depending on `ocamldoc` library when `ocamlfind` is not installed. + (#4811, fixes #4809, @nojb) + +- Fix `(enabled_if ...)` for installed libraries (#4824, fixes #4821, @dra27) + +- Create more future-proof opam files using `--promote-install-files=false` + (#4860, @bobot) + +2.9.0 (29/06/2021) +------------------ + +- Add `(enabled_if ...)` to `(mdx ...)` (#4434, @emillon) + +- Add support for instrumentation dependencies (#4210, fixes #3983, @nojb) + +- Add the possibility to use `locks` with the cram tests stanza (#4397, @voodoos) + +- Allow to set up merlin in a variant of the default context + (#4145, @TheLortex, @voodoos) + +- Add `(package ...)` to `(mdx ...)` (#4691, fixes #3756, @emillon) + +- Handle renaming of `coq.kernel` library to `coq-core.kernel` in Coq 8.14 (#4713, @proux01) + +- Fix generation of merlin configuration when using `(include_subdirs + unqualified)` on Windows (#4745, @nojb) + +- Fix bug for the install of Coq native files when using `(include_subdirs qualified)` + (#4753, @ejgallego) + +- Allow users to specify install target directories for `doc` and + `etc` sections. We add new options `--docdir` and `--etcdir` to both + Dune's configure and `dune install` command. (#4744, fixes #4723, + @ejgallego, thanks to @JasonGross for reporting this issue) + +- Fix issue where Dune would ignore `(env ... (coq (flags ...)))` + declarations appearing in `dune` files (#4749, fixes #4566, @ejgallego @rgrinberg) + +- Disable some warnings on Coq 8.14 and `(lang coq (>= 0.3))` due to + the rework of the Coq "native" compilation system (#4760, @ejgallego) + +- Fix a bug where instrumentation flags would be added even if the + instrumentation was disabled (@nojb, #4770) + +- Fix #4682: option `-p` takes now precedence on environment variable + `DUNE_PROFILE` (#4730, #4774, @bobot, reported by @dra27 #4632) + +- Fix installation with opam of package with dune sites. The `.install` file is + now produced by a local `dune install` during the build phase (#4730, #4645, + @bobot, reported by @kit-ty-kate #4198) + +- Fix multiple issues in the sites feature (#4730, #4645 @bobot, reported by @Lelio-Brun + #4219, by @Kakadu #4325, by @toots #4415) + +2.8.5 (28/03/2021) +------------------ + +- Fixed absence of executable bit for installed `.cmxs` (#4149, fixes #4148, @bobot) + +- Fix a race in Dune cache. It was particularly easy to hit this race when using + the cache on Windows (#4406, fixes #4167, @snowleopard) + +2.8.4 (08/03/2021) +------------------ + +- Fix crash when META file for `compiler-libs.toplevel` is present + (@jeremiedimino, #4249) + +2.8.3 (07/03/2021) +------------------ + +- Make `patdiff` show refined diffs (#4257, fixes #4254, @hakuch) + +- Fixed a bug that could result in needless recompilation under Windows due to + case differences in the result of `Sys.getcwd` (observed under `emacs`). + (#3966, @nojb). + +- Restore compatibility with Coq < 8.10 for coq-lang < 0.3 , document + that `(using coq 0.3)` does require Coq 8.10 at least (#4224, fixes + #4142, @ejgallego) + +- Add a META rule for `compiler-libs.native-toplevel` (#4175, @altgr) + +- No longer call `chmod` on symbolic links (fixes #4195, @dannywillems) + +- Have `dune` communicate the location of the standard library directory to + `merlin` (#4211, fixes #4188, @nojb) + +- Workaround incorrect exception raised by `Unix.utimes` (OCaml PR#8857) in + `Path.touch` on Windows. This fixes dune cache in direct mode on Windows. + (#4223, @dra27) + +- `dune ocaml-merlin` is now able to provide configuration for source files in + the `_build` directory. (#4274, @voodoos) + +- Automatically delete left-over Merlin files when rebuilding for the first time + a project previously built with Dune `<= 2.7`. (#4261, @voodoos, @aalekseyev) + +- Fix `ppx.exe` being compiled for the wrong target when cross-compiling + (#3751, fixes #3698, @toots) + +- `dune top` correctly escapes the generated toplevel directives, and make it + easier for `dune top` to locate C stubs associated to concerned libraries. + (#4242, fixes #4231, @nojb) + +- Do not pass include directories containing native objects when compiling + bytecode (#4200, @nojb) + +2.8.2 (21/01/2021) +------------------ + +- Fixed wrong workspace discovery from `dune ocaml-merlin` (#4127, fixes #4125, + @voodoos) + +- Fixed memory blow up introduced in 2.8.0 (#4144, fixes #4134, + @jeremiedimino) + +- Configurator: always link the C libraries in the build command + (#4088, @MisterDA). + +2.8.1 (14/01/2021) +------------------ + +- Fixed `dune --version` printing `n/a` rather than the version + +2.8.0 (13/01/2021) +------------------ + +- `dune rules` accepts aliases and other non-path rules (#4063, @mrmr1993) + +- Action `(diff reference test_result)` now accept `reference` to be absent and + in that case consider that the reference is empty. Then running `dune promote` + will create the reference file. (#3795, @bobot) + +- Ignore special files (BLK, CHR, FIFO, SOCKET), (#3570, fixes #3124, #3546, + @ejgallego) + +- Experimental: Simplify loading of additional files (data or code) at runtime + in programs by introducing specific installation sites. In particular it allow + to define plugins to be installed in these sites. (#3104, #3794, fixes #1185, + @bobot) + +- Move all temporary files created by dune to run actions to a single directory + and make sure that actions executed by dune also use this directory by setting + `TMPDIR` (or `TEMP` on Windows). (#3691, fixes #3422, @rgrinberg) + +- Fix bootstrap script with custom configuration. (#3757, fixes #3774, @marsam) + +- Add the `executable` field to `inline_tests` to customize the compilation + flags of the test runner executable (#3747, fixes #3679, @lubegasimon) + +- Add `(enabled_if ...)` to `(copy_files ...)` (#3765, @nojb) + +- Make sure Dune cleans up the status line before exiting (#3767, + fixes #3737, @alan-j-hu) + +- Add `{gitlab,bitbucket}` as options for defining project sources with `source` + stanza `(source ( user/repo))` in the `dune-project` file. (#3813, + @rgrinberg) + +- Fix generation of `META` and `dune-package` files when some targets (byte, + native, dynlink) are disabled. Previously, dune would generate all archives + for regardless of settings. (#3829, #4041, @rgrinberg) + +- Do not run ocamldep to for single module executables & libraries. The + dependency graph for such artifacts is trivial (#3847, @rgrinberg) + +- Fix cram tests inside vendored directories not being interpreted correctly. + (#3860, fixes #3843, @rgrinberg) + +- Add `package` field to private libraries. This allows such libraries to be + installed and to be usable by other public libraries in the same project + (#3655, fixes #1017, @rgrinberg) + +- Fix the `%{make}` variable on Windows by only checking for a `gmake` binary + on UNIX-like systems as a unrelated `gmake` binary might exist on Windows. + (#3853, @kit-ty-kate) + +- Fix `$ dune install` modifying the build directory. This made the build + directory unusable when `$ sudo dune install` modified permissions. (fix + #3857, @rgrinberg) + +- Fix handling of aliases given on the command line (using the `@` and `@@` + syntax) so as to correctly handle relative paths. (#3874, fixes #3850, @nojb) + +- Allow link time code generation to be used in preprocessing executable. This + makes it possible to use the build info module inside the preprocessor. + (#3848, fix #3848, @rgrinberg) + +- Correctly call `git ls-tree` so unicode files are not quoted, this fixes + problems with `dune subst` in the presence of unicode files. Fixes #3219 + (#3879, @ejgallego) + +- `dune subst` now accepts common command-line arguments such as + `--debug-backtraces` (#3878, @ejgallego) + +- `dune describe` now also includes information about executables in addition to + that of libraries. (#3892, #3895, @nojb) + +- instrumentation backends can now receive arguments via `(instrumentation + (backend ))`. (#3906, #3932, @nojb) + +- Tweak auto-formatting of `dune` files to improve readability. (#3928, @nojb) + +- Add a switch argument to opam when context is not default. (#3951, @tmattio) + +- Avoid pager when running `$ git diff` (#3912, @AltGr) + +- Add `(root_module ..)` field to libraries & executables. This makes it + possible to use library dependencies shadowed by local modules (#3825, + @rgrinberg) + +- Allow `(formatting ...)` field in `(env ...)` stanza to set per-directory + formatting specification. (#3942, @nojb) + +- [coq] In `coq.theory`, `:standard` for the `flags` field now uses the + flags set in `env` profile flags (#3931 , @ejgallego @rgrinberg) + +- [coq] Add `-q` flag to `:standard` `coqc` flags , fixes #3924, (#3931 , @ejgallego) + +- Add support for Coq's native compute compilation mode (@ejgallego, #3210) + +- Add a `SUFFIX` directive in `.merlin` files for each dialect with no + preprocessing, to let merlin know of additional file extensions (#3977, + @vouillon) + +- Stop promoting `.merlin` files. Write per-stanza Merlin configurations in + binary form. Add a new subcommand `dune ocaml-merlin` that Merlin can use to + query the configuration files. The `allow_approximate_merlin` option is now + useless and deprecated. Dune now conflicts with `merlin < 3.4.0` and + `ocaml-lsp-server < 1.3.0` (#3554, @voodoos) + +- Configurator: fix a bug introduced in 2.6.0 where the configurator V1 API + doesn't work at all when used outside of dune. (#4046, @aalekseyev) + +- Fix `libexec` and `libexec-private` variables. In cross-compilation settings, + they now point to the file in the host context. (#4058, fixes #4057, + @TheLortex) + +- When running `$ dune subst`, use project metadata as a fallback when package + metadata is missing. We also generate a warning when `(name ..)` is missing in + `dune-project` files to avoid failures in production builds. + +- Remove support for passing `-nodynlink` for executables. It was bypassed in + most cases and not correct in other cases in particular on arm32. + (#4085, fixes #4069, fixes #2527, @emillon) + +- Generate archive rules compatible with 4.12. Dune no longer attempts to + generate an archive file if it's unnecessary (#3973, fixes #3766, @rgrinberg) + +- Fix generated Merlin configurations when multiple preprocessors are defined + for different modules in the same folder. (#4092, fixes #2596, #1212 and + #3409, @voodoos) + +- Add the option `use_standard_c_and_cxx_flags` to `dune-project` that 1. + disables the unconditional use of the `ocamlc_cflags` and `ocamlc_cppflags` + from `ocamlc -config` in C compiler calls, these flags will be present in the + `:standard` set instead; and 2. enables the detection of the C compiler family + and populates the `:standard` set of flags with common default values when + building CXX stubs. (#3875, #3802, fix #3718 and #3528, @voodoos) + +2.7.1 (2/09/2020) +----------------- + +- configurator: More flexible probing of `#define`. We allow duplicate values in + the object file, as long as they are the same after parsing. (#3739, fixes + #3736, @rgrinberg) + +- Record instrumentation backends in dune-package files. This makes it possible + to use instrumentation backends defined in installed libraries (eg via OPAM). + (#3735, @nojb) + +- Add missing `.aux` & `.glob` targets to coq rules (#3721, fixes #3437, + @rgrinberg) + +- Fix `dune-package` installation when META templates are present (#3743, fixes + #3746, @rgrinberg) + +- Resolve symlinks before running `$ git diff` (#3750, fixes #3740, @rgrinberg) + +- Cram tests: when checking that all test directories contain a `run.t` file, + skip empty directories. These can be left around by git. (#3753, @emillon) + +2.7.0 (13/08/2020) +------------------ + +- Write intermediate files in a `.mdx` folder for each `mdx` stanza + to prevent the corresponding actions to be executed as part of the `@all` + alias (#3659, @NathanReb) + +- Read Coq flags from `env` (#3547 , fixes #3486, @gares) + +- Add instrumentation framework to toggle instrumentation by `bisect_ppx`, + `landmarks`, etc, via dune-workspace and/or the command-line. (#3404, #3526 + @stephanieyou, @nojb) + +- Formatting of dune files is now done in the executing dune process instead of + in a separate process. (#3536, @nojb) + +- Add a `--debug-artifact-substitution` flag to help debug problem with + version not being captured by `dune-build-info` (#3589, + @jeremiedimino) + +- Allow the use of the `context_name` variable in the `enabled_if` fields of + executable(s) and install stanzas. (#3568, fixes #3566, @voodoos) + +- Fix compatibility with OCaml 4.12.0 when compiling empty archives; no .a file + is generated. (#3576, @dra27) + +- `$ dune utop` no longer tries to load optional libraries that are unavailable + (#3612, fixes #3188, @anuragsoni) + +- Fix dune-build-info on 4.10.0+flambda (#3599, @emillon, @jeremiedimino). + +- Allow multiple libraries with `inline_tests` to be defined in the same + directory (#3621, @rgrinberg) + +- Run exit hooks in jsoo separate compilation mode (#3626, fixes #3622, + @rgrinberg) + +- Add (alias ...), (mode ...) fields to (copy_fields ...) stanza (#3631, @nojb) + +- (copy_files ...) now supports copying files from outside the workspace using + absolute file names (#3639, @nojb) + +- Dune does not use `ocamlc` as an intermediary to call C compiler anymore. + Configuration flags `ocamlc_cflags` and `ocamlc_cppflags` are always prepended + to the compiler arguments. (#3565, fixes #3346, @voodoos) + +- Revert the build optimization in #2268. This optimization slows down building + individual executables when they're part of an `executables` stanza group + (#3644, @rgrinberg) + +- Use `{dev}` rather than `{pinned}` in the generated `.opam` file. (#3647, + @kit-ty-kate) + +- Insert correct extension name when editing `dune-project` files. Previously, + dune would just insert the stanza name. (#3649, fixes #3624, @rgrinberg) + +- Fix crash when evaluating an `mdx` stanza that depends on unavailable + packages. (#3650, @CraigFe) + +- Fix typo in `cache-check-probablity` field in dune config files. This field + now requires 2.7 as it wasn't usable before this version. (#3652, @edwintorok) + +- Add `"odoc" {with-doc}` to the dependencies in the generated `.opam` files. + (#3667, @kit-ty-kate) + +- Do not allow user actions to capture dune's stdin (#3677, fixes #3672, + @rgrinberg) + +- `(subdir ...)` stanzas can now appear in dune files used via `(include ...)`. + (#3676, @nojb) + +- Add actions `pipe-{stdout,stderr,outputs}` for output redirections (#3392, + fixes #428, @NathanReb) + +2.6.2 (26/07/2020) +------------------ + +* Fix compatibility with OCaml 4.12 (#3585, fixes #3583, @ejgallego) + +2.6.1 (02/07/2020) +------------------ + +- Fix crash when caching is enabled (@rgrinberg, #3581, fixes #3580) + +- Do not use `-output-complete-exe` until 4.10.1 as it is broken in + 4.10.0 (@jeremiedimino, #3187) + +- Fix crash when an unknown pform is found (such as `%{unknown}`) (#3560, + @emillon) + +- Improve error message when invalid package names (such as the empty string) + are passed to `dune build -p`. (#3561, @emillon) + +- Fix a stack overflow when displaying large outputs (including diffs) (#3537, + fixes #2767, #3490, @emillon) + +- Pass `-g` when compiling ppx preprocessors (#3671, @rgrinberg) + +2.6.0 (05/06/2020) +------------------ + +- Fix a bug where valid lib names in `dune init exec --libs=lib1,lib2` + results in an error. (#3444, fix #3443, @bikallem) + +- Add and `enabled_ if` field to the `install` stanza. Enforce the same variable + restrictions for `enabled_if` fields in the `executable` and `install` stanzas + than in the `library` stanza. When using dune lang < 2.6, the usage of + forbidden variables in executables stanzas with only trigger a warning to + maintain compatibility. (#3408 and #3496, fixes #3354, @voodoos) + +- Insert a constraint one the version of dune when the user explicitly + specify the dependency on dune in the `dune-project` file (#3434 , + fixes #3427, @diml) + +- Generate correct META files for sub-libraries (of the form `lib.foo`) that + contain .js runtime files. (#3445, @hhugo) + +- Add a `(no-infer ...)` action that prevents inference of targets and + dependencies in actions. (#3456, fixes #2006, @roddyyaga) + +- Correctly infer targets for the `diff?` action. (#3457, fixes #2990, @greedy) + +- Fix `$ dune print-rules` crashing (#3459, fixes #3440, @rgrinberg) + +- Simplify js_of_ocaml rules using js_of_ocaml.3.6 (#3375, @hhugo) + +- Add a new `ocaml-merlin` subcommand that can be used by Merlin to get + configuration directly from dune instead of using `.merlin` files. (#3395, + @voodoos) + +- Remove experimental variants feature and make default implementations part of + the language (#3491, fixes #3483, @rgrinberg) + +2.5.1 (17/04/2020) +------------------ + +- [coq] Fix install .v files for Coq theories (#3384, @lthms) + +- [coq] Fix install path for theory names with level greater than 1 (#3358, + @ejgallego) + +- Fix a bug introduced in 2.0.0 where the [locks] field in rules with no targets + had no effect. (@aalekseyev, report by @craigfe) + +2.5.0 (09/04/2020) +------------------ + +- Add a `--release` option meaning the same as `-p` but without the + package filtering. This is useful for custom `dune` invocation in opam + files where we don't want `-p` (#3260, @diml) + +- Fix a bug introduced in 2.4.0 causing `.bc` programs to be built + with `-custom` by default (#3269, fixes #3262, @diml) + +- Allow contexts to be defined with local switches in workspace files (#3265, + fix #3264, @rgrinberg) + +- Delay expansion errors until the rule is used to build something (#3261, fix + #3252, @rgrinberg, @diml) + +- [coq] Support for theory dependencies and compositional builds using + new field `(theories ...)` (#2053, @ejgallego, @rgrinberg) + +- From now on, each version of a syntax extension must be explicitly tied to a + minimum version of the dune language. Inconsistent versions in a + `dune-project` will trigger a warning for version <=2.4 and an error for + versions >2.4 of the dune language. (#3270, fixes #2957, @voodoos) + +- [coq] Bump coq lang version to 0.2. New coq features presented this release + require this version of the coq lang. (#3283, @ejgallego) + +- Prevent installation of public executables disabled using the `enabled_if` field. + Installation will now simply skip such executables instead of raising an + error. (#3195, @voodoos) + +- `dune upgrade` will now try to upgrade projects using versions <2.0 to version + 2.0 of the dune language. (#3174, @voodoos) + +- Add a `top` command to integrate dune with any toplevel, not just + utop. It is meant to be used with the new `#use_output` directive of + OCaml 4.11 (#2952, @mbernat, @diml) + +- Allow per-package `version` in generated `opam` files (#3287, @toots) + +- [coq] Introduce the `coq.extraction` stanza. It can be used to extract OCaml + sources (#3299, fixes #2178, @rgrinberg) + +- Load ppx rewriters in dune utop and add pps field to toplevel stanza. Ppx + extensions will now be usable in the toplevel + (#3266, fixes #346, @stephanieyou) + +- Add a `(subdir ..)` stanza to allow evaluating stanzas in sub directories. + (#3268, @rgrinberg) + +- Fix a bug preventing one from running inline tests in multiple modes + (#3352, @diml) + +- Allow the use of the `%{profile}` variable in the `enabled_if` field of the + library stanza. (#3344, @mrmr1993) + +- Allow the use of `%{ocaml_version}` variable in `enabled_if` field of the + library stanza. (#3339, @voodoos) + +- Fix dune build freezing on MacOS when cache is enabled. (#3249, fixes ##2973, + @artempyanykh) + +2.4.0 (06/03/2020) +------------------ + +- Add `mdx` extension and stanza version 0.1 (#3094, @NathanReb) + +- Allow to make Odoc warnings fatal. This is configured from the `(env ...)` + stanza. (#3029, @Julow) + +- Fix separate compilation of JS when findlib is not installed. (#3177, @nojb) + +- Add a `dune describe` command to obtain the topology of a dune workspace, for + projects such as ROTOR. (#3128, @diml) + +- Add `plugin` linking mode for executables and the `(embed_in_plugin_libraries + ...)` field. (#3141, @nojb) + +- Add an `%{ext_plugin}` variable (#3141, @nojb) + +- Dune will no longer build shared objects for stubs if + `supports_shared_libraries` is false (#3225, fixes #3222, @rgrinberg) + +- Fix a memory leak in the file-watching mode (`dune build -w`) + (#3220, @snowleopard and @aalekseyev) + +- Starting from `(lang dune 2.4)`, dune systematically puts all files + under `_build` in read-only mode instead of only doing it when the + shared cache is enabled (#3092, @mefyl) + +2.3.1 (20/02/2020) +------------------ + +- Fix versioning of artifact variables (eg %{cmxa:...}), which were introduced + in 2.0, not 1.11. (#3149, @nojb) + +- Fix a bug introduced in 2.3.0 where dune insists on using `fswatch` on linux + (even when `inotifywait` is available). (#3162, @aalekseyev) + +- Fix a bug causing all executables to be considered as optional (#3163, @diml) + +2.3.0 (15/02/2020) +------------------ + +- Improve validation and error handling of arguments to `dune init` (#3103, fixes + #3046, @shonfeder) + +- `dune init exec NAME` now uses the `NAME` argument for private modules (#3103, + fixes #3088, @shonfeder) + +- Avoid linear walk to detect children, this should greatly improve + performance when a target has a large number of dependencies (#2959, + @ejgallego, @aalekseyev, @Armael) + +- [coq] Add `(boot)` option to `(coq.theories)` to enable bootstrap of + Coq's stdlib (#3096, @ejgallego) + +- [coq] Deprecate `public_name` field in favour of `package` (#2087, @ejgallego) + +- Better error reporting for "data only" and "vendored" dirs. Using these with + anything else than a strict subdirectory or `*` will raise an error. The + previous behavior was to just do nothing (#3056, fixes #3019, @voodoos) + +- Fix bootstrap on bytecode only switches on windows or where `-j1` is set. + (#3112, @xclerc, @rgrinberg) + +- Allow `enabled_if` fields in `executable(s)` stanzas (#3137, fixes #1690 + @voodoos) + +- Do not fail if `ocamldep`, `ocamlmklib`, or `ocaml` are absent. Wait for them + to be used to fail (#3138, @rgrinberg) + +- Introduce a `strict_package_deps` mode that verifies that dependencies between + packages in the workspace are specified correctly. (@rgrinberg, #3117) + +- Make sure the `@all` alias is defined when no `dune` file is present + in a directory (#2946, fix #2927, @diml) + +2.2.0 (06/02/2020) +------------------ + +- `dune test` is now a command alias for `dune runtest`. This is to make the CLI + less idiosyncratic (#3006, @shonfeder) + +- Allow to set menhir flags in the `env` stanza using the `menhir_flags` field. + (#2960, fix #2924, @bschommer) + +- By default, do not show the full command line of commands executed + by `dune` when `dune` is executed inside `dune`. This is to make + integration tests more reproducible (#3042, @diml) + +- `dune subst` now works even without opam files (#2955, fixes #2910, + @fangyi-zhou and @diml) + +- Hint when trying to execute an executable defined in the current directory + without using the `./` prefix (#3041, fixes #1094, @voodoos). + +- Extend the list of modifiers that can be nested under + `with-accepted-exit-codes` with `chdir`, `setenv`, `ignore-`, + `with-stdin-from` and `with--to` (#3027, fixes #3014, @voodoos) + +- It is now an error to have a preprocessing dependency on a ppx rewriter + library that is not marked as `(kind ppx_rewriter)` (#3039, @snowleopard). + +- Fix permissions of files promoted to the source tree when using the + shared cache. In particular, make them writable by the user (#3043, + fixes #3026, @diml) + +- Only detect internal OCaml tools with `.opt` extensions. Previously, this + detection applied to other binaries as well (@kit-ty-kate, @rgrinberg, #3051). + +- Give the user a proper error message when they try to promote into a source + directory that doesn't exist. (#3073, fix #3069, @rgrinberg) + +- Correctly build vendored packages in `-p` mode. These packages were + incorrectly filtered out before. (#3075, @diml) + +- Do not install vendored packages (#3074, @diml) + +- `make` now prints a message explaining the main targets available + (#3085, fix #3078, @diml) + +- Add a `byte_complete` executable mode to build programs as + self-contained bytecode programs + (#3076, fixes #1519, @diml) + +2.1.3 (16/01/2020) +------------------ + +- Fix building the OCaml compiler with Dune (#3038, fixes #2974, + @diml) + +2.1.2 (08/01/2020) +------------------ + +- Fix a bug in the `Fiber.finalize` function of the concurrency monad of Dune, + causing a race condition at the user level (#3009, fix #2958, @diml) + +2.1.1 (07/01/2020) +------------------ + +- Guess foreign archives & native archives for libraries defined using the + `META` format. (#2994, @rgrinberg, @anmonteiro) + +- Fix generation of `.merlin` files when depending on local libraries with more + than one source directory. (#2983, @rgrinberg) + +2.1.0 (21/12/2019) +------------------ + +- Attach cinaps stanza actions to both `@runtest` and `@cinaps` aliases + (#2831, @NathanReb) + +- Add variables `%{lib-private...}` and `%{libexec-private...}` for finding + build paths of files in public and private libraries within the same + project. (#2901, @snowleopard) + +- Add `--mandir` option to `$ dune install`. This option allows to override the + installation directory for man pages. (#2915, fixes #2670, @rgrinberg) + +- Fix `dune --version`. The bootstrap didn't compute the version + correctly. (#2929, fixes #2911, @diml) + +- Do not open the log file in `dune clean`. (#2965, fixes #2964 and + #2921, @diml) + +- Support passing two arguments to `=`, `<>`, ... operators in package + dependencies so that we can have things such as `(<> :os win32)` + (#2965, @diml) + +2.0.1 (17/12/2019) +------------------ + +- Delay errors raised by invalid `dune-package` files. The error is now raised + only if the invalid package is treated as a library and used to build + something. (#2972, @rgrinberg) + +2.0.0 (20/11/2019) +------------------ + +- Remove existing destination files in `install` before installing the new + ones. (#2885, fixes #2883, @bschommer) + +- The `action` field in the `alias` stanza is not available starting `lang dune + 2.0`. The `alias` field in the `rule` stanza is a replacement. (#2846, fixes + 2681, @rgrinberg) + +- Introduce `alias` and `package` fields to the `rule` stanza. This is the + preferred way of attaching rules to aliases. (#2744, @rgrinberg) + +- Add field `(optional)` for executable stanzas (#2463, fixes #2433, @bobot) + +- Infer targets for rule stanzas expressed in long form (#2494, fixes #2469, + @NathanReb) + +- Indicate the progress of the initial file tree loading (#2459, fixes #2374, + @bobot) + +- Build `.cm[ox]` files for executables more eagerly. This speeds up builds at + the cost of building unnecessary artifacts in some cases. Some of these extra + artifacts can fail to built, so this is a breaking change. (#2268, @rgrinberg) + +- Do not put the `.install` files in the source tree unless `-p` or + `--promote-install-files` is passed on the command line (#2329, @diml) + +- Compilation units of user defined executables are now mangled by default. This + is done to prevent the accidental collision with library dependencies of the + executable. (#2364, fixes #2292, @rgrinberg) + +- Enable `(explicit_js_mode)` by default. (#1941, @nojb) + +- Add an option to clear the console in-between builds with + `--terminal-persistence=clear-on-rebuild` + +- Stop symlinking object files to main directory for stanzas defined `jbuild` + files (#2440, @rgrinberg) + +- Library names are now validated in a strict fashion. Previously, invalid names + would be allowed for unwrapped libraries (#2442, @rgrinberg) + +- mli only modules must now be explicitly declared. This was previously a + warning and is now an error. (#2442, @rgrinberg) + +- Modules filtered out from the module list via the Ordered Set Language must + now be actual modules. (#2442, @rgrinberg) + +- Actions which introduce targets where new targets are forbidden (e.g. + preprocessing) are now an error instead of a warning. (#2442, @rgrinberg) + +- No longer install a `jbuilder` binary. (#2441, @diml) + +- Stub names are no longer allowed relative paths. This was previously a warning + and is now an error (#2443, @rgrinberg). + +- Define (paths ...) fields in (context ...) definitions in order to set or + extend any PATH-like variable in the context environment. (#2426, @nojb) + +- The `diff` action will always normalize newlines before diffing. Previously, it + would not do this normalization for rules defined in jbuild files. (#2457, + @rgrinberg) + +- Modules may no longer belong to more than one stanza. This was previously + allowed only in stanzas defined in `jbuild` files. (#2458, @rgrinberg) + +- Remove support for `jbuild-ignore` files. They have been replaced by the the + `dirs` stanza in `dune` files. (#2456, @rgrinberg) + +- Add a new config option `sandboxing_preference`, the cli argument `--sandbox`, + and the dep spec `sandbox` in dune language. These let the user control the + level of sandboxing done by dune per rule and globally. The rule specification + takes precedence. The global configuration merely specifies the default. + (#2213, @aalekseyev, @diml) + +- Remove support for old style subsystems. Dune will now emit a warning to + reinstall the library with the old style subsystem. (#2480, @rgrinberg) + +- Add action (with-stdin-from ) to redirect input from + when performing . (#2487, @nojb) + +- Change the automatically generated odoc index to only list public modules. + This only affects unwrapped libraries (#2479, @rgrinberg) + +- Set up formatting rules by default. They can be configured through a new + `(formatting)` stanza in `dune-project` (#2347, fixes #2315, @emillon) + +- Change default target from `@install` to `@all`. (#2449, fixes #1220, + @rgrinberg) + +- Include building stubs in `@check` rules. (@rgrinberg, #2530) + +- Get rid of ad-hoc rules for guessing the version. Dune now only + relies on the version written in the `dune-project` file and no + longer read `VERSION` or similar files (#2541, @diml) + +- In `(diff? x y)` action, require `x` to exist and register a + dependency on that file. (#2486, @aalekseyev) + +- On Windows, an .exe suffix is no longer added implicitly to binary names that + already end in .exe. Second, when resolving binary names, .opt variants are no + longer chosen automatically. (#2543, @nojb) + +- Make `(diff? x y)` move the correction file (`y`) away from the build + directory to promotion staging area. This makes corrections work with + sandboxing and in general reduces build directory pollution. (#2486, + @aalekseyev, fixes #2482) + +- `c_flags`, `c_names` and `cxx_names` are now supported in `executable` and + `executables` stanzas. (#2562, @nojb) Note: this feature has been subsequently + extended into a separate `foreign_stubs` field. The fields `c(xx)_names` and + `c(xx)_flags` are now deleted. (#2659, RFC #2650, @snowleopard) + +- Remove git integration from `$ dune upgrade` (#2565, @rgrinberg) + +- Add a `--disable-promotion` to disable all modification to the source + directory. There's also a corresponding `DUNE_DISABLE_PROMOTION` environment + variable. (#2588, fix #2568, @rgrinberg) + +- Add a `forbidden_libraries` field to prevent some library from being + linked in an executable. This help detecting who accidentally pulls in + `unix` for instance (#2570, @diml) + +- Fix incorrect error message when a variable is expanded in static context: + `%{lib:lib:..}` when the library does not exist. (#2597, fix #1541, + @rgrinberg) + +- Add `--sections` option to `$ dune install` to install subsections of .install + files. This is useful for installing only the binaries in a workspace for + example. (#2609, fixes #2554, @rgrinberg) + +- Drop support for `jbuild` and `jbuild-ignore` files (#2607, @diml) + +- Add a `dune-action-plugin` library for describing dependencies directly in + the executable source. Programs that use this feature can be run by a new + action (dynamic-run ...). (#2635, @staronj, @aalekseyev) + +- Stop installing the `ocaml-syntax-shims` binary. In order to use + `future_syntax`, one now need to depend on the `ocaml-syntax-shims` + package (#2654, @diml) + +- Add support for dependencies that are re-exported. Such dependencies + are marked with`re_export` and will automatically be provided to + users of a library (#2605, @rgrinberg) + +- Add a `deprecated_library_name` stanza to redirect old names after a + library has been renamed (#2528, @diml) + +- Error out when a `preprocessor_deps` field is present but not + `preprocess` field is. It is a warning with Dune 1.x projects + (#2660, @Julow) + +- Dune will use `-output-complete-exe` instead of `-custom` when compiling + self-contained bytecode executables whenever this options is available + (OCaml version >= 4.10) (#2692, @nojb) + +- Add action `(with-accepted-exit-codes )` to specify the set of + successful exit codes of ``. `` is specified using the predicate + language. (#2699, @nojb) + +- Do not setup rules for disabled libraries (#2491, fixes #2272, @bobot) + +- Configurator: filter out empty flags from `pkg-config` (#2716, @AltGr) + +- `no_keep_locs` is a no-op for projects that use `lang dune` older than 2.0. In + projects where the language is at least `2.0`, the field is now forbidden. + (#2752, fixes #2747, @rgrinberg) + +- Extend support for foreign sources and archives via the `(foreign_library ...)` + stanza as well as the `(foreign_stubs ...)` and `(foreign_archives ...)` fields. + (#2659, RFC #2650, @snowleopard) + +- Add (deprecated_package_names) field to (package) declaration in + dune-project. The names declared here can be used in the (old_public_name) + field of (deprecated_library_name) stanza. These names are interpreted as + library names (not prefixed by a package name) and appropriate redirections are + setup in their META files. This feature is meant to migrate old libraries which + do not follow Dune's convention of prefixing libraries with the package + name. (#2696, @nojb) + +- The fields `license`, `authors`, `maintainers`, `source`, `bug_reports`, + `homepage`, and `documentation` of `dune-project` can now be overridden on a + per-package basis. (#2774, @nojb) + +- Change the default `modes` field of executables to `(mode exe)`. If + one wants to build a bytecode program, it now needs to be explicitly + requested via `(modes byte exe)`. (#2851, @diml) + +- Allow `ccomp_type` as a variable for evaluating `enabled_if`. (#2855, @dra27, + @rgrinberg) + +- Stricter validation of file names in `select`. The file names of conditional + sources must match the prefix and the extension of the resultant filename. + (#2867, @rgrinberg) + +- Add flag `disable_dynamically_linked_foreign_archives` to the workspace file. + If the flag is set to `true` then: (i) when installing libraries, we do not + install dynamic foreign archives `dll*.so`; (ii) when building executables in + the `byte` mode, we statically link in foreign archives into the runtime + system; (iii) we do not generate any `dll*.so` rules. (#2864, @snowleopard) + +- Reimplement the bootstrap procedure. The new procedure is faster and + should no longer stack overflow (#2854, @dra27, @diml) + +- Allow `.opam.template` files to be generated using rules (#2866, @rgrinberg) + +- Delete the deprecated `self_build_stubs_archive` field, replaced by + `foreign_archives`. + +1.11.4 (09/10/2019) +------------------- + +- Allow to mark directories as `data_only_dirs` without including them as `dirs` + (#2619, fix #2584, @rgrinberg) + +- Fix reading `.install` files generated with an external `--build-dir`. (#2638, + fix #2629, @rgrinberg) + +1.11.3 (23/08/2019) +------------------- + +- Fix a ppx hash collision in watch mode (#2546, fixes #2520, @diml) + +1.11.2 (20/08/2019) +------------------- + +- Remove the optimisation of passing `-nodynlink` for executables when + not necessary. It seems to be breaking things (see #2527, @diml) + +- Fix invalid library names in `dune-package` files. Only public names should + exist in such files. (#2558, fix #2425, @rgrinberg) + +1.11.1 (09/08/2019) +------------------- + +- Fix config file dependencies of ocamlformat (#2471, fixes #2464, + @nojb) + +- Cleanup stale directories when using `(source_tree ...)` in the + presence of directories with only sub-directories and no files + (#2514, fixes #2499, @diml) + +1.11.0 (23/07/2019) +------------------- + +- Don't select all local implementations in `dune utop`. Instead, let the + default implementation selection do its job. (#2327, fixes #2323, @TheLortex, + review by @rgrinberg) + +- Check that selected implementations (either by variants or default + implementations) are indeed implementations. (#2328, @TheLortex, review by + @rgrinberg) + +- Don't reserve the `Ppx` toplevel module name for ppx rewriters (#2242, @diml) + +- Redesign of the library variant feature according to the #2134 proposal. The + set of variants is now computed when the virtual library is installed. + Introducing a new `external_variant` stanza. (#2169, fixes #2134, @TheLortex, + review by @diml) + +- Add proper line directives when copying `.cc` and `.cxx` sources (#2275, + @rgrinberg) + +- Fix error message for missing C++ sources. The `.cc` extension was always + ignored before. (#2275, @rgrinberg) + +- Add `$ dune init project` subcommand to create project boilerplate according + to a common template. (#2185, fixes #159, @shonfeder) + +- Allow to run inline tests in javascript with nodejs (#2266, @hhugo) + +- Build `ppx.exe` as compiling host binary. (#2286, fixes #2252, @toots, review + by @rgrinberg and @diml) + +- Add a `cinaps` extension and stanza for better integration with the + [cinaps tool](https://github.com/janestreet/cinaps) tool (#2269, + @diml) + +- Allow to embed build info in executables such as version and list + and version of statically linked libraries (#2224, @diml) + +- Set version in `META` and `dune-package` files to the one read from + the vcs when no other version is available (#2224, @diml) + +- Add a variable `%{target}` to be used in situations where the context + requires at most one word, so `%{targets}` can be confusing; stdout + redirections and "-o" arguments of various tools are the main use + case; also, introduce a separate field `target` that must be used + instead of `targets` in those situations. (#2341, @aalekseyev) + +- Fix dependency graph of wrapped_compat modules. Previously, the dependency on + the user written entry module was omitted. (#2305, @rgrinberg) + +- Allow to promote executables built with an `executable` stanza + (#2379, @diml) + +- When instantiating an implementation with a variant, make sure it matches + virtual library's list of known implementations. (#2361, fixes #2322, + @TheLortex, review by @rgrinberg) + +- Add a variable `%{ignoring_promoted_rules}` that is `true` when + `--ignore-promoted-rules` is passed on the command line and false + otherwise (#2382, @diml) + +- Fix a bug in `future_syntax` where the characters `@` and `&` were + not distinguished in the names of binding operators (`let@` was the + same as `let&`) (#2376, @aalekseyev, @diml) + +- Workspaces with non unique project names are now supported. (#2377, fix #2325, + @rgrinberg) + +- Improve opam generation to include the `dune` dependencies with the minimum + constraint set based on the dune language version specified in the + `dune-project` file. (2383, @avsm) + +- The order of fields in the generated opam file now follows order preferred in + opam-lib. (@avsm, #2380) + +- Fix coloring of error messages from the compiler (@diml, #2384) + +- Add warning `66` to default set of warnings starting for dune projects with + language version >= `1.11` (@rgrinberg, @diml, fixes #2299) + +- Add (dialect ...) stanza + (@nojb, #2404) + +- Add a `--context` argument to `dune install/uninstall` (@diml, #2412) + +- Do not warn about merlin files pre 1.9. This warning can only be disabled in + 1.9 (#2421, fixes #2399, @emillon) + +- Add a new `inline_tests` field in the env stanza to control inline_tests + framework with a variable (#2313, @mlasson, original idea by @diml, review + by @rgrinberg). + +- New binary kind `js` for executables in order to explicitly enable Javascript + targets, and a switch `(explicit_js_mode)` to require this mode in order to + declare JS targets corresponding to executables. (#1941, @nojb) + +- Allow unwrapped implementations of public libraries to introduce new public + modules (@rgrinberg) + +1.10.0 (04/06/2019) +------------------- + +- Restricted the set of variables available for expansion in the destination + filename of `install` stanza to simplify implementation and avoid dependency + cycles. (#2073, @aalekseyev, @diml) + +- [menhir] call menhir from context root build_dir (#2067, @ejgallego, + review by @diml, @rgrinberg) + +- [coq] Add `coq.pp` stanza to help with pre-processing of grammar + files (#2054, @ejgallego, review by @rgrinberg) + +- Add a new more generic form for the *promote* mode: `(promote + (until-clean) (into ))` (#2068, @diml) + +- Allow to promote only a subset of the targets via `(promote (only + ))`. For instance: `(promote (only *.mli))` (#2068, @diml) + +- Improve the behavior when a strict subset of the targets of a rule is already + in the source tree for projects using the dune language < 1.10 (#2068, fixes + #2061, @diml) + +- With lang dune >= 1.10, rules in standard mode are no longer allowed to + produce targets that are present in the source tree. This has been a warning + for long enough (#2068, @diml) + +- Allow %{...} variables in pps flags (#2076, @mlasson review by @diml and + @aalekseyev). + +- Add a 'cookies' option to ppx_rewriter/deriver flags in library stanzas. This + allow to specify cookie requests from variables expanded at each invocation of + the preprocessor. (#2106, @mlasson @diml) + +- Add more opam metadata and use it to generate `.opam` files. In particular, a + `package` field has been added to specify package specific information. + (#2017, #2091, @avsm, @jonludlam, @rgrinberg) + +- Clean up the special support for `findlib.dynload`. Before, Dune would simply + match on the library name. Now, we only match on the findlib package name when + the library doesn't come from Dune. Someone writing a library called + `findlib.dynload` with Dune would have to add `(special_builtin_support + findlib_dynload)` to trigger the special behavior. (#2115, @diml) + +- Install the `future_syntax` preprocessor as `ocaml-syntax-shims.exe` (#2125, + @rgrinberg) + +- Hide full command on errors and warnings in development and show them in CI. + (detected using the `CI` environment variable). Commands for which the + invocation might be omitted must output an error prefixed with `File `. Add an + `--always-show-command-line` option to disable this behavior and always show + the full command. (#2120, fixes #1733, @rgrinberg) + +- In `dune-workspace` files, add the ability to choose the host context and to + create duplicates of the default context with different settings. (#2098, + @TheLortex, review by @diml, @rgrinberg and @aalekseyev) + +- Add support for hg in `dune subst` (#2135, @diml) + +- Don't build documentation for implementations of virtual libraries (#2141, + fixes #2138, @jonludlam) + +- Fix generation of the `-pp` flag in .merlin (#2142, @rgrinberg) + +- Make `dune subst` add a `(version ...)` field to the `dune-project` + file (#2148, @diml) + +- Add the `%{os_type}` variable, which is a short-hand for + `%{ocaml-config:os_type}` (#1764, @diml) + +- Allow `enabled_if` fields in `library` stanzas, restricted to the + `%{os_type}`, `%{model}`, `%{architecture}`, `%{system}` variables (#1764, + #2164 @diml, @rgrinberg) + +- Fix `chdir` on external and source paths. Dune will also fail gracefully if + the external or source path does not exist (#2165, fixes #2158, @rgrinberg) + +- Support the `.cc` extension for C++ sources (#2195, fixes #83, @rgrinberg) + +- Run `ocamlformat` relative to the context root. This improves the locations of + errors. (#2196, fixes #1370, @rgrinberg) + +- Fix detection of `README`, `LICENSE`, `CHANGE`, and `HISTORY` files. These + would be undetected whenever the project was nested in another workspace. + (#2194, @rgrinberg) + +- Fix generation of `.merlin` whenever there's more than one stanza with the + same ppx preprocessing specification (#2209 ,fixes #2206, @rgrinberg) + +- Fix generation of `.merlin` in the presence of the `copy_files` stanza and + preprocessing specifications of other stanazs. (#2211, fixes #2206, + @rgrinberg) + +- Run `refmt` from the context's root directory. This improves error messages in + case of syntax errors. (#2223, @rgrinberg) + +- In .merlin files, don't pass `-dump-ast` to the `future_syntax` preprocessor. + Merlin doesn't seem to like it when binary AST is generated by a `-pp` + preprocessor. (#2236, @aalekseyev) + +- `dune install` will verify that all files mentioned in all .install files + exist before trying to install anything. This prevents partial installation of + packages (#2230, @rgrinberg) + +1.9.3 (06/05/2019) +------------------ + +- Fix `.install` files not being generated (#2124, fixes #2123, @rgrinberg) + +1.9.2 (02/05/2019) +------------------ + +- Put back library variants in development mode. We discovered a + serious unexpected issue and we might need to adjust the design of + this feature before we are ready to commit to a final version. Users + will need to write `(using library_variants 0.1)` in their + `dune-project` file if they want to use it before the design is + finalized. (#2116, @diml) + +- Forbid to attach a variant to a library that implements a virtual + library outside the current project (#2104, @rgrinberg) + +- Fix a bug where `dune install` would install man pages to incorrect + paths when compared to `opam-installer`. For example dune now + installs `(foo.1 as man1/foo.1)` correctly and previously that was + installed to `man1/man1/foo.1`. (#2105, @aalekseyev) + +- Do not fail when a findlib directory doesn't exist (#2101, fix #2099, @diml) + +- [coq] Rename `(coqlib ...)` to `(coq.theory ...)`, support for + `coqlib` will be dropped in the 1.0 version of the Coq language + (#2055, @ejgallego) + +- Fix crash when calculating library dependency closure (#2090, fixes #2085, + @rgrinberg) + +- Clean up the special support for `findlib.dynload`. Before, Dune + would simply match on the library name. Now, we only match on the + findlib package name when the library doesn't come from + Dune. Someone writing a library called `findlib.dynload` with Dune + would have to add `(special_builton_support findlib_dynload)` to + trigger the special behavior. (#2115, @diml) + +- Include permissions in the digest of targets and dependencies (#2121, fix + #1426, @rgrinberg, @xclerc) + +1.9.1 (11/04/2019) +------------------ + +- Fix invocation of odoc to add previously missing include paths, impacting + mld files that are not in directories containing libraries (#2016, fixes + #2007, @jonludlam) + +1.9.0 (09/04/2019) +------------------ + +- Warn when generated `.merlin` does not reflect the preprocessing + specification. This occurs when multiple stanzas in the same directory use + different preprocessing specifications. This warning can now be disabled with + `allow_approx_merlin` (#1947, fix #1946, @rgrinberg) + +- Watch mode: display "Success" in green and "Had errors" in red (#1956, + @emillon) + +- Fix glob dependencies on installed directories (#1965, @rgrinberg) + +- Add support for library variants and default implementations. (#1900, + @TheLortex) + +- Add experimental `$ dune init` command. This command is used to create or + update project boilerplate. (#1448, fixes #159, @shonfeder) + +- Experimental Coq support (fix #1466, @ejgallego) + +- Install .cmi files of private modules in a `.private` directory (#1983, fix + #1973 @rgrinberg) + +- Fix `dune subst` attempting to substitute on directories. (#2000, fix #1997, + @rgrinberg) + +- Do not list private modules in the generated index. (#2009, fix #2008, + @rgrinberg) + +- Warn instead of failing if an opam file fails to parse. This opam file can + still be used to define scope. (#2023, @rgrinberg) + +- Do not crash if unable to read a directory when traversing to find root + (#2024, @rgrinberg) + +- Do not exit dune if some source directories are unreadable. Instead, warn the + user that such directories need to be ignored (#2004, fix #310, @rgrinberg) + +- Fix nested `(binaries ..)` fields in the `env` stanza. Previously, parent + `binaries` fields would be ignored, but instead they should be combined. + (#2029, @rgrinberg) + +- Allow "." in `c_names` and `cxx_names` (#2036, fix #2033, @rgrinberg) + +- Format rules: if a dune file uses OCaml syntax, do not format it. + (#2014, fix #2012, @emillon) + +1.8.2 (10/03/2019) +------------------ + +- Fix auto-generated `index.mld`. Use correct headings for the listing. (#1925, + @rgrinberg, @aantron) + +1.8.1 (08/03/2019) +------------------ + +- Correctly write `dune-package` when version is empty string (#1919, fix #1918, + @rgrinberg) + +1.8.0 (07/03/2019) +------------------ + +- Clean up watch mode polling loop: improves signal handling and error handling + during polling (#1912, fix #1907, fix #1671, @aalekseyev) + +- Change status messages during polling to be one-line, so that the messages are + correctly erased by ^K. (#1912, @aalekseyev) + +- Add support for `.cxx` extension for C++ stubs (#1831, @rgrinberg) + +- Add `DUNE_WORKSPACE` variable. This variable is equivalent to setting + `--workspace` in the command line. (#1711, fix #1503, @rgrinberg) + +- Add `c_flags` and `cxx_flags` to env profile settings (#1700 and #1800, + @gretay-js) + +- Format `dune printenv` output (#1867, fix #1862, @emillon) + +- Add the `(promote-into )` and `(promote-until-clean-into + )` modes for `(rule ...)` stanzas, so that files can be + promoted in another directory than the current one. For instance, + this is used in merlin to promote menhir generated files in a + directory that depends on the version of the compiler (#1890, @diml) + +- Improve error message when `dune subst` fails (#1898, fix #1897, @rgrinberg) + +- Add more GC counters to catapult traces (fix908, @rgrinberg) + +- Add a preprocessor shim for the `let+` syntax of OCaml 4.08 (#1899, + implements #1891, @diml) + +- Fix generation of `.merlin` files on Windows. `\` characters needed + to be escaped (#1869, @mlasson) + +- Fix 0 error code when `$ dune format-dune-file` fails. (#1915, fix #1914, + @rgrinberg) + +- Configurator: deprecated `query_expr` and introduced `query_expr_err` which is + the same but with a better error in case it fails. (#1886, @ejgallego) + +- Make sure `(menhir (mode promote) ...)` stanzas are ignored when + using `--ignore-promoted-rules` or `-p` (#1917, @diml) + +1.7.3 (27/02/2019) +------------------ + +- Fix interpretation of `META` files containing archives with `/` in + the filename. For instance, this was causing llvm to be unusable + with dune (#1889, fix #1885, @diml) + +- Make errors about menhir stanzas be located (#1881, fix #1876, + @diml) + +1.7.2 (21/02/2019) +------------------ + +- Add `${corrected-suffix}`, `${library-name}` and a few other + variables to the list of variables to upgrade. This fixes the + support for various framework producing corrections (#1840, #1853, + @diml) + +- Fix `$ dune subst` failing because the build directory wasn't set. (#1854, fix + #1846, @rgrinberg) + +- Configurator: Add warning to `Pkg_config.query` when a full package expression + is used. Add `Pkg_config.query_expr` for cases when the full power of + pkg-config's querying is needed (#1842, fix #1833, @rgrinberg) + +- Fix unavailable, optional implementations eagerly breaking the build (#1857, + fix #1856, @rgrinberg) + +1.7.1 (13/02/2019) +------------------ + +- Fix the watch mode (#1837, #1839, fix #1836, @diml) + +- Configurator: Fix misquoting when running pkg-config (#1835, fix #1833, + @Chris00) + +1.7.0 (12/02/2019) +------------------ + + +- Second step of the deprecation of jbuilder: the `jbuilder` binary + now emits a warning on every startup and both `jbuilder` and `dune` + emit warnings when encountering `jbuild` files (#1752, @diml) + +- Change the layout of build artifacts inside _build. The new layout enables + optimizations that depend on the presence of `.cmx` files of private modules + (#1676, @bobot) + +- Fix merlin handling of private module visibility (#1653 @bobot) + +- unstable-fmt: use boxes to wrap some lists (#1608, fix #1153, @emillon, + thanks to @rgrinberg) + +- skip directories when looking up programs in the PATH (#1628, fixes + #1616, @diml) + +- Use `lsof` on macOS to implement `--stats` (#1636, fixes #1634, @xclerc) + +- Generate `dune-package` files for every package. These files are installed and + read instead of `META` files whenever they are available (#1329, @rgrinberg) + +- Fix preprocessing for libraries with `(include_subdirs ..)` (#1624, fix #1626, + @nojb, @rgrinberg) + +- Do not generate targets for archive that don't match the `modes` field. + (#1632, fix #1617, @rgrinberg) + +- When executing actions, open files lazily and close them as soon as + possible in order to reduce the maximum number of file descriptors + opened by Dune (#1635, #1643, fixes #1633, @jonludlam, @rgrinberg, + @diml) + +- Reimplement the core of Dune using a new generic memoization system + (#1489, @rudihorn, @diml) + +- Replace the broken cycle detection algorithm by a state of the art + one from [this paper](https://doi.org/10.1145/2756553) (#1489, + @rudihorn) + +- Get the correct environment node for multi project workspaces (#1648, + @rgrinberg) + +- Add `dune compute` to call internal memoized functions (#1528, + @rudihorn, @diml) + +- Add `--trace-file` option to trace dune internals (#1639, fix #1180, @emillon) + +- Add `--no-print-directory` (borrowed from GNU make) to suppress + `Entering directory` messages. (#1668, @dra27) + +- Remove `--stats` and track fd usage in `--trace-file` (#1667, @emillon) + +- Add virtual libraries feature and enable it by default (#1430 fixes #921, + @rgrinberg) + +- Fix handling of Control+C in watch mode (#1678, fixes #1671, @diml) + +- Look for jsoo runtime in the same dir as the `js_of_ocaml` binary + when the ocamlfind package is not available (#1467, @nojb) + +- Make the `seq` package available for OCaml >= 4.07 (#1714, @rgrinberg) + +- Add locations to error messages where a rule fails to generate targets and + rules that require files outside the build/source directory. (#1708, fixes + #848, @rgrinberg) + +- Let `Configurator` handle `sizeof` (in addition to negative numbers). + (#1726, fixes #1723, @Chris00) + +- Fix an issue causing menhir generated parsers to fail to build in + some cases. The fix is to systematically use `-short-paths` when + calling `ocamlc -i` (#1743, fix #1504, @diml) + +- Never raise when printing located errors. The code that would print the + location excerpts was prone to raising. (#1744, fix #1736, @rgrinberg) + +- Add a `dune upgrade` command for upgrading jbuilder projects to Dune + (#1749, @diml) + +- When automatically creating a `dune-project` file, insert the + detected name in it (#1749, @diml) + +- Add `(implicit_transitive_deps )` mode to dune projects. When this mode + is turned off, transitive dependencies are not accessible. Only listed + dependencies are directly accessible. (#1734, #430, @rgrinberg, @hnrgrgr) + +- Add `toplevel` stanza. This stanza is used to define toplevels with libraries + already preloaded. (#1713, @rgrinberg) + +- Generate `.merlin` files that account for normal preprocessors defined using a + subset of the `action` language. (#1768, @rgrinberg) + +- Emit `(orig_src_dir )` metadata in `dune-package` for dune packages + built with `--store-orig-source-dir` command line flag (also controlled by + `DUNE_STORE_ORIG_SOURCE_DIR` env variable). This is later used to generate + `.merlin` with `S`-directives pointed to original source locations and thus + allowing merlin to see those. (#1750, @andreypopp) + +- Improve the behavior of `dune promote` when the files to be promoted have been + deleted. (#1775, fixes #1772, @diml) + +- unstable-fmt: preserve comments (#1766, @emillon) + +- Pass flags correctly when using `staged_pps` (#1779, fixes #1774, @diml) + +- Fix an issue with the use of `(mode promote)` in the menhir + stanza. It was previously causing intermediate *mock* files to be + promoted (#1783, fixes #1781, @diml) + +- unstable-fmt: ignore files using OCaml syntax (#1784, @emillon) + +- Configurator: Add `which` function to replace the `which` command line utility + in a cross platform way. (#1773, fixes #1705, @Chris00) + +- Make configurator append paths to `$PKG_CONFIG_PATH` on macOS. Previously it + was prepending paths and thus `$PKG_CONFIG_PATH` set by users could have been + overridden by homebrew installed libraries (#1785, @andreypopp) + +- Disallow c/cxx sources that share an object file in the same stubs archive. + This means that `foo.c` and `foo.cpp` can no longer exist in the same library. + (#1788, @rgrinberg) + +- Forbid use of `%{targets}` (or `${@}` in jbuild files) inside + preprocessing actions + (#1812, fixes #1811, @diml) + +- Add `DUNE_PROFILE` environment variable to easily set the profile. (#1806, + @rgrinberg) + +- Deprecate the undocumented `(no_keep_locs)` field. It was only + necessary until virtual libraries were supported (#1822, fix #1816, + @diml) + +- Rename `unstable-fmt` to `format-dune-file` and remove its `--inplace` option. + (#1821, @emillon). + +- Autoformatting: `(using fmt 1.1)` will also format dune files (#1821, @emillon). + +- Autoformatting: record dependencies on `.ocamlformat-ignore` files (#1824, + fixes #1793, @emillon) + +1.6.2 (05/12/2018) +------------------ + +- Fix regression introduced by #1554 reported in: + https://github.com/ocaml/dune/issues/734#issuecomment-444177134 (#1612, + @rgrinberg) + +- Fix `dune external-lib-deps` when preprocessors are not installed + (#1607, @diml) + +1.6.1 (04/12/2018) +------------------ + +- Fix hash collision for on-demand ppx rewriters once and for all + (#1602, fixes #1524, @diml) + +- Add `dune external-lib-deps --sexp --unstable-by-dir` so that the output can + be easily processed by a machine (#1599, @diml) + +1.6.0 (29/11/2018) +------------------ + +- Expand variables in `install` stanzas (#1354, @mseri) + +- Add predicate language support for specifying sub directories. This allows the + use globs, set operations, and special values in specifying the sub + directories used for the build. For example: `(dirs :standard \ lib*)` will + use all directories except those that start with `lib`. (#1517, #1568, + @rgrinberg) + +- Add `binaries` field to the `(env ..)` stanza. This field sets and overrides + binaries for rules defined in a directory. (#1521, @rgrinberg) + +- Fix a crash caused by using an extension in a project without + dune-project file (#1535, fix #1529, @diml) + +- Allow `%{bin:..}`, `%{exe:..}`, and other static expansions in the `deps` + field. (#1155, fix #1531, @rgrinberg) + +- Fix bad interaction between on-demand ppx rewriters and using multiple build + contexts (#1545, @diml) + +- Fix handling of installed .dune files when the backend is declared via a + `dune` file (#1551, fixes #1549, @diml) + +- Add a `--stats` command line option to record resource usage (#1543, @diml) + +- Fix `dune build @doc` deleting `highlight.pack.js` on rebuilds, after the + first build (#1557, @aantron). + +- Allow targets to be directories, which Dune will treat opaquely + (#1547, @jordwalke) + +- Support for OCaml 4.08: `List.t` is now provided by OCaml (#1561, @ejgallego) + +- Exclude the local esy directory (`_esy`) from the list of watched directories + (#1578, @andreypopp) + +- Fix the output of `dune external-lib-deps` (#1594, @diml) + +- Introduce `data_only_dirs` to replace `ignored_subdirs`. `ignored_subdirs` is + deprecated since 1.6. (#1590, @rgrinberg) + +1.5.1 (7/11/2018) +----------------- + +- Fix `dune utop ` when invoked from a sub-directory of the + project (#1520, fix #1518, @diml) + +- Fix bad interaction between on-demand ppx rewriters and polling mode + (#1525, fix #1524, @diml) + +1.5.0 (1/11/2018) +----------------- + +- Filter out empty paths from `OCAMLPATH` and `PATH` (#1436, @rgrinberg) + +- Do not add the `lib.cma.js` target in lib's directory. Put this target in a + sub directory instead. (#1435, fix #1302, @rgrinberg) + +- Install generated OCaml files with a `.ml` rather than a `.ml-gen` extension + (#1425, fix #1414, @rgrinberg) + +- Allow to use the `bigarray` library in >= 4.07 without ocamlfind and without + installing the corresponding `otherlib`. (#1455, @nojb) + +- Add `@all` alias to build all targets defined in a directory (#1409, fix + #1220, @rgrinberg) + +- Add `@check` alias to build all targets required for type checking and tooling + support. (#1447, fix #1220, @rgrinberg) + +- Produce the odoc index page with the content wrapper to make it consistent + with odoc's theming (#1469, @rizo) + +- Unblock signals in processes started by dune (#1461, fixes #1451, + @diml) + +- Respect `OCAMLFIND_TOOLCHAIN` and add a `toolchain` option to contexts in the + workspace file. (#1449, fix #1413, @rgrinberg) + +- Fix error message when using `copy_files` stanza to copy files from + a non sub directory with lang set to dune < 1.3 (#1486, fixes #1485, + @NathanReb) + +- Install man pages in the correct subdirectory (#1483, fixes #1441, @emillon) + +- Fix version syntax check for `test` stanza's `action` field. Only + emits a warning for retro-compatibility (#1474, fixes #1471, + @NathanReb) + +- Interpret the `DESTDIR` environment variable (#1475, @emillon) + +- Fix interpretation of paths in `env` stanzas (#1509, fixes #1508, @diml) + +- Add `context_name` expansion variable (#1507, @rgrinberg) + +- Use shorter paths for generated on-demand ppx drivers. This is to + help Windows builds where paths are limited in length (#1511, fixes + #1497, @diml) + +- Fix interpretation of `%{env:=}` environment variables + under `setenv`. Also forbid dynamic environment names or values + (#1503, @rgrinberg). + +1.4.0 (10/10/2018) +------------------ + +- Do not fail if the output of `ocamlc -config` doesn't include + `standard_runtime` (#1326, @diml) + +- Let `Configurator.V1.C_define.import` handle negative integers + (#1334, @Chris00) + +- Re-execute actions when a target is modified by the user inside + `_build` (#1343, fix #1342, @diml) + +- Pass `--set-switch` to opam (#1341, fix #1337, @diml) + +- Fix bad interaction between multi-directory libraries the `menhir` + stanza (#1373, fix #1372, @diml) + +- Integration with automatic formatters (#1252, fix #1201, @emillon) + +- Better error message when using `(self_build_stubs_archive ...)` and + `(c_names ...)` or `(cxx_names ...)` simultaneously. + (#1375, fix #1306, @nojb) + +- Improve name detection for packages when the prefix isn't an actual package + (#1361, fix #1360, @rgrinberg) + +- Support for new menhir rules (#863, fix #305, @fpottier, @rgrinberg) + +- Do not remove flags when compiling compatibility modules for wrapped mode + (#1382, fix #1364, @rgrinberg) + +- Fix reason support when using `staged_pps` (#1384, @charlesetc) + +- Add support for `enabled_if` in `rule`, `menhir`, `ocamllex`, + `ocamlyacc` (#1387, @diml) + +- Exit gracefully when a signal is received (#1366, @diml) + +- Load all defined libraries recursively into utop (#1384, fix #1344, + @rgrinberg) + +- Allow to use libraries `bytes`, `result` and `uchar` without `findlib` + installed (#1391, @nojb) + +- Take argument to self_build_stubs_archive into account. (#1395, @nojb) + +- New variable form `%{env:=}` that expands to the environment + variable ``, or `` if not found. Example: `%{env:BIN=/usr/bin}`. + (#1305, @trefis) + +- Fix bad interaction between `env` customization and vendored + projects: when a vendored project didn't have its own `env` stanza, + the `env` stanza from the enclosing project was in effect (#1408, + @diml) + +- Fix stop early bug when scanning for watermarks (#1423, @struktured) + +1.3.0 (23/09/2018) +------------------ + +- Support colors on Windows (#1290, @diml) + +- Allow `dune.configurator` and `base` to be used together (#1291, fix + #1167, @diml) + +- Support interrupting and restarting builds on file changes (#1246, + @kodek16) + +- Fix findlib-dynload support with byte mode only (#1295, @bobot) + +- Make `dune rules -m` output a valid makefile (#1293, @diml) + +- Expand variables in `(targets ..)` field (#1301, #1320, fix #1189, @nojb, + @rgrinberg, @diml) + +- Fix a race condition on Windows that was introduced in 1.2.0 + (#1304, fix #1303, @diml) + +- Fix the generation of .merlin files to account for private modules + (@rgrinberg, fix #1314) + +- Exclude the local opam switch directory (`_opam`) from the list of watched + directories (#1315, @dysinger) + +- Fix compilation of the module generated for `findlib.dynload` + (#1317, fix #1310, @diml) + +- Lift restriction on `copy_files` and `copy_files#` stanzas that files to be + copied should be in a subdirectory of the current directory. + (#1323, fix #911, @nojb) + +1.2.1 (17/09/2018) +------------------ + +- Enrich the `dune` Emacs mode with syntax highlighting and indentation. New + file `dune-flymake` to provide a hook `dune-flymake-dune-mode-hook` to enable + linting of dune files. (#1265, @Chris00) + +- Pass `link_flags` to `cc` when compiling with `Configurator.V1.c_test` (#1274, + @rgrinberg) + +- Fix digest calculation of aliases. It should take into account extra bindings + passed to the alias (#1277, fix #1276, @rgrinberg) + +- Fix a bug causing `dune` to fail eagerly when an optional library + isn't available (#1281, @diml) + +- ocamlmklib should use response files only if ocaml >= 4.08 (#1268, @bryphe) + +1.2.0 (14/09/2018) +------------------ + +- Ignore stderr output when trying to find out the number of jobs + available (#1118, fix #1116, @diml) + +- Fix error message when the source directory of `copy_files` does not exist. + (#1120, fix #1099, @emillon) + +- Highlight error locations in error messages (#1121, @emillon) + +- Display actual stanza when package is ambiguous (#1126, fix #1123, @emillon) + +- Add `dune unstable-fmt` to format `dune` files. The interface and syntax are + still subject to change, so use with caution. (#1130, fix #940, @emillon) + +- Improve error message for `dune utop` without a library name (#1154, fix + #1149, @emillon) + +- Fix parsing `ocamllex` stanza in jbuild files (#1150, @rgrinberg) + +- Highlight multi-line errors (#1131, @anuragsoni) + +- Do no try to generate shared libraries when this is not supported by + the OS (#1165, fix #1051, @diml) + +- Fix `Flags.write_{sexp,lines}` in configurator by avoiding the use of + `Stdune.Path` (#1175, fix #1161, @rgrinberg) + +- Add support for `findlib.dynload`: when linking an executable using + `findlib.dynload`, automatically record linked in libraries and + findlib predicates (#1172, @bobot) + +- Add support for promoting a selected list of files (#1192, @diml) + +- Add an emacs mode providing helpers to promote correction files + (#1192, @diml) + +- Improve message suggesting to remove parentheses (#1196, fix #1173, @emillon) + +- Add `(wrapped (transition "..message.."))` as an option that will generate + wrapped modules but keep unwrapped modules with a deprecation message to + preserve compatibility. (#1188, fix #985, @rgrinberg) + +- Fix the flags passed to the ppx rewriter when using `staged_pps` (#1218, @diml) + +- Add `(env var)` to add a dependency to an environment variable. + (#1186, @emillon) + +- Add a simple version of a polling mode: `dune build -w` keeps + running and restarts the build when something change on the + filesystem (#1140, @kodek16) + +- Cleanup the way we detect the library search path. We no longer call + `opam config var lib` in the default build context (#1226, @diml) + +- Make test stanzas honor the -p flag. (#1236, fix #1231, @emillon) + +- Test stanzas take an optional (action) field to customize how they run (#1248, + #1195, @emillon) + +- Add support for private modules via the `private_modules` field (#1241, fix + #427, @rgrinberg) + +- Add support for passing arguments to the OCaml compiler via a + response file when the list of arguments is too long (#1256, @diml) + +- Do not print diffs by default when running inside dune (#1260, @diml) + +- Interpret `$ dune build dir` as building the default alias in `dir`. (#1259, + @rgrinberg) + +- Make the `dynlink` library available without findlib installed (#1270, fix + #1264, @rgrinberg) + +1.1.1 (08/08/2018) +------------------ + +- Fix `$ jbuilder --dev` (#1104, fixes #1103, @rgrinberg) + +- Fix dune exec when `--build-dir` is set to an absolute path (#1105, fixes + #1101, @rgrinberg) + +- Fix duplicate profile argument in suggested command when an external library + is missing (#1109, #1106, @emillon) + +- `-opaque` wasn't correctly being added to modules without an interface. + (#1108, fix #1107, @rgrinberg) + +- Fix validation of library `name` fields and make sure this validation also + applies when the `name` is derived from the `public_name`. (#1110, fix #1102, + @rgrinberg) + +- Fix a bug causing the toplevel `env` stanza in the workspace file to + be ignored when at least one context had `(merlin)` (#1114, @diml) + +1.1.0 (06/08/2018) +------------------ + +- Fix lookup of command line specified files when `--root` is given. Previously, + passing in `--root` in conjunction with `--workspace` or `--config` would not + work correctly (#997, @rgrinberg) + +- Add support for customizing env nodes in workspace files. The `env` stanza is + now allowed in toplevel position in the workspace file, or for individual + contexts. This feature requires `(dune lang 1.1)` (#1038, @rgrinberg) + +- Add `enabled_if` field for aliases and tests. This field controls whether the + test will be ran using a boolean expression language. (#819, @rgrinberg) + +- Make `name`, `names` fields optional when a `public_name`, `public_names` + field is provided. (#1041, fix #1000, @rgrinberg) + +- Interpret `X` in `--libdir X` as relative to `PREFIX` when `X` is relative + (#1072, fix #1070, @diml) + +- Add support for multi directory libraries by writing + `(include_subdirs unqualified)` (#1034, @diml) + +- Add `(staged_pps ...)` to support staged ppx rewriters such as ones + using the OCaml typer like `ppx_import` (#1080, fix #193, @diml) + +- Use `-opaque` in the `dev` profile. This option trades off binary quality for + compilation speed when compiling .cmx files. (#1079, fix #1058, @rgrinberg) + +- Fix placeholders in `dune subst` documentation (#1090, @emillon, thanks + @trefis for the bug report) + +- Add locations to errors when a missing binary in PATH comes from a dune file + (#1096, fixes #1095, @rgrinberg) + +1.0.1 (19/07/2018) +------------------ + +- Fix parsing of `%{lib:name:file}` forms (#1022, fixes #1019, @diml) + +1.0.0 (10/07/2018) +------------------ + +- Do not load the user configuration file when running inside dune + (#700 @diml) + +- Do not infer ${null} to be a target (#693 fixes #694 @rgrinberg) + +- Introduce jbuilder.configurator library. This is a revived version of + janestreet's configurator library with better cross compilation support, a + versioned API, and no external dependencies. (#673, #678 #692, #695 + @rgrinberg) + +- Register the transitive dependencies of compilation units as the + compiler might read `.cm*` files recursively (#666, fixes #660, + @emillon) + +- Fix a bug causing `jbuilder external-lib-deps` to crash (#723, + @diml) + +- `-j` now defaults to the number of processing units available rather + 4 (#726, @diml) + +- Fix attaching index.mld to documentation (#731, fixes #717 @rgrinberg) + +- Scan the file system lazily (#732, fixes #718 and #228, @diml) + +- Add support for setting the default ocaml flags and for build + profiles (#419, @diml) + +- Display a better error messages when writing `(inline_tests)` in an + executable stanza (#748, @diml) + +- Restore promoted files when they are deleted or changed in the + source tree (#760, fix #759, @diml) + +- Fix a crash when using an invalid alias name (#762, fixes #761, + @diml) + +- Fix a crash when using c files from another directory (#758, fixes + #734, @diml) + +- Add an `ignored_subdirs` stanza to replace `jbuild-ignore` files + (#767, @diml) + +- Fix a bug where Dune ignored previous occurrences of duplicated + fields (#779, @diml) + +- Allow setting custom build directories using the `--build-dir` flag or + `DUNE_BUILD_DIR` environment variable (#846, fix #291, @diml @rgrinberg) + +- In dune files, remove support for block (`#| ... |#)`) and sexp + (`#;`) comments. These were very rarely used and complicate the + language (#837, @diml) + +- In dune files, add support for block strings, allowing to nicely + format blocks of texts (#837, @diml) + +- Remove hard-coded knowledge of ppx_driver and + ocaml-migrate-parsetree when using a `dune` file (#576, @diml) + +- Make the output of Dune slightly more deterministic when run from + inside Dune (#855, @diml) + +- Simplify quoting behavior of variables. All values are now multi-valued and + whether a multi valued variable is allowed is determined by the quoting and + substitution context it appears in. (#849, fix #701, @rgrinberg) + +- Fix documentation generation for private libraries. (#864, fix #856, + @rgrinberg) + +- Use `Marshal` to store digest and incremental databases. This improves the + speed of 0 rebuilds. (#817, @diml) + +* Allow setting environment variables in `findlib.conf` for cross compilation + contexts. (#733, @rgrinberg) + +- Add a `link_deps` field to executables, to specify link-time dependencies + like version scripts. (#879, fix #852, @emillon) + +- Rename `files_recursively_in` to `source_tree` to make it clearer it + doesn't include generated files (#899, fix #843, @diml) + +- Present the `menhir` stanza as an extension with its own version + (#901, @diml) + +- Improve the syntax of flags in `(pps ...)`. Now instead of `(pps + (ppx1 -arg1 ppx2 (-foo x)))` one should write `(pps ppx1 -arg ppx2 + -- -foo x)` which looks nicer (#910, @diml) + +- Make `(diff a b)` ignore trailing cr on Windows and add `(cmp a b)` for + comparing binary files (#904, fix #844, @diml) + +- Make `dev` the default build profile (#920, @diml) + +- Version `dune-workspace` and `~/.config/dune/config` files (#932, @diml) + +- Add the ability to build an alias non-recursively from the command + line by writing `@@alias` (#926, @diml) + +- Add a special `default` alias that defaults to `(alias_rec install)` + when not defined by the user and make `@@default` be the default + target (#926, @diml) + +- Forbid `#require` in `dune` files in OCaml syntax (#938, @diml) + +- Add `%{profile}` variable. (#938, @rgrinberg) + +- Do not require opam-installer anymore (#941, @diml) + +- Add the `lib_root` and `libexec_root` install sections (#947, @diml) + +- Rename `path:file` to `dep:file` (#944, @emillon) + +- Remove `path-no-dep:file` (#948, @emillon) + +- Adapt the behavior of `dune subst` for dune projects (#960, @diml) + +- Add the `lib_root` and `libexec_root` sections to install stanzas + (#947, @diml) + +- Add a `Configurator.V1.Flags` module that improves the flag reading/writing + API (#840, @avsm) + +- Add a `tests` stanza that simplified defining regular and expect tests + (#822, @rgrinberg) + +- Change the `subst` subcommand to lookup the project name from the + `dune-project` whenever it's available. (#960, @diml) + +- The `subst` subcommand no longer looks up the root workspace. Previously this + detection would break the command whenever `-p` wasn't passed. (#960, @diml) + +- Add a `# DUNE_GEN` in META template files. This is done for consistency with + `# JBUILDER_GEN`. (#958, @rgrinberg) + +- Rename the following variables in dune files: + + `SCOPE_ROOT` to `project_root` + + `@` to `targets` + + `^` to `deps` + `<` was renamed in this PR and latter deleted in favor or named dependencies. + (#957, @rgrinberg) + +- Rename `ROOT` to `workspace_root` in dune files (#993, @diml) + +- Lowercase all built-in %{variables} in dune files (#956, @rgrinberg) + +- New syntax for naming dependencies: `(deps (:x a b) (:y (glob_files *.c*)))`. + This replaces the use for `${<}` in dune files. (#950, @diml, @rgrinberg) + +- Fix detection of dynamic cycles, which in particular may appear when + using `(package ..)` dependencies (#988, @diml) + +1.0+beta20 (10/04/2018) +----------------------- + +- Add a `documentation` stanza. This stanza allows one to attach .mld files to + opam packages. (#570 @rgrinberg) + +- Execute all actions (defined using `(action ..)`) in the context's + environment. (#623 @rgrinberg) + +- Add a `(universe)` special dependency to specify that an action depend on + everything in the universe. Jbuilder cannot cache the result of an action that + depend on the universe (#603, fixes #255 @diml) + +- Add a `(package )` dependency specification to indicate dependency on + a whole package. Rules depending on whole package will be executed in an + environment similar to the one we get once the package is installed (#624, + @rgrinberg and @diml) + +- Don't pass `-runtime-variant _pic` on Windows (#635, fixes #573 @diml) + +- Display documentation in alphabetical order. This is relevant to packages, + libraries, and modules. (#647, fixes #606 @rgrinberg) + +- Missing asm in ocaml -config on bytecode only architecture is no longer fatal. + The same kind of fix is preemptively applied to C compilers being absent. + (#646, fixes $637 @rgrinberg) + +- Use the host's PATH variable when running actions during cross compilation + (#649, fixes #625 @rgrinberg) + +- Fix incorrect include (`-I`) flags being passed to odoc. These flags should be + directories that include .odoc files, rather than the include flags of the + libraries. (#652 fixes #651 @rgrinberg) + +- Fix a regression introduced by beta19 where the generated merlin + files didn't include the right `-ppx` flags in some cases (#658 + fixes #657 @diml) + +- Fix error message when a public library is defined twice. Before + jbuilder would raise an uncaught exception (Fixes #661, @diml) + +- Fix several cases where `external-lib-deps` was returning too little + dependencies (#667, fixes #644 @diml) + +- Place module list on own line in generated entry point mld (#670 @antron) + +- Cosmetic improvements to generated entry point mld (#653 @trefis) + +- Remove most useless parentheses from the syntax (#915, @diml) + +1.0+beta19.1 (21/03/2018) +------------------------- + +- Fix regression introduced by beta19 where duplicate environment variables in + Unix.environ would cause a fatal error. The first defined environment variable + is now chosen. (#638 fixed by #640) + +- Use ';' as the path separator for OCAMLPATH on Cygwin (#630 fixed by #636 + @diml). + +- Use the contents of the `OCAMLPATH` environment variable when not relying on + `ocamlfind` (#642 @diml) + +1.0+beta19 (14/03/2018) +----------------------- + +- Ignore errors during the generation of the .merlin (#569, fixes #568 and #51) + +- Add a workaround for when a library normally installed by the + compiler is not installed but still has a META file (#574, fixes + #563) + +- Do not depend on ocamlfind. Instead, hard-code the library path when + installing from opam (#575) + +- Change the default behavior regarding the check for overlaps between + local and installed libraries. Now even if there is no link time + conflict, we don't allow an external dependency to overlap with a + local library, unless the user specifies `allow_overlapping_dependencies` + in the jbuild file (#587, fixes #562) + +- Expose a few more variables in jbuild files: `ext_obj`, `ext_asm`, + `ext_lib`, `ext_dll` and `ext_exe` as well as `${ocaml-config:XXX}` + for most variables in the output of `ocamlc -config` (#590) + +- Add support for inline and inline expectation tests. The system is + generic and should support several inline test systems such as + `ppx_inline_test`, `ppx_expect` or `qtest` (#547) + +- Make sure modules in the current directory always have precedence + over included directories (#597) + +- Add support for building executables as object or shared object + files (#23) + +- Add a `best` mode which is native with fallback to byte-code when + native compilation is not available (#23) + +- Fix locations reported in error messages (#609) + +- Report error when a public library has a private dependency. Previously, this + would be silently ignored and install broken artifacts (#607). + +- Fix display when output is not a tty (#518) + +1.0+beta18.1 (14/03/2018) +------------------------- + +- Reduce the number of simultaneously opened fds (#578) + +- Always produce an implementation for the alias module, for + non-jbuilder users (Fix #576) + +- Reduce interleaving in the scheduler in an attempt to make Jbuilder + keep file descriptors open for less long (#586) + +- Accept and ignore upcoming new library fields: `ppx.driver`, + `inline_tests` and `inline_tests.backend` (#588) + +- Add a hack to be able to build ppxlib, until beta20 which will have + generic support for ppx drivers + +1.0+beta18 (25/02/2018) +----------------------- + +- Fix generation of the implicit alias module with 4.02. With 4.02 it + must have an implementation while with OCaml >= 4.03 it can be an + interface only module (#549) + +- Let the parser distinguish quoted strings from atoms. This makes + possible to use "${v}" to concatenate the list of values provided by + a split-variable. Concatenating split-variables with text is also + now required to be quoted. + +- Split calls to ocamldep. Before ocamldep would be called once per + `library`/`executables` stanza. Now it is called once per file + (#486) + +- Make sure to not pass `-I ` to the compiler. It is + useless and it causes problems in some cases (#488) + +- Don't stop on the first error. Before, jbuilder would stop its + execution after an error was encountered. Now it continues until + all branches have been explored (#477) + +- Add support for a user configuration file (#490) + +- Add more display modes and change the default display of + Jbuilder. The mode can be set from the command line or from the + configuration file (#490) + +- Allow to set the concurrency level (`-j N`) from the configuration file (#491) + +- Store artifacts for libraries and executables in separate + directories. This ensure that Two libraries defined in the same + directory can't see each other unless one of them depend on the + other (#472) + +- Better support for mli/rei only modules (#489) + +- Fix support for byte-code only architectures (#510, fixes #330) + +- Fix a regression in `external-lib-deps` introduced in 1.0+beta17 + (#512, fixes #485) + +- `@doc` alias will now build only documentation for public libraries. A new + `@doc-private` alias has been added to build documentation for private + libraries. + +- Refactor internal library management. It should now be possible to + run `jbuilder build @lint` in Base for instance (#516) + +- Fix invalid warning about non-existent directory (#536, fixes #534) + +1.0+beta17 (01/02/2018) +----------------------- + +- Make jbuilder aware that `num` is an external package in OCaml >= 4.06.0 + (#358) + +- `jbuilder exec` will now rebuild the executable before running it if + necessary. This can be turned off by passing `--no-build` (#345) + +- Fix `jbuilder utop` to work in any working directory (#339) + +- Fix generation of META synopsis that contains double quotes (#337) + +- Add `S .` to .merlin by default (#284) + +- Improve `jbuilder exec` to make it possible to execute non public executables. + `jbuilder exec path/bin` will execute `bin` inside default (or specified) + context relative to `path`. `jbuilder exec /path` will execute `/path` as + absolute path but with the context's environment set appropriately. Lastly, + `jbuilder exec` will change the root as to which paths are relative using the + `-root` option. (#286) + +- Fix `jbuilder rules` printing rules when some binaries are missing (#292) + +- Build documentation for non public libraries (#306) + +- Fix doc generation when several private libraries have the same name (#369) + +- Fix copy# for C/C++ with Microsoft C compiler (#353) + +- Add support for cross-compilation. Currently we are supporting the + opam-cross-x repositories such as + [opam-cross-windows](https://github.com/whitequark/opam-cross-windows) + (#355) + +- Simplify generated META files: do not generate the transitive + closure of dependencies in META files (#405) + +- Deprecated `${!...}`: the split behavior is now a property of the + variable. For instance `${CC}`, `${^}`, `${read-lines:...}` all + expand to lists unless used in the middle of a longer atom (#336) + +- Add an `(include ...)` stanza allowing one to include another + non-generated jbuild file in the current file (#402) + +- Add a `(diff )` action allowing to diff files and + promote generated files in case of mismatch (#402, #421) + +- Add `jbuilder promote` and `--auto-promote` to promote files (#402, + #421) + +- Report better errors when using `(glob_files ...)` with a directory + that doesn't exist (#413, Fix #412) + +- Jbuilder now properly handles correction files produced by + ppx_driver. This allows to use `[@@deriving_inline]` in .ml/.mli + files. This require `ppx_driver >= v0.10.2` to work properly (#415) + +- Make jbuilder load rules lazily instead of generating them all + eagerly. This speeds up the initial startup time of jbuilder on big + workspaces (#370) + +- Now longer generate a `META.pkg.from-jbuilder` file. Now the only + way to customize the generated `META` file is through + `META.pkg.template`. This feature was unused and was making the code + complicated (#370) + +- Remove read-only attribute on Windows before unlink (#247) + +- Use /Fo instead of -o when invoking the Microsoft C compiler to eliminate + deprecation warning when compiling C++ sources (#354) + +- Add a mode field to `rule` stanzas: + + `(mode standard)` is the default + + `(mode fallback)` replaces `(fallback)` + + `(mode promote)` means that targets are copied to the source tree + after the rule has completed + + `(mode promote-until-clean)` is the same as `(mode promote)` except + that `jbuilder clean` deletes the files copied to the source tree. + (#437) + +- Add a flag `--ignore-promoted-rules` to make jbuilder ignore rules + with `(mode promote)`. `-p` implies `--ignore-promoted-rules` (#437) + +- Display a warning for invalid lines in jbuild-ignore (#389) + +- Always build `boot.exe` as a bytecode program. It makes the build of + jbuilder faster and fix the build on some architectures (#463, fixes #446) + +- Fix bad interaction between promotion and incremental builds on OSX + (#460, fix #456) + +- Make the beginning of a new build more explicit in watch mode + (#2542 @diml) + +1.0+beta16 (05/11/2017) +----------------------- + +- Fix build on 32-bit OCaml (#313) + +1.0+beta15 (04/11/2017) +----------------------- + +- Change the semantic of aliases: there are no longer aliases that are + recursive such as `install` or `runtest`. All aliases are + non-recursive. However, when requesting an alias from the command + line, this request the construction of the alias in the specified + directory and all its children recursively. This allows users to get + the same behavior as previous recursive aliases for their own + aliases, such as `example`. Inside jbuild files, one can use `(deps + (... (alias_rec xxx) ...))` to get the same behavior as on the + command line. (#268) + +- Include sub libraries that have a `.` in the generated documentation index + (#280). + +- Fix "up" links to the top-level index in the odoc generated documentation + (#282). + +- Fix `ARCH_SIXTYFOUR` detection for OCaml 4.06.0 (#303) + +1.0+beta14 (11/10/2017) +----------------------- + +- Add (copy_files ) and (copy_files# ) stanzas. These + stanzas setup rules for copying files from a sub-directory to the + current directory. This provides a reasonable way to support + multi-directory library/executables in jbuilder (#35, @bobot) + +- An empty `jbuild-workspace` file is now interpreted the same as one + containing just `(context default)` + +- Better support for on-demand utop toplevels on Windows and when the + library has C stubs + +- Print `Entering directory '...'` when the workspace root is not the + current directory. This allows Emacs and Vim to know where relative + filenames should be interpreted from. (fixes #138, @jeremiedimino) + +- Fix a bug related to `menhir` stanzas: `menhir` stanzas with a + `merge_into` field that were in `jbuild` files in sub-directories + where incorrectly interpreted (#264) + +- Add support for locks in actions, for tests that can't be run + concurrently (#263) + +- Support `${..}` syntax in the `include` stanza. (#231) + +1.0+beta13 (05/09/2017) +----------------------- + +- Generate toplevel html index for documentation (#224, @samoht) + +- Fix recompilation of native artifacts. Regression introduced in the last + version (1.0+beta12) when digests replaces timestamps for checking staleness + (#238, @dra27) + +1.0+beta12 (18/08/2017) +----------------------- + +- Fix the quoting of `FLG` lines in generated `.merlin` files (#200, + @mseri) + +- Use the full path of archive files when linking. Before jbuilder + would do: `-I file.cmxa`, now it does `-I + /file.cmxa`. Fixes #118 and #177 + +- Use an absolute path for ppx drivers in `.merlin` files. Merlin + <3.0.0 used to run ppx commands from the directory where the + `.merlin` was present but this is no longer the case + +- Allow to use `jbuilder install` in contexts other than opam; if + `ocamlfind` is present in the `PATH` and the user didn't pass + `--prefix` or `--libdir` explicitly, use the output of `ocamlfind + printconf destdir` as destination directory for library files (#179, + @bobot) + +- Allow `(:include ...)` forms in all `*flags` fields (#153, @dra27) + +- Add a `utop` subcommand. Running `jbuilder utop` in a directory + builds and executes a custom `utop` toplevel with all libraries + defined in the current directory (#183, @rgrinberg) + +- Do not accept `per_file` anymore in `preprocess` field. `per_file` + was renamed `per_module` and it is planned to reuse `per_file` for + another purpose + +- Warn when a file is both present in the source tree and generated by + a rule. Before, jbuilder would silently ignore the rule. One now has + to add a field `(fallback)` to custom rules to keep the current + behavior (#218) + +- Get rid of the `deprecated-ppx-method` findlib package for ppx + rewriters (#222, fixes #163) + +- Use digests (MD5) of files contents to detect changes rather than + just looking at the timestamps. We still use timestamps to avoid + recomputing digests. The performance difference is negligible and we + avoid more useless recompilations, especially when switching branches + for instance (#209, fixes #158) + +1.0+beta11 (21/07/2017) +----------------------- + +- Fix the error message when there are more than one `.opam` + file for a given package + +- Report an error when in a wrapped library, a module that is not the + toplevel module depends on the toplevel module. This doesn't make as + such a module would in theory be inaccessible from the outside + +- Add `${SCOPE_ROOT}` pointing to the root of the current scope, to + fix some misuses of `${ROOT}` + +- Fix useless hint when all missing dependencies are optional (#137) + +- Fix a bug preventing one from generating `META.pkg.template` with a + custom rule (#190) + +- Fix compilation of reason projects: .rei files where ignored and + caused the build to fail (#184) + +1.0+beta10 (08/06/2017) +----------------------- + +- Add a `clean` subcommand (@rdavison, #89) + +- Add support for generating API documentation with odoc (#74) + +- Don't use unix in the bootstrap script, to avoid surprises with + Cygwin + +- Improve the behavior of `jbuilder exec` on Windows + +- Add a `--no-buffer` option to see the output of commands in + real-time. Should only be used with `-j1` + +- Deprecate `per_file` in preprocessing specifications and + rename it `per_module` + +- Deprecate `copy-and-add-line-directive` and rename it `copy#` + +- Remove the ability to load arbitrary libraries in jbuild file in + OCaml syntax. Only `unix` is supported since a few released packages + are using it. The OCaml syntax might eventually be replaced by a + simpler mechanism that plays better with incremental builds + +- Properly define and implement scopes + +- Inside user actions, `${^}` now includes files matches by + `(glob_files ...)` or `(file_recursively_in ...)` + +- When the dependencies and targets of a rule can be inferred + automatically, you no longer need to write them: `(rule (copy a b))` + +- Inside `(run ...)`, `${xxx}` forms that expands to lists can now be + split across multiple arguments by adding a `!`: `${!xxx}`. For + instance: `(run foo ${!^})` + +- Add support for using the contents of a file inside an action: + - `${read:}` + - `${read-lines:}` + - `${read-strings:}` (same as `read-lines` but lines are + escaped using OCaml convention) + +- When exiting prematurely because of a failure, if there are other + background processes running and they fail, print these failures + +- With msvc, `-lfoo` is transparently replaced by `foo.lib` (@dra27, #127) + +- Automatically add the `.exe` when installing executables on Windows + (#123) + +- `(run ...)` now resolves `` locally if + possible. i.e. `(run ${bin:prog} ...)` and `(run prog ...)` behave + the same. This seems like the right default + +- Fix a bug where `jbuild rules` would crash instead of reporting a + proper build error + +- Fix a race condition in future.ml causing jbuilder to crash on + Windows in some cases (#101) + +- Fix a bug causing ppx rewriter to not work properly when using + multiple build contexts (#100) + +- Fix .merlin generation: projects in the same workspace are added to + merlin's source path, so "locate" works on them. + +1.0+beta9 (19/05/2017) +---------------------- + +- Add support for building Reason projects (@rgrinberg, #58) + +- Add support for building javascript with js-of-ocaml (@hhugo, #60) + +- Better support for topkg release workflow. See + [topkg-jbuilder](https://github.com/diml/topkg-jbuilder) for more + details + +- Port the manual to rst and setup a jbuilder project on + readthedocs.org (@rgrinberg, #78) + +- Hint for mistyped targets. Only suggest correction on the basename + for now, otherwise it's slow when the workspace is big + +- Add a `(package ...)` field for aliases, so that one can restrict + tests to a specific package (@rgrinberg, #64) + +- Fix a couple of bugs on Windows: + + fix parsing of end of lines in some cases + + do not take the case into account when comparing environment + variable names + +- Add AppVeyor CI + +- Better error message in case a chain of dependencies *crosses* the + installed world + +- Better error messages for invalid dependency list in jbuild files + +- Several improvements/fixes regarding the handling of findlib packages: + + Better error messages when a findlib package is unavailable + + Don't crash when an installed findlib package has missing + dependencies + + Handle the findlib alternative directory layout which is still + used by a few packages + +- Add `jbuilder installed-libraries --not-available` explaining why + some libraries are not available + +- jbuilder now records dependencies on files of external + libraries. This mean that when you upgrade a library, jbuilder will + know what need to be rebuilt. + +- Add a `jbuilder rules` subcommand to dump internal compilation + rules, mostly for debugging purposes + +- Ignore all directories starting with a `.` or `_`. This seems to be + a common pattern: + - `.git`, `.hg`, `_darcs` + - `_build` + - `_opam` (opam 2 local switches) + +- Fix the hint for `jbuilder external-lib-deps` (#72) + +- Do not require `ocamllex` and `ocamlyacc` to be at the same location + as `ocamlc` (#75) + +1.0+beta8 (17/04/2017) +---------------------- + +- Added `${lib-available:}` which expands to `true` or + `false` with the same semantic as literals in `(select ...)` stanzas + +- Remove hard-coded knowledge of a few specific ppx rewriters to ease + maintenance moving forward + +- Pass the library name to ppx rewriters via the `library-name` cookie + +- Fix: make sure the action working directory exist before running it + +1.0+beta7 (12/04/2017) +---------------------- + +- Make the output quieter by default and add a `--verbose` argument + (@stedolan, #40) + +- Various documentation fixes (@adrieng, #41) + +- Make `@install` the default target when no targets are specified + (@stedolan, #47) + +- Add predefined support for menhir, similar to ocamlyacc support + (@rgrinberg, #42) + +- Add internal support for sandboxing actions and sandbox the build of + the alias module with 4.02 to workaround the compiler trying to read + the cmi of the aliased modules + +- Allow to disable dynlink support for libraries via `(no_dynlink)` + (#55) + +- Add a -p/--for-release-of-packages command line argument to simplify + the jbuilder invocation in opam files and make it more future proof + (#52) + +- Fix the lookup of the executable in `jbuilder exec foo`. Before, + even if `foo` was to be installed, the freshly built version wasn't + selected + +- Don't generate a `exists_if ...` lines in META files. These are + useless sine the META files are auto-generated + +1.0+beta6 (29/03/2017) +---------------------- + +- Add an `(executable ...)` stanza for single executables (#33) + +- Add a `(package ...)` and `(public_name )/(public_names + (.opam` file + +- Fixed a bug where `.merlin` files where not generated at the root of + the workspace (#20) + +- Fix a bug where a `(glob_files ...)` would cause other dependencies + to be ignored + +- Fix the generated `ppx(...)` line in `META` files + +- Fix `(optional)` when a ppx runtime dependency is not available + (#24) + +- Do not crash when an installed package that we don't need has + missing dependencies (#25) + +1.0+beta2 (10/03/2017) +---------------------- + +- Simplified the rules for finding the root of the workspace as the + old ones were often picking up the home directory. New rules are: + + look for a `jbuild-workspace` file in parent directories + + look for a `jbuild-workspace*` file in parent directories + + use the current directory +- Fixed the expansion of `${ROOT}` in actions + +- Install `quick-start.org` in the documentation directory + +- Add a few more things in the log file to help debugging + +1.0+beta1 (07/03/2017) +---------------------- + +- Added a manual + +- Support incremental compilation + +- Switched the CLI to cmdliner and added a `build` command (#5, @rgrinberg) + +- Added a few commands: + + `runtest` + + `install` + + `uninstall` + + `installed-libraries` + + `exec`: execute a command in an environment similar to what you + would get after `jbuilder install` +- Removed the `build-package` command in favor of a `--only-packages` + option that is common to all commands + +- Automatically generate `.merlin` files (#2, @rdavison) + +- Improve the output of jbuilder, in particular don't mangle the + output of commands when using `-j N` with `N > 1` + +- Generate a log in `_build/log` + +- Versioned the jbuild format and added a first stable version. You + should now put `(jbuilder_version 1)` in a `jbuild` file at the root + of your project to ensure forward compatibility + +- Switch from `ppx_driver` to `ocaml-migrate-parsetree.driver`. In + order to use ppx rewriters with Jbuilder, they need to use + `ocaml-migrate-parsetree.driver` + +- Added support for aliases (#7, @rgrinberg) + +- Added support for compiling against multiple opam switch + simultaneously by writing a `jbuild-workspace` file + +- Added support for OCaml 4.02.3 + +- Added support for architectures that don't have natdynlink + +- Search the root according to the rules described in the manual + instead of always using the current directory + +- extended the action language to support common actions without using + a shell: + + `(with-stdout-to )` + + `(copy )` + + ... + +- Removed all implicit uses of bash or the system shell. Now one has + to write explicitly `(bash "...")` or `(system "...")` + +- Generate meaningful versions in `META` files + +- Strengthen the scope of a package. Jbuilder knows about package + `foo` only in the sub-tree starting from where `foo.opam` lives + +0.1.alpha1 (04/12/2016) +----------------------- + +First release diff --git a/unikernel/duniverse/dune_/CODE_OF_CONDUCT.md b/unikernel/duniverse/dune_/CODE_OF_CONDUCT.md new file mode 100644 index 00000000..5a915b87 --- /dev/null +++ b/unikernel/duniverse/dune_/CODE_OF_CONDUCT.md @@ -0,0 +1,7 @@ +# Code of Conduct + +This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md). + +# Enforcement + +This project follows the OCaml Code of Conduct [enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement). diff --git a/unikernel/duniverse/dune_/CONTRIBUTING.md b/unikernel/duniverse/dune_/CONTRIBUTING.md new file mode 100644 index 00000000..555c16e5 --- /dev/null +++ b/unikernel/duniverse/dune_/CONTRIBUTING.md @@ -0,0 +1,89 @@ +Dune is an community orientated open source project. It was originally +developed at [Jane Street][js] and is now maintained by Jane Street, +[Tarides][tarides] as well as several developers from the OCaml +community. + +Contributions to Dune are welcome and should be submitted via GitHub +pull requests against the `main` branch. See [./doc/hacking.rst][hack] +for a guide to getting started on the code base. + +Dune is distributed under the MIT license and contributors are +required to sign their work in order to certify that they have the +right to submit it under this license. See the following section for +more details. + +Signing contributions +--------------------- + +We require that you sign your contributions. Your signature certifies +that you wrote the patch or otherwise have the right to pass it on as +an open-source patch. The rules are pretty simple: if you can certify +the below (from [developercertificate.org][dco]): + +``` +Developer Certificate of Origin +Version 1.1 + +Copyright (C) 2004, 2006 The Linux Foundation and its contributors. +1 Letterman Drive +Suite D4700 +San Francisco, CA, 94129 + +Everyone is permitted to copy and distribute verbatim copies of this +license document, but changing it is not allowed. + + +Developer's Certificate of Origin 1.1 + +By making a contribution to this project, I certify that: + +(a) The contribution was created in whole or in part by me and I + have the right to submit it under the open source license + indicated in the file; or + +(b) The contribution is based upon previous work that, to the best + of my knowledge, is covered under an appropriate open source + license and I have the right under that license to submit that + work with modifications, whether created in whole or in part + by me, under the same open source license (unless I am + permitted to submit under a different license), as indicated + in the file; or + +(c) The contribution was provided directly to me by some other + person who certified (a), (b) or (c) and I have not modified + it. + +(d) I understand and agree that this project and the contribution + are public and that a record of the contribution (including all + personal information I submit with it, including my sign-off) is + maintained indefinitely and may be redistributed consistent with + this project or the open source license(s) involved. +``` + +Then you just add a line to every git commit message: + +``` +Signed-off-by: Joe Smith +``` + +Use your real name (sorry, no pseudonyms or anonymous contributions.) + +If you set your `user.name` and `user.email` git configs, you can sign +your commit automatically with `git commit -s`. + +It is possible to set up `git` so that it signs off automatically by using a +prepare-commit-msg hook in git. See for +details. As noted in the manual for `format.signOff`, note that adding the +`Signed-off-by` trailer should be a conscious act and means that you certify +you have the rights to submit this work under the same open source license. + +[dco]: http://developercertificate.org/ +[js]: https://www.janestreet.com/ +[tarides]: https://tarides.com/ +[hack]: ./doc/hacking.rst + +Coding style +------------ + +- wrap lines at 80 characters, +- use `[Ss]nake_case` over `[Pp]ascalCase`. diff --git a/unikernel/duniverse/dune_/LICENSE.md b/unikernel/duniverse/dune_/LICENSE.md new file mode 100644 index 00000000..06829595 --- /dev/null +++ b/unikernel/duniverse/dune_/LICENSE.md @@ -0,0 +1,21 @@ +The MIT License + +Copyright (c) 2016 Jane Street Group, LLC + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/unikernel/duniverse/dune_/Makefile b/unikernel/duniverse/dune_/Makefile new file mode 100644 index 00000000..acf9dcec --- /dev/null +++ b/unikernel/duniverse/dune_/Makefile @@ -0,0 +1,178 @@ +.DEFAULT_GOAL := help + +PREFIX_ARG := $(if $(PREFIX),--prefix $(PREFIX),) +LIBDIR_ARG := $(if $(LIBDIR),--libdir $(LIBDIR),) +DESTDIR_ARG := $(if $(DESTDIR),--destdir $(DESTDIR),) +INSTALL_ARGS := $(PREFIX_ARG) $(LIBDIR_ARG) $(DESTDIR_ARG) +BIN := ./_boot/dune.exe + +# Dependencies recommended for developing dune locally, +# but not wanted in CI +DEV_DEPS := \ +core_bench \ +patdiff + +TEST_OCAMLVERSION := 5.3.0 +# When updating this version, don't forget to also bump the number in the docs. + +-include Makefile.dev + +.PHONY: help +help: + @cat doc/make-help.txt + +.PHONY: bootstrap +bootstrap: + $(MAKE) -B $(BIN) + +.PHONY: test-bootstrap +test-bootstrap: + @ocaml boot/bootstrap.ml --boot-dir _test_boot + +.PHONY: release +release: $(BIN) + @$(BIN) build @install -p dune --profile dune-bootstrap + +$(BIN): + @ocaml boot/bootstrap.ml + +dev: $(BIN) + $(BIN) build @install + +watch: $(BIN) + $(BIN) build @install --watch + +all: $(BIN) + $(BIN) build + +.PHONY: install +install: + $(BIN) install $(INSTALL_ARGS) dune + +.PHONY: uninstall +uninstall: + $(BIN) uninstall $(INSTALL_ARGS) dune + +.PHONY: reinstall +reinstall: uninstall install + +.PHONY: install-ocamlformat +install-ocamlformat: + opam install -y ocamlformat.$$(awk -F = '$$1 == "version" {print $$2}' .ocamlformat) + +.PHONY: dev-deps +dev-deps: + opam install -y . --deps-only --with-dev-setup + +.PHONY: dev-deps-sans-melange +dev-deps-sans-melange: dev-deps + +.PHONY: dev-switch +dev-switch: + opam update +# Ensuring that either a dev switch already exists or a new one is created + if test -d _opam ; then \ + opam install -y --update-invariant ocaml.$(TEST_OCAMLVERSION); \ + else \ + opam switch create -y . $(TEST_OCAMLVERSION) --no-install ; \ + fi + opam pin add -y . -n --with-version=dev + opam install -y . --deps-only --with-test --with-dev-setup + $(MAKE) install-ocamlformat + opam install -y $(DEV_DEPS) + +.PHONY: test +test: $(BIN) + $(BIN) runtest + +test-windows: $(BIN) + $(BIN) build @runtest-windows + +test-js: $(BIN) + $(BIN) build @runtest-js + +test-wasm: $(BIN) + DUNE_WASM_TEST=enable $(BIN) build @runtest-wasm + +test-coq: $(BIN) + DUNE_COQ_TEST=enable $(BIN) build @runtest-coq + +test-melange: $(BIN) + $(BIN) build @runtest-melange + +test-all: $(BIN) + $(BIN) build @runtest @runtest-js @runtest-coq @runtest-melange + +test-all-sans-melange: $(BIN) + $(BIN) build @runtest @runtest-js @runtest-coq + +.PHONY: check +check: $(BIN) + @$(BIN) build @check + +.PHONY: fmt +fmt: $(BIN) + @$(BIN) fmt + +.PHONY: promote +promote: $(BIN) + @$(BIN) promote + +.PHONY: accept-corrections +accept-corrections: promote + +.PHONY: clean +clean: + rm -rf _boot _build + +distclean: clean + rm -f src/dune_rules/setup.ml + +.PHONY: doc +doc: + sphinx-build -W doc doc/_build + +# livedoc-deps: you may need to [pip3 install sphinx-autobuild] and [pip3 install -r doc/requirements.txt] +livedoc: + cd doc && sphinx-autobuild . _build --port 8888 -q --re-ignore '\.#.*' + +update-jbuilds: $(BIN) + $(BIN) build @doc/runtest --auto-promote + +# If the first argument is "run"... +ifeq (dune,$(firstword $(MAKECMDGOALS))) + # use the rest as arguments for "run" + RUN_ARGS := $(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)) + # ...and turn them into do-nothing targets + $(eval $(RUN_ARGS):;@:) +endif + +.PHONY: bench +bench: $(BIN) + @$(BIN) exec -- ./bench/bench.exe $(BIN) + +.PHONY: dune +dune: $(BIN) + $(BIN) $(RUN_ARGS) + +# Use this target to make sure that we always run the in source dune when making +# the release +.PHONY: opam-release +opam-release: dev + $(BIN) exec -- $(MAKE) dune-release + +dune-release: + dune-release tag + dune-release distrib --skip-build --skip-lint --skip-tests +# See https://github.com/ocamllabs/dune-release/issues/206 + DUNE_RELEASE_DELEGATE=github-dune-release-delegate dune-release publish --verbose + dune-release opam pkg + dune-release opam submit + +.PHONY: docker-build-image +docker-build-image: + docker build -f docker/dev.Dockerfile -t dune . + +.PHONY: docker-compose +docker-compose: + docker compose -f docker/dev.yml run dune bash diff --git a/unikernel/duniverse/dune_/README.md b/unikernel/duniverse/dune_/README.md new file mode 100644 index 00000000..6c460a5b --- /dev/null +++ b/unikernel/duniverse/dune_/README.md @@ -0,0 +1,152 @@ +![Dune][logo] + +# A Composable Build System for OCaml + +[![Main Workflow][workflow-badge]][workflow] +[![Release][release-badge]][release] +[![License][license-badge]][license] +[![Contributors][contributors-badge]][contributors] + +[logo]: doc/assets/imgs/dune_logo_459x116.png +[workflow]: https://github.com/ocaml/dune/actions/workflows/workflow.yml +[workflow-badge]: https://img.shields.io/github/actions/workflow/status/ocaml/dune/workflow.yml?label=CI&logo=github +[release]: https://github.com/ocaml/dune/releases/latest +[release-badge]: https://img.shields.io/github/v/release/ocaml/dune?label=release +[license]: https://github.com/ocaml/dune/blob/main/LICENSE.md +[license-badge]: https://img.shields.io/github/license/ocaml/dune +[contributors]: https://github.com/ocaml/dune/graphs/contributors +[contributors-badge]: https://img.shields.io/github/contributors-anon/ocaml/dune + +Dune is a build system for OCaml. It provides a consistent experience and takes +care of the low-level details of OCaml compilation. You need only to provide a +description of your project, and Dune will do the rest. + +Dune implements a scheme that's inspired from the one used inside Jane Street +and adapted to the open source world. It has matured over a long time and is +used daily by hundreds of developers, meaning it's highly tested and productive. + +Dune comes with a [manual][manual]. If you want to get started without reading +too much, look at the [quick start guide][quick-start] or watch [this +introduction video][video]. + +The [example][example] directory contains examples of projects using Dune. + +[manual]: https://dune.readthedocs.io/en/latest/ +[quick-start]: https://dune.readthedocs.io/en/latest/quick-start.html +[example]: https://github.com/ocaml/dune/tree/main/example +[merlin]: https://github.com/ocaml/merlin +[opam]: https://opam.ocaml.org +[issues]: https://github.com/ocaml/dune/issues +[discussions]: https://github.com/ocaml/dune/discussions +[dune-release]: https://github.com/ocamllabs/dune-release +[video]: https://youtu.be/BNZhmMAJarw + +# How does it work? + +Dune reads project metadata from `dune` files, which are static files with a +simple S-expression syntax. It uses this information to setup build rules, +generate configuration files for development tools such as [Merlin][merlin], +handle installation, etc. + +Dune itself is fast, has very little overhead, and supports parallel builds on +all platforms. It has no system dependencies. OCaml is all you need to build +Dune and packages using Dune. + +In particular, one can install OCaml on Windows with a binary installer and then +use only the Windows Console to build Dune and packages using Dune. + +# Strengths + +## Composable + +Dune is composable, meaning that multiple Dune projects can be arranged +together, leading to a single build that Dune knows how to execute. This allows +for monorepos of projects. + +Dune makes simultaneous development on multiple packages a trivial task. + +## Gracefully Handles Multi-Package Repositories + +Dune knows how to handle repositories containing several packages. When building +via [opam][opam], it is able to correctly use libraries that were previously +installed, even if they are already present in the source tree. + +The magic invocation is: + +```console +$ dune build --only-packages @install +``` + +## Build Against Several Configurations at Once + +Dune can build a given source code repository against several configurations +simultaneously. This helps maintaining packages across several versions of +OCaml, as you can test them all at once without hassle. + +In particular, this makes it easy to handle +[cross-compilation][cross-compilation]. This feature requires [opam][opam]. + +[cross-compilation]: https://dune.readthedocs.io/en/latest/cross-compilation.html + +# Installation + +## Requirements + +Dune requires OCaml version 4.08.0 to build itself and can build OCaml projects +using OCaml 4.02.3 or greater. + +## Installation + +We recommended installing Dune via the [opam package manager][opam]: + +```console +$ opam install dune +``` + +If you are new to opam, make sure to run `eval $(opam config env)` to make +`dune` available in your `PATH`. The `dune` binary is self-contained and +relocatable, so you can safely copy it somewhere else to make it permanently +available. + +You can also build it manually with: + +```console +$ make release +$ make install +``` + +If you do not have `make`, you can do the following: + +```console +$ ocaml boot/bootstrap.ml +$ ./dune.exe build -p dune --profile dune-bootstrap +$ ./dune.exe install dune +``` + +The first command builds the `dune.exe` binary. The second builds the additional +files installed by Dune, such as the _man_ pages, and the last simply installs +all of that on the system. + +**Please note**: unless you ran the optional `./configure` script, you can +simply copy `dune.exe` anywhere and it will just work. `dune` is fully +relocatable and discovers its environment at runtime rather than hard-coding it +at compilation time. + +# Support + +[![Issues][issues-badge]][issues] +[![Discussions][discussions-badge]][discussions] +[![Discuss OCaml][discuss-ocaml-badge]][discuss-ocaml] +[![Discord][discord-badge]][discord] + +If you have questions or issues about Dune, you can ask in [our GitHub +discussions page][discussions] or [open a ticket on GitHub][issues]. + +[discussions]: https://github.com/ocaml/dune/discussions +[discussions-badge]: https://img.shields.io/github/discussions/ocaml/dune?logo=github +[issues]: https://github.com/ocaml/dune/issues +[issues-badge]: https://img.shields.io/github/issues/ocaml/dune?logo=github +[discuss-ocaml]: https://discuss.ocaml.org +[discuss-ocaml-badge]: https://img.shields.io/discourse/topics?server=https%3A%2F%2Fdiscuss.ocaml.org%2F +[discord]: https://discord.com/invite/cCYQbqN +[discord-badge]: https://img.shields.io/discord/436568060288172042?logo=discord diff --git a/unikernel/duniverse/dune_/bench.Dockerfile b/unikernel/duniverse/dune_/bench.Dockerfile new file mode 100644 index 00000000..39db67c8 --- /dev/null +++ b/unikernel/duniverse/dune_/bench.Dockerfile @@ -0,0 +1,4 @@ +FROM ocaml/opam:debian-12-ocaml-4.14 +RUN opam depext -u patdiff.v0.15.0 +COPY --chown=opam:opam . bench-dir +WORKDIR bench-dir diff --git a/unikernel/duniverse/dune_/bench/bench.ml b/unikernel/duniverse/dune_/bench/bench.ml new file mode 100644 index 00000000..7a27251d --- /dev/null +++ b/unikernel/duniverse/dune_/bench/bench.ml @@ -0,0 +1,275 @@ +open Stdune +module Process = Dune_engine.Process + +module Console = struct + include Dune_console + + let printf fmt = printf ("[Bench] " ^^ fmt) +end + +module Json = struct + include Chrome_trace.Json + include Dune_stats.Json +end + +module Output = struct + type measurement = + [ `Int of int + | `Float of float + ] + + type bench = + { name : string + ; metrics : (string * [ measurement | `List of measurement list ] * string) list + } + + let json_of_bench { name; metrics } : Json.t = + let metrics = + List.map metrics ~f:(fun (name, value, units) -> + let value = + match value with + | `Int i -> `Int i + | `Float f -> `Float f + | `List xs -> `List (xs :> Json.t list) + in + `Assoc [ "name", `String name; "value", value; "units", `String units ]) + in + `Assoc [ "name", `String name; "metrics", `List metrics ] + ;; + + type t = + { config : (string * Json.t) list + ; version : int + ; results : bench list + } + + let to_json { config; version; results } : Json.t = + let assoc = [ "results", `List (List.map results ~f:json_of_bench) ] in + let assoc = ("version", `Int version) :: assoc in + let assoc = + match config with + | [] -> assoc + | _ :: _ -> ("config", `Assoc config) :: assoc + in + `Assoc assoc + ;; +end + +let git = + lazy + (let path = Env.get Env.initial "PATH" |> Option.value_exn |> Bin.parse_path in + Bin.which ~path "git" |> Option.value_exn) +;; + +let dune = Path.of_string (Filename.concat Fpath.initial_cwd Sys.argv.(1)) +let output_limit = Dune_engine.Execution_parameters.Action_output_limit.default +let make_stdout () = Process.Io.make_stdout ~output_on_success:Swallow ~output_limit +let make_stderr () = Process.Io.make_stderr ~output_on_success:Swallow ~output_limit + +module Package = struct + type t = + { org : string + ; name : string + } + + let uri { org; name } = sprintf "https://github.com/%s/%s" org name + let make org name = { org; name } + + let clone t = + let stdout_to = make_stdout () in + let stderr_to = make_stderr () in + let stdin_from = Process.Io.(null In) in + Process.run + Strict + ~display:Quiet + ~stdout_to + ~stderr_to + ~stdin_from + (Lazy.force git) + [ "clone"; uri t ] + ;; +end + +let duniverse = + let pkg = Package.make in + [ pkg "ocaml-dune" "dune-bench" ] +;; + +let prepare_workspace () = + Fiber.parallel_iter duniverse ~f:(fun (pkg : Package.t) -> + Fpath.rm_rf pkg.name; + Console.printf "cloning %s/%s" pkg.org pkg.name; + Fiber.finalize + (fun () -> Package.clone pkg) + ~finally:(fun () -> + Fiber.return @@ Console.printf "finished cloning %s/%s" pkg.org pkg.name)) +;; + +let dune_build ~name ~sandbox = + let stdin_from = Process.(Io.null In) in + let stdout_to = make_stdout () in + let stderr_to = make_stderr () in + let gc_dump = Temp.create File ~prefix:"gc_stat" ~suffix:name in + let open Fiber.O in + (* Build with timings and gc stats *) + let+ times = + Process.run_with_times + Strict + dune + ~display:Quiet + ~stdin_from + ~stdout_to + ~stderr_to + ([ "build" + ; "@install" + ; "--release" + ; "--cache" (* explicitly disable cache *) + ; "disabled" + ; "--dump-gc-stats" + ; Path.to_string gc_dump + ] + @ + match sandbox with + | `Yes -> [ "--sandbox"; "hardlink" ] + | `No -> []) + in + (* Read the gc stats from the dump file *) + Dune_lang.Parser.parse_string + ~mode:Single + ~fname:(Path.to_string gc_dump) + (Io.read_file gc_dump) + |> Dune_lang.Decoder.parse Dune_util.Gc.decode Univ_map.empty + |> Metrics.make times +;; + +let run_bench ~sandbox = + let open Fiber.O in + let* clean = dune_build ~name:"clean" ~sandbox in + let+ zero = + let rec zero acc n = + if n = 0 + then Fiber.return (List.rev acc) + else + let* time = dune_build ~name:("zero" ^ string_of_int n) ~sandbox in + zero (time :: acc) (pred n) + in + zero [] 5 + in + clean, zero +;; + +type ('float, 'int) bench_results = + { size : int + ; clean : ('float, 'int) Metrics.t + ; zero : ('float, 'int) Metrics.t list + } + +let tag_results { size; clean; zero } = + let tag data = Metrics.map ~f:(fun t -> `Float t) ~g:(fun t -> `Int t) data in + let list_tag data = + List.map data ~f:tag + |> Metrics.unzip + |> Metrics.map ~f:(fun x -> `List x) ~g:(fun x -> `List x) + in + `Int size, tag clean, list_tag zero +;; + +(** Display all clean and null builds with a few exceptions: + + - fragments - not consistent between builds + - stack_size - not very useful + - forced_collections - only available in OCaml >= 4.12 *) +let display_clean_and_zero_with_sandboxing + ({ elapsed_time + ; user_cpu_time + ; system_cpu_time + ; minor_words + ; promoted_words + ; major_words + ; minor_collections + ; major_collections + ; heap_words + ; heap_chunks + ; live_words + ; live_blocks + ; free_words + ; free_blocks + ; largest_free + ; fragments = _ + ; compactions + ; top_heap_words + ; stack_size = _ + } : + _ Metrics.t) + (zero : _ Metrics.t) + = + let display what units clean zero = + { Output.name = what + ; metrics = [ "[Clean] " ^ what, clean, units; "[Null] " ^ what, zero, units ] + } + in + [ display "Build Time" "Seconds" elapsed_time zero.elapsed_time + ; display "Minor Words" "Approx. Words" minor_words zero.minor_words + ; display "Promoted Words" "Approx. Words" promoted_words zero.promoted_words + ; display "Major Words" "Approx. Words" major_words zero.major_words + ; display "Minor Collections" "Collections" minor_collections zero.minor_collections + ; display "Major Collections" "Collections" major_collections zero.major_collections + ; display "Heap Words" "Words" heap_words zero.heap_words + ; display "Heap Chunks" "Chunks" heap_chunks zero.heap_chunks + ; display "Live Words" "Words" live_words zero.live_words + ; display "Live Blocks" "Blocks" live_blocks zero.live_blocks + ; display "Free Words" "Words" free_words zero.free_words + ; display "Free Blocks" "Blocks" free_blocks zero.free_blocks + ; display "Largest Free" "Words" largest_free zero.largest_free + ; display "Compactions" "Compactions" compactions zero.compactions + ; display "Top Heap Words" "Words" top_heap_words zero.top_heap_words + ; display "User CPU Time" "Seconds" user_cpu_time zero.user_cpu_time + ; display "System CPU Time" "Seconds" system_cpu_time zero.system_cpu_time + ] +;; + +let format_results bench_results = + (* tagging data for json conversion *) + let size, clean, zero = tag_results bench_results in + (* bench results *) + [ { Output.name = "Misc"; metrics = [ "Size of _boot/dune.exe", size, "Bytes" ] } ] + @ display_clean_and_zero_with_sandboxing clean zero +;; + +let () = + Dune_util.Log.init ~file:No_log_file (); + let dir = Temp.create Dir ~prefix:"dune" ~suffix:"bench" in + Sys.chdir (Path.to_string dir); + Path.as_external dir |> Option.value_exn |> Path.set_root; + Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build"); + let module Scheduler = Dune_engine.Scheduler in + let config = + Dune_engine.Clflags.display := Quiet; + { Scheduler.Config.concurrency = 10 + ; stats = None + ; print_ctrl_c_warning = false + ; watch_exclusions = [] + } + in + let size = + let stat : Unix.stats = Path.stat_exn dune in + stat.st_size + in + let results = + Scheduler.Run.go config ~on_event:(fun _ _ -> ()) + @@ fun () -> + let open Fiber.O in + (* Prepare the workspace *) + let* () = prepare_workspace () in + (* Build the clean and null builds *) + Console.printf "Building clean and null builds"; + let+ clean, zero = run_bench ~sandbox:`No in + Console.printf "Finished building clean and null builds"; + (* Return the bench results *) + format_results { size; clean; zero } + in + let version = 4 in + let output = { Output.config = []; version; results } in + print_string (Json.to_string (Output.to_json output)); + flush stdout +;; diff --git a/unikernel/duniverse/dune_/bench/bench.mli b/unikernel/duniverse/dune_/bench/bench.mli new file mode 100644 index 00000000..e69de29b diff --git a/unikernel/duniverse/dune_/bench/dune b/unikernel/duniverse/dune_/bench/dune new file mode 100644 index 00000000..71c19f13 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/dune @@ -0,0 +1,27 @@ +(executable + (name bench) + (modules bench metrics) + (libraries + dune_stats + dune_console + chrome_trace + stdune + fiber + dune_lang + dune_engine + dune_util)) + +(rule + (alias bench) + (action + (run ./bench.exe %{bin:dune}))) + +(executable + (modules gen_synthetic) + (libraries unix) + (name gen_synthetic)) + +(executable + (modules gen_synthetic_dune_watch) + (libraries unix) + (name gen_synthetic_dune_watch)) diff --git a/unikernel/duniverse/dune_/bench/gen-benchmark.sh b/unikernel/duniverse/dune_/bench/gen-benchmark.sh new file mode 100755 index 00000000..1da639d4 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/gen-benchmark.sh @@ -0,0 +1,40 @@ +#!/bin/bash + +set -eu + +usage() +{ + cat < +EOF +} + +if [ $# -ne 3 ]; then + usage + exit 1 +fi + +command="${1}" +clean_command="${2}" +name="${3}" + +hyperfine "${command}" \ + --show-output \ + --warmup 2 \ + --runs 3 \ + --prepare "${clean_command}" \ + --export-json bench.json \ + > /dev/null + +mean_time=$(cat bench.json | jq '.results[0].mean | tostring') + +cat< num_modules := n) + , " number of modules to include in the synthetic library" ) + ] + (fun d -> basedir := d) + (sprintf "usage: %s [basedir]" (Filename.basename Sys.argv.(0))); + write !basedir !num_modules +;; diff --git a/unikernel/duniverse/dune_/bench/gen_synthetic_dune_watch.ml b/unikernel/duniverse/dune_/bench/gen_synthetic_dune_watch.ml new file mode 100644 index 00000000..b0d0459a --- /dev/null +++ b/unikernel/duniverse/dune_/bench/gen_synthetic_dune_watch.ml @@ -0,0 +1,96 @@ +open Printf + +type lib = + | Leaf + | Internal + +let subsets_per_library = 4 +let count n = Array.to_list (Array.init n (fun k -> k + 1)) + +let write_subset base_dir library_index subset = + let mod_rows = 10 in + let mod_cols = 10 in + for row = 1 to mod_rows do + for col = 1 to mod_cols do + let deps = + if row = 1 + then + if library_index = 1 + then [] + else + List.flatten + (List.map + (fun k -> + List.map + (fun j -> + sprintf "M_%d_%d_%d_%d.f()" (library_index - 1) j mod_rows k) + (count subsets_per_library)) + (count mod_cols)) + else + List.map + (fun k -> sprintf "M_%d_%d_%d_%d.f()" library_index subset (row - 1) k) + (count mod_cols) + in + let deps = List.rev ("()" :: List.rev deps) in + let str_deps = String.concat ";\n " deps in + let mod_text = sprintf "let f() =\n %s\n" str_deps in + let modname = sprintf "%s/m_%d_%d_%d_%d" base_dir library_index subset row col in + let f = open_out (sprintf "%s.ml" modname) in + output_string f mod_text; + close_out f; + let f = open_out (sprintf "%s.mli" modname) in + output_string f "val f : unit -> unit"; + close_out f + done + done +;; + +let write_lib ~base_dir ~lib ~dune = + let name = + match lib with + | Leaf -> "leaf" + | Internal -> "internal" + in + let lib_dir = Filename.concat base_dir name in + let () = Unix.mkdir lib_dir 0o777 in + let f = open_out (Filename.concat lib_dir "dune") in + output_string f dune; + let () = close_out f in + let library_index = + match lib with + | Leaf -> 2 + | Internal -> 1 + in + for subset = 1 to subsets_per_library do + write_subset lib_dir library_index subset + done +;; + +let write base_dir = + let () = Unix.mkdir base_dir 0o777 in + let dune = + {| +(library + (name leaf) + (libraries internal)) +|} + in + write_lib ~base_dir ~lib:Leaf ~dune; + let dune = + {| +(library + (name internal) + (wrapped false)) +|} + in + write_lib ~base_dir ~lib:Internal ~dune +;; + +let () = + let base_dir = ref "." in + Arg.parse + [] + (fun d -> base_dir := d) + (sprintf "usage: %s [base_dir]" (Filename.basename Sys.argv.(0))); + write !base_dir +;; diff --git a/unikernel/duniverse/dune_/bench/metrics.ml b/unikernel/duniverse/dune_/bench/metrics.ml new file mode 100644 index 00000000..49ec3dd4 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/metrics.ml @@ -0,0 +1,125 @@ +open Stdune + +type ('float, 'int) t = + { elapsed_time : 'float + ; user_cpu_time : 'float + ; system_cpu_time : 'float + ; minor_words : 'float + ; promoted_words : 'float + ; major_words : 'float + ; minor_collections : 'int + ; major_collections : 'int + ; heap_words : 'int + ; heap_chunks : 'int + ; live_words : 'int + ; live_blocks : 'int + ; free_words : 'int + ; free_blocks : 'int + ; largest_free : 'int + ; fragments : 'int + ; compactions : 'int + ; top_heap_words : 'int + ; stack_size : 'int + } + +let make (times : Proc.Times.t) (gc : Gc.stat) = + (* We default to 0 for the other processor times since they are rarely None in + pracice. *) + let { Proc.Resource_usage.user_cpu_time; system_cpu_time } = + Option.value + times.resource_usage + ~default:{ user_cpu_time = 0.; system_cpu_time = 0. } + in + { elapsed_time = times.elapsed_time + ; user_cpu_time + ; system_cpu_time + ; minor_words = gc.minor_words + ; promoted_words = gc.promoted_words + ; major_words = gc.major_words + ; minor_collections = gc.minor_collections + ; major_collections = gc.major_collections + ; heap_words = gc.heap_words + ; heap_chunks = gc.heap_chunks + ; live_words = gc.live_words + ; live_blocks = gc.live_blocks + ; free_words = gc.free_words + ; free_blocks = gc.free_blocks + ; largest_free = gc.largest_free + ; fragments = gc.fragments + ; compactions = gc.compactions + ; top_heap_words = gc.top_heap_words + ; stack_size = gc.stack_size + } +;; + +let map ~f ~g (metrics : ('float, 'int) t) : ('float_, 'int_) t = + { elapsed_time = f metrics.elapsed_time + ; user_cpu_time = f metrics.user_cpu_time + ; system_cpu_time = f metrics.system_cpu_time + ; minor_words = f metrics.minor_words + ; promoted_words = f metrics.promoted_words + ; major_words = f metrics.major_words + ; minor_collections = g metrics.minor_collections + ; major_collections = g metrics.major_collections + ; heap_words = g metrics.heap_words + ; heap_chunks = g metrics.heap_chunks + ; live_words = g metrics.live_words + ; live_blocks = g metrics.live_blocks + ; free_words = g metrics.free_words + ; free_blocks = g metrics.free_blocks + ; largest_free = g metrics.largest_free + ; fragments = g metrics.fragments + ; compactions = g metrics.compactions + ; top_heap_words = g metrics.top_heap_words + ; stack_size = g metrics.stack_size + } +;; + +(** Turns a list of records into a record of lists. *) +let unzip (metrics : ('float, 'int) t list) : ('float list, 'int list) t = + List.fold_left + metrics + ~init: + { elapsed_time = [] + ; user_cpu_time = [] + ; system_cpu_time = [] + ; minor_words = [] + ; promoted_words = [] + ; major_words = [] + ; minor_collections = [] + ; major_collections = [] + ; heap_words = [] + ; heap_chunks = [] + ; live_words = [] + ; live_blocks = [] + ; free_words = [] + ; free_blocks = [] + ; largest_free = [] + ; fragments = [] + ; compactions = [] + ; top_heap_words = [] + ; stack_size = [] + } + ~f:(fun acc x -> + { elapsed_time = x.elapsed_time :: acc.elapsed_time + ; user_cpu_time = x.user_cpu_time :: acc.user_cpu_time + ; system_cpu_time = x.system_cpu_time :: acc.system_cpu_time + ; minor_words = x.minor_words :: acc.minor_words + ; promoted_words = x.promoted_words :: acc.promoted_words + ; major_words = x.major_words :: acc.major_words + ; minor_collections = x.minor_collections :: acc.minor_collections + ; major_collections = x.major_collections :: acc.major_collections + ; heap_words = x.heap_words :: acc.heap_words + ; heap_chunks = x.heap_chunks :: acc.heap_chunks + ; live_words = x.live_words :: acc.live_words + ; live_blocks = x.live_blocks :: acc.live_blocks + ; free_words = x.free_words :: acc.free_words + ; free_blocks = x.free_blocks :: acc.free_blocks + ; largest_free = x.largest_free :: acc.largest_free + ; fragments = x.fragments :: acc.fragments + ; compactions = x.compactions :: acc.compactions + ; top_heap_words = x.top_heap_words :: acc.top_heap_words + ; stack_size = x.stack_size :: acc.stack_size + }) + |> map ~f:List.rev ~g:List.rev +;; diff --git a/unikernel/duniverse/dune_/bench/metrics.mli b/unikernel/duniverse/dune_/bench/metrics.mli new file mode 100644 index 00000000..336819fd --- /dev/null +++ b/unikernel/duniverse/dune_/bench/metrics.mli @@ -0,0 +1,66 @@ +open Stdune + +(** [('float, 'int) t] is a record of metrics about the current process. It + includes timing information and information available from [Gc.stat]. It is + polymorphic in the type of field values to allow for the definition of + [unzip] functions which make serialisation easier. *) +type ('float, 'int) t = + { elapsed_time : 'float + (** Real time elapsed since the process started and the process + finished. *) + ; user_cpu_time : 'float + (** The amount of CPU time spent in user mode during the process. Other + processes and blocked time are not included. *) + ; system_cpu_time : 'float + (** The amount of CPU time spent in kernel mode during the process. + Similar to user time, other processes and time spent blocked by + other processes are not counted. *) + ; minor_words : 'float + (** Number of words allocated in the minor heap since the program was + started. *) + ; promoted_words : 'float + (** Number of words that have been promoted from the minor to the major + heap since the program was started. *) + ; major_words : 'float + (** Number of words allocated in the major heap since the program was + started. *) + ; minor_collections : 'int + (** Number of minor collections since the program was started. *) + ; major_collections : 'int + (** Number of major collection cycles completed since the program was + started. *) + ; heap_words : 'int (** Total size of the major heap, in words. *) + ; heap_chunks : 'int + (** Number of contiguous pieces of memory that make up the major heap. *) + ; live_words : 'int + (** Number of words of live data in the major heap, including the header + words. *) + ; live_blocks : 'int (** Number of live blocks in the major heap. *) + ; free_words : 'int (** Number of words in the free list. *) + ; free_blocks : 'int (** Number of blocks in the free list. *) + ; largest_free : 'int (** Size (in words) of the largest block in the free list. *) + ; fragments : 'int + (** Number of wasted words due to fragmentation. These are 1-words free + blocks placed between two live blocks. They are not available for + allocation. *) + ; compactions : 'int (** Number of heap compactions since the program was started. *) + ; top_heap_words : 'int (** Maximum size reached by the major heap, in words. *) + ; stack_size : 'int (** Current size of the stack, in words. *) + } + +(** [make t gc] creates a new metrics record from the given [t] and [gc] + information. *) +val make : Proc.Times.t -> Gc.stat -> (float, int) t + +(** [map ~f ~g m] applies [f] to the float fields and [g] to the int fields of + [m]. *) +val map + : f:('float -> 'float_) + -> g:('int -> 'int_) + -> ('float, 'int) t + -> ('float_, 'int_) t + +(** [unzip m] takes a list of metrics [m] and returns a records with the lists + of values for each field. This is particularly convenient when serialising + to json. *) +val unzip : ('float, 'int) t list -> ('float list, 'int list) t diff --git a/unikernel/duniverse/dune_/bench/micro/copyfile.ml b/unikernel/duniverse/dune_/bench/micro/copyfile.ml new file mode 100644 index 00000000..f384f3f9 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/copyfile.ml @@ -0,0 +1,28 @@ +open Stdune + +let dir = + (if Array.length Sys.argv > 1 + then ( + let dir = Path.of_filename_relative_to_initial_cwd Sys.argv.(1) in + Temp.temp_in_dir Dir ~dir) + else Temp.create Dir) + ~prefix:"copyfile" + ~suffix:"bench" +;; + +let contents = + let len = + if Array.length Sys.argv > 2 then Int.of_string_exn Sys.argv.(2) else 50_000 + in + String.make len '0' +;; + +let () = + let src = Path.relative dir "initial" in + Io.write_file (Path.relative dir "initial") contents; + let chmod _ = 444 in + for i = 1 to 10_000 do + let dst = Path.relative dir (sprintf "dst-%d" i) in + Io.copy_file ~chmod ~src ~dst () + done +;; diff --git a/unikernel/duniverse/dune_/bench/micro/digest_bench.ml b/unikernel/duniverse/dune_/bench/micro/digest_bench.ml new file mode 100644 index 00000000..427740d6 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/digest_bench.ml @@ -0,0 +1,24 @@ +open Stdune +module Digest = Dune_digest +module Caml = Stdlib + +let create_file size = + let name = Printf.sprintf "digest-bench-%d" size in + let out = open_out name in + for _ = 1 to size do + output_char out 'X' + done; + close_out out; + at_exit (fun () -> Unix.unlink name); + name +;; + +let%bench_fun ("string" [@indexed len = [ 10; 100; 1_000; 10_000; 1_000_000 ]]) = + let s = String.make len 'x' in + fun () -> ignore (Digest.string s) +;; + +let%bench_fun ("file" [@indexed len = [ 10; 100; 1_000; 10_000; 100_000; 1_000_000 ]]) = + let f = Path.of_filename_relative_to_initial_cwd (create_file len) in + fun () -> ignore (Digest.file f) +;; diff --git a/unikernel/duniverse/dune_/bench/micro/digest_bench_main.ml b/unikernel/duniverse/dune_/bench/micro/digest_bench_main.ml new file mode 100644 index 00000000..e406b351 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/digest_bench_main.ml @@ -0,0 +1 @@ +Inline_benchmarks_public.Runner.main ~libname:"digest_bench" diff --git a/unikernel/duniverse/dune_/bench/micro/dune b/unikernel/duniverse/dune_/bench/micro/dune new file mode 100644 index 00000000..a84ffb4f --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/dune @@ -0,0 +1,57 @@ +(executable + (name copyfile) + (modules copyfile) + (libraries stdune)) + +(executable + (name main) + (modules main) + (libraries dune_bench core_bench.inline_benchmarks)) + +(executable + (name memo_bench_main) + (allow_overlapping_dependencies) + (modules memo_bench_main) + (libraries memo_bench core_bench.inline_benchmarks)) + +(library + (name thread_pool_bench) + (modules thread_pool_bench) + (library_flags -linkall) + (preprocess + (pps ppx_bench)) + (libraries dune_thread_pool unix threads.posix core_bench.inline_benchmarks)) + +(executable + (name thread_pool_bench_main) + (allow_overlapping_dependencies) + (modules thread_pool_bench_main) + (libraries thread_pool_bench core_bench.inline_benchmarks)) + +(library + (name digest_bench) + (modules digest_bench) + (library_flags -linkall) + (preprocess + (pps ppx_bench)) + (libraries dune_digest stdune unix core_bench.inline_benchmarks)) + +(executable + (name digest_bench_main) + (allow_overlapping_dependencies) + (modules digest_bench_main) + (libraries digest_bench core_bench.inline_benchmarks)) + +(library + (name path_bench) + (modules path_bench) + (library_flags -linkall) + (preprocess + (pps ppx_bench)) + (libraries base stdune core_bench.inline_benchmarks)) + +(executable + (name path_bench_main) + (allow_overlapping_dependencies) + (modules path_bench_main) + (libraries path_bench core_bench.inline_benchmarks)) diff --git a/unikernel/duniverse/dune_/bench/micro/dune_bench/dune b/unikernel/duniverse/dune_/bench/micro/dune_bench/dune new file mode 100644 index 00000000..b90a3a7f --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/dune_bench/dune @@ -0,0 +1,6 @@ +(library + (name dune_bench) + (libraries stdune fiber dune_engine dune_rules) + (library_flags -linkall) + (preprocess + (pps ppx_bench))) diff --git a/unikernel/duniverse/dune_/bench/micro/dune_bench/scheduler_bench.ml b/unikernel/duniverse/dune_/bench/micro/dune_bench/scheduler_bench.ml new file mode 100644 index 00000000..a6d88ae4 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/dune_bench/scheduler_bench.ml @@ -0,0 +1,39 @@ +(* Benchmark the scheduler *) + +open Stdune +open Dune_engine +module Caml = Stdlib + +let config = + Dune_engine.Clflags.display := Short; + { Scheduler.Config.concurrency = 1 + ; stats = None + ; print_ctrl_c_warning = false + ; watch_exclusions = [] + } +;; + +let setup = + lazy + (Path.set_root (Path.External.cwd ()); + Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build")) +;; + +let prog = Option.value_exn (Bin.which ~path:(Env_path.path Env.initial) "true") +let run () = Process.run ~display:Quiet ~env:Env.initial Strict prog [] + +let go ~jobs fiber = + Scheduler.Run.go ~on_event:(fun _ _ -> ()) { config with concurrency = jobs } fiber +;; + +let%bench_fun "single" = + Lazy.force setup; + fun () -> go run ~jobs:1 +;; + +let l = List.init 100 ~f:ignore + +let%bench_fun ("many" [@indexed jobs = [ 1; 2; 4; 8 ]]) = + Lazy.force setup; + fun () -> go ~jobs (fun () -> Fiber.parallel_iter l ~f:run) +;; diff --git a/unikernel/duniverse/dune_/bench/micro/main.ml b/unikernel/duniverse/dune_/bench/micro/main.ml new file mode 100644 index 00000000..4a8e5b0d --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/main.ml @@ -0,0 +1 @@ +Inline_benchmarks_public.Runner.main ~libname:"dune_bench" diff --git a/unikernel/duniverse/dune_/bench/micro/memo_bench/benchmarks.ml b/unikernel/duniverse/dune_/bench/micro/memo_bench/benchmarks.ml new file mode 100644 index 00000000..944be3e6 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/memo_bench/benchmarks.ml @@ -0,0 +1,174 @@ +open Stdune + +let invalidation_acc = ref Memo.Invalidation.empty + +module Memo = struct + include Memo + + let sample_count = + (* Count number of samples of all lifted computations, to allow simple + detection of looping tests executed by [run] *) + ref 0 + ;; + + let exec build = + (* not expected to be used in re-entrant way *) + sample_count := 0; + Memo.reset !invalidation_acc; + invalidation_acc := Memo.Invalidation.empty; + let fiber = Memo.run build in + Fiber.run fiber ~iter:(fun _ -> failwith "deadlock?") + ;; + + let memoize t = + let l = Memo.lazy_ ~cutoff:(fun _ _ -> false) (fun () -> t) in + Memo.of_thunk (fun () -> Memo.Lazy.force l) + ;; + + let map2 x y ~f = + map ~f:(fun (x, y) -> f x y) (Memo.fork_and_join (fun () -> x) (fun () -> y)) + ;; + + let all l = Memo.all_concurrently l +end + +let run tenacious = Memo.exec tenacious + +module Var = struct + type 'a t = + { value : 'a ref + ; cell : (unit, 'a) Memo.Cell.t + } + + let create value = + let value = ref value in + { value + ; cell = Memo.lazy_cell ~cutoff:(fun _ _ -> false) (fun () -> Memo.return !value) + } + ;; + + let set t v = + t.value := v; + invalidation_acc + := Memo.Invalidation.combine + !invalidation_acc + (Memo.Cell.invalidate ~reason:Memo.Invalidation.Reason.Test t.cell) + ;; + + let read t = Memo.of_thunk (fun () -> Memo.Cell.read t.cell) + let peek t = !(t.value) +end + +let incr v = Var.set v (Var.peek v) + +module Case = struct + (* The first [unit] it to delay the creation of functions until benchmarking + is ready to run. *) + type 'a t = + { create_and_compute : unit -> unit -> 'a + ; incr_and_recompute : unit -> unit -> 'a + ; restore_from_cache : unit -> unit -> 'a + } + + let create (f : unit -> _ Var.t * 'a Memo.t) : 'a t = + let create_and_compute () () = run (f () |> snd) in + let incr_and_recompute () = + let var, build = f () in + let (_ : 'a) = run build in + fun () -> + incr var; + run build + in + let restore_from_cache () = + let build = f () |> snd in + let (_ : 'a) = run build in + fun () -> run build + in + { create_and_compute; incr_and_recompute; restore_from_cache } + ;; +end + +let one_bind = + Case.create (fun () -> + let v = Var.create 0 in + ( v + , List.fold_left + ~init:(Memo.return 0) + (List.init 1 ~f:(fun _i -> ())) + ~f:(fun acc () -> + Memo.bind acc ~f:(fun acc -> Memo.map (Var.read v) ~f:(fun v -> acc + v))) )) +;; + +let%bench_fun "1-bind (create and compute)" = one_bind.create_and_compute () +let%bench_fun "1-bind (incr and recompute)" = one_bind.incr_and_recompute () +let%bench_fun "1-bind (restore from cache)" = one_bind.restore_from_cache () + +let twenty_reads = + Case.create (fun () -> + let v = Var.create 0 in + ( v + , List.fold_left + ~init:(Memo.return 0) + (List.init 20 ~f:(fun _i -> ())) + ~f:(fun acc () -> + Memo.bind acc ~f:(fun acc -> Memo.map (Var.read v) ~f:(fun v -> acc + v))) )) +;; + +let%bench_fun "20-reads (create and compute)" = twenty_reads.create_and_compute () +let%bench_fun "20-reads (incr and recompute)" = twenty_reads.incr_and_recompute () +let%bench_fun "20-reads (restore from cache)" = twenty_reads.restore_from_cache () + +let clique = + Case.create (fun () -> + let v = Var.create 0 in + let read_v = Memo.memoize (Var.read v) in + ( v + , List.fold_left + ~init:read_v + (List.init 30 ~f:(fun _i -> ())) + ~f:(fun acc () -> + let node = Memo.memoize acc in + Memo.map2 node acc ~f:( + )) )) +;; + +let%bench_fun "clique (create and compute)" = clique.create_and_compute () +let%bench_fun "clique (incr and recompute)" = clique.incr_and_recompute () +let%bench_fun "clique (restore from cache)" = clique.restore_from_cache () + +let bipartite = + Case.create (fun () -> + let first_var = Var.create 0 in + let inputs = + List.init 30 ~f:(fun i -> + let v = if i = 0 then first_var else Var.create 0 in + Memo.memoize (Var.read v)) + in + let matrix i j = if i = j then 1 else 0 in + let outputs = + List.init 30 ~f:(fun i -> + Memo.memoize + (Memo.all + (List.mapi inputs ~f:(fun j x -> Memo.map x ~f:(fun x -> matrix i j * x))) + |> Memo.map ~f:(List.fold_left ~init:0 ~f:( + )))) + in + first_var, Memo.memoize (Memo.all outputs)) +;; + +let%bench_fun "bipartite (create and compute)" = bipartite.create_and_compute () +let%bench_fun "bipartite (incr and recompute)" = bipartite.incr_and_recompute () +let%bench_fun "bipartite (restore from cache)" = bipartite.restore_from_cache () + +let memo_diamonds = + Case.create (fun () -> + let v = Var.create 0 in + ( v + , List.fold_left + ~init:(Var.read v) + (List.init 20 ~f:(fun _i -> ())) + ~f:(fun acc () -> + Memo.memoize (Memo.bind acc ~f:(fun x -> Memo.map acc ~f:(fun y -> x + y)))) )) +;; + +let%bench_fun "memo diamonds (create and compute)" = memo_diamonds.create_and_compute () +let%bench_fun "memo diamonds (incr and recompute)" = memo_diamonds.incr_and_recompute () +let%bench_fun "memo diamonds (restore from cache)" = memo_diamonds.restore_from_cache () diff --git a/unikernel/duniverse/dune_/bench/micro/memo_bench/benchmarks.mli b/unikernel/duniverse/dune_/bench/micro/memo_bench/benchmarks.mli new file mode 100644 index 00000000..e69de29b diff --git a/unikernel/duniverse/dune_/bench/micro/memo_bench/dune b/unikernel/duniverse/dune_/bench/micro/memo_bench/dune new file mode 100644 index 00000000..3793b339 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/memo_bench/dune @@ -0,0 +1,6 @@ +(library + (name memo_bench) + (library_flags -linkall) + (preprocess + (pps ppx_bench)) + (libraries fiber stdune memo core_bench.inline_benchmarks)) diff --git a/unikernel/duniverse/dune_/bench/micro/memo_bench/memo_intf.ml b/unikernel/duniverse/dune_/bench/micro/memo_bench/memo_intf.ml new file mode 100644 index 00000000..86aa5abb --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/memo_bench/memo_intf.ml @@ -0,0 +1,62 @@ +module type Monad_intf = sig + type 'a t + + val return : 'a -> 'a t + val bind : 'a t -> f:('a -> 'b t) -> 'b t + val map : 'a t -> f:('a -> 'b) -> 'b t + + module Let_syntax : sig + val return : 'a -> 'a t + val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + end +end + +module type Test_env = sig + module Glass : sig + type t + + val create : unit -> t + val break : t -> unit + end + + module Io : sig + include Monad_intf + + module Ivar : sig + type 'a io := 'a t + type 'a t + + val create : unit -> 'a t + val read : 'a t -> 'a io + val fill : 'a t -> 'a -> unit io + end + + val of_thunk : (unit -> 'a t) -> 'a t + end + + module Memo : sig + include Monad_intf + + val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + val all : 'a t list -> 'a list t + val of_glass : Glass.t -> 'a -> 'a t + val of_thunk : (unit -> 'a t) -> 'a t + val of_io : (unit -> 'a Io.t) -> 'a t + val memoize : 'a t -> 'a t + end + + module Var : sig + type 'a t + + val create : 'a -> 'a t + val set : 'a t -> 'a -> unit + val read : 'a t -> 'a Memo.t + + (** peek once without registering interest in future updates *) + val peek : 'a t -> 'a + end + + val run : 'a Memo.t -> 'a + val make_counter : unit -> int Memo.t * (unit -> unit) +end diff --git a/unikernel/duniverse/dune_/bench/micro/memo_bench/memo_tests_env.ml b/unikernel/duniverse/dune_/bench/micro/memo_bench/memo_tests_env.ml new file mode 100644 index 00000000..12d796c7 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/memo_bench/memo_tests_env.ml @@ -0,0 +1,121 @@ +module Io = struct + type 'a t = 'a Fiber.t + + let of_thunk f = Fiber.of_thunk f + let map t ~f = Fiber.map t ~f + let bind t ~f = Fiber.bind t ~f:(fun x -> f x) + let return x = Fiber.return x + + module Ivar = struct + include Fiber.Ivar + + let read x = read x + let fill x v = fill x v + end + + module Let_syntax = struct + let ( let+ ) x f = map x ~f + let ( let* ) x f = bind x ~f + let return = return + end +end + +let invalidation_acc = ref Memo.Invalidation.empty + +module Memo = struct + include Memo + + let sample_count = + (* Count number of samples of all lifted computations, to allow simple + detection of looping tests executed by [run] *) + ref 0 + ;; + + let exec build = + (* not expected to be used in re-entrant way *) + sample_count := 0; + Memo.reset !invalidation_acc; + invalidation_acc := Memo.Invalidation.empty; + let fiber = Memo.run build in + Fiber.run fiber ~iter:(fun _ -> failwith "deadlock?") + ;; + + let of_io f = Memo.of_reproducible_fiber (Fiber.of_thunk f) + + let memoize t = + let l = Memo.lazy_ ~cutoff:(fun _ _ -> false) (fun () -> t) in + Memo.of_thunk (fun () -> Memo.Lazy.force l) + ;; + + let map2 x y ~f = + map ~f:(fun (x, y) -> f x y) (Memo.fork_and_join (fun () -> x) (fun () -> y)) + ;; + + let all l = Memo.all_concurrently l + + module Glass = struct + type t = (unit, unit) Memo.Cell.t + + let create () = Memo.lazy_cell ~cutoff:(fun _ _ -> false) (fun () -> Memo.return ()) + + let break (t : t) = + invalidation_acc + := Memo.Invalidation.combine + (Memo.Cell.invalidate ~reason:Memo.Invalidation.Reason.Test t) + !invalidation_acc + ;; + end + + let of_glass (g : Glass.t) v = + Memo.of_thunk (fun () -> Memo.map (Memo.Cell.read g) ~f:(fun () -> v)) + ;; + + let of_thunk f = Memo.of_reproducible_fiber (Fiber.of_thunk (fun () -> Memo.run (f ()))) + + module Let_syntax = struct + let ( let+ ) x f = map x ~f + let ( let* ) x f = bind x ~f + let return = return + end +end + +let run tenacious = Memo.exec tenacious + +module Glass = Memo.Glass + +let make_counter () = + let r = ref 0 in + let glass = Glass.create () in + let break () = Glass.break glass in + ( Memo.map + (Memo.of_thunk (fun () -> Memo.Cell.read glass)) + ~f:(fun () -> + incr r; + !r) + , break ) +;; + +module Var = struct + type 'a t = + { value : 'a ref + ; cell : (unit, 'a) Memo.Cell.t + } + + let create value = + let value = ref value in + { value + ; cell = Memo.lazy_cell ~cutoff:(fun _ _ -> false) (fun () -> Memo.return !value) + } + ;; + + let set t v = + t.value := v; + invalidation_acc + := Memo.Invalidation.combine + !invalidation_acc + (Memo.Cell.invalidate ~reason:Memo.Invalidation.Reason.Test t.cell) + ;; + + let read t = Memo.of_thunk (fun () -> Memo.Cell.read t.cell) + let peek t = !(t.value) +end diff --git a/unikernel/duniverse/dune_/bench/micro/memo_bench_main.ml b/unikernel/duniverse/dune_/bench/micro/memo_bench_main.ml new file mode 100644 index 00000000..8ea7d21c --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/memo_bench_main.ml @@ -0,0 +1 @@ +Inline_benchmarks_public.Runner.main ~libname:"memo_bench" diff --git a/unikernel/duniverse/dune_/bench/micro/path_bench.ml b/unikernel/duniverse/dune_/bench/micro/path_bench.ml new file mode 100644 index 00000000..997b6d77 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/path_bench.ml @@ -0,0 +1,67 @@ +module Path = Stdune.Path +module Fpath = Stdune.Fpath +open Base +module Filename = Stdlib.Filename + +let () = Path.Build.set_build_dir (In_source_dir Path.Source.(relative root "_build")) +let root = "." +let short_path = "a/b/c" +let long_path = List.init 20 ~f:(fun _ -> "foo-bar-baz") |> String.concat ~sep:"/" + +let%bench_fun + ("is_root" + [@params path = [ "root", "."; "short path", short_path; "long path", long_path ]]) + = + fun () -> ignore (Fpath.is_root path) +;; + +let%bench_fun + ("reach" + [@params + t + = [ "from root long path", (long_path, root) + ; "from root short path", (short_path, root) + ; "reach root from short path", (root, short_path) + ; "reach root from long path", (root, long_path) + ; ( "reach long path from similar long path" + , (Filename.concat long_path "a", Filename.concat long_path "b") ) + ; ( "reach short path from similar short path" + , (Filename.concat short_path "a", Filename.concat short_path "b") ) + ]]) + = + let t, from = t in + let t = Path.of_string t in + let from = Path.of_string from in + fun () -> ignore (Path.reach t ~from) +;; + +let%bench_fun + ("Path.Local.relative" + [@params + t + = [ "left root", (".", long_path) + ; "right root", (long_path, ".") + ; "short paths", (short_path, short_path) + ; "long paths", (long_path, long_path) + ]]) + = + let x, y = t in + let x = Path.Local.of_string x in + fun () -> ignore (Path.Local.relative x y) +;; + +let%bench_fun + ("Path.Local.append" + [@params + t + = [ "left root", (".", long_path) + ; "right root", (long_path, ".") + ; "short paths", (short_path, short_path) + ; "long paths", (long_path, long_path) + ]]) + = + let x, y = t in + let x = Path.Local.of_string x in + let y = Path.Local.of_string y in + fun () -> ignore (Path.Local.append x y) +;; diff --git a/unikernel/duniverse/dune_/bench/micro/path_bench_main.ml b/unikernel/duniverse/dune_/bench/micro/path_bench_main.ml new file mode 100644 index 00000000..28ea3873 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/path_bench_main.ml @@ -0,0 +1 @@ +Inline_benchmarks_public.Runner.main ~libname:"path_bench" diff --git a/unikernel/duniverse/dune_/bench/micro/runner.sh b/unikernel/duniverse/dune_/bench/micro/runner.sh new file mode 100755 index 00000000..557a9cb7 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/runner.sh @@ -0,0 +1,12 @@ +#!/usr/bin/env sh +export BENCHMARKS_RUNNER=TRUE +case "$1" in + "dune" ) test="dune_bench"; main="main";; + "memo" ) test="memo_bench"; main="memo_bench_main";; + "thread_pool" ) test="thread_pool_bench"; main="thread_pool_bench_main";; + "digest" ) test="digest_bench"; main="digest_bench_main";; + "path" ) test="path_bench"; main="path_bench_main";; +esac +shift; +export BENCH_LIB="$test" +exec ./dune.exe exec --release -- "./bench/micro/$main.exe" -fork -run-without-cross-library-inlining "$@" diff --git a/unikernel/duniverse/dune_/bench/micro/thread_pool_bench.ml b/unikernel/duniverse/dune_/bench/micro/thread_pool_bench.ml new file mode 100644 index 00000000..e406fabd --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/thread_pool_bench.ml @@ -0,0 +1,47 @@ +open Dune_thread_pool + +let spawn_thread f = ignore (Thread.create f ()) + +let%bench "almost no-op" = + let tp = Thread_pool.create ~min_workers:10 ~max_workers:50 ~spawn_thread in + let tasks = 50_000 in + let counter = Atomic.make tasks in + let f () = Atomic.decr counter in + for _ = 0 to tasks - 1 do + Thread_pool.task tp ~f + done; + while Atomic.get counter > 0 do + Thread.yield () + done +;; + +let%bench "syscall" = + let tp = Thread_pool.create ~min_workers:10 ~max_workers:50 ~spawn_thread in + let tasks = 50_000 in + let counter = Atomic.make tasks in + let f () = + Unix.sleepf 0.0; + Atomic.decr counter + in + for _ = 0 to tasks - 1 do + Thread_pool.task tp ~f + done; + while Atomic.get counter > 0 do + Thread.yield () + done +;; + +let%bench "syscall - no background" = + let tasks = 50_000 in + let counter = Atomic.make tasks in + let f () = + Unix.sleepf 0.0; + Atomic.decr counter + in + for _ = 0 to tasks - 1 do + f () + done; + while Atomic.get counter > 0 do + Thread.yield () + done +;; diff --git a/unikernel/duniverse/dune_/bench/micro/thread_pool_bench_main.ml b/unikernel/duniverse/dune_/bench/micro/thread_pool_bench_main.ml new file mode 100644 index 00000000..4c38b20b --- /dev/null +++ b/unikernel/duniverse/dune_/bench/micro/thread_pool_bench_main.ml @@ -0,0 +1 @@ +Inline_benchmarks_public.Runner.main ~libname:"thread_pool_bench" diff --git a/unikernel/duniverse/dune_/bench/perf.sh b/unikernel/duniverse/dune_/bench/perf.sh new file mode 100755 index 00000000..d251efe5 --- /dev/null +++ b/unikernel/duniverse/dune_/bench/perf.sh @@ -0,0 +1,90 @@ +#!/usr/bin/env bash + +# Run this script simply as ./bench/perf.sh from the root directory. + +set -e + +TEST_REPO=https://github.com/ocaml-dune/dune-bench +TEST_COMMIT=b6bfaf2974ec8ee1eea92c4316ec37b9966322e3 + +# Some alternative benchmarks: + +# TEST_REPO=https://github.com/ocaml/dune +# TEST_COMMIT=002edc11f4e0a57f11d5226cb2497c8b406027b5 + +# TEST_REPO=https://github.com/avsm/platform +# TEST_COMMIT=b254e3c6b60f3c0c09dfdcde92eb1abdc267fa1c + +dune() { + TIMEFORMAT=$'real %Rs\nuser %Us\nsys %Ss\n'; time ../_build/default/bin/main.exe "$@" > /dev/null 2>&1 +} + +setup_test() { + mkdir -p _perf + + cd _perf + if [ ! -f README.md ]; then + echo "Cloning $TEST_REPO..." + wget $TEST_REPO/archive/$TEST_COMMIT.tar.gz + tar -xzf $TEST_COMMIT.tar.gz --strip-components=1 + fi + cd .. +} + +pad () { + while IFS='' read -r x; do printf "%-$1s\n" "$x"; done +} + +run_test() { + echo "Building Dune..." + # [make release] is used for bootstrapping, but the real binary to benchmark is + # then produced by a separate dune invocation. + # This is done mainly because [make release] won't rebuild dune if it's stale. + make release > /dev/null + ./dune.exe build _build/default/bin/main.exe + + cd _perf + rm -rf _build + + echo "Running full build..." + dune build --release --cache=disabled 2>> $1 + + echo "Running zero build..." + dune build --release --cache=disabled 2>> $1 + + cd .. +} + +setup_test +CURRENT_BRANCH=$(git branch | sed -n -e 's/^\* \(.*\)/\1/p') + +rm -f _perf/rows _perf/current _perf/main + +echo " " >> _perf/rows +echo " " >> _perf/rows +echo " |" >> _perf/rows +echo "Full build |" >> _perf/rows +echo " |" >> _perf/rows +echo " " >> _perf/rows +echo " |" >> _perf/rows +echo "Zero build |" >> _perf/rows +echo " |" >> _perf/rows + +echo "Current branch" >> _perf/current +echo "==============" >> _perf/current +echo "Testing the current branch ($CURRENT_BRANCH)" +run_test current + +echo " Main branch " >> _perf/main +echo "=============" >> _perf/main +git checkout main +echo "Testing main" +run_test main + +git checkout $CURRENT_BRANCH + +echo "" +echo "Summary for building $TEST_REPO:" +echo "" + +paste -d ' ' <(pad 10 < _perf/rows) <(pad 14 < _perf/current) _perf/main diff --git a/unikernel/duniverse/dune_/bench/run-synthetic-dune-watch.sh b/unikernel/duniverse/dune_/bench/run-synthetic-dune-watch.sh new file mode 100755 index 00000000..dcdbf79d --- /dev/null +++ b/unikernel/duniverse/dune_/bench/run-synthetic-dune-watch.sh @@ -0,0 +1,63 @@ +#!/bin/bash + +set -eu + +usage() +{ + cat < +EOF +} + +if [ $# -ne 1 ]; then + usage + exit 1 +fi + +path_to_dune="${1}" + +start_dune () { + ((${path_to_dune} build "$@" --watch @all > .#dune-output 2>&1) || (echo exit $? >> .#dune-output)) & + DUNE_PID=$!; +} + +timeout="$(command -v timeout || echo gtimeout)" + +with_timeout () { + $timeout 2 "$@" + exit_code=$? + if [ "$exit_code" = 124 ] + then + echo Timed out + cat .#dune-output + else + return "$exit_code" + fi +} + +stop_dune () { + with_timeout dune shutdown; + wait $DUNE_PID; + cat .#dune-output; +} + +echo Breaking build +echo "let f() = 2" > ./internal/m_1_1_1_1.ml +echo "val f : unit -> int" > ./internal/m_1_1_1_1.mli + +echo Starting dune +start_dune + +echo Checking for error +until grep 'error' .#dune-output > /dev/null; do sleep 0.1; done + +echo Found, fixing build +echo "let f() = ()" > ./internal/m_1_1_1_1.ml +echo "val f : unit -> unit" > ./internal/m_1_1_1_1.mli + +echo Checking for success +until grep 'Success' .#dune-output > /dev/null; do sleep 0.1; done + +echo Found, stopping dune +stop_dune diff --git a/unikernel/duniverse/dune_/bin/alias.ml b/unikernel/duniverse/dune_/bin/alias.ml new file mode 100644 index 00000000..35eb5051 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/alias.ml @@ -0,0 +1,145 @@ +open Import +module Alias = Dune_engine.Alias +module Alias0 = Dune_rules.Alias +module Alias_builder = Dune_rules.Alias_builder + +type t = + { name : Alias.Name.t + ; recursive : bool + ; dir : Path.Source.t + ; contexts : Dune_rules.Context.t list + } + +let pp { name; recursive; dir; contexts = _ } = + let open Pp.O in + let s = + (if recursive then "@" else "@@") + ^ Path.Source.to_string (Path.Source.relative dir (Alias.Name.to_string name)) + in + let pp = Pp.verbatim "alias" ++ Pp.space ++ Pp.verbatim s in + if recursive then Pp.verbatim "recursive" ++ Pp.space ++ pp else pp +;; + +let in_dir ~name ~recursive ~contexts dir = + let checked = Util.check_path contexts dir in + match checked with + | External _ -> + User_error.raise + [ Pp.textf "@@ on the command line must be followed by a relative path" ] + | In_source_dir dir -> { dir; recursive; name; contexts } + | In_private_context _ -> + User_error.raise [ Pp.textf "no aliases in the testing context" ] + | In_install_dir _ -> + User_error.raise + [ Pp.textf + "Invalid alias: %s." + (Path.to_string_maybe_quoted + (Path.build Install.Context.install_context.build_dir)) + ; Pp.textf "There are no aliases in %s." (Path.to_string_maybe_quoted dir) + ] + | In_build_dir (ctx, dir) -> + { dir + ; recursive + ; name + ; contexts = + [ List.find_exn contexts ~f:(fun c -> + Context_name.equal (Context.name c) (Context.name ctx)) + ] + } +;; + +let of_string (root : Workspace_root.t) ~recursive s ~contexts = + let path = Path.relative Path.root (root.reach_from_root_prefix ^ s) in + if Path.is_root path + then + User_error.raise + [ Pp.textf "@ on the command line must be followed by a valid alias name" ] + else ( + let dir = Path.parent_exn path in + let name = Alias.Name.of_string (Path.basename path) in + in_dir ~name ~recursive ~contexts dir) +;; + +let find_dir_specified_on_command_line ~dir = + let open Memo.O in + Source_tree.find_dir dir + >>| function + | Some dir -> dir + | None -> + User_error.raise + [ Pp.textf + "Don't know about directory %s specified on the command line!" + (Path.Source.to_string_maybe_quoted dir) + ] +;; + +let dep_on_alias_multi_contexts ~dir ~name ~contexts = + ignore (find_dir_specified_on_command_line ~dir : _ Memo.t); + let context_to_alias_expansion ctx = + let ctx_dir = Context_name.build_dir ctx in + let dir = Path.Build.(append_source ctx_dir dir) in + Alias_builder.alias (Alias.make ~dir name) + in + Action_builder.all_unit (List.map contexts ~f:context_to_alias_expansion) +;; + +let dep_on_alias_rec_multi_contexts ~dir:src_dir ~name ~contexts = + let open Action_builder.O in + let* dir = Action_builder.of_memo (find_dir_specified_on_command_line ~dir:src_dir) in + let* alias_statuses = + Action_builder.all + (List.map contexts ~f:(fun ctx -> + let dir = + Path.Build.append_source + (Context_name.build_dir ctx) + (Source_tree.Dir.path dir) + in + Dune_rules.Alias_rec.dep_on_alias_rec name dir)) + in + match + Alias0.is_standard name + || List.exists alias_statuses ~f:(fun (x : Alias_builder.Alias_status.t) -> + match x with + | Defined -> true + | Not_defined -> false) + with + | true -> Action_builder.return () + | false -> + let* load_dir = + Action_builder.all + @@ List.map contexts ~f:(fun ctx -> + let dir = + Source_tree.Dir.path dir + |> Path.Build.append_source (Context_name.build_dir ctx) + |> Path.build + in + Action_builder.of_memo @@ Load_rules.load_dir ~dir) + in + let hints = + let candidates = + Alias.Name.Set.union_map load_dir ~f:(function + | Load_rules.Loaded.Build build -> Alias.Name.Set.of_keys build.aliases + | _ -> Alias.Name.Set.empty) + in + User_message.did_you_mean + (Alias.Name.to_string name) + ~candidates:(Alias.Name.Set.to_list_map ~f:Alias.Name.to_string candidates) + in + User_error.raise + ~hints + [ Pp.textf + "Alias %S specified on the command line is empty." + (Alias.Name.to_string name) + ; Pp.textf + "It is not defined in %s or any of its descendants." + (Path.Source.to_string_maybe_quoted src_dir) + ] +;; + +let request { name; recursive; dir; contexts } = + let contexts = List.map ~f:Context.name contexts in + (if recursive then dep_on_alias_rec_multi_contexts else dep_on_alias_multi_contexts) + ~dir + ~name + ~contexts +;; diff --git a/unikernel/duniverse/dune_/bin/alias.mli b/unikernel/duniverse/dune_/bin/alias.mli new file mode 100644 index 00000000..cbd21d2b --- /dev/null +++ b/unikernel/duniverse/dune_/bin/alias.mli @@ -0,0 +1,25 @@ +open Import + +type t = private + { name : Dune_engine.Alias.Name.t + ; recursive : bool + ; dir : Path.Source.t + ; contexts : Context.t list + } + +val in_dir + : name:Dune_engine.Alias.Name.t + -> recursive:bool + -> contexts:Context.t list + -> Path.t + -> t + +val of_string + : Workspace_root.t + -> recursive:bool + -> string + -> contexts:Context.t list + -> t + +val pp : t -> _ Pp.t +val request : t -> unit Action_builder.t diff --git a/unikernel/duniverse/dune_/bin/arg.ml b/unikernel/duniverse/dune_/bin/arg.ml new file mode 100644 index 00000000..ad57a2f2 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/arg.ml @@ -0,0 +1,155 @@ +open Stdune +include Cmdliner.Arg + +include struct + open Dune_lang + module Stanza = Stanza + module String_with_vars = String_with_vars + module Profile = Profile + module Pform = Pform + module Lib_name = Lib_name + module Dep_conf = Dep_conf +end + +module Package = Dune_lang.Package +module Context_name = Dune_engine.Context_name + +let package_name = conv Package.Name.conv + +module Path = struct + module External = struct + type t = string + + let path p = Path.External.of_filename_relative_to_initial_cwd p + let arg s = s + let conv = conv ((fun p -> Ok p), Format.pp_print_string) + end + + type t = string + + let path p = Path.of_filename_relative_to_initial_cwd p + let arg s = s + let conv = conv ((fun p -> Ok p), Format.pp_print_string) +end + +let path = Path.conv +let external_path = Path.External.conv +let profile = conv Profile.conv + +module Dep = struct + module Dep_conf = Dep_conf + + type t = Dep_conf.t + + let equal = Dep_conf.equal + let file s = Dep_conf.File (String_with_vars.make_text Loc.none s) + + let make_alias_sw ~dir s = + let path = + Dune_engine.Alias.Name.to_string s + |> Stdune.Path.Local.relative dir + |> Stdune.Path.Local.to_string + in + String_with_vars.make_text Loc.none path + ;; + + let alias ~dir s = Dep_conf.Alias (make_alias_sw ~dir s) + let alias_rec ~dir s = Dep_conf.Alias_rec (make_alias_sw ~dir s) + + let parse_alias s = + if not (String.is_prefix s ~prefix:"@") + then None + else ( + let pos, recursive = + if String.length s >= 2 && s.[1] = '@' then 2, false else 1, true + in + let s = String_with_vars.make_text Loc.none (String.drop s pos) in + Some (if recursive then Dep_conf.Alias_rec s else Dep_conf.Alias s)) + ;; + + let dep_parser = + Dune_lang.Syntax.set + Stanza.syntax + (Active Stanza.latest_version) + (String_with_vars.set_decoding_env + (Pform.Env.initial ~stanza:Stanza.latest_version ~extensions:[]) + Dep_conf.decode) + ;; + + let parser s = + match parse_alias s with + | Some dep -> Ok dep + | None -> + (match + Dune_lang.Decoder.parse + dep_parser + Univ_map.empty + (Dune_lang.Parser.parse_string + ~fname:"command line" + ~mode:Dune_lang.Parser.Mode.Single + s) + with + | x -> Ok x + | exception User_error.E msg -> Error (User_message.to_string msg)) + ;; + + let string_of_alias ~recursive sv = + let prefix = if recursive then "@" else "@@" in + String_with_vars.text_only sv |> Option.map ~f:(fun s -> prefix ^ s) + ;; + + let printer ppf t = + let s = + match t with + | Dep_conf.Alias sv -> string_of_alias ~recursive:false sv + | Alias_rec sv -> string_of_alias ~recursive:true sv + | File sv -> Some (Dune_lang.to_string (String_with_vars.encode sv)) + | _ -> None + in + let s = + match s with + | Some s -> s + | None -> Dune_lang.to_string (Dep_conf.encode t) + in + Format.pp_print_string ppf s + ;; + + let conv = conv' (parser, printer) + let to_string_maybe_quoted t = String.maybe_quoted (Format.asprintf "%a" printer t) + + let alias_arg = + let parse x = Ok (Dep_conf.Alias (String_with_vars.make_text Loc.none x)) in + conv' (parse, printer) + ;; + + let alias_rec_arg = + let parse x = Ok (Dep_conf.Alias_rec (String_with_vars.make_text Loc.none x)) in + conv' (parse, printer) + ;; +end + +let dep = Dep.conv + +let bytes = + let decode repr = + let ast = + Dune_lang.Parser.parse_string + ~fname:"command line" + ~mode:Dune_lang.Parser.Mode.Single + repr + in + match Dune_lang.Decoder.parse Dune_lang.Decoder.bytes_unit Univ_map.empty ast with + | x -> Result.Ok x + | exception User_error.E msg -> Result.Error (`Msg (User_message.to_string msg)) + in + let pp_print_int64 state i = Format.pp_print_string state (Int64.to_string i) in + conv (decode, pp_print_int64) +;; + +let graph_format : Dune_graph.Graph.File_format.t conv = + conv Dune_graph.Graph.File_format.conv +;; + +let context_name : Context_name.t conv = conv Context_name.conv +let lib_name = conv Lib_name.conv +let version = pair ~sep:'.' int int diff --git a/unikernel/duniverse/dune_/bin/arg.mli b/unikernel/duniverse/dune_/bin/arg.mli new file mode 100644 index 00000000..3ab4dacd --- /dev/null +++ b/unikernel/duniverse/dune_/bin/arg.mli @@ -0,0 +1,42 @@ +open Stdune + +include module type of struct + include Cmdliner.Arg +end + +module Path : sig + module External : sig + type t + + val path : t -> Path.External.t + val arg : t -> string + end + + type t + + val path : t -> Path.t + val arg : t -> string +end + +module Dep : sig + type t = Dune_lang.Dep_conf.t + + val equal : t -> t -> bool + val file : string -> t + val alias : dir:Stdune.Path.Local.t -> Dune_engine.Alias.Name.t -> t + val alias_rec : dir:Stdune.Path.Local.t -> Dune_engine.Alias.Name.t -> t + val to_string_maybe_quoted : t -> string + val alias_arg : t conv + val alias_rec_arg : t conv +end + +val bytes : int64 conv +val context_name : Dune_engine.Context_name.t conv +val dep : Dep.t conv +val graph_format : Dune_graph.Graph.File_format.t conv +val path : Path.t conv +val external_path : Path.External.t conv +val package_name : Dune_lang.Package.Name.t conv +val profile : Dune_lang.Profile.t conv +val lib_name : Dune_lang.Lib_name.t conv +val version : Dune_lang.Syntax.Version.t conv diff --git a/unikernel/duniverse/dune_/bin/build.ml b/unikernel/duniverse/dune_/bin/build.ml new file mode 100644 index 00000000..a9f5e062 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/build.ml @@ -0,0 +1,215 @@ +open Import + +let with_metrics ~common f = + let start_time = Unix.gettimeofday () in + Fiber.finalize f ~finally:(fun () -> + let duration = Unix.gettimeofday () -. start_time in + if Common.print_metrics common + then ( + let gc_stat = Gc.quick_stat () in + (* We reset Memo counters below, unconditionally. *) + let memo_counters_report = Memo.Metrics.report ~reset_after_reporting:false in + Console.print_user_message + (User_message.make + ([ Pp.textf "%s" memo_counters_report + ; Pp.textf + "(%.2fs total, %.1fM heap words)" + duration + (float_of_int gc_stat.heap_words /. 1_000_000.) + ; Pp.text "Timers:" + ] + @ List.map + ~f:(fun (timer, { Metrics.Timer.Measure.cumulative_time; count }) -> + Pp.textf + "%s - time spent = %.2fs, count = %d" + timer + cumulative_time + count) + (String.Map.to_list (Metrics.Timer.aggregated_timers ()))))); + Memo.Metrics.reset (); + Fiber.return ()) +;; + +let run_build_system ~common ~request = + let run ~(toplevel : unit Memo.Lazy.t) = + with_metrics ~common (fun () -> build (fun () -> Memo.Lazy.force toplevel)) + in + let open Fiber.O in + Fiber.finalize + (fun () -> + (* CR-someday amokhov: Currently we invalidate cached timestamps on every + incremental rebuild. This conservative approach helps us to work around + some [mtime] resolution problems (e.g. on Mac OS). It would be nice to + find a way to avoid doing this. In fact, this may be unnecessary even + for the initial build if we assume that the user does not modify files + in the [_build] directory. For now, it's unclear if optimising this is + worth the effort. *) + Cached_digest.invalidate_cached_timestamps (); + let* setup = Import.Main.setup () in + let request = + Action_builder.bind (Action_builder.of_memo setup) ~f:(fun setup -> + request setup) + in + (* CR-someday cmoseley: Can we avoid creating a new lazy memo node every + time the build system is rerun? *) + (* This top-level node is used for traversing the whole Memo graph. *) + let toplevel_cell, toplevel = + Memo.Lazy.Expert.create ~name:"toplevel" (fun () -> + let open Memo.O in + let+ (), (_ : Dep.Fact.t Dep.Map.t) = + Action_builder.evaluate_and_collect_facts request + in + ()) + in + let* res = run ~toplevel in + let+ () = + match Common.dump_memo_graph_file common with + | None -> Fiber.return () + | Some file -> + let path = Path.external_ file in + let+ graph = + Memo.dump_cached_graph + ~time_nodes:(Common.dump_memo_graph_with_timing common) + toplevel_cell + in + Graph.serialize graph ~path ~format:(Common.dump_memo_graph_format common) + (* CR-someday cmoseley: It would be nice to use Persistent to dump a + copy of the graph's internal representation here, so it could be used + without needing to re-run the build*) + in + res) + ~finally:(fun () -> + Hooks.End_of_build.run (); + Fiber.return ()) +;; + +let poll_handling_rpc_build_requests ~(common : Common.t) ~config = + let open Fiber.O in + let rpc = + match Common.rpc common with + | `Allow server -> server + | `Forbid_builds -> Code_error.raise "rpc server must be allowed in passive mode" [] + in + Scheduler.Run.poll_passive + ~get_build_request: + (let+ (Build (targets, ivar)) = Dune_rpc_impl.Server.pending_build_action rpc in + let request setup = + Target.interpret_targets (Common.root common) config setup targets + in + run_build_system ~common ~request, ivar) +;; + +let run_build_command_poll_eager ~(common : Common.t) ~config ~request : unit = + Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config (fun () -> + let open Fiber.O in + (* Run two fibers concurrently. One is responible for rebuilding targets + named on the command line in reaction to file system changes. The other + is responsible for building targets named in RPC build requests. *) + let+ () = Scheduler.Run.poll (run_build_system ~common ~request) + and+ () = poll_handling_rpc_build_requests ~common ~config in + ()) +;; + +let run_build_command_poll_passive ~common ~config ~request:_ : unit = + (* CR-someday aalekseyev: It would've been better to complain if [request] is + non-empty, but we can't check that here because [request] is a function.*) + Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config (fun () -> + poll_handling_rpc_build_requests ~common ~config) +;; + +let run_build_command_once ~(common : Common.t) ~config ~request = + let open Fiber.O in + let once () = + let+ res = run_build_system ~common ~request in + match res with + | Error `Already_reported -> raise Dune_util.Report_error.Already_reported + | Ok () -> () + in + Scheduler.go_with_rpc_server ~common ~config once +;; + +let run_build_command ~(common : Common.t) ~config ~request = + (match Common.watch common with + | Yes Eager -> run_build_command_poll_eager + | Yes Passive -> run_build_command_poll_passive + | No -> run_build_command_once) + ~common + ~config + ~request +;; + +let build_via_rpc_server ~print_on_success ~targets = + Rpc_common.wrap_build_outcome_exn + ~print_on_success + (Rpc.Build.build ~wait:true) + targets + () +;; + +let build = + let doc = "Build the given targets, or the default ones if none are given." in + let man = + [ `S "DESCRIPTION" + ; `P {|Targets starting with a $(b,@) are interpreted as aliases.|} + ; `Blocks Common.help_secs + ; Common.examples + [ "Build all targets in the current source tree", "dune build" + ; "Build targets in the `./foo/bar' directory", "dune build ./foo/bar" + ; ( "Build the minimal set of targets required for tooling such as Merlin \ + (useful for quickly detecting errors)" + , "dune build @check" ) + ; "Run all code formatting tools in-place", "dune build --auto-promote @fmt" + ] + ] + in + let name_ = Arg.info [] ~docv:"TARGET" in + let term = + let+ builder = Common.Builder.term + and+ targets = Arg.(value & pos_all dep [] name_) + and+ aliases_rec = Arg.(value & opt_all Dep.alias_rec_arg [] & info [ "alias-rec" ]) + and+ aliases = Arg.(value & opt_all Dep.alias_arg [] & info [ "alias" ]) in + let targets = List.concat [ targets; aliases; aliases_rec ] in + let targets = + match targets with + | [] -> [ Common.Builder.default_target builder ] + | _ :: _ -> targets + in + let common, config = Common.init builder in + (* Here we need to find out whether another instance of dune already holds + the global build lock, as this will determine whether the current + instance of dune will perform the build itself or send a build request + to the RPC server in an already-running dune process. The method of + checking whether another dune instance holds the lock is to simply try + to take the lock. If taking the lock succeeds then the current process + will perform the build itself, and future attempts by this process to + take the lock are guaranteed to succeed. If taking the lock fails then + we know that another instance of dune must have it, and the current + process will send a build RPC request to that dune instance. Checking + the status of the lock by taking prevents a race condition where the + state of the lock could otherwise change between checking it and taking + it. *) + match Dune_util.Global_lock.lock ~timeout:None with + | Error lock_held_by -> + (* This case is reached if dune detects that another instance of dune + is already running. Rather than performing the build itself, the + current instance of dune will instruct the already-running instance to + perform the build by sending an RPC message. As only one RPC server + can run at a time we need to use a fiber scheduler which does not run + an RPC server in the background to schedule the fiber which will + perform the RPC call. + *) + Rpc_common.run_via_rpc + ~builder + ~common + ~config + lock_held_by + (Rpc.Build.build ~wait:true) + targets + | Ok () -> + let request setup = + Target.interpret_targets (Common.root common) config setup targets + in + run_build_command ~common ~config ~request + in + Cmd.v (Cmd.info "build" ~doc ~man ~envs:Common.envs) term +;; diff --git a/unikernel/duniverse/dune_/bin/build.mli b/unikernel/duniverse/dune_/bin/build.mli new file mode 100644 index 00000000..eadbc980 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/build.mli @@ -0,0 +1,24 @@ +open Import + +(** Connect to an RPC server (waiting for the server to start if necessary) and + then send a request to the server to build the specified targets. If the + build fails then a diagnostic error message is printed. If + [print_on_success] is true then this function will also print a message + after the build succeeds. *) +val build_via_rpc_server + : print_on_success:bool + -> targets:Dune_lang.Dep_conf.t list + -> unit Fiber.t + +val run_build_system + : common:Common.t + -> request:(Dune_rules.Main.build_system -> unit Action_builder.t) + -> (unit, [ `Already_reported ]) result Fiber.t + +val build : unit Cmd.t + +val run_build_command + : common:Common.t + -> config:Dune_config.t + -> request:(Dune_rules.Main.build_system -> unit Action_builder.t) + -> unit diff --git a/unikernel/duniverse/dune_/bin/cache.ml b/unikernel/duniverse/dune_/bin/cache.ml new file mode 100644 index 00000000..4e3a4e77 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/cache.ml @@ -0,0 +1,117 @@ +open Import + +(* CR-someday amokhov: Implement other commands supported by Jenga. *) + +let trim = + let info = + let doc = "Trim the Dune cache." in + let man = + [ `P "Trim the Dune cache to a specified size or by a specified amount." + ; `S "EXAMPLES" + ; `Pre + {|Trimming the Dune cache to 1 GB. + + \$ dune cache trim --size=1GB |} + ; `Pre + {|Trimming 500 MB from the Dune cache. + + \$ dune cache trim --trimmed-size=500MB |} + ] + in + Cmd.info "trim" ~doc ~man + in + Cmd.v info + @@ let+ trimmed_size = + Arg.( + value + & opt (some bytes) None + & info + ~docv:"BYTES" + [ "trimmed-size" ] + ~doc:"Size to trim from the cache. $(docv) is the same as for --size.") + and+ size = + Arg.( + value + & opt (some bytes) None + & info + ~docv:"BYTES" + [ "size" ] + ~doc: + (sprintf + "Size to trim the cache to. $(docv) is the number of bytes followed by \ + a unit. Byte units can be one of %s." + (String.enumerate_or + (List.map + ~f:(fun (units, _) -> List.hd units) + Bytes_unit.conversion_table)))) + in + Log.init_disabled (); + let open Result.O in + match + let+ goal = + match trimmed_size, size with + | Some trimmed_size, None -> Result.Ok trimmed_size + | None, Some size -> + Result.Ok (Int64.sub (Dune_cache.Trimmer.overhead_size ()) size) + | _ -> Result.Error "please specify either --size or --trimmed-size" + in + Dune_cache.Trimmer.trim ~goal + with + | Error s -> User_error.raise [ Pp.text s ] + | Ok { trimmed_bytes; number_of_files_removed } -> + User_message.print + (User_message.make + [ Pp.textf + "Freed %s (%d files removed)" + (Bytes_unit.pp trimmed_bytes) + number_of_files_removed + ]) +;; + +let size = + let info = + let doc = "Query the size of the Dune cache." in + let man = + [ `P + "Compute the total size of files in the Dune cache which are not hardlinked \ + from any build directory and output it in a human-readable form." + ] + in + Cmd.info "size" ~doc ~man + in + Cmd.v info + @@ let+ machine_readable = + Arg.( + value + & flag + & info [ "machine-readable" ] ~doc:"Outputs size as a plain number of bytes.") + in + let size = Dune_cache.Trimmer.overhead_size () in + if machine_readable + then User_message.print (User_message.make [ Pp.textf "%Ld" size ]) + else User_message.print (User_message.make [ Pp.textf "%s" (Bytes_unit.pp size) ]) +;; + +let clear = + let info = + let doc = "Clear the Dune cache." in + let man = [ `P "Remove any traces of the Dune cache." ] in + Cmd.info "clear" ~doc ~man + in + Cmd.v info @@ Term.(const Dune_cache_storage.clear $ const ()) +;; + +let command = + let info = + let doc = "Manage Dune's shared cache of build artifacts." in + let man = + [ `S "DESCRIPTION" + ; `P + "Dune can share build artifacts between workspaces. We currently only support \ + a few subcommands; however, we plan to provide more functionality soon." + ] + in + Cmd.info "cache" ~doc ~man + in + Cmd.group info [ trim; size; clear ] +;; diff --git a/unikernel/duniverse/dune_/bin/cache.mli b/unikernel/duniverse/dune_/bin/cache.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/cache.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/clean.ml b/unikernel/duniverse/dune_/bin/clean.ml new file mode 100644 index 00000000..d5f67c5d --- /dev/null +++ b/unikernel/duniverse/dune_/bin/clean.ml @@ -0,0 +1,25 @@ +open Import + +let command = + let doc = "Clean the project." in + let man = + [ `S "DESCRIPTION" + ; `P {|Removes files added by dune such as _build, .install, and .merlin|} + ; `Blocks Common.help_secs + ] + in + let term = + let+ builder = Common.Builder.term in + (* Disable log file creation. Indeed, we are going to delete the whole build directory + right after and that includes deleting the log file. Not only would creating the + log file be useless but with some FS this also causes [dune clean] to fail (cf + https://github.com/ocaml/dune/issues/2964). *) + let builder = Common.Builder.disable_log_file builder in + let _common, _config = Common.init builder in + Dune_util.Global_lock.lock_exn ~timeout:None; + Dune_engine.Target_promotion.files_in_source_tree_to_delete () + |> Path.Source.Set.iter ~f:(fun p -> Path.unlink_no_err (Path.source p)); + Path.rm_rf Path.build_dir + in + Cmd.v (Cmd.info "clean" ~doc ~man) term +;; diff --git a/unikernel/duniverse/dune_/bin/clean.mli b/unikernel/duniverse/dune_/bin/clean.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/clean.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/common.ml b/unikernel/duniverse/dune_/bin/common.ml new file mode 100644 index 00000000..836cb189 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/common.ml @@ -0,0 +1,1480 @@ +open Stdune +open Dune_config_file +module Console = Dune_console +module Graph = Dune_graph.Graph +module Profile = Dune_lang.Profile + +open struct + open Dune_util + module Execution_env = Execution_env + module Log = Log + module Report_error = Report_error +end + +open struct + open Dune_rules + module Colors = Colors + module Only_packages = Only_packages +end + +module Workspace = Source.Workspace + +open struct + open Cmdliner + module Cmd = Cmd + + module Term = struct + include Term + + (* Evaluate a parser, passing it no command-line arguments, in an + environment with no variables set. It's only valid to pass a parser + which can be evaluated with no arguments, otherwise a code error will + be raised. Returns the result of the parser. This is intended to be + used to extract the default value for a type implied by the behaviour + of its parser when no command-line arguments are passed to it. *) + let eval_no_args_empty_env t = + let raise_code_error data = + Code_error.raise "Unexpected result evaluating term with no args" data + in + (* Cmdliner doesn't allow argv to be empty. *) + let argv = [| "dune" |] in + let env _ = None in + match Cmd.eval_value ~argv ~env (Cmd.v (Cmd.info "dune") t) with + | Ok (`Ok x) -> x + | Ok `Help -> raise_code_error [ "ok", Dyn.string "help" ] + | Ok `Version -> raise_code_error [ "ok", Dyn.string "version" ] + | Error e -> + let error_string = + match e with + | `Parse -> "parse" + | `Term -> "term" + | `Exn -> "exn" + in + raise_code_error [ "error", Dyn.string error_string ] + ;; + end + + module Manpage = Manpage +end + +module Package = Dune_lang.Package + +module Let_syntax = struct + let ( let+ ) t f = Term.(const f $ t) + let ( and+ ) a b = Term.(const (fun x y -> x, y) $ a $ b) +end + +open Let_syntax + +let copts_sect = "COMMON OPTIONS" + +let debug_backtraces = + Arg.( + value + & flag + & info + [ "debug-backtraces" ] + ~docs:copts_sect + ~doc:"Always print exception backtraces.") +;; + +let default_build_dir = "_build" + +let one_of term1 term2 = + Term.ret + @@ let+ x, args1 = Term.with_used_args term1 + and+ y, args2 = Term.with_used_args term2 in + match args1, args2 with + | _, [] -> `Ok x + | [], _ -> `Ok y + | arg1 :: _, arg2 :: _ -> + `Error (true, sprintf "Cannot use %s and %s simultaneously" arg1 arg2) +;; + +let build_info = + let+ build_info = + Arg.( + value & flag & info [ "build-info" ] ~docs:"OPTIONS" ~doc:"Show build information.") + in + if build_info + then ( + let module B = Build_info.V1 in + let pr fmt = Printf.printf (fmt ^^ "\n") in + let ver_string v = + match v with + | None -> "n/a" + | Some v -> B.Version.to_string v + in + pr "version: %s" (ver_string (B.version ())); + let libs = + B.Statically_linked_libraries.to_list () + |> List.map ~f:(fun lib -> + ( B.Statically_linked_library.name lib + , ver_string (B.Statically_linked_library.version lib) )) + |> List.sort ~compare:(Tuple.T2.compare String.compare String.compare) + in + (match libs with + | [] -> () + | _ -> + pr "statically linked libraries:"; + let longest = String.longest_map libs ~f:fst in + List.iter libs ~f:(fun (name, v) -> pr "- %-*s %s" longest name v)); + exit 0) +;; + +module Options_implied_by_dash_p = struct + type t = + { root : string option + ; only_packages : Only_packages.Clflags.t + ; ignore_promoted_rules : bool + ; config_from_config_file : Dune_config.Partial.t + ; profile : Profile.t option + ; default_target : Arg.Dep.t + ; always_show_command_line : bool + ; promote_install_files : bool + ; require_dune_project_file : bool + ; ignore_lock_dir : bool + } + + let docs = copts_sect + + type config_file = + | No_config + | Default + | This of Path.t + + let config_term = + let+ x = + one_of + (let+ fn = + Arg.( + value + & opt (some path) None + & info + [ "config-file" ] + ~docs + ~docv:"FILE" + ~doc:"Load this configuration file instead of the default one.") + in + Option.map fn ~f:(fun fn -> This (Arg.Path.path fn))) + (let+ x = + Arg.( + value + & flag + & info [ "no-config" ] ~docs ~doc:"Do not load the configuration file") + in + Option.some_if x No_config) + in + match Option.value x ~default:Default with + | No_config -> Dune_config.Partial.empty + | This fname -> Dune_config.load_config_file fname + | Default -> + if Execution_env.inside_dune + then Dune_config.Partial.empty + else Dune_config.load_user_config_file () + ;; + + let packages = + let parser s = + let parse_one s = + match Package.Name.of_string_opt s with + | Some x -> Ok x + | None -> ksprintf (fun s -> Error (`Msg s)) "Invalid package name: %S" s + in + String.split s ~on:',' + |> List.map ~f:parse_one + |> Result.List.all + |> Result.map ~f:Package.Name.Set.of_list + in + let printer ppf set = + Format.pp_print_string + ppf + (String.concat + ~sep:"," + (Package.Name.Set.to_list set |> List.map ~f:Package.Name.to_string)) + in + Arg.conv ~docv:"PACKAGES" (parser, printer) + ;; + + let options = + let+ root = + Arg.( + value + & opt (some dir) None + & info + [ "root" ] + ~docs + ~docv:"DIR" + ~doc: + "Use this directory as workspace root instead of guessing it. Note that \ + this option doesn't change the interpretation of targets given on the \ + command line. It is only intended for scripts.") + and+ ignore_promoted_rules = + Arg.( + value + & flag + & info + [ "ignore-promoted-rules" ] + ~docs + ~doc: + "Ignore rules with (mode promote), except ones with (only ...). The \ + variable %{ignoring_promoted_rules} in dune files reflects whether this \ + option was passed or not.") + and+ config_from_config_file = config_term + and+ default_target = + Arg.( + value + & opt dep (Dep.alias ~dir:Stdune.Path.Local.root Dune_engine.Alias.Name.default) + & info + [ "default-target" ] + ~docs + ~docv:"TARGET" + ~doc: + "Set the default target that is used when none is specified to $(b,dune \ + build).") + and+ always_show_command_line = + let doc = "Always show the full command lines of programs executed by dune." in + Arg.(value & flag & info [ "always-show-command-line" ] ~docs ~doc) + and+ promote_install_files = + let doc = "Promote any generated .install files to the source tree." in + Arg.( + last + & opt_all ~vopt:true bool [ false ] + & info [ "promote-install-files" ] ~docs ~doc) + and+ require_dune_project_file = + let doc = "Fail if a dune-project file is missing." in + Arg.( + last + & opt_all ~vopt:true bool [ false ] + & info [ "require-dune-project-file" ] ~docs ~doc) + and+ ignore_lock_dir = + let doc = "Ignore dune.lock/ directory." in + Arg.(value & flag & info [ "ignore-lock-dir" ] ~docs ~doc) + in + { root + ; only_packages = No_restriction + ; ignore_promoted_rules + ; config_from_config_file + ; profile = None + ; default_target + ; always_show_command_line + ; promote_install_files + ; require_dune_project_file + ; ignore_lock_dir + } + ;; + + let dash_dash_release = + let shorthand_for = + [ "--root" + ; "." + ; "--ignore-promoted-rules" + ; "--no-config" + ; "--profile" + ; "release" + ; "--always-show-command-line" + ; "--promote-install-files" + ; "--require-dune-project-file" + ; "--default-target" + ; "@install" + ] + in + Arg.( + value + & alias shorthand_for + & info + [ "release" ] + ~docs + ~docv:"PACKAGES" + ~doc: + (sprintf + "Put $(b,dune) into a reproducible $(i,release) mode. Shorthand for \ + $(b,%s). You should use this option for release builds. For instance, \ + you must use this option in your $(i,.opam) files. Except if \ + you already use $(b,-p), as $(b,-p) implies this option." + (String.concat ~sep:" " shorthand_for))) + ;; + + let options = + let+ t = options + and+ _ = dash_dash_release + and+ only_packages = + let+ names = + Arg.( + value + & opt (some packages) None + & info + [ "only-packages" ] + ~docs + ~docv:"PACKAGES" + ~doc: + "Ignore stanzas referring to a package that is not in $(b,PACKAGES). \ + $(b,PACKAGES) is a comma-separated list of package names. Note that \ + this has the same effect as deleting the relevant stanzas from dune \ + files. It is mostly meant for releases. During development, it is \ + likely that what you want instead is to build a particular \ + $(b,.install) target.") + in + match names with + | None -> Only_packages.Clflags.No_restriction + | Some names -> Restrict { names; command_line_option = "--only-packages" } + in + { t with only_packages } + ;; + + let dash_p = + Term.with_used_args + Arg.( + value + & alias_opt (fun s -> [ "--release"; "--ignore-lock-dir"; "--only-packages"; s ]) + & info + [ "p"; "for-release-of-packages" ] + ~docs + ~docv:"PACKAGES" + ~doc: + "Shorthand for $(b,--release --only-packages PACKAGE). You must use this \ + option in your $(i,.opam) files, in order to build only what's \ + necessary when your project contains multiple packages as well as getting \ + reproducible builds.") + ;; + + let term = + let+ t = options + and+ _ = dash_p + and+ profile = + let doc = "Build profile. $(b,dev) if unspecified or $(b,release) if -p is set." in + Arg.( + last + & opt_all (some profile) [ None ] + & info + [ "profile" ] + ~docs + ~env:(Cmd.Env.info ~doc "DUNE_PROFILE") + ~doc: + (Printf.sprintf + "Select the build profile, for instance $(b,dev) or $(b,release). The \ + default is $(b,%s)." + (Profile.to_string Profile.default))) + in + match profile with + | None -> t + | Some _ -> { t with profile } + ;; +end + +let display_term = + let module Display = Dune_config.Display in + one_of + (let+ verbose = + Arg.( + value + & flag + & info [ "verbose" ] ~docs:copts_sect ~doc:"Same as $(b,--display verbose)") + in + Option.some_if verbose Dune_config.Display.verbose) + Arg.( + let doc = + let all = Display.all |> List.map ~f:fst |> String.enumerate_or in + sprintf + "Control the display mode of Dune. See $(b,dune-config\\(5\\)) for more \ + details. Valid values for this option are %s." + all + in + value + & opt (some (enum Display.all)) None + & info [ "display" ] ~docs:copts_sect ~docv:"MODE" ~doc) +;; + +let shared_with_config_file = + let docs = copts_sect in + let+ concurrency = + let module Concurrency = Dune_config.Concurrency in + let arg = + Arg.conv + ( (fun s -> Result.map_error (Concurrency.of_string s) ~f:(fun s -> `Msg s)) + , fun pp x -> Format.pp_print_string pp (Concurrency.to_string x) ) + in + Arg.( + value + & opt (some arg) None + & info + [ "j" ] + ~docs + ~docv:"JOBS" + ~doc:"Run no more than $(i,JOBS) commands simultaneously.") + and+ sandboxing_preference = + let all = + List.map Dune_engine.Sandbox_mode.all_except_patch_back_source_tree ~f:(fun s -> + Dune_engine.Sandbox_mode.to_string s, s) + in + Arg.( + value + & opt (some (enum all)) None + & info + [ "sandbox" ] + ~env: + (Cmd.Env.info + ~doc:"Sandboxing mode to use by default. (see --sandbox)" + "DUNE_SANDBOX") + ~doc: + (Printf.sprintf + "Set sandboxing mode. Some actions require a certain sandboxing mode, so \ + they will ignore this setting. The allowed values are: %s." + (String.concat + ~sep:", " + (List.map + Dune_engine.Sandbox_mode.all_except_patch_back_source_tree + ~f:Dune_engine.Sandbox_mode.to_string)))) + and+ terminal_persistence = + let modes = Dune_config.Terminal_persistence.all in + let doc = + let f s = fst s |> Printf.sprintf "$(b,%s)" in + Printf.sprintf + "Change how the log of build results are displayed to the console between \ + rebuilds while in $(b,--watch) mode. Supported modes: %s." + (List.map ~f modes |> String.concat ~sep:", ") + in + Arg.( + value + & opt (some (enum modes)) None + & info [ "terminal-persistence" ] ~docs ~docv:"MODE" ~doc) + and+ display = display_term + and+ cache_enabled = + let doc = + Printf.sprintf + "Enable or disable Dune cache (%s). Default is `%s'." + (Arg.doc_alts_enum Dune_config.Cache.Toggle.all) + (Dune_config.Cache.Toggle.to_string Dune_config.default.cache_enabled) + in + Arg.( + value + & opt (some (enum Dune_config.Cache.Toggle.all)) None + & info [ "cache" ] ~docs ~env:(Cmd.Env.info ~doc "DUNE_CACHE") ~doc) + and+ cache_storage_mode = + let doc = + Printf.sprintf + "Dune cache storage mode (%s). Default is `%s'." + (Arg.doc_alts_enum Dune_config.Cache.Storage_mode.all) + (Dune_config.Cache.Storage_mode.to_string Dune_config.default.cache_storage_mode) + in + Arg.( + value + & opt (some (enum Dune_config.Cache.Storage_mode.all)) None + & info + [ "cache-storage-mode" ] + ~docs + ~env:(Cmd.Env.info ~doc "DUNE_CACHE_STORAGE_MODE") + ~doc) + and+ cache_check_probability = + let doc = + Printf.sprintf + "Check build reproducibility by re-executing randomly chosen rules and comparing \ + their results with those stored in Dune cache. Note: by increasing the \ + probability of such checks you slow down the build. The default probability is \ + zero, i.e. no rules are checked." + in + Arg.( + value + & opt (some float) None + & info + [ "cache-check-probability" ] + ~docs + ~env:(Cmd.Env.info ~doc "DUNE_CACHE_CHECK_PROBABILITY") + ~doc) + and+ action_stdout_on_success = + Arg.( + value + & opt (some (enum Dune_config.Action_output_on_success.all)) None + & info + [ "action-stdout-on-success" ] + ~doc: + "Specify how to deal with the standard output of actions when they succeed. \ + Possible values are: $(b,print) to just print it to Dune's output, \ + $(b,swallow) to completely ignore it and $(b,must-be-empty) to enforce that \ + the action printed nothing. With $(b,must-be-empty), Dune will consider \ + that the action failed if it printed something to its standard output. The \ + default is $(b,print).") + and+ action_stderr_on_success = + Arg.( + value + & opt (some (enum Dune_config.Action_output_on_success.all)) None + & info + [ "action-stderr-on-success" ] + ~doc: + "Same as $(b,--action-stdout-on-success) but for standard error instead of \ + standard output. A good default for large mono-repositories is \ + $(b,--action-stdout-on-success=swallow \ + --action-stderr-on-success=must-be-empty). This ensures that a successful \ + build has a \"clean\" empty output.") + in + { Dune_config.Partial.display + ; concurrency + ; sandboxing_preference = Option.map sandboxing_preference ~f:(fun x -> [ x ]) + ; terminal_persistence + ; cache_enabled + ; cache_reproducibility_check = + Option.map + cache_check_probability + ~f:Dune_cache.Config.Reproducibility_check.check_with_probability + ; cache_storage_mode + ; action_stdout_on_success + ; action_stderr_on_success + ; project_defaults = None + ; pkg_enabled = None + ; experimental = None + } +;; + +module Cache_debug_flags = Dune_engine.Cache_debug_flags + +let cache_debug_flags_term : Cache_debug_flags.t Term.t = + let initial = + { Cache_debug_flags.shared_cache = false + ; workspace_local_cache = false + ; fs_cache = false + } + in + let all_layers = + [ ("shared", fun r -> { r with Cache_debug_flags.shared_cache = true }) + ; ( "workspace-local" + , fun r -> { r with Cache_debug_flags.workspace_local_cache = true } ) + ; ("fs", fun r -> { r with Cache_debug_flags.fs_cache = true }) + ] + in + let no_layers = [], Fun.id in + let combine_layers = + List.fold_right ~init:no_layers ~f:(fun (names, value) (acc_names, acc_value) -> + names @ acc_names, fun x -> acc_value (value x)) + in + let all_layer_names = String.concat ~sep:"," (List.map ~f:fst all_layers) in + let layers_conv = + let parser s = + let parse_one s = + match + List.find_map all_layers ~f:(fun (name, value) -> + match String.equal name s with + | true -> Some ([ name ], value) + | false -> None) + with + | None -> ksprintf (fun s -> Error (`Msg s)) "Invalid cache layer name: %S" s + | Some x -> Ok x + in + String.split s ~on:',' + |> List.map ~f:parse_one + |> Result.List.all + |> Result.map ~f:combine_layers + in + let printer ppf (names, _value) = + Format.pp_print_string ppf (String.concat ~sep:"," names) + in + Arg.conv ~docv:"CACHE-LAYERS" (parser, printer) + in + let+ _names, value = + Arg.( + value + & opt layers_conv no_layers + & info + [ "debug-cache" ] + ~docs:copts_sect + ~doc: + (sprintf + "Show debug messages on cache misses for the given cache layers. Value is \ + a comma-separated list of cache layer names. All available cache layers: \ + %s." + all_layer_names)) + in + value initial +;; + +module Builder = struct + type t = + { debug_dep_path : bool + ; debug_backtraces : bool + ; debug_artifact_substitution : bool + ; debug_load_dir : bool + ; debug_digests : bool + ; debug_package_logs : bool + ; wait_for_filesystem_clock : bool + ; only_packages : Only_packages.Clflags.t + ; capture_outputs : bool + ; diff_command : string option + ; promote : Dune_engine.Clflags.Promote.t option + ; ignore_promoted_rules : bool + ; force : bool + ; no_print_directory : bool + ; ignore_lock_dir : bool + ; store_orig_src_dir : bool + ; default_target : Arg.Dep.t (* For build & runtest only *) + ; watch : Dune_rpc_impl.Watch_mode_config.t + ; print_metrics : bool + ; dump_memo_graph_file : Path.External.t option + ; dump_memo_graph_format : Graph.File_format.t + ; dump_memo_graph_with_timing : bool + ; dump_gc_stats : Path.External.t option + ; always_show_command_line : bool + ; promote_install_files : bool + ; file_watcher : Dune_engine.Scheduler.Run.file_watcher + ; workspace_config : Workspace.Clflags.t + ; cache_debug_flags : Dune_engine.Cache_debug_flags.t + ; report_errors_config : Dune_engine.Report_errors_config.t + ; separate_error_messages : bool + ; stop_on_first_error : bool + ; require_dune_project_file : bool + ; watch_exclusions : string list + ; build_dir : string + ; root : string option + ; stats_trace_file : string option + ; stats_trace_extended : bool + ; allow_builds : bool + ; default_root_is_cwd : bool + ; log_file : Dune_util.Log.File.t + } + + let root t = t.root + let set_root t root = { t with root = Some root } + let forbid_builds t = { t with allow_builds = false; no_print_directory = true } + let default_root_is_cwd t = t.default_root_is_cwd + let set_default_root_is_cwd t x = { t with default_root_is_cwd = x } + let set_log_file t x = { t with log_file = x } + let disable_log_file t = { t with log_file = No_log_file } + let set_promote t v = { t with promote = Some v } + let default_target t = t.default_target + + (** Cmdliner documentation markup language + (https://erratique.ch/software/cmdliner/doc/tool_man.html#doclang) + requires that dollar signs (ex. $(tname)) and backslashes are escaped. *) + let docmarkup_escape s = + let b = Buffer.create (2 * String.length s) in + for i = 0 to String.length s - 1 do + match s.[i] with + | ('$' | '\\') as c -> + Buffer.add_char b '\\'; + Buffer.add_char b c + | c -> Buffer.add_char b c + done; + Buffer.contents b + ;; + + let term = + let docs = copts_sect in + let+ config_from_command_line = shared_with_config_file + and+ debug_dep_path = + Arg.( + value + & flag + & info + [ "debug-dependency-path" ] + ~docs + ~doc: + "In case of error, print the dependency path from the targets on the \ + command line to the rule that failed.") + and+ debug_backtraces = debug_backtraces + and+ debug_artifact_substitution = + Arg.( + value + & flag + & info + [ "debug-artifact-substitution" ] + ~docs + ~doc:"Print debugging info about artifact substitution") + and+ debug_load_dir = + Arg.( + value + & flag + & info + [ "debug-load-dir" ] + ~docs + ~doc:"Print debugging info about directory loading") + and+ debug_digests = + Arg.( + value + & flag + & info + [ "debug-digests" ] + ~docs + ~doc:"Explain why Dune decides to re-digest some files") + and+ debug_package_logs = + let doc = "Always print the standard logs when building packages" in + Arg.( + value + & flag + & info + [ "debug-package-logs" ] + ~docs + ~doc + ~env:(Cmd.Env.info ~doc "DUNE_DEBUG_PACKAGE_LOGS")) + and+ no_buffer = + let doc = + "Do not buffer the output of commands executed by dune. By default dune buffers \ + the output of subcommands, in order to prevent interleaving when multiple \ + commands are executed in parallel. However, this can be an issue when debugging \ + long running tests. With $(b,--no-buffer), commands have direct access to the \ + terminal. Note that as a result their output won't be captured in the log file. \ + You should use this option in conjunction with $(b,-j 1), to avoid \ + interleaving. Additionally you should use $(b,--verbose) as well, to make sure \ + that commands are printed before they are being executed." + in + Arg.(value & flag & info [ "no-buffer" ] ~docs ~docv:"DIR" ~doc) + and+ workspace_file = + let doc = "Use this specific workspace file instead of looking it up." in + Arg.( + value + & opt (some external_path) None + & info + [ "workspace" ] + ~docs + ~docv:"FILE" + ~doc + ~env:(Cmd.Env.info ~doc "DUNE_WORKSPACE")) + and+ promote = + one_of + (let+ auto = + Arg.( + value + & flag + & info + [ "auto-promote" ] + ~docs + ~doc: + "Automatically promote files. This is similar to running $(b,dune \ + promote) after the build.") + in + Option.some_if auto Dune_engine.Clflags.Promote.Automatically) + (let+ disable = + let doc = "Disable all promotion rules" in + let env = Cmd.Env.info ~doc "DUNE_DISABLE_PROMOTION" in + Arg.(value & flag & info [ "disable-promotion" ] ~docs ~env ~doc) + in + Option.some_if disable Dune_engine.Clflags.Promote.Never) + and+ force = + Arg.( + value + & flag + & info + [ "force"; "f" ] + ~doc: + "Force actions associated to aliases to be re-executed even if their \ + dependencies haven't changed.") + and+ watch = + let+ res = + one_of + (let+ watch = + Arg.( + value + & flag + & info + [ "watch"; "w" ] + ~doc: + "Instead of terminating build after completion, wait continuously \ + for file changes.") + in + if watch then Some Dune_rpc_impl.Watch_mode_config.Eager else None) + (let+ watch = + Arg.( + value + & flag + & info + [ "passive-watch-mode" ] + ~doc: + "Similar to [--watch], but only start a build when instructed \ + externally by an RPC.") + in + if watch then Some Dune_rpc_impl.Watch_mode_config.Passive else None) + in + match res with + | None -> Dune_rpc_impl.Watch_mode_config.No + | Some mode -> Yes mode + and+ print_metrics = + Arg.( + value + & flag + & info + [ "print-metrics" ] + ~docs + ~doc:"Print out various performance metrics after every build.") + and+ dump_memo_graph_file = + Arg.( + value + & opt (some string) None + & info + [ "dump-memo-graph" ] + ~docs + ~docv:"FILE" + ~doc:"Dump the dependency graph to a file after the build is complete.") + and+ dump_memo_graph_format = + Arg.( + value + & opt graph_format Gexf + & info + [ "dump-memo-graph-format" ] + ~docs + ~docv:"FORMAT" + ~doc:"Set the file format used by $(b,--dump-memo-graph)") + and+ dump_memo_graph_with_timing = + Arg.( + value + & flag + & info + [ "dump-memo-graph-with-timing" ] + ~docs + ~doc: + "Re-run each cached node in the Memo graph after building and include the \ + run duration in the output of $(b,--dump-memo-graph). Since all nodes \ + contain a cached value, each measurement will only account for a single \ + node.") + and+ dump_gc_stats = + Arg.( + value + & opt (some string) None + & info + [ "dump-gc-stats" ] + ~docs + ~docv:"FILE" + ~doc:"Dump the garbage collector stats to a file after the build is complete.") + and+ { Options_implied_by_dash_p.root + ; only_packages + ; ignore_promoted_rules + ; config_from_config_file + ; profile + ; default_target + ; always_show_command_line + ; promote_install_files + ; require_dune_project_file + ; ignore_lock_dir + } + = + Options_implied_by_dash_p.term + and+ x = + Arg.( + value + & opt (some Arg.context_name) None + & info [ "x" ] ~docs ~doc:"Cross-compile using this toolchain.") + and+ build_dir = + let doc = "Specified build directory. _build if unspecified" in + Arg.( + value + & opt (some string) None + & info + [ "build-dir" ] + ~docs + ~docv:"FILE" + ~env:(Cmd.Env.info ~doc "DUNE_BUILD_DIR") + ~doc) + and+ diff_command = + let doc = + "Shell command to use to diff files. Use - to disable printing the diff." + in + Arg.( + value + & opt (some string) None + & info [ "diff-command" ] ~docs ~env:(Cmd.Env.info ~doc "DUNE_DIFF_COMMAND") ~doc) + and+ stats_trace_file = + Arg.( + value + & opt (some string) None + & info + [ "trace-file" ] + ~docs + ~docv:"FILE" + ~doc: + "Output trace data in catapult format (compatible with chrome://tracing).") + and+ stats_trace_extended = + Arg.( + value + & flag + & info + [ "trace-extended" ] + ~docs + ~doc:"Output extended trace data (requires trace-file).") + and+ no_print_directory = + Arg.( + value + & flag + & info + [ "no-print-directory" ] + ~docs + ~doc:"Suppress \"Entering directory\" messages.") + and+ store_orig_src_dir = + let doc = "Store original source location in dune-package metadata." in + Arg.( + value + & flag + & info + [ "store-orig-source-dir" ] + ~docs + ~env:(Cmd.Env.info ~doc "DUNE_STORE_ORIG_SOURCE_DIR") + ~doc) + and+ () = build_info + and+ instrument_with = + let doc = + "Enable instrumentation by $(b,BACKENDS). $(b,BACKENDS) is a comma-separated \ + list of library names, each one of which must declare an instrumentation \ + backend." + in + Arg.( + value + & opt (some (list lib_name)) None + & info + [ "instrument-with" ] + ~docs + ~env:(Cmd.Env.info ~doc "DUNE_INSTRUMENT_WITH") + ~docv:"BACKENDS" + ~doc) + and+ file_watcher = + let doc = + "Mechanism to detect changes in the source. Automatic to make dune run an \ + external program to detect changes. Manual to notify dune that files have \ + changed manually." + in + Arg.( + value + & opt + (enum + [ "automatic", Dune_engine.Scheduler.Run.Automatic; "manual", No_watcher ]) + Automatic + & info [ "file-watcher" ] ~doc) + and+ watch_exclusions = + let std_exclusions = Dune_config.standard_watch_exclusions in + let doc = + let escaped_std_exclusions = List.map ~f:docmarkup_escape std_exclusions in + "Adds a POSIX regular expression that will exclude matching directories from \ + $(b,`dune build --watch`). The option $(opt) can be repeated to add multiple \ + exclusions. Semicolons can be also used as a separator. If no exclusions are \ + provided, then a standard set of exclusions is used; however, if $(i,one or \ + more) $(opt) are used, $(b,none) of the standard exclusions are used. The \ + standard exclusions are: " + ^ String.concat ~sep:" " escaped_std_exclusions + in + let arg = + Arg.( + value + & opt_all (list ~sep:';' string) [ std_exclusions ] + & info [ "watch-exclusions" ] ~docs ~docv:"REGEX" ~doc) + in + Term.(const List.flatten $ arg) + and+ wait_for_filesystem_clock = + Arg.( + value + & flag + & info + [ "wait-for-filesystem-clock" ] + ~doc: + "Dune digest file contents for better incrementally. These digests are \ + themselves cached. In some cases, Dune needs to drop some digest cache \ + entries in order for things to be reliable. This option makes Dune wait \ + for the file system clock to advance so that it doesn't need to drop \ + anything. You should probably not care about this option; it is mostly \ + useful for Dune developers to make Dune tests of the digest cache more \ + reproducible.") + and+ cache_debug_flags = cache_debug_flags_term + and+ report_errors_config = + Arg.( + value + & opt + (enum + [ "early", Dune_engine.Report_errors_config.Early + ; "deterministic", Deterministic + ; "twice", Twice + ]) + Dune_engine.Report_errors_config.default + & info + [ "error-reporting" ] + ~doc: + "Controls when the build errors are reported. $(b,early) reports errors as \ + soon as they are discovered. $(b,deterministic) reports errors at the end \ + of the build in a deterministic order. $(b,twice) reports each error \ + twice: once as soon as the error is discovered and then again at the end \ + of the build, in a deterministic order.") + and+ separate_error_messages = + Arg.( + value + & flag + & info + [ "display-separate-messages" ] + ~doc:"Separate error messages with a blank line.") + and+ stop_on_first_error = + Arg.( + value + & flag + & info + [ "stop-on-first-error" ] + ~doc:"Stop the build as soon as an error is encountered.") + in + if Option.is_none stats_trace_file && stats_trace_extended + then User_error.raise [ Pp.text "--trace-extended can only be used with --trace" ]; + { debug_dep_path + ; debug_backtraces + ; debug_artifact_substitution + ; debug_load_dir + ; debug_digests + ; debug_package_logs + ; wait_for_filesystem_clock + ; only_packages + ; capture_outputs = not no_buffer + ; diff_command + ; promote + ; ignore_promoted_rules + ; force + ; no_print_directory + ; ignore_lock_dir + ; store_orig_src_dir + ; default_target + ; watch + ; print_metrics + ; dump_memo_graph_file = + Option.map + dump_memo_graph_file + ~f:Path.External.of_filename_relative_to_initial_cwd + ; dump_memo_graph_format + ; dump_memo_graph_with_timing + ; dump_gc_stats = + Option.map dump_gc_stats ~f:Path.External.of_filename_relative_to_initial_cwd + ; always_show_command_line + ; promote_install_files + ; file_watcher + ; workspace_config = + { x + ; profile + ; instrument_with + ; workspace_file = + Option.map workspace_file ~f:(fun p -> + Path.Outside_build_dir.External (Arg.Path.External.path p)) + ; config_from_command_line + ; config_from_config_file + } + ; cache_debug_flags + ; report_errors_config + ; separate_error_messages + ; stop_on_first_error + ; require_dune_project_file + ; watch_exclusions + ; build_dir = Option.value ~default:default_build_dir build_dir + ; root + ; stats_trace_file + ; stats_trace_extended + ; allow_builds = true + ; default_root_is_cwd = false + ; log_file = Default + } + ;; + + let default = Term.eval_no_args_empty_env term + + let equal + t + { debug_dep_path + ; debug_backtraces + ; debug_artifact_substitution + ; debug_load_dir + ; debug_digests + ; debug_package_logs + ; wait_for_filesystem_clock + ; only_packages + ; capture_outputs + ; diff_command + ; promote + ; ignore_promoted_rules + ; force + ; no_print_directory + ; ignore_lock_dir + ; store_orig_src_dir + ; default_target + ; watch + ; print_metrics + ; dump_memo_graph_file + ; dump_memo_graph_format + ; dump_memo_graph_with_timing + ; dump_gc_stats + ; always_show_command_line + ; promote_install_files + ; file_watcher + ; workspace_config + ; cache_debug_flags + ; report_errors_config + ; separate_error_messages + ; stop_on_first_error + ; require_dune_project_file + ; watch_exclusions + ; build_dir + ; root + ; stats_trace_file + ; stats_trace_extended + ; allow_builds + ; default_root_is_cwd + ; log_file + } + = + Bool.equal t.debug_dep_path debug_dep_path + && Bool.equal t.debug_backtraces debug_backtraces + && Bool.equal t.debug_artifact_substitution debug_artifact_substitution + && Bool.equal t.debug_load_dir debug_load_dir + && Bool.equal t.debug_digests debug_digests + && Bool.equal t.debug_package_logs debug_package_logs + && Bool.equal t.wait_for_filesystem_clock wait_for_filesystem_clock + && Only_packages.Clflags.equal t.only_packages only_packages + && Bool.equal t.capture_outputs capture_outputs + && Option.equal String.equal t.diff_command diff_command + && Option.equal Dune_engine.Clflags.Promote.equal t.promote promote + && Bool.equal t.ignore_promoted_rules ignore_promoted_rules + && Bool.equal t.force force + && Bool.equal t.no_print_directory no_print_directory + && Bool.equal t.ignore_lock_dir ignore_lock_dir + && Bool.equal t.store_orig_src_dir store_orig_src_dir + && Arg.Dep.equal t.default_target default_target + && Dune_rpc_impl.Watch_mode_config.equal t.watch watch + && Bool.equal t.print_metrics print_metrics + && Option.equal Path.External.equal t.dump_memo_graph_file dump_memo_graph_file + && Graph.File_format.equal t.dump_memo_graph_format dump_memo_graph_format + && Bool.equal t.dump_memo_graph_with_timing dump_memo_graph_with_timing + && Option.equal Path.External.equal t.dump_gc_stats dump_gc_stats + && Bool.equal t.always_show_command_line always_show_command_line + && Bool.equal t.promote_install_files promote_install_files + && Dune_engine.Scheduler.Run.file_watcher_equal t.file_watcher file_watcher + && Source.Workspace.Clflags.equal t.workspace_config workspace_config + && Dune_engine.Cache_debug_flags.equal t.cache_debug_flags cache_debug_flags + && Dune_engine.Report_errors_config.equal t.report_errors_config report_errors_config + && Bool.equal t.separate_error_messages separate_error_messages + && Bool.equal t.stop_on_first_error stop_on_first_error + && Bool.equal t.require_dune_project_file require_dune_project_file + && List.equal String.equal t.watch_exclusions watch_exclusions + && String.equal t.build_dir build_dir + && Option.equal String.equal t.root root + && Option.equal String.equal t.stats_trace_file stats_trace_file + && Bool.equal t.stats_trace_extended stats_trace_extended + && Bool.equal t.allow_builds allow_builds + && Bool.equal t.default_root_is_cwd default_root_is_cwd + && Log.File.equal t.log_file log_file + ;; +end + +type t = + { builder : Builder.t + ; root : Workspace_root.t + ; rpc : + [ `Allow of Dune_lang.Dep_conf.t Dune_rpc_impl.Server.t Lazy.t | `Forbid_builds ] + ; stats : Dune_stats.t option + } + +let capture_outputs t = t.builder.capture_outputs +let root t = t.root +let watch t = t.builder.watch +let x t = t.builder.workspace_config.x +let print_metrics t = t.builder.print_metrics +let dump_memo_graph_file t = t.builder.dump_memo_graph_file +let dump_memo_graph_format t = t.builder.dump_memo_graph_format +let dump_memo_graph_with_timing t = t.builder.dump_memo_graph_with_timing +let file_watcher t = t.builder.file_watcher +let prefix_target t s = t.root.reach_from_root_prefix ^ s + +let rpc t = + match t.rpc with + | `Forbid_builds -> `Forbid_builds + | `Allow rpc -> `Allow (Lazy.force rpc) +;; + +let watch_exclusions t = t.builder.watch_exclusions +let stats t = t.stats + +(* To avoid needless recompilations under Windows, where the case of + [Sys.getcwd] can vary between different invocations of [dune], normalize to + lowercase. *) +let normalize_path path = + if Sys.win32 + then ( + let src = Path.External.to_string path in + let is_letter = function + | 'a' .. 'z' | 'A' .. 'Z' -> true + | _ -> false + in + if String.length src >= 2 && is_letter src.[0] && src.[1] = ':' + then ( + let dst = Bytes.create (String.length src) in + Bytes.set dst 0 (Char.uppercase_ascii src.[0]); + Bytes.blit_string ~src ~src_pos:1 ~dst ~dst_pos:1 ~len:(String.length src - 1); + Path.External.of_string (Bytes.unsafe_to_string dst)) + else path) + else path +;; + +let print_entering_message c = + let cwd = Path.to_absolute_filename Path.root in + if cwd <> Fpath.initial_cwd && not c.builder.no_print_directory + then ( + (* Editors such as Emacs parse the output of the build system and interpret + filenames in error messages relative to where the build system was + started. + + If the build system changes directory, the editor will not be able to + correctly locate files. However, such editors also understand messages of + the form "Entering directory ''" that the "make" command prints. + + This is why Dune also prints such a message; this way people running Dune + through such an editor will be able to use the "jump to error" feature of + their editor. *) + let dir = + match Execution_env.inside_dune with + | false -> cwd + | true -> + let descendant_simple p ~of_ = + match String.drop_prefix p ~prefix:of_ with + | None | Some "" -> None + | Some s -> Some (String.drop s 1) + in + (match descendant_simple cwd ~of_:Fpath.initial_cwd with + | Some s -> s + | None -> + (match descendant_simple Fpath.initial_cwd ~of_:cwd with + | None -> cwd + | Some s -> + let rec loop acc dir = + if dir = Filename.current_dir_name + then acc + else loop (Filename.concat acc "..") (Filename.dirname dir) + in + loop ".." (Filename.dirname s))) + in + Console.print [ Pp.verbatim (sprintf "Entering directory '%s'" dir) ]; + at_exit (fun () -> + flush stdout; + Console.print [ Pp.verbatim (sprintf "Leaving directory '%s'" dir) ])) +;; + +(* CR-someday rleshchinskiy: The split between `build` and `init` seems quite arbitrary, + we should probably refactor that at some point. *) +let build (builder : Builder.t) = + let root = + Workspace_root.create_exn + ~default_is_cwd:builder.default_root_is_cwd + ~specified_by_user:builder.root + in + let stats = + Option.map builder.stats_trace_file ~f:(fun f -> + let stats = + Dune_stats.create + ~extended_build_job_info:builder.stats_trace_extended + (Out (open_out f)) + in + Dune_stats.set_global stats; + stats) + in + let rpc = + if builder.allow_builds + then + `Allow + (lazy + (let registry = + match builder.watch with + | Yes _ -> `Add + | No -> `Skip + in + let lock_timeout = + match builder.watch with + | Yes Passive -> Some 1.0 + | _ -> None + in + Dune_rpc_impl.Server.create + ~lock_timeout + ~registry + ~root:root.dir + ~handle:Dune_rules_rpc.register + ~parse_build_arg:Dune_rules_rpc.parse_build_arg + stats)) + else `Forbid_builds + in + if builder.print_metrics then Dune_metrics.enable (); + { builder; root; rpc; stats } +;; + +let maybe_init_cache (cache_config : Dune_cache.Config.t) = + match cache_config with + | Disabled -> cache_config + | Enabled _ -> + (match Dune_cache_storage.Layout.create_cache_directories () with + | Ok () -> cache_config + | Error (path, exn) -> + User_warning.emit + ~hints: + [ Pp.textf "Make sure the directory %s can be created" (Path.to_string path) ] + [ Pp.textf + "Cache directories could not be created: %s; disabling cache" + (Unix.error_message exn) + ]; + Disabled) +;; + +let init (builder : Builder.t) = + let c = build builder in + if c.root.dir <> Filename.current_dir_name then Sys.chdir c.root.dir; + Path.set_root (normalize_path (Path.External.cwd ())); + Path.Build.set_build_dir (Path.Outside_build_dir.of_string c.builder.build_dir); + (* Once we have the build directory set, initialise the logging. We can't do + this earlier, because the build log typically goes into [_build/log]. *) + Log.init () ~file:builder.log_file; + (* We need to print this before reading the workspace file, so that the editor + can interpret errors in the workspace file. *) + print_entering_message c; + Workspace.Clflags.set c.builder.workspace_config; + let config = + (* Here we make the assumption that this computation doesn't yield. *) + Fiber.run (Memo.run (Workspace.workspace_config ())) ~iter:(fun () -> assert false) + in + let config = + Dune_config.adapt_display + config + ~output_is_a_tty:(Lazy.force Ansi_color.output_is_a_tty) + in + Dune_config.init + config + ~watch: + (match c.builder.watch with + | No -> false + | Yes _ -> true); + Dune_engine.Execution_parameters.init + (let open Memo.O in + let+ w = Workspace.workspace () in + Dune_engine.Execution_parameters.builtin_default + |> Workspace.update_execution_parameters w); + Dune_rules.Global.init ~capture_outputs:c.builder.capture_outputs; + let cache_config = + match config.cache_enabled with + | Disabled -> Dune_cache.Config.Disabled + | Enabled_except_user_rules | Enabled -> + Enabled + { storage_mode = Option.value config.cache_storage_mode ~default:Hardlink + ; reproducibility_check = config.cache_reproducibility_check + } + in + Log.info + [ Pp.textf + "Shared cache: %s" + (Dune_config.Cache.Toggle.to_string config.cache_enabled) + ]; + Log.info + [ Pp.textf + "Shared cache location: %s" + (Path.to_string Dune_cache_storage.Layout.root_dir) + ]; + Dune_rules.Main.init + ~stats:c.stats + ~sandboxing_preference:config.sandboxing_preference + ~cache_config:(maybe_init_cache cache_config) + ~cache_debug_flags:c.builder.cache_debug_flags + (); + Only_packages.Clflags.set c.builder.only_packages; + Report_error.print_memo_stacks := c.builder.debug_dep_path; + Dune_engine.Clflags.report_errors_config := c.builder.report_errors_config; + Dune_engine.Clflags.debug_backtraces c.builder.debug_backtraces; + Dune_rules.Clflags.debug_artifact_substitution := c.builder.debug_artifact_substitution; + Dune_engine.Clflags.debug_load_dir := c.builder.debug_load_dir; + Dune_engine.Clflags.debug_fs_cache := c.builder.cache_debug_flags.fs_cache; + Dune_digest.Clflags.debug_digests := c.builder.debug_digests; + Dune_rules.Clflags.debug_package_logs := c.builder.debug_package_logs; + Dune_digest.Clflags.wait_for_filesystem_clock := c.builder.wait_for_filesystem_clock; + Dune_engine.Clflags.capture_outputs := c.builder.capture_outputs; + Promote.Clflags.diff_command := c.builder.diff_command; + Dune_engine.Clflags.promote := c.builder.promote; + Dune_engine.Clflags.force := c.builder.force; + Dune_engine.Clflags.stop_on_first_error := c.builder.stop_on_first_error; + Dune_rules.Clflags.store_orig_src_dir := c.builder.store_orig_src_dir; + Dune_rules.Clflags.promote_install_files := c.builder.promote_install_files; + Dune_engine.Clflags.always_show_command_line := c.builder.always_show_command_line; + Dune_rules.Clflags.ignore_promoted_rules := c.builder.ignore_promoted_rules; + Dune_rules.Clflags.ignore_lock_dir := c.builder.ignore_lock_dir; + Source.Clflags.on_missing_dune_project_file + := if c.builder.require_dune_project_file then Error else Warn; + (Dune_engine.Clflags.can_go_in_shared_cache_default + := match config.cache_enabled with + | Disabled | Enabled_except_user_rules -> false + | Enabled -> true); + Log.info + [ Pp.textf + "Workspace root: %s" + (Path.to_absolute_filename Path.root |> String.maybe_quoted) + ]; + Dune_console.separate_messages c.builder.separate_error_messages; + Option.iter c.stats ~f:(fun stats -> + if Dune_stats.extended_build_job_info stats + then + (* Communicate config settings as an instant event here. *) + let open Chrome_trace in + let args = [ "build_dir", `String (Path.Build.to_string Path.Build.root) ] in + let ts = Event.Timestamp.of_float_seconds (Unix.gettimeofday ()) in + let common = Event.common_fields ~cat:[ "config" ] ~name:"config" ~ts () in + let event = Event.instant ~args common in + Dune_stats.emit stats event); + (* Setup hook for printing GC stats to a file *) + at_exit (fun () -> + match c.builder.dump_gc_stats with + | None -> () + | Some file -> + Gc.full_major (); + Gc.compact (); + let stat = Gc.stat () in + let path = Path.external_ file in + Dune_util.Gc.serialize ~path stat); + c, config +;; + +let footer = + `Blocks [ `S "BUGS"; `P "Check bug reports at https://github.com/ocaml/dune/issues" ] +;; + +let examples = function + | [] -> `Blocks [] + | _ :: _ as examples -> + let block_of_example index (intro, ex) = + let prose = `I (Int.to_string (index + 1) ^ ".", String.trim intro ^ ":") + and code_lines = + ex + |> String.trim + |> String.split_lines + |> List.concat_map ~f:(fun codeline -> [ `Noblank; `Pre (" " ^ codeline) ]) + (* suppress initial blank *) + |> List.tl + in + `Blocks (prose :: code_lines) + in + let example_blocks = examples |> List.mapi ~f:block_of_example in + `Blocks (`S Cmdliner.Manpage.s_examples :: example_blocks) +;; + +(* Short reminders for the most used and useful commands *) +let command_synopsis commands = + let format_command c acc = `Noblank :: `P (Printf.sprintf "$(b,dune %s)" c) :: acc in + [ `S "SYNOPSIS"; `Blocks (List.fold_right ~init:[] ~f:format_command commands) ] +;; + +let help_secs = + [ `S copts_sect + ; `P "These options are common to all commands." + ; `S "MORE HELP" + ; `P "Use `$(mname) $(i,COMMAND) --help' for help on a single command." + ; footer + ] +;; + +let envs = + Cmd.Env. + [ info + ~doc: + "If different than $(b,0), ANSI colors are supported and should be used when \ + the program isn't piped. If equal to $(b,0), don't output ANSI color escape \ + codes" + "CLICOLOR" + ; info + ~doc:"If different than $(b,0), ANSI colors should be enabled no matter what." + "CLICOLOR_FORCE" + ; info + "DUNE_CACHE_ROOT" + ~doc:"If set, determines the location of the machine-global shared cache." + ] +;; + +let config_from_config_file = Options_implied_by_dash_p.config_term + +let context_arg ~doc = + Arg.( + value + & opt Arg.context_name Dune_engine.Context_name.default + & info [ "context" ] ~docv:"CONTEXT" ~doc) +;; diff --git a/unikernel/duniverse/dune_/bin/common.mli b/unikernel/duniverse/dune_/bin/common.mli new file mode 100644 index 00000000..1ed5e618 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/common.mli @@ -0,0 +1,84 @@ +open Dune_config_file +open Stdune + +type t + +val x : t -> Dune_engine.Context_name.t option +val capture_outputs : t -> bool +val root : t -> Workspace_root.t + +val rpc + : t + -> [ `Allow of Dune_lang.Dep_conf.t Dune_rpc_impl.Server.t + (** Will run rpc if in watch mode and acquire the build lock *) + | `Forbid_builds (** Promise not to build anything. For now, this isn't checked *) + ] + +val watch_exclusions : t -> string list +val stats : t -> Dune_stats.t option +val print_metrics : t -> bool +val dump_memo_graph_file : t -> Path.External.t option +val dump_memo_graph_format : t -> Dune_graph.Graph.File_format.t +val dump_memo_graph_with_timing : t -> bool +val watch : t -> Dune_rpc_impl.Watch_mode_config.t +val file_watcher : t -> Dune_engine.Scheduler.Run.file_watcher +val prefix_target : t -> string -> string + +(** [Builder] describes how to initialize Dune. *) +module Builder : sig + type t + + val equal : t -> t -> bool + val root : t -> string option + val set_root : t -> string -> t + val forbid_builds : t -> t + val default_root_is_cwd : t -> bool + val set_default_root_is_cwd : t -> bool -> t + val set_log_file : t -> Dune_util.Log.File.t -> t + val disable_log_file : t -> t + val set_promote : t -> Dune_engine.Clflags.Promote.t -> t + val default_target : t -> Arg.Dep.t + val term : t Cmdliner.Term.t + val default : t +end + +(** [init] creates a [Common.t] by executing a sequence of side-effecting actions to + initialize Dune's working environment based on the options determined in the\ + [Builder.t]. + + Return the [Common.t] and the final configuration, which is the same as the one + returned in the [config] field of [Dune_rules.Workspace.workspace ()]) *) +val init : Builder.t -> t * Dune_config_file.Dune_config.t + +(** [examples [("description", "dune cmd foo"); ...]] is an [EXAMPLES] manpage + section of enumerated examples illustrating how to run the documented + commands. *) +val examples : (string * string) list -> Cmdliner.Manpage.block + +(** [command_synopsis subcommands] is a custom [SYNOPSIS] manpage section + listing the given [subcommands]. Each subcommand is prefixed with the `dune` + top-level command. *) +val command_synopsis : string list -> Cmdliner.Manpage.block list + +val help_secs : Cmdliner.Manpage.block list +val footer : Cmdliner.Manpage.block +val envs : Cmdliner.Cmd.Env.info list +val debug_backtraces : bool Cmdliner.Term.t +val config_from_config_file : Dune_config.Partial.t Cmdliner.Term.t +val display_term : Dune_config.Display.t option Cmdliner.Term.t +val context_arg : doc:string -> Dune_engine.Context_name.t Cmdliner.Term.t + +(** A [--build-info] command line argument that print build information + (included in [term]) *) +val build_info : unit Cmdliner.Term.t + +val default_build_dir : string + +module Let_syntax : sig + val ( let+ ) : 'a Cmdliner.Term.t -> ('a -> 'b) -> 'b Cmdliner.Term.t + val ( and+ ) : 'a Cmdliner.Term.t -> 'b Cmdliner.Term.t -> ('a * 'b) Cmdliner.Term.t +end + +(** [one_of term1 term2] allows options from [term1] or exclusively options from + [term2]. If the user passes options from both terms, an error is reported. *) +val one_of : 'a Cmdliner.Term.t -> 'a Cmdliner.Term.t -> 'a Cmdliner.Term.t diff --git a/unikernel/duniverse/dune_/bin/coq/coq.ml b/unikernel/duniverse/dune_/bin/coq/coq.ml new file mode 100644 index 00000000..644f22d7 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/coq/coq.ml @@ -0,0 +1,7 @@ +open Import + +let doc = "Command group related to Coq." +let sub_commands_synopsis = Common.command_synopsis [ "coq top FILE -- ARGS" ] +let man = [ `Blocks sub_commands_synopsis ] +let info = Cmd.info ~doc ~man "coq" +let group = Cmd.group info [ Coqtop.command ] diff --git a/unikernel/duniverse/dune_/bin/coq/coq.mli b/unikernel/duniverse/dune_/bin/coq/coq.mli new file mode 100644 index 00000000..d4c5902f --- /dev/null +++ b/unikernel/duniverse/dune_/bin/coq/coq.mli @@ -0,0 +1,3 @@ +open Import + +val group : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/coq/coqtop.ml b/unikernel/duniverse/dune_/bin/coq/coqtop.ml new file mode 100644 index 00000000..2e2fa8b5 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/coq/coqtop.ml @@ -0,0 +1,159 @@ +open Import + +let doc = "Execute a Coq toplevel with the local configuration." + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune coq top FILE -- ARGS) runs the Coq toplevel to process the + given $(b,FILE). The given arguments are completed according to the + local configuration. This is equivalent to running $(b,coqtop ARGS) + with a $(b,_CoqProject) file containing the local configurations + from the $(b,dune) files, but does not require maintaining a + $(b,_CoqProject) file.|} + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "top" ~doc ~man + +let term = + let+ default_builder = Common.Builder.term + and+ context = + let doc = "Run the Coq toplevel in this build context." in + Common.context_arg ~doc + and+ coqtop = + let doc = "Run the given toplevel command instead of the default." in + Arg.(value & opt string "coqtop" & info [ "toplevel" ] ~docv:"CMD" ~doc) + and+ coq_file_arg = + Arg.(required & pos 0 (some string) None (Arg.info [] ~docv:"COQFILE")) + and+ extra_args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) + and+ no_rebuild = + Arg.( + value + & flag + & info [ "no-build" ] ~doc:"Don't rebuild dependencies before executing.") + in + let common, config = + let builder = + if no_rebuild then Common.Builder.forbid_builds default_builder else default_builder + in + Common.init builder + in + let coq_file_arg = Common.prefix_target common coq_file_arg |> Path.Local.of_string in + let coqtop, args, env = + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + let* setup = Memo.run setup in + let sctx = Import.Main.find_scontext_exn setup ~name:context in + let context = Dune_rules.Super_context.context sctx in + let coq_file_build = + Path.Build.append_local (Context.build_dir context) coq_file_arg + in + let dir = + (match Path.Local.parent coq_file_arg with + | None -> Path.Local.root + | Some dir -> dir) + |> Path.Build.append_local (Context.build_dir context) + in + let* coqtop, args, env = + build_exn + @@ fun () -> + let open Memo.O in + let* (tr : Dune_rules.Dir_contents.triage) = + Dune_rules.Dir_contents.triage sctx ~dir + in + let dir = + match tr with + | Group_part dir -> dir + | Standalone_or_root _ -> dir + in + let* dc = Dune_rules.Dir_contents.get sctx ~dir in + let* coq_src = Dune_rules.Dir_contents.coq dc in + let coq_module = + let source = coq_file_build in + match Dune_rules.Coq.Coq_sources.find_module ~source coq_src with + | Some m -> snd m + | None -> + let hints = + [ Pp.textf "Is the file part of a stanza?" + ; Pp.textf "Has the file been written to disk?" + ] + in + User_error.raise + ~hints + [ Pp.textf "Cannot find file: %s" (coq_file_arg |> Path.Local.to_string) ] + in + let stanza = Dune_rules.Coq.Coq_sources.lookup_module coq_src coq_module in + let args, use_stdlib, coq_lang_version, wrapper_name, mode = + match stanza with + | None -> + User_error.raise + [ Pp.textf + "File not part of any stanza: %s" + (coq_file_arg |> Path.Local.to_string) + ] + | Some (`Theory theory) -> + ( Dune_rules.Coq.Coq_rules.coqtop_args_theory + ~sctx + ~dir + ~dir_contents:dc + theory + coq_module + , theory.buildable.use_stdlib + , theory.buildable.coq_lang_version + , Dune_rules.Coq.Coq_lib_name.wrapper (snd theory.name) + , theory.buildable.mode ) + | Some (`Extraction extr) -> + ( Dune_rules.Coq.Coq_rules.coqtop_args_extraction ~sctx ~dir extr coq_module + , extr.buildable.use_stdlib + , extr.buildable.coq_lang_version + , "DuneExtraction" + , extr.buildable.mode ) + in + (* Run coqdep *) + let* (_ : unit * Dep.Fact.t Dep.Map.t) = + let deps_of = + if no_rebuild + then Action_builder.return () + else ( + let mode = + match mode with + | None -> Dune_rules.Coq.Coq_mode.VoOnly + | Some mode -> mode + in + Dune_rules.Coq.Coq_rules.deps_of + ~dir + ~use_stdlib + ~wrapper_name + ~mode + ~coq_lang_version + coq_module) + in + Action_builder.evaluate_and_collect_facts deps_of + in + (* Get args *) + let* (args, _) : string list * Dep.Fact.t Dep.Map.t = + let* args = args in + let dir = Path.external_ Path.External.initial_cwd in + let args = Dune_rules.Command.expand ~dir (S args) in + Action_builder.evaluate_and_collect_facts args.build + in + let* prog = Super_context.resolve_program_memo sctx ~dir ~loc:None coqtop in + let prog = Action.Prog.ok_exn prog in + let* () = Build_system.build_file prog in + let+ env = Super_context.context_env sctx in + Path.to_string prog, args, env + in + let args = + let topfile = Path.to_absolute_filename (Path.build coq_file_build) in + ("-topfile" :: topfile :: args) @ extra_args + in + Fiber.return (coqtop, args, env) + in + restore_cwd_and_execve (Common.root common) coqtop args env +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/coq/coqtop.mli b/unikernel/duniverse/dune_/bin/coq/coqtop.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/coq/coqtop.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/aliases_targets.ml b/unikernel/duniverse/dune_/bin/describe/aliases_targets.ml new file mode 100644 index 00000000..3385eb2b --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/aliases_targets.ml @@ -0,0 +1,141 @@ +open Import + +let ls_term (fetch_results : Path.Build.t -> string list Action_builder.t) = + let+ builder = Common.Builder.term + and+ paths = Arg.(value & pos_all string [ "." ] & info [] ~docv:"DIR") + and+ context = + Common.context_arg ~doc:"The context to look in. Defaults to the default context." + in + let common, config = Common.init builder in + let request (_ : Dune_rules.Main.build_system) = + let header = List.length paths > 1 in + let open Action_builder.O in + let+ paragraphs = + Action_builder.List.map paths ~f:(fun path -> + (* The user supplied directory *) + let dir = Path.of_string path in + (* The _build and source tree version of this directory *) + let build_dir, src_dir = + match (dir : Path.t) with + | In_source_tree d -> + Path.Build.append_source (Dune_engine.Context_name.build_dir context) d, d + | In_build_dir d -> + let src_dir = + (* We only drop the build context if it is correct. *) + match Path.Build.extract_build_context d with + | Some (dir_context_name, d) -> + if + Dune_engine.Context_name.equal + context + (Dune_engine.Context_name.of_string dir_context_name) + then d + else + User_error.raise + [ Pp.textf + "Directory %s is not in context %S." + (Path.to_string_maybe_quoted dir) + (Dune_engine.Context_name.to_string context) + ] + | None -> Code_error.raise "aliases_targets: build dir without context" [] + in + d, src_dir + | External _ -> + User_error.raise + [ Pp.textf + "Directories outside of the project are not supported: %s" + (Path.to_string_maybe_quoted dir) + ] + in + (* Check if the directory exists. *) + let* () = + Action_builder.of_memo + @@ + let open Memo.O in + Source_tree.find_dir src_dir + >>= function + | Some _ -> Memo.return () + | None -> + (* The directory didn't exist. We therefore check if it was a + directory target and error for the user accordingly. *) + let+ is_dir_target = + Load_rules.is_under_directory_target (Path.build build_dir) + in + if is_dir_target + then + User_error.raise + [ Pp.textf + "Directory %s is a directory target. This command does not support \ + the inspection of directory targets." + (Path.to_string dir) + ] + else + User_error.raise + [ Pp.textf "Directory %s does not exist." (Path.to_string dir) ] + in + let+ targets = fetch_results build_dir in + (* If we are printing multiple directories, we print the directory + name as a header. *) + (if header then [ Pp.textf "%s:" (Path.to_string dir) ] else []) + @ [ Pp.concat_map targets ~f:Pp.text ~sep:Pp.space ] + |> Pp.concat ~sep:Pp.space) + in + Console.print + [ Pp.vbox @@ Pp.concat_map ~f:Pp.vbox paragraphs ~sep:(Pp.seq Pp.space Pp.space) ] + in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + Build.run_build_system ~common ~request + >>| fun (_ : (unit, [ `Already_reported ]) result) -> () +;; + +module Aliases_cmd = struct + let fetch_results (dir : Path.Build.t) = + let open Action_builder.O in + let+ alias_targets = + let+ load_dir = + Action_builder.of_memo (Load_rules.load_dir ~dir:(Path.build dir)) + in + match load_dir with + | Load_rules.Loaded.Build build -> Dune_engine.Alias.Name.Map.keys build.aliases + | _ -> [] + in + List.map ~f:Dune_engine.Alias.Name.to_string alias_targets + ;; + + let term = ls_term fetch_results + + let command = + let doc = "Print aliases in a given directory. Works similarly to ls." in + Cmd.v (Cmd.info "aliases" ~doc ~envs:Common.envs) term + ;; +end + +module Targets_cmd = struct + let fetch_results (dir : Path.Build.t) = + let open Action_builder.O in + let+ targets = + let open Memo.O in + Target.all_direct_targets (Some (Path.Build.drop_build_context_exn dir)) + >>| Path.Build.Map.to_list + |> Action_builder.of_memo + in + List.filter_map targets ~f:(fun (path, kind) -> + match Path.Build.equal (Path.Build.parent_exn path) dir with + | false -> None + | true -> + (* directory targets can be distinguied by the trailing path separator + *) + Some + (match kind with + | Target.File -> Path.Build.basename path + | Directory -> Path.Build.basename path ^ Filename.dir_sep)) + ;; + + let term = ls_term fetch_results + + let command = + let doc = "Print targets in a given directory. Works similarly to ls." in + Cmd.v (Cmd.info "targets" ~doc ~envs:Common.envs) term + ;; +end diff --git a/unikernel/duniverse/dune_/bin/describe/aliases_targets.mli b/unikernel/duniverse/dune_/bin/describe/aliases_targets.mli new file mode 100644 index 00000000..e052b4fd --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/aliases_targets.mli @@ -0,0 +1,15 @@ +open Import + +(** ls like commands for showing aliases and targets *) + +module Aliases_cmd : sig + (** The aliases command lists all the aliases available in the given + directory, defaulting to the current working directory. *) + val command : unit Cmd.t +end + +module Targets_cmd : sig + (** The targets command lists all the targets available in the given + directory, defaulting to the current working directory. *) + val command : unit Cmd.t +end diff --git a/unikernel/duniverse/dune_/bin/describe/describe.ml b/unikernel/duniverse/dune_/bin/describe/describe.ml new file mode 100644 index 00000000..6bfa4914 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe.ml @@ -0,0 +1,56 @@ +open Import + +(* This command is not yet versioned, but some people are using it in + non-released tools. If you change the format of the output, please contact: + + - rotor people for "describe workspace" + + - duniverse people for "describe opam-files" *) + +let subcommands = + [ Describe_workspace.command + ; Describe_external_lib_deps.command + ; Describe_opam_files.command + ; Describe_pp.command + ; Printenv.command + ; Print_rules.command + ; Installed_libraries.command + ; Aliases_targets.Targets_cmd.command + ; Aliases_targets.Aliases_cmd.command + ; Package_entries.command + ; Describe_pkg.command + ; Describe_contexts.command + ; Describe_depexts.command + ; Describe_location.command + ] +;; + +let group = + let doc = "Describe the workspace." in + let man = + [ `S "DESCRIPTION" + ; `P + {|Describe what is in the current workspace in either human or + machine readable form. + + By default, this command output a human readable description of + the current workspace. This output is aimed at human and is not + suitable for machine processing. In particular, it is not versioned. + + If you want to interpret the output of this command from a program, + you must use the $(b,--format) option to specify a machine readable + format as well as the $(b,--lang) option to get a stable output.|} + ; `Blocks Common.help_secs + ] + in + let info = Cmd.info "describe" ~doc ~man in + let default = Describe_workspace.term in + Cmd.group ~default info subcommands +;; + +module Show = struct + let group = + let doc = "Command group for showing information about the workspace" in + Cmd.group (Cmd.info ~doc "show") subcommands + ;; +end diff --git a/unikernel/duniverse/dune_/bin/describe/describe.mli b/unikernel/duniverse/dune_/bin/describe/describe.mli new file mode 100644 index 00000000..3627ce93 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe.mli @@ -0,0 +1,9 @@ +open Import + +(** Command group for dune describe *) +val group : unit Cmd.t + +module Show : sig + (** Command group for dune show (alias of describe) *) + val group : unit Cmd.t +end diff --git a/unikernel/duniverse/dune_/bin/describe/describe_contexts.ml b/unikernel/duniverse/dune_/bin/describe/describe_contexts.ml new file mode 100644 index 00000000..89076fe1 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_contexts.ml @@ -0,0 +1,23 @@ +open Import + +let term = + let+ builder = Common.Builder.term in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + let+ setup = Memo.run setup in + let ctxts = + List.map + ~f:(fun (name, _) -> Context_name.to_string name) + (Context_name.Map.to_list setup.scontexts) + in + List.iter ctxts ~f:print_endline +;; + +let command = + let doc = "List the build contexts available in the workspace." in + let info = Cmd.info ~doc "contexts" in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_contexts.mli b/unikernel/duniverse/dune_/bin/describe/describe_contexts.mli new file mode 100644 index 00000000..5422c3c1 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_contexts.mli @@ -0,0 +1,4 @@ +open Import + +(** Dune command to print out the available build contexts.*) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_depexts.ml b/unikernel/duniverse/dune_/bin/describe/describe_depexts.ml new file mode 100644 index 00000000..b63a8acd --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_depexts.ml @@ -0,0 +1,24 @@ +open Import + +let print_depexts context_name = + let open Fiber.O in + let+ depexts = + build_exn (fun () -> Dune_rules.Pkg_rules.all_filtered_depexts context_name) + in + Console.print [ Pp.concat_map ~sep:Pp.newline ~f:Pp.verbatim depexts ] +;; + +let term = + let+ builder = Common.Builder.term + and+ context_name = Common.context_arg ~doc:"Build context to use." in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> print_depexts context_name) +;; + +let info = + let doc = "Print the list of all the available depexts" in + Cmd.info "depexts" ~doc +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/describe/describe_depexts.mli b/unikernel/duniverse/dune_/bin/describe/describe_depexts.mli new file mode 100644 index 00000000..18084dc8 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_depexts.mli @@ -0,0 +1,4 @@ +open Import + +(** Command to print all depexts *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.ml b/unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.ml new file mode 100644 index 00000000..69ae01fb --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.ml @@ -0,0 +1,234 @@ +open Import +module Lib_dep = Dune_lang.Lib_dep + +module Kind = struct + type t = + | Required + | Optional + + let to_dyn : t -> Dyn.t = function + | Required -> String "required" + | Optional -> String "optional" + ;; +end + +type lib_dep = + { name : Lib_name.t + ; kind : Kind.t + } + +let lib_dep_to_dyn t = + let open Dyn in + List [ String (Lib_name.to_string t.name); Kind.to_dyn t.kind ] +;; + +module Item = struct + module Kind = struct + type t = + | Executables + | Library + | Tests + + let to_string = function + | Executables -> "executables" + | Library -> "library" + | Tests -> "tests" + ;; + end + + type t = + { kind : Kind.t + ; dir : Path.Source.t + ; external_deps : lib_dep list + ; internal_deps : lib_dep list + ; names : string list + ; package : Package.t option + ; extensions : string list + } + + let to_dyn { kind; dir; external_deps; internal_deps; names; package; extensions } = + let open Dyn in + let record = + record + [ "names", (list string) names + ; "extensions", (list string) extensions + ; "package", option Package.Name.to_dyn (Option.map ~f:Package.name package) + ; "source_dir", String (Path.Source.to_string dir) + ; "external_deps", list lib_dep_to_dyn external_deps + ; "internal_deps", list lib_dep_to_dyn internal_deps + ] + in + Variant (Kind.to_string kind, [ record ]) + ;; +end + +type dep = + | Local of lib_dep + | External of lib_dep + +let is_external db name = + let open Memo.O in + let+ lib = Dune_rules.Lib.DB.find_even_when_hidden db name in + match lib with + | None -> true + | Some t -> + (match Dune_rules.Lib_info.status (Dune_rules.Lib.info t) with + | Installed_private | Public _ | Private _ -> false + | Installed -> true) +;; + +let resolve_lib db name kind = + let open Memo.O in + let+ is_external = is_external db name in + if is_external then External { name; kind } else Local { name; kind } +;; + +let resolve_lib_pps db preprocess = + let open Memo.O in + Dune_rules.Instrumentation.with_instrumentation + preprocess + ~instrumentation_backend:(Dune_rules.Lib.DB.instrumentation_backend db) + |> Resolve.Memo.read_memo + >>| Dune_lang.Preprocess.Per_module.pps + >>= Memo.parallel_map ~f:(fun (_, name) -> resolve_lib db name Kind.Required) +;; + +let resolve_lib_deps db lib_deps = + let open Memo.O in + Memo.parallel_map lib_deps ~f:(fun (lib : Lib_dep.t) -> + match lib with + | Direct (_, name) | Re_export (_, name) -> + let+ v = resolve_lib db name Kind.Required in + [ v ] + | Select select -> + select.choices + |> Memo.parallel_map ~f:(fun (choice : Lib_dep.Select.Choice.t) -> + Lib_name.Set.to_string_list choice.required + @ Lib_name.Set.to_string_list choice.forbidden + |> Memo.parallel_map ~f:(fun name -> + let name = Lib_name.of_string name in + resolve_lib db name Kind.Optional)) + >>| List.concat) + >>| List.concat +;; + +let resolve_libs db dir libraries preprocess names package kind extensions = + let open Memo.O in + let open Item in + let* lib_deps = resolve_lib_deps db libraries in + let+ lib_pps = resolve_lib_pps db preprocess in + let deps = lib_deps @ lib_pps in + let internal_deps, external_deps = + deps + |> List.partition_map ~f:(function + | Local lib -> Either.Left lib + | External lib -> Either.Right lib) + in + { external_deps; internal_deps; kind; names; package; dir; extensions } +;; + +let exes_extensions (lib_config : Dune_rules.Lib_config.t) modes = + Dune_rules.Executables.Link_mode.Map.to_list modes + |> List.map ~f:(fun (m, loc) -> + Dune_rules.Executables.Link_mode.extension + m + ~loc + ~ext_obj:lib_config.ext_obj + ~ext_dll:lib_config.ext_dll) +;; + +let libs db (context : Context.t) = + let open Memo.O in + let* dune_files = Context.name context |> Dune_rules.Dune_load.dune_files in + Memo.parallel_map dune_files ~f:(fun (dune_file : Dune_rules.Dune_file.t) -> + Dune_file.stanzas dune_file + >>= Memo.parallel_map ~f:(fun stanza -> + let dir = Dune_file.dir dune_file in + match Stanza.repr stanza with + | Dune_rules.Executables.T exes -> + let* ocaml = Context.ocaml context in + resolve_libs + db + dir + exes.buildable.libraries + exes.buildable.preprocess + (List.map (Nonempty_list.to_list exes.names) ~f:snd) + exes.package + Item.Kind.Executables + (exes_extensions ocaml.lib_config exes.modes) + >>| List.singleton + | Dune_rules.Library.T lib -> + resolve_libs + db + dir + lib.buildable.libraries + lib.buildable.preprocess + [ Dune_rules.Library.best_name lib |> Lib_name.to_string ] + (Dune_rules.Library.package lib) + Item.Kind.Library + [] + >>| List.singleton + | Dune_rules.Tests.T tests -> + let* ocaml = Context.ocaml context in + resolve_libs + db + dir + tests.exes.buildable.libraries + tests.exes.buildable.preprocess + (List.map (Nonempty_list.to_list tests.exes.names) ~f:snd) + (if Option.is_none tests.package then tests.exes.package else tests.package) + Item.Kind.Tests + (exes_extensions ocaml.lib_config tests.exes.modes) + >>| List.singleton + | _ -> Memo.return []) + >>| List.concat) + >>| List.concat +;; + +let external_resolved_libs (context : Context.t) = + let open Memo.O in + let* scope = Dune_rules.Scope.DB.find_by_dir (Context.build_dir context) in + let db = Dune_rules.Scope.libs scope in + libs db context + >>| List.filter ~f:(fun (x : Item.t) -> + not (List.is_empty x.external_deps && List.is_empty x.internal_deps)) +;; + +let to_dyn context_name external_resolved_libs = + let open Dyn in + Tuple [ String context_name; list Item.to_dyn external_resolved_libs ] +;; + +let term = + let+ builder = Common.Builder.term + and+ context_name = Common.context_arg ~doc:"Build context to use." + and+ _ = Describe_lang_compat.arg + and+ format = Describe_format.arg in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + let* setup = Memo.run setup in + let super_context = Import.Main.find_scontext_exn setup ~name:context_name in + build_exn + @@ fun () -> + let open Memo.O in + let context_name = + Super_context.context super_context + |> Context.name + |> Dune_engine.Context_name.to_string + in + external_resolved_libs (Super_context.context super_context) + >>| to_dyn context_name + >>| Describe_format.print_dyn format +;; + +let command = + let doc = + "Print out external libraries needed to build the project. It's an approximated set \ + of libraries." + in + let info = Cmd.info ~doc "external-lib-deps" in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.mli b/unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.mli new file mode 100644 index 00000000..1a632e1c --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.mli @@ -0,0 +1,4 @@ +open Import + +(** Dune command to describe the external library dependencies *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_format.ml b/unikernel/duniverse/dune_/bin/describe/describe_format.ml new file mode 100644 index 00000000..da786017 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_format.ml @@ -0,0 +1,34 @@ +open Import + +type t = + | Sexp + | Csexp + +let all = [ "sexp", Sexp; "csexp", Csexp ] + +let arg = + let doc = Printf.sprintf "$(docv) must be %s" (Arg.doc_alts_enum all) in + Arg.(value & opt (enum all) Sexp & info [ "format" ] ~docv:"FORMAT" ~doc) +;; + +let print_as_sexp dyn = + let rec dune_lang_of_sexp : Sexp.t -> Dune_lang.t = function + | Atom s -> Dune_lang.atom_or_quoted_string s + | List l -> List (List.map l ~f:dune_lang_of_sexp) + in + let cst = + dyn + |> Sexp.of_dyn + |> dune_lang_of_sexp + |> Dune_lang.Ast.add_loc ~loc:Loc.none + |> Dune_lang.Cst.concrete + in + let version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in + Pp.to_fmt Stdlib.Format.std_formatter (Dune_lang.Format.pp_top_sexps ~version [ cst ]) +;; + +let print_dyn t dyn = + match t with + | Csexp -> Csexp.to_channel stdout (Sexp.of_dyn dyn) + | Sexp -> print_as_sexp dyn +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_format.mli b/unikernel/duniverse/dune_/bin/describe/describe_format.mli new file mode 100644 index 00000000..838d64f0 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_format.mli @@ -0,0 +1,13 @@ +open Import + +(** Formatting utilities for dune describe commands *) + +type t = + | Sexp + | Csexp + +(** Command line option for taking a serialisation format *) +val arg : t Term.t + +(** [print_dyn t dyn] prints the dyn to stdout serialised as configured in [t] *) +val print_dyn : t -> Dyn.t -> unit diff --git a/unikernel/duniverse/dune_/bin/describe/describe_lang_compat.ml b/unikernel/duniverse/dune_/bin/describe/describe_lang_compat.ml new file mode 100644 index 00000000..57704794 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_lang_compat.ml @@ -0,0 +1,11 @@ +let arg = + Arg.( + value + & opt (some string) None + & info + [ "lang" ] + ~docv:"VERSION" + ~doc: + "This argument has no effect and is deprecated. It exists solely for backwards \ + compatibility.") +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_lang_compat.mli b/unikernel/duniverse/dune_/bin/describe/describe_lang_compat.mli new file mode 100644 index 00000000..8f0fff8a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_lang_compat.mli @@ -0,0 +1,5 @@ +(** Dune describe commands used to take a --lang argument that did nothing + expect for dune describe workspace. To keep compatilbility with accepting + such an argument we provide a dummy argument here that can be used. It's + value will typically be ignored. *) +val arg : string option Cmdliner.Term.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_location.ml b/unikernel/duniverse/dune_/bin/describe/describe_location.ml new file mode 100644 index 00000000..3bc69c39 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_location.ml @@ -0,0 +1,43 @@ +open! Import + +let doc = + "Print the path to the executable using the same resolution logic as [dune exec]." +;; + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune describe location NAME) prints the path to the executable NAME using the same logic as: + |} + ; `Pre "$ dune exec NAME" + ; `P + "Dune will first try to resolve the executable within the public executables in \ + the current project, then inside the \"bin\" directory of each package among the \ + project's dependencies (when using dune package management), and finally within \ + the directories listed in the $PATH environment variable." + ] +;; + +let info = Cmd.info "location" ~doc ~man + +let term : unit Term.t = + let+ builder = Common.Builder.term + and+ context = Common.context_arg ~doc:{|Run the command in this build context.|} + and+ prog = + Arg.(required & pos 0 (some Exec.Cmd_arg.conv) None (Arg.info [] ~docv:"PROG")) + in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn + @@ fun () -> + let open Memo.O in + let* sctx = setup >>| Import.Main.find_scontext_exn ~name:context in + let* prog = Exec.Cmd_arg.expand ~root:(Common.root common) ~sctx prog in + let+ path = Exec.get_path common sctx ~prog >>| Path.to_string in + Dune_console.printf "%s" path +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/describe/describe_location.mli b/unikernel/duniverse/dune_/bin/describe/describe_location.mli new file mode 100644 index 00000000..5505206a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_location.mli @@ -0,0 +1,3 @@ +open! Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_opam_files.ml b/unikernel/duniverse/dune_/bin/describe/describe_opam_files.ml new file mode 100644 index 00000000..0bd4870d --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_opam_files.ml @@ -0,0 +1,38 @@ +open Import + +let term = + let+ builder = Common.Builder.term + and+ format = Describe_format.arg + and+ _ = Describe_lang_compat.arg in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + build_exn + @@ fun () -> + let open Memo.O in + let+ project = Source_tree.root () >>| Source_tree.Dir.project in + let packages = Dune_project.packages project |> Package.Name.Map.values in + let opam_file_to_dyn pkg = + let opam_file = Path.source (Package.opam_file pkg) in + let contents = + if Dune_project.generate_opam_files project + then ( + let template_file = Dune_rules.Opam_create.template_file opam_file in + let template = + if Path.exists template_file + then Some (template_file, Io.read_file template_file) + else None + in + Dune_rules.Opam_create.generate project pkg ~template) + else Io.read_file opam_file + in + Dyn.Tuple [ String (Path.to_string opam_file); String contents ] + in + packages |> Dyn.list opam_file_to_dyn |> Describe_format.print_dyn format +;; + +let command = + let doc = "Print information about the opam files that have been discovered." in + let info = Cmd.info ~doc "opam-files" in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_opam_files.mli b/unikernel/duniverse/dune_/bin/describe/describe_opam_files.mli new file mode 100644 index 00000000..72dc170b --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_opam_files.mli @@ -0,0 +1,4 @@ +open Import + +(** Dune command to describe the opam files in a workspace *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_pkg.ml b/unikernel/duniverse/dune_/bin/describe/describe_pkg.ml new file mode 100644 index 00000000..14922ce6 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_pkg.ml @@ -0,0 +1,200 @@ +open Import +module Lock_dir = Dune_pkg.Lock_dir +module Local_package = Dune_pkg.Local_package + +module Show_lock = struct + let print_lock lock_dir_arg () = + let open Fiber.O in + let* lock_dir_paths = + Memo.run (Workspace.workspace ()) + >>| Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dir_arg + in + Fiber.parallel_map lock_dir_paths ~f:(fun lock_dir_path -> + let+ platform = Pkg_common.solver_env_from_system_and_context ~lock_dir_path in + let lock_dir = Lock_dir.read_disk_exn lock_dir_path in + let packages = + Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform + |> Package_name.Map.values + in + Pp.concat + ~sep:Pp.space + [ Pp.hovbox + @@ Pp.textf "Contents of %s:" (Path.Source.to_string_maybe_quoted lock_dir_path) + ; Pkg_common.pp_packages packages + ] + |> Pp.vbox) + >>| Console.print + ;; + + let term = + let+ builder = Common.Builder.term + and+ lock_dir_arg = Pkg_common.Lock_dirs_arg.term in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config @@ print_lock lock_dir_arg + ;; + + let command = + let doc = "Display packages in a lock file" in + let info = Cmd.info ~doc "lock" in + Cmd.v info term + ;; +end + +module Dependency_hash = struct + let print_local_packages_hash () = + let open Fiber.O in + let+ local_packages = + Pkg_common.find_local_packages + |> Memo.run + >>| Package_name.Map.values + >>| List.map ~f:Local_package.for_solver + in + let hash = + Local_package.For_solver.non_local_dependencies local_packages + |> Local_package.Dependency_hash.of_dependency_formula + in + match hash with + | None -> User_error.raise [ Pp.text "No non-local dependencies" ] + | Some dependency_hash -> + print_endline (Local_package.Dependency_hash.to_string dependency_hash) + ;; + + let term = + let+ builder = Common.Builder.term in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config print_local_packages_hash + ;; + + let info = + let doc = + "Print the hash of the project's non-local dependencies such as what would appear \ + in the \"dependency_hash\" field of a a lock.dune file." + in + Cmd.info "dependency-hash" ~doc + ;; + + let command = Cmd.v info term +end + +module List_locked_dependencies = struct + module Package_universe = Dune_pkg.Package_universe + module Lock_dir = Dune_pkg.Lock_dir + module Opam_repo = Dune_pkg.Opam_repo + module Package_version = Dune_pkg.Package_version + module Opam_solver = Dune_pkg.Opam_solver + + let info = + let doc = "List the dependencies locked by a lockdir" in + let man = [ `S "DESCRIPTION"; `P "List the dependencies locked by a lockdir" ] in + Cmd.info "list-locked-dependencies" ~doc ~man + ;; + + let package_deps_in_lock_dir_pp package_universe package_name ~transitive = + let traverse, traverse_word = + if transitive then `Transitive, "Transitive" else `Immediate, "Immediate" + in + let opam_package = + Package_universe.opam_package_of_package package_universe package_name + in + let list_dependencies which = + Package_universe.opam_package_dependencies_of_package + package_universe + package_name + ~which + ~traverse + in + Pp.concat + ~sep:Pp.cut + [ Pp.hbox + (Pp.textf + "%s dependencies of local package %s" + traverse_word + (OpamPackage.to_string opam_package)) + ; Pp.enumerate (list_dependencies `Non_test) ~f:(fun opam_package -> + Pp.text (OpamPackage.to_string opam_package)) + ; Pp.enumerate (list_dependencies `Test_only) ~f:(fun opam_package -> + Pp.textf "%s (test only)" (OpamPackage.to_string opam_package)) + ] + |> Pp.vbox + ;; + + let enumerate_lock_dirs_by_path workspace ~lock_dirs = + let lock_dirs = Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs workspace in + List.filter_map lock_dirs ~f:(fun lock_dir_path -> + if Path.exists (Path.source lock_dir_path) + then ( + try Some (lock_dir_path, Lock_dir.read_disk_exn lock_dir_path) with + | User_error.E e -> + User_warning.emit + [ Pp.textf + "Failed to parse lockdir %s:" + (Path.Source.to_string_maybe_quoted lock_dir_path) + ; User_message.pp e + ]; + None) + else None) + ;; + + let list_locked_dependencies ~transitive ~lock_dirs () = + let open Fiber.O in + let* lock_dirs_by_path, local_packages = + let open Memo.O in + Memo.both + (Workspace.workspace () >>| enumerate_lock_dirs_by_path ~lock_dirs) + Pkg_common.find_local_packages + |> Memo.run + in + let+ pp = + Fiber.parallel_map lock_dirs_by_path ~f:(fun (lock_dir_path, lock_dir) -> + let+ platform = Pkg_common.solver_env_from_system_and_context ~lock_dir_path in + let package_universe = + Package_universe.create ~platform local_packages lock_dir |> User_error.ok_exn + in + Pp.vbox + (Pp.concat + ~sep:Pp.cut + [ Pp.hbox + (Pp.textf + "Dependencies of local packages locked in %s" + (Path.Source.to_string_maybe_quoted lock_dir_path)) + ; Pp.enumerate + (Package_name.Map.keys local_packages) + ~f:(package_deps_in_lock_dir_pp package_universe ~transitive) + |> Pp.box + ])) + >>| Pp.concat ~sep:Pp.cut + >>| Pp.vbox + in + Console.print [ pp ] + ;; + + let term = + let+ builder = Common.Builder.term + and+ transitive = + Arg.( + value + & flag + & info + [ "transitive" ] + ~doc: + "Display transitive dependencies (by default only immediate dependencies \ + are displayed)") + and+ lock_dirs = Pkg_common.Lock_dirs_arg.term in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ list_locked_dependencies ~transitive ~lock_dirs + ;; + + let command = Cmd.v info term +end + +let command = + let doc = "Subcommands related to package management" in + let info = Cmd.info ~doc "pkg" in + Cmd.group + info + [ Show_lock.command; List_locked_dependencies.command; Dependency_hash.command ] +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_pkg.mli b/unikernel/duniverse/dune_/bin/describe/describe_pkg.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_pkg.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_pp.ml b/unikernel/duniverse/dune_/bin/describe/describe_pp.ml new file mode 100644 index 00000000..ea098a36 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_pp.ml @@ -0,0 +1,183 @@ +open Import +module Dialect = Dune_lang.Dialect + +let dialect_and_ml_kind file = + let open Memo.O in + let _base, ext = + let file = Path.of_string file in + Path.split_extension file + in + let+ project = Source_tree.root () >>| Source_tree.Dir.project in + let dialects = Dune_project.dialects project in + match Dialect.DB.find_by_extension dialects ext with + | None -> User_error.raise [ Pp.textf "unsupported extension: %s" ext ] + | Some x -> x +;; + +let execute_pp_action ~sctx file pp_file dump_file = + let open Memo.O in + let* expander = + let bindings = + Dune_lang.Pform.Map.singleton + (Var Input_file) + [ Dune_lang.Value.Path (Path.build (pp_file |> Path.as_in_build_dir_exn)) ] + in + let dir = pp_file |> Path.parent_exn |> Path.as_in_build_dir_exn in + Super_context.expander sctx ~dir >>| Dune_rules.Expander.add_bindings ~bindings + in + let context = Dune_rules.Expander.context expander in + let build_dir = Context_name.build_dir context in + let* input = + let* action, _observing_facts = + let* loc, action = + let+ dialect, ml_kind = dialect_and_ml_kind file in + match Dialect.print_ast dialect ml_kind with + | Some print_ast -> print_ast + | None -> + (* fall back to the OCaml print_ast function, known to exist, if one + doesn't exist for this dialect. *) + Dialect.print_ast Dialect.ocaml ml_kind |> Option.value_exn + in + let build = + let open Action_builder.O in + let+ build = + Dune_rules.For_tests.Action_unexpanded.expand_no_targets + action + ~chdir:build_dir + ~loc + ~expander + ~deps:[] + ~what:"describe pp" + in + Action.with_outputs_to dump_file build.action + in + Action_builder.evaluate_and_collect_facts build + in + let+ env = Dune_rules.Super_context.context_env sctx + and+ execution_parameters = Dune_engine.Execution_parameters.default in + let targets = + let unvalidated = Targets.File.create dump_file in + match Targets.validate unvalidated with + | Valid targets -> targets + | No_targets + | Inconsistent_parent_dir + | File_and_directory_target_with_the_same_name _ -> assert false + in + { Dune_engine.Action_exec.targets = Some targets + ; root = Path.build build_dir + ; context = Some (Dune_engine.Build_context.create ~name:context) + ; env + ; rule_loc = Loc.none + ; execution_parameters + ; action + } + in + let ok = + let open Fiber.O in + let build_deps deps = Build_system.build_deps deps |> Memo.run in + let* result = Dune_engine.Action_exec.exec input ~build_deps in + Dune_engine.Action_exec.Exec_result.ok_exn result >>| ignore + in + Memo.of_non_reproducible_fiber ok +;; + +let print_pped_file = + let dump_file pp_file ~ml_kind = + Path.set_extension + pp_file + ~ext: + (match (ml_kind : Ocaml.Ml_kind.t) with + | Intf -> ".cmi.dump" + | Impl -> ".cmo.dump") + |> Path.as_in_build_dir_exn + in + fun ~sctx file pp_file ~ml_kind -> + let open Memo.O in + let dump_file = dump_file pp_file ~ml_kind in + let+ () = execute_pp_action ~sctx file pp_file dump_file in + let dump_file = Path.build dump_file in + match Path.stat dump_file with + | Ok { st_kind = S_REG; _ } -> + Io.cat dump_file; + Path.unlink_no_err dump_file + | _ -> + User_error.raise + [ Pp.textf "cannot find a dump file: %s" (Path.to_string dump_file) ] +;; + +let find_module ~sctx file = + let open Memo.O in + let src = Path.drop_optional_build_context_src_exn (Path.build file) in + Dune_rules.Top_module.find_module sctx src + >>| function + | None -> None + | Some (m, _, _, origin) -> + (match + Dune_rules.Ml_sources.Origin.preprocess origin + |> Dune_lang.Preprocess.Per_module.find (Dune_rules.Module.name m) + with + | Pps { staged = true; loc; _ } -> Some (`Staged_pps loc) + | _ -> Some (`Module m)) +;; + +let get_pped_file super_context file = + let open Memo.O in + let context = Super_context.context super_context in + let in_build_dir file = + file |> Path.to_string |> Path.Build.relative (Context.build_dir context) + in + let file_in_build_dir = + if String.is_empty file + then User_error.raise [ Pp.textf "No file given." ] + else Path.of_string file |> in_build_dir + in + let* ml_kind = + let+ _, ml_kind = dialect_and_ml_kind file in + ml_kind + in + let file_not_found () = + User_error.raise + [ Pp.textf "%s does not exist" (Path.Build.to_string_maybe_quoted file_in_build_dir) + ] + in + find_module ~sctx:super_context file_in_build_dir + >>= function + | None -> file_not_found () + | Some (`Module m) -> + (match + Dune_rules.Module.source m ~ml_kind |> Option.map ~f:Dune_rules.Module.File.path + with + | None -> file_not_found () + | Some pp_file -> + let+ () = Build_system.build_file pp_file in + Ok (pp_file, ml_kind)) + | Some (`Staged_pps loc) -> + User_error.raise ~loc [ Pp.text "staged_pps are not supported." ] +;; + +let term = + let+ builder = Common.Builder.term + and+ context_name = Common.context_arg ~doc:"Build context to use." + and+ _ = Describe_lang_compat.arg + and+ file = Arg.(required & pos 0 (some string) None (Arg.info [] ~docv:"FILE")) in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + let* setup = Memo.run setup in + let sctx = Import.Main.find_scontext_exn setup ~name:context_name in + build_exn + @@ fun () -> + let open Memo.O in + let* result = get_pped_file sctx file in + match result with + | Error file -> Io.cat file |> Memo.return + | Ok (pp_file, ml_kind) -> print_pped_file ~sctx file pp_file ~ml_kind +;; + +let command = + let doc = "Build a given FILE and print the preprocessed output." in + let info = Cmd.info ~doc "pp" in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_pp.mli b/unikernel/duniverse/dune_/bin/describe/describe_pp.mli new file mode 100644 index 00000000..0477f803 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_pp.mli @@ -0,0 +1,4 @@ +open Import + +(** Dune command to show the preprocessed version of a file. *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/describe_workspace.ml b/unikernel/duniverse/dune_/bin/describe/describe_workspace.ml new file mode 100644 index 00000000..809151f9 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_workspace.ml @@ -0,0 +1,687 @@ +open Import + +module Options = struct + (* Option flags for what to do while crawling the workspace *) + type t = + { with_deps : bool (* whether to compute direct dependencies between modules *) + ; with_pps : bool + (* whether to include the dependencies to ppx-rewriters (that are + used at compile time) *) + } + + (* whether to sanitize absolute paths of workspace items, and their UIDs, to + ensure reproducible tests *) + let sanitize_for_tests = ref false + + let arg_with_deps = + let open Arg in + value + & flag + & info + [ "with-deps" ] + ~doc:"Whether the dependencies between modules should be printed." + ;; + + let arg_with_pps = + let open Arg in + value + & flag + & info + [ "with-pps" ] + ~doc: + "Whether the dependencies towards ppx-rewriters (that are called at compile \ + time) should be taken into account." + ;; + + let arg_sanitize_for_tests = + let open Arg in + value + & flag + & info + [ "sanitize-for-tests" ] + ~doc: + "Sanitize the absolute paths in workspace items, and the associated UIDs, so \ + that the output is reproducible." + ;; + + let arg : t Term.t = + let+ with_deps = arg_with_deps + and+ with_pps = arg_with_pps + and+ sanitize_for_tests_value = arg_sanitize_for_tests in + sanitize_for_tests := sanitize_for_tests_value; + { with_deps; with_pps } + ;; +end + +(* The module [Descr] is a typed representation of the description of a + workspace, that is provided by the ``dune describe workspace`` command. + + Each sub-module contains a [to_dyn] function, that translates the + descriptors to a value of type [Dyn.t]. + + The typed representation aims at precisely describing the structure of the + information computed by ``dune describe``, and hopefully make users' life + easier in decoding the S-expressions into meaningful contents. *) +module Descr = struct + (* [dyn_path p] converts a path to a value of type [Dyn.t]. Remark: this is + different from Path.to_dyn, that produces extra tags from a variant + datatype. *) + let dyn_path (p : Path.t) : Dyn.t = String (Path.to_string p) + + (* Description of the dependencies of a module *) + module Mod_deps = struct + type t = + { for_intf : Dune_rules.Module_name.t list + (* direct module dependencies for the interface *) + ; for_impl : Dune_rules.Module_name.t list + (* direct module dependencies for the implementation *) + } + + (* Conversion to the [Dyn.t] type *) + let to_dyn { for_intf; for_impl } = + let open Dyn in + record + [ "for_intf", list Dune_rules.Module_name.to_dyn for_intf + ; "for_impl", list Dune_rules.Module_name.to_dyn for_impl + ] + ;; + end + + (* Description of modules *) + module Mod = struct + type t = + { name : Dune_rules.Module_name.t (* name of the module *) + ; impl : Path.t option (* path to the .ml file, if any *) + ; intf : Path.t option (* path to the .mli file, if any *) + ; cmt : Path.t option (* path to the .cmt file, if any *) + ; cmti : Path.t option (* path to the .cmti file, if any *) + ; module_deps : Mod_deps.t (* direct module dependencies *) + } + + (* Conversion to the [Dyn.t] type *) + let to_dyn { Options.with_deps; _ } { name; impl; intf; cmt; cmti; module_deps } + : Dyn.t + = + let open Dyn in + let optional_fields = + let module_deps = + if with_deps then Some ("module_deps", Mod_deps.to_dyn module_deps) else None + in + (* we build a list of options, that is later filtered, so that adding + new optional fields in the future can be done easily *) + match module_deps with + | None -> [] + | Some module_deps -> [ module_deps ] + in + record + @@ [ "name", Dune_rules.Module_name.to_dyn name + ; "impl", option dyn_path impl + ; "intf", option dyn_path intf + ; "cmt", option dyn_path cmt + ; "cmti", option dyn_path cmti + ] + @ optional_fields + ;; + end + + (* Description of executables *) + module Exe = struct + type t = + { names : string list (* names of the executable *) + ; requires : Digest.t list + (* list of direct dependencies to libraries, identified by their + digests *) + ; modules : Mod.t list (* list of the modules the executable is composed of *) + ; include_dirs : Path.t list (* list of include directories *) + } + + let map_path t ~f = { t with include_dirs = List.map ~f t.include_dirs } + + (* Conversion to the [Dyn.t] type *) + let to_dyn options { names; requires; modules; include_dirs } : Dyn.t = + let open Dyn in + record + [ "names", List (List.map ~f:(fun name -> String name) names) + ; "requires", Dyn.(list string) (List.map ~f:Digest.to_string requires) + ; "modules", list (Mod.to_dyn options) modules + ; "include_dirs", list dyn_path include_dirs + ] + ;; + end + + (* Description of libraries *) + + module Lib = struct + type t = + { name : Lib_name.t (* name of the library *) + ; uid : Digest.t (* digest of the library *) + ; local : bool (* whether this library is local *) + ; requires : Digest.t list + (* list of direct dependendies to libraries, identified by their + digests *) + ; source_dir : Path.t + (* path to the directory that contains the sources of this library *) + ; modules : Mod.t list (* list of the modules the executable is composed of *) + ; include_dirs : Path.t list (* list of include directories *) + } + + let map_path t ~f = + { t with source_dir = f t.source_dir; include_dirs = List.map ~f t.include_dirs } + ;; + + (* Conversion to the [Dyn.t] type *) + let to_dyn options { name; uid; local; requires; source_dir; modules; include_dirs } + : Dyn.t + = + let open Dyn in + record + [ "name", Lib_name.to_dyn name + ; "uid", String (Digest.to_string uid) + ; "local", Bool local + ; "requires", (list string) (List.map ~f:Digest.to_string requires) + ; "source_dir", dyn_path source_dir + ; "modules", list (Mod.to_dyn options) modules + ; "include_dirs", (list dyn_path) include_dirs + ] + ;; + end + + (* Description of items: executables, or libraries *) + module Item = struct + type t = + | Executables of Exe.t + | Library of Lib.t + | Root of Path.t + | Build_context of Path.t + + let map_path t ~f = + match t with + | Executables exe -> Executables (Exe.map_path exe ~f) + | Library lib -> Library (Lib.map_path lib ~f) + | Root r -> Root (f r) + | Build_context c -> Build_context (f c) + ;; + + (* Conversion to the [Dyn.t] type *) + let to_dyn options : t -> Dyn.t = function + | Executables exe_descr -> Variant ("executables", [ Exe.to_dyn options exe_descr ]) + | Library lib_descr -> Variant ("library", [ Lib.to_dyn options lib_descr ]) + | Root root -> Variant ("root", [ String (Path.to_absolute_filename root) ]) + | Build_context build_ctxt -> + Variant ("build_context", [ String (Path.to_string build_ctxt) ]) + ;; + end + + (* Description of a workspace: a list of items *) + module Workspace = struct + type t = Item.t list + + (* Conversion to the [Dyn.t] type *) + let to_dyn options (items : t) : Dyn.t = Dyn.list (Item.to_dyn options) items + end +end + +module Lang = struct + type t = Dune_lang.Syntax.Version.t + + let arg_conv = + let parser s = + match Scanf.sscanf s "%u.%u" (fun a b -> a, b) with + | Ok t -> Ok t + | Error () -> Error (`Msg "Expected version of the form NNN.NNN.") + in + let printer ppf t = + Stdlib.Format.fprintf ppf "%s" (Dune_lang.Syntax.Version.to_string t) + in + Arg.conv ~docv:"VERSION" (parser, printer) + ;; + + let arg : t Term.t = + Term.ret + @@ let+ v = + Arg.( + value + & opt arg_conv (0, 1) + & info + [ "lang" ] + ~docv:"VERSION" + ~doc:"Behave the same as this version of Dune.") + in + if v = (0, 1) + then `Ok v + else ( + let msg = + let pp = + "Only --lang 0.1 is available at the moment as this command is not yet \ + stabilised. If you would like to release a software that relies on the \ + output of 'dune describe', please open a ticket on \ + https://github.com/ocaml/dune." + |> Pp.text + in + Stdlib.Format.asprintf "%a" Pp.to_fmt pp + in + `Error (true, msg)) + ;; +end + +(* The following module is responsible sanitizing the output of + [dune describe workspace], so that the absolute paths and the UIDs that + depend on them are stable for tests. These paths may differ, depending on + the machine they are run on. *) +module Sanitize_for_tests = struct + module Workspace = struct + let fake_findlib = lazy (Path.External.of_string "/FINDLIB") + let fake_workspace = lazy (Path.External.of_string "/WORKSPACE_ROOT") + + let sanitize_with_findlib ~findlib_paths path = + let path = Path.external_ path in + List.find_map findlib_paths ~f:(fun candidate -> + let open Option.O in + let* candidate = Path.as_external candidate in + (* if the path to rename is an external path, try to find the + OCaml root inside, and replace it with a fixed string *) + let+ without_prefix = Path.drop_prefix ~prefix:(Path.external_ candidate) path in + (* we have found the OCaml root path: let's replace it with a + constant string *) + Path.External.append_local (Lazy.force fake_findlib) without_prefix) + ;; + + (* Sanitizes a workspace description, by renaming non-reproducible UIDs and + paths *) + let really_sanitize ~findlib_paths items = + let rename_path = function + (* we have found a path for OCaml's root: let's define the renaming + function *) + | Path.External path -> + sanitize_with_findlib ~findlib_paths path + |> Option.value ~default:path + |> Path.external_ + | In_source_tree p -> + (* Replace the workspace root with a fixed string *) + Path.External.append_local (Lazy.force fake_workspace) (Path.Source.to_local p) + |> Path.external_ + | path -> + (* Otherwise, it should not be changed *) + path + in + (* now, we rename the UIDs in the [requires] field , while reversing the + list of items, so that we get back the original ordering *) + List.map ~f:(Descr.Item.map_path ~f:rename_path) items + ;; + + (* Sanitizes a workspace description when options ask to do so, or performs + no change at all otherwise *) + let sanitize ~findlib_paths items = + if !Options.sanitize_for_tests then really_sanitize ~findlib_paths items else items + ;; + end +end + +(* Crawl the workspace to get all the data *) +module Crawl = struct + open Dune_rules + open Dune_engine + open Memo.O + + (* Computes the digest of a library *) + let uid_of_library (lib : Lib.t) : Digest.t = + let name = Lib.name lib in + if Lib.is_local lib + then ( + let source_dir = Lib_info.src_dir (Lib.info lib) in + Digest.generic (name, Path.to_string source_dir)) + else Digest.generic name + ;; + + let immediate_deps_of_module ~options ~obj_dir ~modules unit = + match (options : Options.t) with + | { with_deps = false; _ } -> + Action_builder.return { Ocaml.Ml_kind.Dict.intf = []; impl = [] } + | { with_deps = true; _ } -> + let deps ml_kind = + Dune_rules.Dep_rules.immediate_deps_of unit modules ~obj_dir ~ml_kind + in + let open Action_builder.O in + let+ intf, impl = Action_builder.both (deps Intf) (deps Impl) in + { Ocaml.Ml_kind.Dict.intf; impl } + ;; + + (* Builds the description of a module from a module and its object directory *) + let module_ + ~obj_dir + ~(deps_for_intf : Module.t list) + ~(deps_for_impl : Module.t list) + (m : Module.t) + : Descr.Mod.t + = + let source ml_kind = Option.map (Module.source m ~ml_kind) ~f:Module.File.path in + let cmt ml_kind = + Dune_rules.Obj_dir.Module.cmt_file obj_dir m ~ml_kind ~cm_kind:(Ocaml Cmi) + in + { Descr.Mod.name = Module.name m + ; impl = source Impl + ; intf = source Intf + ; cmt = cmt Impl + ; cmti = cmt Intf + ; module_deps = + { for_intf = List.map ~f:Module.name deps_for_intf + ; for_impl = List.map ~f:Module.name deps_for_impl + } + } + ;; + + (* Builds the list of modules *) + let modules ~obj_dir ~deps_of modules_ : Descr.Mod.t list Memo.t = + modules_ + |> Modules.With_vlib.drop_vlib + |> Modules.fold ~init:(Memo.return []) ~f:(fun m macc -> + let* acc = macc in + let deps = deps_of m in + let+ { Ocaml.Ml_kind.Dict.intf = deps_for_intf; impl = deps_for_impl }, _ = + Dune_engine.Action_builder.evaluate_and_collect_facts deps + in + module_ ~obj_dir ~deps_for_intf ~deps_for_impl m :: acc) + ;; + + (* Builds a workspace item for the provided executables object *) + let executables sctx ~options ~project ~dir (exes : Executables.t) + : (Descr.Item.t * Lib.Set.t) option Memo.t + = + let* expander = Super_context.expander sctx ~dir in + Expander.eval_blang expander exes.enabled_if + >>= function + | false -> Memo.return None + | true -> + let first_exe = snd (Nonempty_list.hd exes.names) in + let* scope = + Scope.DB.find_by_project (Super_context.context sctx |> Context.name) project + in + let* modules_, obj_dir = + let+ modules_, obj_dir = + Dir_contents.get sctx ~dir + >>= Dir_contents.ocaml + >>= Ml_sources.modules_and_obj_dir + ~libs:(Scope.libs scope) + ~for_:(Exe { first_exe }) + in + Modules.With_vlib.modules modules_, obj_dir + in + let* pp_map = + let+ version = + let+ ocaml = Super_context.context sctx |> Context.ocaml in + ocaml.version + in + Staged.unstage + @@ Pp_spec.pped_modules_map + (Dune_lang.Preprocess.Per_module.without_instrumentation + exes.buildable.preprocess) + version + in + let deps_of module_ = + let module_ = pp_map module_ in + immediate_deps_of_module ~options ~obj_dir ~modules:modules_ module_ + in + let obj_dir = Obj_dir.of_local obj_dir in + let* modules_ = modules ~obj_dir ~deps_of modules_ in + let+ requires = + let* compile_info = Exe_rules.compile_info ~scope exes in + let open Resolve.Memo.O in + let* requires = Lib.Compile.direct_requires compile_info in + if options.with_pps + then + let+ pps = Lib.Compile.pps compile_info in + pps @ requires + else Resolve.Memo.return requires + in + (match Resolve.peek requires with + | Error () -> None + | Ok libs -> + let include_dirs = Obj_dir.all_cmis obj_dir in + let exe_descr = + { Descr.Exe.names = List.map ~f:snd (Nonempty_list.to_list exes.names) + ; requires = List.map ~f:uid_of_library libs + ; modules = modules_ + ; include_dirs + } + in + Some (Descr.Item.Executables exe_descr, Lib.Set.of_list libs)) + ;; + + (* Builds a workspace item for the provided library object *) + let library sctx ~options (lib : Lib.t) : Descr.Item.t option Memo.t = + let* requires = Lib.requires lib in + match Resolve.peek requires with + | Error () -> Memo.return None + | Ok requires -> + let name = Lib.name lib in + let info = Lib.info lib in + let src_dir = Lib_info.src_dir info in + let obj_dir = Lib_info.obj_dir info in + let+ modules_ = + match Lib.is_local lib with + | false -> Memo.return [] + | true -> + (* XXX why do we have a second object directory? *) + let* modules_, obj_dir_ = + let* libs = + Scope.DB.find_by_dir (Path.as_in_build_dir_exn src_dir) >>| Scope.libs + in + let+ modules_, obj_dir_ = + Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir) + >>= Dir_contents.ocaml + >>= Ml_sources.modules_and_obj_dir + ~libs + ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) + in + Modules.With_vlib.modules modules_, obj_dir_ + in + let* pp_map = + let+ version = + let+ ocaml = Super_context.context sctx |> Context.ocaml in + ocaml.version + in + Staged.unstage + @@ Pp_spec.pped_modules_map + (Dune_lang.Preprocess.Per_module.without_instrumentation + (Lib_info.preprocess info)) + version + in + let deps_of module_ = + immediate_deps_of_module + ~options + ~obj_dir:obj_dir_ + ~modules:modules_ + (pp_map module_) + in + modules ~obj_dir ~deps_of modules_ + in + let include_dirs = Obj_dir.all_cmis obj_dir in + let lib_descr = + { Descr.Lib.name + ; uid = uid_of_library lib + ; local = Lib.is_local lib + ; requires = List.map requires ~f:uid_of_library + ; source_dir = src_dir + ; modules = modules_ + ; include_dirs + } + in + Some (Descr.Item.Library lib_descr) + ;; + + (* [source_path_is_in_dirs dirs p] tests whether the source path [p] is a + descendant of some of the provided directory [dirs]. If [dirs = None], + then it always succeeds. If [dirs = Some l], then a matching directory is + search in the list [l]. *) + let source_path_is_in_dirs dirs (p : Path.Source.t) = + match dirs with + | None -> true + | Some dirs -> List.exists ~f:(fun dir -> Path.Source.is_descendant p ~of_:dir) dirs + ;; + + (* Tests whether a dune file is located in a path that is a descendant of + some directory *) + let dune_file_is_in_dirs dirs dune_file = + Dune_file.dir dune_file |> source_path_is_in_dirs dirs + ;; + + (* Tests whether a library is located in a path that is a descendant of some + directory *) + let lib_is_in_dirs dirs (lib : Lib.t) = + source_path_is_in_dirs + dirs + (Path.drop_build_context_exn @@ Lib_info.best_src_dir @@ Lib.info lib) + ;; + + (* Builds a workspace item for the root path *) + let root () = Descr.Item.Root Path.root + + (* Builds a workspace item for the build directory path *) + let build_ctxt (context : Context.t) : Descr.Item.t = + Descr.Item.Build_context (Path.build (Context.build_dir context)) + ;; + + (* Builds a workspace description for the provided dune setup and context *) + let workspace + options + ({ Dune_rules.Main.contexts = _; scontexts } : Dune_rules.Main.build_system) + (context : Context.t) + dirs + : Descr.Workspace.t Memo.t + = + let context_name = Context.name context in + let sctx = Context_name.Map.find_exn scontexts context_name in + let open Memo.O in + let* dune_files = + Dune_load.dune_files context_name >>| List.filter ~f:(dune_file_is_in_dirs dirs) + in + let* exes, exe_libs = + (* the list of workspace items that describe executables, and the list of + their direct library dependencies *) + Memo.parallel_map dune_files ~f:(fun (dune_file : Dune_file.t) -> + Dune_file.stanzas dune_file + >>= Memo.parallel_map ~f:(fun stanza -> + match Stanza.repr stanza with + | Executables.T exes -> + let dir = + Path.Build.append_source + (Context.build_dir context) + (Dune_file.dir dune_file) + in + let project = Dune_file.project dune_file in + executables sctx ~options ~project ~dir exes + | _ -> Memo.return None) + >>| List.filter_opt) + >>| List.concat + >>| List.split + in + let exe_libs = + (* conflate the dependencies of executables into a single set *) + Lib.Set.union_all exe_libs + in + let* project_libs = + (* the list of libraries declared in the project *) + Dune_load.projects () + >>= Memo.parallel_map ~f:(fun project -> + Scope.DB.find_by_project (Context.name context) project + >>| Scope.libs + >>= Lib.DB.all) + >>| Lib.Set.union_all + >>| Lib.Set.filter ~f:(lib_is_in_dirs dirs) + in + let+ libs = + (* the executables' libraries, and the project's libraries *) + Lib.Set.union exe_libs project_libs + |> Lib.Set.to_list + |> Lib.descriptive_closure ~with_pps:options.with_pps + >>= Memo.parallel_map ~f:(library ~options sctx) + >>| List.filter_opt + in + let root = root () in + let build_ctxt = build_ctxt context in + root :: build_ctxt :: (exes @ libs) + ;; +end + +let find_dir common dir = + let p = Path.Source.(relative root) (Common.prefix_target common dir) in + let s = Path.source p in + if not @@ Path.exists s + then User_error.raise [ Pp.textf "No such file or directory: %s" (Path.to_string s) ]; + if not @@ Path.is_directory s + then + User_error.raise + [ Pp.textf "File exists, but is not a directory: %s" (Path.to_string s) ]; + Memo.return p +;; + +let term : unit Term.t = + let+ builder = Common.Builder.term + and+ what = + Arg.( + value + & pos_all string [] + & info + [] + ~docv:"DIRS" + ~doc: + "prints a description of the workspace's structure. If some directories DIRS \ + are provided, then only those directories of the workspace are considered.") + and+ context_name = Common.context_arg ~doc:"Build context to use." + and+ format = Describe_format.arg + and+ lang = Lang.arg + and+ options = Options.arg in + let common, config = Common.init builder in + let dirs = + let args = "workspace" :: what in + let parse = + Dune_lang.Syntax.set Stanza.syntax (Active lang) + @@ + let open Dune_lang.Decoder in + fields + @@ field "workspace" + @@ let+ dirs = repeat relative_file in + (* [None] means that all directories should be accepted, + whereas [Some l] means that only the directories in the + list [l] should be accepted. The checks on whether the + paths exist and whether they are directories are performed + later in the [describe] function. *) + let dirs = if List.is_empty dirs then None else Some dirs in + dirs + in + let ast = + Dune_lang.Ast.add_loc + ~loc:Loc.none + (List (List.map args ~f:Dune_lang.atom_or_quoted_string)) + in + Dune_lang.Decoder.parse parse Univ_map.empty ast + in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn + @@ fun () -> + let open Memo.O in + let* setup = setup in + let super_context = Import.Main.find_scontext_exn setup ~name:context_name in + let context = Super_context.context super_context in + let* findlib_paths = Context.findlib_paths context in + (* prefix directories with the workspace root, so that the + command also works correctly when it is run from a + subdirectory *) + Memo.Option.map dirs ~f:(Memo.List.map ~f:(find_dir common)) + >>= Crawl.workspace options setup context + >>| Sanitize_for_tests.Workspace.sanitize ~findlib_paths + >>| Descr.Workspace.to_dyn options + >>| Describe_format.print_dyn format +;; + +let command = + let doc = + "Print a description of the workspace's structure. If some directories DIRS are \ + provided, then only those directories of the workspace are considered." + in + let info = Cmd.info ~doc "workspace" in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/describe/describe_workspace.mli b/unikernel/duniverse/dune_/bin/describe/describe_workspace.mli new file mode 100644 index 00000000..12895212 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/describe_workspace.mli @@ -0,0 +1,6 @@ +open Import + +val term : unit Term.t + +(** Dune command that describes the workspace *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/describe/package_entries.ml b/unikernel/duniverse/dune_/bin/describe/package_entries.ml new file mode 100644 index 00000000..9b85cd26 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/package_entries.ml @@ -0,0 +1,26 @@ +open Import + +let term = + let+ builder = Common.Builder.term + and+ context_name = Common.context_arg ~doc:"Build context to use." + and+ format = Describe_format.arg in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + let* setup = Memo.run setup in + let super_context = Import.Main.find_scontext_exn setup ~name:context_name in + build_exn + @@ fun () -> + let open Memo.O in + Dune_rules.Install_rules.stanzas_to_entries super_context + >>| Package.Name.Map.to_dyn (Dyn.list Install.Entry.Sourced.to_dyn) + >>| Describe_format.print_dyn format +;; + +let command = + let doc = "prints information about the entries per package." in + let info = Cmd.info ~doc "package-entries" in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/describe/package_entries.mli b/unikernel/duniverse/dune_/bin/describe/package_entries.mli new file mode 100644 index 00000000..8e5fbcdb --- /dev/null +++ b/unikernel/duniverse/dune_/bin/describe/package_entries.mli @@ -0,0 +1,4 @@ +open Import + +(** Dune command to print out information about the entries per package.*) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/diagnostics.ml b/unikernel/duniverse/dune_/bin/diagnostics.ml new file mode 100644 index 00000000..135370ea --- /dev/null +++ b/unikernel/duniverse/dune_/bin/diagnostics.ml @@ -0,0 +1,38 @@ +open Import + +let exec () = + let open Fiber.O in + let where = Rpc_common.active_server_exn () in + let module Client = Dune_rpc_client.Client in + let+ errors = + let* connect = Client.Connection.connect_exn where in + Dune_rpc_impl.Client.client + connect + (Dune_rpc_private.Initialize.Request.create + ~id:(Dune_rpc_private.Id.make (Sexp.Atom "diagnostics_cmd"))) + ~f:(fun cli -> + let* decl = + Client.Versioned.prepare_request cli Dune_rpc_private.Public.Request.diagnostics + in + match decl with + | Error e -> raise (Dune_rpc_private.Version_error.E e) + | Ok decl -> Client.request cli decl ()) + in + match errors with + | Ok errors -> + List.iter errors ~f:(fun err -> + Console.print_user_message (Dune_rpc.Diagnostic.to_user_message err)) + | Error e -> Rpc_common.raise_rpc_error e +;; + +let info = + let doc = "Fetch and return errors from the current build." in + Cmd.info "diagnostics" ~doc +;; + +let term = + let+ (builder : Common.Builder.t) = Common.Builder.term in + Rpc_common.client_term builder exec +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/diagnostics.mli b/unikernel/duniverse/dune_/bin/diagnostics.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/diagnostics.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/dune b/unikernel/duniverse/dune_/bin/dune new file mode 100644 index 00000000..202e982c --- /dev/null +++ b/unikernel/duniverse/dune_/bin/dune @@ -0,0 +1,87 @@ +(include_subdirs unqualified) + +(executable + (name main) + (public_name dune) + (package dune) + (enabled_if + (<> %{profile} dune-bootstrap)) + (libraries + memo + promote + ocaml + ocaml_config + dune_lang + predicate_lang + fiber + fiber_event_bus + stdune + dune_console + unix + install + dune_findlib + dune_metrics + dune_digest + dune_cache + dune_cache_storage + dune_graph + dune_rules + dune_vcs + dune_engine + dune_targets + dune_util + dune_upgrader + dune_pkg + cmdliner + threads + ; Kept to keep implicit_transitive_deps false working in 4.x + threads.posix + build_info + dune_config + dune_config_file + chrome_trace + dune_stats + csexp + csexp_rpc + dune_rpc_impl + dune_rules_rpc + dune_rpc_private + dune_rpc_client + dune_spawn + opam_format + source + xdg) + (bootstrap_info bootstrap-info)) + +; Installing the dune binary depends on the kind of build: +; - for bootstrap builds, dune.exe is copied from ../dune.exe +; and installed using a manual install stanza +; - for non-bootstrap builds (building dune with another dune), +; the executable stanza does everything (and attached it to the +; right package, which is important for build-info to succeed) +; but we still need to setup a dummy dune.exe so that profiles +; agree on the targets. + +(rule + (enabled_if + (<> %{profile} dune-bootstrap)) + (action + (with-stdout-to dune.exe (progn)))) + +(rule + (action + (copy ../_boot/dune.exe dune.exe)) + (enabled_if + (= %{profile} dune-bootstrap))) + +(install + (section bin) + (enabled_if + (= %{profile} dune-bootstrap)) + (package dune) + (files + (dune.exe as dune))) + +(deprecated_library_name + (old_public_name dune.configurator) + (new_public_name dune-configurator)) diff --git a/unikernel/duniverse/dune_/bin/dune_init.ml b/unikernel/duniverse/dune_/bin/dune_init.ml new file mode 100644 index 00000000..63111997 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/dune_init.ml @@ -0,0 +1,611 @@ +open Import + +(** Because the dune_init utility deals with the addition of stanzas and fields + to dune projects and files, we need to inspect and manipulate the concrete + syntax tree (CST) a good deal. *) +module Cst = Dune_lang.Cst + +(** Abstractions around the kinds of files handled during initialization *) +module File = struct + type dune = + { path : Path.t + ; name : string + ; content : Cst.t list + } + + type text = + { path : Path.t + ; name : string + ; content : string + } + + type t = + | Dune of dune + | Text of text + + let make_text path name content = Text { path; name; content } + + let full_path = function + | Dune { path; name; _ } | Text { path; name; _ } -> Path.relative path name + ;; + + (** Inspection and manipulation of stanzas in a file *) + module Stanza = struct + let pp s = + match Cst.to_sexp s with + | None -> Pp.nop + | Some s -> Dune_lang.pp s + ;; + + let libraries_conflict (a : Library.t) (b : Library.t) = a.name = b.name + + let executables_conflict (a : Dune_rules.Executables.t) (b : Dune_rules.Executables.t) + = + let a_names = String.Set.of_list_map ~f:snd (Nonempty_list.to_list a.names) in + let b_names = String.Set.of_list_map ~f:snd (Nonempty_list.to_list b.names) in + String.Set.inter a_names b_names |> String.Set.is_empty |> not + ;; + + let tests_conflict (a : Dune_rules.Tests.t) (b : Dune_rules.Tests.t) = + executables_conflict a.exes b.exes + ;; + + let stanzas_conflict (a : Stanza.t) (b : Stanza.t) = + match Stanza.repr a, Stanza.repr b with + | Dune_rules.Executables.T a, Dune_rules.Executables.T b -> executables_conflict a b + | Library.T a, Library.T b -> libraries_conflict a b + | Dune_rules.Tests.T a, Dune_rules.Tests.T b -> tests_conflict a b + (* NOTE No other stanza types currently supported *) + | _ -> false + ;; + + let csts_conflict project (a : Cst.t) (b : Cst.t) = + let of_ast = Dune_rules.Stanzas.of_ast project in + (let open Option.O in + let* a_ast = Cst.abstract a in + let+ b_ast = Cst.abstract b in + let a_asts = of_ast a_ast in + let b_asts = of_ast b_ast in + List.exists ~f:(fun x -> List.exists ~f:(stanzas_conflict x) a_asts) b_asts) + |> Option.value ~default:false + ;; + + (* TODO(shonfeder): replace with stanza merging *) + let find_conflicting project new_stanzas existing_stanzas = + let conflicting_stanza stanza = + match List.find ~f:(csts_conflict project stanza) existing_stanzas with + | Some conflict -> Some (stanza, conflict) + | None -> None + in + List.find_map ~f:conflicting_stanza new_stanzas + ;; + + let add (project : Dune_project.t) stanzas = function + | Text f -> Text f (* Adding a stanza to a text file isn't meaningful *) + | Dune f -> + (match find_conflicting project stanzas f.content with + | None -> Dune { f with content = f.content @ stanzas } + | Some (a, b) -> + User_error.raise + [ Pp.text "Updating existing stanzas is not yet supported." + ; Pp.text "A preexisting dune stanza conflicts with a generated stanza:" + ; Pp.nop + ; Pp.text "Generated stanza:" + ; pp a + ; Pp.nop + ; Pp.text "Pre-existing stanza:" + ; pp b + ]) + ;; + end + + (* Stanza *) + + let create_dir path = + try Path.mkdir_p path with + | Unix.Unix_error (EACCES, _, _) -> + User_error.raise + [ Pp.textf + "A project directory cannot be created or accessed: Lacking permissions \ + needed to create directory %s" + (Path.to_string_maybe_quoted path) + ] + ;; + + let load_dune_file ~path = + let name = "dune" in + let full_path = Path.relative path name in + let content = + if not (Path.exists full_path) + then [] + else if Path.is_directory full_path + then + User_error.raise + [ Pp.textf + "\"%s\" already exists and is a directory" + (Path.to_absolute_filename full_path) + ] + else ( + match Io.with_lexbuf_from_file ~f:Dune_lang.Format.parse full_path with + | Dune_lang.Format.Sexps content -> content + | Dune_lang.Format.OCaml_syntax _ -> + User_error.raise + [ Pp.textf + "Cannot load dune file %s because it uses OCaml syntax" + (Path.to_string_maybe_quoted full_path) + ]) + in + Dune { path; name; content } + ;; + + let write_dune_file (dune_file : dune) = + let path = Path.relative dune_file.path dune_file.name in + let version = + Dune_lang.Syntax.greatest_supported_version_exn Dune_lang.Stanza.syntax + in + Io.with_file_out + ~binary:true + (* Why do we pass [~binary:true] but not anywhere else when formatting? *) + path + ~f:(fun oc -> + let fmt = Format.formatter_of_out_channel oc in + Format.fprintf + fmt + "%a%!" + Pp.to_fmt + (Dune_lang.Format.pp_top_sexps ~version dune_file.content)) + ;; + + let write f = + let path = full_path f in + match f with + | Dune f -> Ok (write_dune_file f) + | Text f -> + if Path.exists path + then Error path + else Ok (Io.write_file ~binary:false path f.content) + ;; +end + +(** The context in which the initialization is executed *) +module Init_context = struct + open Dune_config_file + + type t = + { dir : Path.t + ; project : Dune_project.t + ; defaults : Dune_config.Project_defaults.t + } + + let make path defaults = + let open Memo.O in + let+ project = + (* CR-someday rgrinberg: why not get the project from the source tree? *) + Dune_project.load + ~dir:Path.Source.root + ~files:Filename.Set.empty + ~infer_from_opam_files:true + ~load_opam_file_with_contents:Dune_pkg.Opam_file.load_opam_file_with_contents + >>| function + | Some p -> p + | None -> + Dune_project.anonymous + ~dir:Path.Source.root + Package_info.empty + Package.Name.Map.empty + in + let dir = + match path with + | None -> Path.root + | Some p -> Path.of_string p + in + File.create_dir dir; + { dir; project; defaults } + ;; +end + +let check_module_name name = + let s = Dune_lang.Atom.to_string name in + let (_ : Dune_rules.Module_name.t) = + Dune_rules.Module_name.of_string_user_error (Loc.none, s) |> User_error.ok_exn + in + () +;; + +module Public_name = struct + include Lib_name + module Pkg = Dune_lang.Package_name.Opam_compatible + + let is_opam_compatible l = + Lib_name.package_name l |> Dune_lang.Package_name.is_opam_compatible + ;; + + let of_string_user_error (loc, s) = + let open Result.O in + let* l = of_string_user_error (loc, s) in + if is_opam_compatible l + then Ok l + else + Error + (User_error.make + [ Pp.text + "Public names are composed of an opam package name and optional \ + dot-separated string suffixes." + ; Pkg.description_of_valid_string + ]) + ;; + + let of_name_exn name = + let s = Dune_lang.Atom.to_string name in + of_string_user_error (Loc.none, s) |> User_error.ok_exn + ;; +end + +module Component = struct + module Options = struct + module Common = struct + type t = + { name : Dune_lang.Atom.t + ; public : Public_name.t option + ; libraries : Dune_lang.Atom.t list + ; pps : Dune_lang.Atom.t list + } + + let package_name common = + let name = + match common.public with + | None -> Dune_lang.Atom.to_string common.name + | Some public -> Public_name.to_string public + in + Package.Name.of_string name + ;; + end + + module Executable = struct + type t = unit + end + + module Library = struct + type t = { inline_tests : bool } + end + + module Project = struct + module Template = struct + type t = + | Exec + | Lib + + let of_string = function + | "executable" -> Some Exec + | "library" -> Some Lib + | _ -> None + ;; + + let commands = [ "executable", Exec; "library", Lib ] + end + + module Pkg = struct + type t = + | Opam + | Esy + + let commands = [ "opam", Opam; "esy", Esy ] + end + + type t = + { template : Template.t + ; inline_tests : bool + ; pkg : Pkg.t + } + end + + module Test = struct + type t = unit + end + + type 'options t = + { context : Init_context.t + ; common : Common.t + ; options : 'options + } + end + + (* Options *) + + type 'options t = + | Executable : Options.Executable.t Options.t -> Options.Executable.t t + | Library : Options.Library.t Options.t -> Options.Library.t t + | Project : Options.Project.t Options.t -> Options.Project.t t + | Test : Options.Test.t Options.t -> Options.Test.t t + + (** Internal representation of the files comprising a component *) + type target = + { dir : Path.t + ; files : File.t list + } + + (** Creates Dune language CST stanzas describing components *) + module Stanza_cst = struct + open Dune_lang + + module Field = struct + let inline_tests = Encoder.field_b "inline_tests" + let pps_encoder pps = Encoder.list Encoder.string ("pps" :: pps) + + let preprocess_field = function + | [] -> [] + | pps -> [ Encoder.field "preprocess" pps_encoder pps ] + ;; + + let common (options : Options.Common.t) = + [ Encoder.field "name" Encoder.string (Atom.to_string options.name) + ; Encoder.field_l + "libraries" + Encoder.string + (List.map ~f:Atom.to_string options.libraries) + ] + @ preprocess_field (List.map ~f:Atom.to_string options.pps) + ;; + end + + (* Make CST representation of a stanza for the given `kind` *) + let make kind common_options fields = + Encoder.named_record_fields kind (fields @ Field.common common_options) + (* Convert to a CST *) + |> Dune_lang.Ast.add_loc ~loc:Loc.none + |> Cst.concrete + (* Package as a list CSTs *) |> List.singleton + ;; + + let add_to_list_set elem set = + if List.mem ~equal:Dune_lang.Atom.equal set elem then set else elem :: set + ;; + + let public_name_field = Encoder.field_o "public_name" Public_name.encode + + let executable (common : Options.Common.t) (() : Options.Executable.t) = + make "executable" common [ public_name_field common.public ] + ;; + + let library (common : Options.Common.t) { Options.Library.inline_tests } = + check_module_name common.name; + let common = + if inline_tests + then ( + let pps = + add_to_list_set (Dune_lang.Atom.of_string "ppx_inline_test") common.pps + in + { common with pps }) + else common + in + make + "library" + common + [ public_name_field common.public; Field.inline_tests inline_tests ] + ;; + + let test common (() : Options.Test.t) = make "test" common [] + + (* A list of CSTs for dune-project file content *) + let dune_project + ~opam_file_gen + ~(defaults : Dune_config_file.Dune_config.Project_defaults.t) + dir + (common : Options.Common.t) + = + let cst = + let package = + Package.create + ~name:(Options.Common.package_name common) + ~loc:Loc.none + ~version:None + ~conflicts:[] + ~depopts:[] + ~info:Package_info.empty + ~sites:Site.Map.empty + ~allow_empty:false + ~deprecated_package_names:Package.Name.Map.empty + ~has_opam_file:(Exists false) + ~original_opam_file:None + ~dir + ~synopsis:(Some "A short synopsis") + ~description:(Some "A longer description") + ~tags:[ "add topics"; "to describe"; "your"; "project" ] + ~depends: + [ { Package_dependency.name = Package.Name.of_string "ocaml" + ; constraint_ = None + } + ] + in + let packages = Package.Name.Map.singleton (Package.name package) package in + let info = + Package_info.example + ~authors:defaults.authors + ~maintainers:defaults.maintainers + ~license:defaults.license + in + Dune_project.anonymous ~dir info packages + |> Dune_project.set_generate_opam_files opam_file_gen + |> Dune_project.encode + |> List.map ~f:(fun exp -> + exp |> Dune_lang.Ast.add_loc ~loc:Loc.none |> Cst.concrete) + in + List.append + cst + [ Cst.Comment + ( Loc.none + , [ " See the complete stanza docs at \ + https://dune.readthedocs.io/en/stable/reference/dune-project/index.html" + ] ) + ] + ;; + end + + (* TODO Support for merging in changes to an existing stanza *) + let add_stanza_to_dune_file ~(project : Dune_project.t) ~dir stanza = + File.load_dune_file ~path:dir |> File.Stanza.add project stanza + ;; + + (* Functions to make the various components, represented as lists of files *) + module Make = struct + let bin ({ context; common; options } : Options.Executable.t Options.t) = + let dir = context.dir in + let bin_dune = + Stanza_cst.executable common options + |> add_stanza_to_dune_file ~project:context.project ~dir + in + let bin_ml = + let name = sprintf "%s.ml" (Dune_lang.Atom.to_string common.name) in + let content = sprintf "let () = print_endline \"Hello, World!\"\n" in + File.make_text dir name content + in + let files = [ bin_dune; bin_ml ] in + [ { dir; files } ] + ;; + + let src ({ context; common; options } : Options.Library.t Options.t) = + let dir = context.dir in + let lib_dune = + Stanza_cst.library common options + |> add_stanza_to_dune_file ~project:context.project ~dir + in + let files = [ lib_dune ] in + [ { dir; files } ] + ;; + + let test ({ context; common; options } : Options.Test.t Options.t) = + (* Marking the current absence of test-specific options *) + let dir = context.dir in + let test_dune = + Stanza_cst.test common options + |> add_stanza_to_dune_file ~project:context.project ~dir + in + let test_ml = + let name = sprintf "%s.ml" (Dune_lang.Atom.to_string common.name) in + let content = "" in + File.make_text dir name content + in + let files = [ test_dune; test_ml ] in + [ { dir; files } ] + ;; + + let dune_project_file dir ({ context; common; options } : Options.Project.t Options.t) + = + let opam_file_gen = + match options.pkg with + | Opam -> true + | Esy -> false + in + let content = + Stanza_cst.dune_project + ~opam_file_gen + ~defaults:context.defaults + Path.(as_in_source_tree_exn context.dir) + common + in + File.Dune { path = dir; content; name = "dune-project" } + ;; + + let proj_exec dir ({ context; common; options } : Options.Project.t Options.t) = + let lib_target = + src + { context = { context with dir = Path.relative dir "lib" } + ; options = { inline_tests = options.inline_tests } + ; common = { common with public = None } + } + in + let test_target = + let test_name = "test_" ^ Dune_lang.Atom.to_string common.name in + test + { context = { context with dir = Path.relative dir "test" } + ; options = () + ; common = { common with name = Dune_lang.Atom.of_string test_name } + } + in + let bin_target = + (* Add the lib_target as a library to the executable*) + let libraries = Stanza_cst.add_to_list_set common.name common.libraries in + bin + { context = { context with dir = Path.relative dir "bin" } + ; options = () + ; common = { common with libraries; name = Dune_lang.Atom.of_string "main" } + } + in + bin_target @ lib_target @ test_target + ;; + + let proj_lib dir ({ context; common; options } : Options.Project.t Options.t) = + let lib_target = + src + { context = { context with dir = Path.relative dir "lib" } + ; options = { inline_tests = options.inline_tests } + ; common + } + in + let test_target = + let test_name = "test_" ^ Dune_lang.Atom.to_string common.name in + test + { context = { context with dir = Path.relative dir "test" } + ; options = () + ; common = { common with name = Dune_lang.Atom.of_string test_name } + } + in + lib_target @ test_target + ;; + + let proj ({ common; options; _ } as opts : Options.Project.t Options.t) = + let ({ template; pkg; _ } : Options.Project.t) = options in + let dir = Path.Source.root in + let proj_target = + let package_files = + match (pkg : Options.Project.Pkg.t) with + | Opam -> + let name = Options.Common.package_name common in + let opam_file = Path.source @@ Package_name.file name ~dir in + [ File.make_text (Path.parent_exn opam_file) (Path.basename opam_file) "" ] + | Esy -> [ File.make_text (Path.source dir) "package.json" "" ] + in + let dir = Path.source dir in + { dir; files = dune_project_file dir opts :: package_files } + in + let component_targets = + (match (template : Options.Project.Template.t) with + | Exec -> proj_exec + | Lib -> proj_lib) + (Path.source dir) + opts + in + proj_target :: component_targets + ;; + end + + let report_uncreated_file = function + | Ok _ -> () + | Error path -> + let open Pp.O in + User_warning.emit + [ Pp.textf "File " + ++ Pp.tag + User_message.Style.Kwd + (Pp.verbatim (Path.to_string_maybe_quoted path)) + ++ Pp.text " was not created because it already exists" + ] + ;; + + (** Creates a component, writing the files to disk *) + let create target = + File.create_dir target.dir; + List.map ~f:File.write target.files + ;; + + let init (type options) (t : options t) = + let target = + match t with + | Executable params -> Make.bin params + | Library params -> Make.src params + | Project params -> Make.proj params + | Test params -> Make.test params + in + List.concat_map ~f:create target |> List.iter ~f:report_uncreated_file + ;; +end diff --git a/unikernel/duniverse/dune_/bin/dune_init.mli b/unikernel/duniverse/dune_/bin/dune_init.mli new file mode 100644 index 00000000..d5076048 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/dune_init.mli @@ -0,0 +1,103 @@ +(** Initialize dune components *) + +open Import + +(** The context in which the initialization is executed *) +module Init_context : sig + open Dune_config_file + + type t = + { dir : Path.t + ; project : Dune_project.t + ; defaults : Dune_config.Project_defaults.t + } + + val make : string option -> Dune_config.Project_defaults.t -> t Memo.t +end + +module Public_name : sig + type t + + val to_string : t -> string + val of_string_user_error : Loc.t * string -> (t, User_message.t) result + val of_name_exn : Dune_lang.Atom.t -> t +end + +(** A [Component.t] is a set of files that can be built or included as part of a + build. *) +module Component : sig + (** Options determining the details of a generated component *) + module Options : sig + (** The common options shared by all components *) + module Common : sig + type t = + { name : Dune_lang.Atom.t + ; public : Public_name.t option + ; libraries : Dune_lang.Atom.t list + ; pps : Dune_lang.Atom.t list + } + end + + (** Options for executable components *) + module Executable : sig + (** NOTE: no options supported yet *) + type t = unit + end + + (** Options for library components *) + module Library : sig + type t = { inline_tests : bool } + end + + (** Options for test components *) + module Test : sig + (** NOTE: no options supported yet *) + type t = unit + end + + (** Options for project components (which consist of several sub-components) *) + module Project : sig + (** Determines whether this is a library project or an executable project *) + module Template : sig + type t = + | Exec + | Lib + + val of_string : string -> t option + val commands : (string * t) list + end + + (** The package manager used for a project *) + module Pkg : sig + type t = + | Opam + | Esy + + val commands : (string * t) list + end + + type t = + { template : Template.t + ; inline_tests : bool + ; pkg : Pkg.t + } + end + + type 'a t = + { context : Init_context.t + ; common : Common.t + ; options : 'a + } + end + + (** All the the supported types of components *) + type 'options t = + | Executable : Options.Executable.t Options.t -> Options.Executable.t t + | Library : Options.Library.t Options.t -> Options.Library.t t + | Project : Options.Project.t Options.t -> Options.Project.t t + | Test : Options.Test.t Options.t -> Options.Test.t t + + (** Create or update the component specified by the ['options t], where + ['options] is *) + val init : 'options t -> unit +end diff --git a/unikernel/duniverse/dune_/bin/exec.ml b/unikernel/duniverse/dune_/bin/exec.ml new file mode 100644 index 00000000..d08c57c7 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/exec.ml @@ -0,0 +1,328 @@ +open Import + +let doc = "Execute a command in a similar environment as if installation was performed." + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune exec -- COMMAND) should behave in the same way as if you + do:|} + ; `Pre " \\$ dune install\n \\$ COMMAND" + ; `P + {|In particular if you run $(b,dune exec ocaml), you will have + access to the libraries defined in the workspace using your usual + directives ($(b,#require) for instance)|} + ; `P + {|When a leading / is present in the command (absolute path), then the + path is interpreted as an absolute path|} + ; `P + {|When a / is present at any other position (relative path), then the + path is interpreted as relative to the build context + current + working directory (or the value of $(b,--root) when ran outside of + the project root)|} + ; `Blocks Common.help_secs + ; Common.examples + [ "Run the executable named `my_exec'", "dune exec my_exec" + ; ( "Run the executable defined in `foo.ml' with the argument `arg'" + , "dune exec -- ./foo.exe arg" ) + ] + ] +;; + +let info = Cmd.info "exec" ~doc ~man + +module Cmd_arg = struct + type t = + | Expandable of Dune_lang.String_with_vars.t * string + | Terminal of string + + let parse s = + match Arg.conv_parser Arg.dep s with + | Ok (File sw) when Dune_lang.String_with_vars.has_pforms sw -> Expandable (sw, s) + | _ -> Terminal s + ;; + + let pp pps = function + | Expandable (_, s) -> Format.fprintf pps "%s" s + | Terminal s -> Format.fprintf pps "%s" s + ;; + + let expand t ~root ~sctx = + let open Memo.O in + match t with + | Terminal s -> Memo.return s + | Expandable (sw, _) -> + let+ path, _ = + Target.expand_path_from_root root sctx sw + |> Action_builder.evaluate_and_collect_facts + in + let context = Dune_rules.Super_context.context sctx in + (* TODO Why are we stringifying this path? *) + Path.to_string (Path.build (Path.Build.relative (Context.build_dir context) path)) + ;; + + let conv = Arg.conv ((fun s -> Ok (parse s)), pp) +end + +let not_found ~hints ~prog = + User_error.raise + ~hints + [ Pp.concat + ~sep:Pp.space + [ Pp.text "Program"; User_message.command prog; Pp.text "not found!" ] + ] +;; + +let not_found_with_suggestions ~dir ~prog = + let open Memo.O in + let+ hints = + (* Good candidates for the "./x.exe" instead of "x.exe" error are + executables present in the current directory. Note: we do not + check directory targets here; even if they do indeed include a + matching executable, they would be located in a subdirectory of + [dir], so it's unclear if that's what the user wanted. *) + let+ candidates = + let+ filename_set = Build_system.files_of ~dir:(Path.build dir) in + Filename_set.filenames filename_set + |> Filename.Set.to_list + |> List.filter ~f:(fun filename -> Filename.extension filename = ".exe") + |> List.map ~f:(fun filename -> "./" ^ filename) + in + User_message.did_you_mean prog ~candidates + in + not_found ~hints ~prog +;; + +let program_not_built_yet prog = + User_error.raise + [ Pp.concat + ~sep:Pp.space + [ Pp.text "Program" + ; User_message.command prog + ; Pp.text "isn't built yet. You need to build it first or remove the" + ; User_message.command "--no-build" + ; Pp.text "option." + ] + ] +;; + +let build_prog ~no_rebuild ~prog p = + if no_rebuild + then if Path.exists p then Memo.return p else program_not_built_yet prog + else + let open Memo.O in + let+ () = Build_system.build_file p in + p +;; + +let dir_of_context common sctx = + let context = Dune_rules.Super_context.context sctx in + Path.Build.relative (Context.build_dir context) (Common.prefix_target common "") +;; + +let get_path common sctx ~prog = + let open Memo.O in + let dir = dir_of_context common sctx in + match Filename.analyze_program_name prog with + | In_path -> + Super_context.resolve_program_memo sctx ~dir ~loc:None prog + >>= (function + | Error (_ : Action.Prog.Not_found.t) -> not_found_with_suggestions ~dir ~prog + | Ok p -> Memo.return p) + | Relative_to_current_dir -> + let path = Path.relative_to_source_in_build_or_external ~dir prog in + Build_system.file_exists path + >>= (function + | true -> Memo.return path + | false -> not_found_with_suggestions ~dir ~prog) + | Absolute -> + (match + let prog = Path.of_string prog in + if Path.exists prog + then Some prog + else if not Sys.win32 + then None + else ( + let prog = Path.extend_basename prog ~suffix:Bin.exe in + Option.some_if (Path.exists prog) prog) + with + | Some prog -> Memo.return prog + | None -> not_found_with_suggestions ~dir ~prog) +;; + +let get_path_and_build_if_necessary common sctx ~no_rebuild ~prog = + let open Memo.O in + let* path = get_path common sctx ~prog in + match Filename.analyze_program_name prog with + | In_path | Relative_to_current_dir -> build_prog ~no_rebuild ~prog path + | Absolute -> Memo.return path +;; + +let step ~prog ~args ~common ~no_rebuild ~context ~on_exit () = + let open Memo.O in + let* sctx = Super_context.find_exn context in + let* path = + let* prog = Cmd_arg.expand ~root:(Common.root common) ~sctx prog in + get_path_and_build_if_necessary common sctx ~no_rebuild ~prog + and* args = + Memo.parallel_map args ~f:(Cmd_arg.expand ~root:(Common.root common) ~sctx) + in + let* env = Super_context.context_env sctx in + Memo.of_non_reproducible_fiber + @@ Dune_engine.Process.run_inherit_std_in_out + ~dir:(Path.of_string Fpath.initial_cwd) + ~env + path + args + >>| function + | 0 -> () + | exit_code -> on_exit exit_code +;; + +(* Similar to [get_path_and_build_if_necessary] but doesn't require the build + system (ie. it sequences with [Fiber] rather than with [Memo]) and builds + targets via an RPC server. Some functionality is not available but it can be + run concurrently while a second Dune process holds the global build + directory lock. + + Returns the absolute path to the executable. *) +let build_prog_via_rpc_if_necessary ~dir ~no_rebuild prog = + match Filename.analyze_program_name prog with + | In_path -> + (* This case is reached if [dune exec] is passed the name of an + executable (rather than a path to an executable). When dune is running + directly, dune will try to resolve the executbale name within the public + executables defined in the current project and its dependencies, and + only if no executable with the given name is found will dune then + resolve the name within the $PATH variable instead. Looking up an + executable's name within the current project requires running the + build system, but running the build system is not allowed while + another dune instance holds the global build directory lock. In this + case dune will only resolve the executable's name within $PATH. + Because this behaviour is different from the default, print a warning + so users are hopefully less surprised. + *) + User_warning.emit + [ Pp.textf + "As this is not the main instance of Dune it is unable to locate the \ + executable %S within this project. Dune will attempt to resolve the \ + executable's name within your PATH only." + prog + ]; + let path = Env_path.path Env.initial in + (match Bin.which ~path prog with + | None -> not_found ~hints:[] ~prog + | Some prog_path -> Fiber.return (Path.to_absolute_filename prog_path)) + | Relative_to_current_dir -> + let open Fiber.O in + let path = Path.relative_to_source_in_build_or_external ~dir prog in + let+ () = + if no_rebuild + then if Path.exists path then Fiber.return () else program_not_built_yet prog + else ( + let target = + Dune_lang.Dep_conf.File + (Dune_lang.String_with_vars.make_text Loc.none (Path.to_string path)) + in + Build.build_via_rpc_server ~print_on_success:false ~targets:[ target ]) + in + Path.to_absolute_filename path + | Absolute -> + if Path.exists (Path.of_string prog) + then Fiber.return prog + else not_found ~hints:[] ~prog +;; + +let exec_building_via_rpc_server ~common ~prog ~args ~no_rebuild = + let open Fiber.O in + let ensure_terminal v = + match (v : Cmd_arg.t) with + | Terminal s -> s + | Expandable (_, raw) -> + (* Variables cannot be expanded without running the build system. *) + User_error.raise + [ Pp.textf + "The term %S contains a variable but Dune is unable to expand variables when \ + building via RPC." + raw + ] + in + let context = Common.x common |> Option.value ~default:Context_name.default in + let dir = Context_name.build_dir context in + let prog = ensure_terminal prog in + let args = List.map args ~f:ensure_terminal in + let+ prog = build_prog_via_rpc_if_necessary ~dir ~no_rebuild prog in + restore_cwd_and_execve (Common.root common) prog args Env.initial +;; + +let exec_building_directly ~common ~config ~context ~prog ~args ~no_rebuild = + match Common.watch common with + | Yes Passive -> + User_error.raise [ Pp.textf "passive watch mode is unsupported by exec" ] + | Yes Eager -> + Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config + @@ fun () -> + let open Fiber.O in + let on_exit = Console.printf "Program exited with code [%d]" in + Scheduler.Run.poll + @@ + let* () = Fiber.return @@ Scheduler.maybe_clear_screen ~details_hum:[] config in + build @@ step ~prog ~args ~common ~no_rebuild ~context ~on_exit + | No -> + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn (fun () -> + let open Memo.O in + let* sctx = setup >>| Import.Main.find_scontext_exn ~name:context in + let* env = Super_context.context_env sctx + and* prog = + let* prog = Cmd_arg.expand ~root:(Common.root common) ~sctx prog in + get_path_and_build_if_necessary common sctx ~no_rebuild ~prog >>| Path.to_string + and* args = + Memo.parallel_map ~f:(Cmd_arg.expand ~root:(Common.root common) ~sctx) args + in + restore_cwd_and_execve (Common.root common) prog args env) +;; + +let term : unit Term.t = + let+ builder = Common.Builder.term + and+ context = Common.context_arg ~doc:{|Run the command in this build context.|} + and+ prog = Arg.(required & pos 0 (some Cmd_arg.conv) None (Arg.info [] ~docv:"PROG")) + and+ no_rebuild = + Arg.(value & flag & info [ "no-build" ] ~doc:"don't rebuild target before executing") + and+ args = Arg.(value & pos_right 0 Cmd_arg.conv [] (Arg.info [] ~docv:"ARGS")) in + (* TODO we should make sure to finalize the current backend before exiting dune. + For watch mode, we should finalize the backend and then restart it in between + runs. *) + let common, config = Common.init builder in + match Dune_util.Global_lock.lock ~timeout:None with + | Error lock_held_by -> + (match Common.watch common with + | Yes _ -> + User_error.raise + [ Pp.textf + "Another instance of dune%s has locked the _build directory. Refusing to \ + start a new watch server until no other instances of dune are running." + (match lock_held_by with + | Unknown -> "" + | Pid_from_lockfile pid -> sprintf " (pid: %d)" pid) + ] + | No -> + if not (Common.Builder.equal builder Common.Builder.default) + then + User_warning.emit + [ Pp.textf + "Your build request is being forwarded to a running Dune instance%s. Note \ + that certain command line arguments may be ignored." + (match lock_held_by with + | Unknown -> "" + | Pid_from_lockfile pid -> sprintf " (pid: %d)" pid) + ]; + Scheduler.go_without_rpc_server ~common ~config + @@ fun () -> exec_building_via_rpc_server ~common ~prog ~args ~no_rebuild) + | Ok () -> exec_building_directly ~common ~config ~context ~prog ~args ~no_rebuild +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/exec.mli b/unikernel/duniverse/dune_/bin/exec.mli new file mode 100644 index 00000000..00ecf4c5 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/exec.mli @@ -0,0 +1,24 @@ +open Import + +module Cmd_arg : sig + type t + + val conv : t Arg.conv + val expand : t -> root:Workspace_root.t -> sctx:Super_context.t -> string Memo.t +end + +(** Returns the path to the executable [prog] as it will be resolved by dune: + - if [prog] is the name of an executable defined by the project then the path + to that executable will be returned, and evaluating the returned memo will + build the executable if necessary. + - otherwise if [prog] is the name of an executable in the "bin" directory of + a package in this project's dependency cone then the path to that executable + file will be returned. Note that for this reason all dependencies of the + project will be built when the returned memo is evaluated (unless the first + case is hit). + - otherwise if [prog] is the name of an executable in one of the directories + listed in the PATH environment variable, the path to that executable will be + returned. *) +val get_path : Common.t -> Super_context.t -> prog:string -> Path.t Memo.t + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/exit_code.ml b/unikernel/duniverse/dune_/bin/exit_code.ml new file mode 100644 index 00000000..3e300198 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/exit_code.ml @@ -0,0 +1,20 @@ +type t = + | Success + | Error + | Signal + +let all = [ Success; Error; Signal ] + +let code = function + | Success -> 0 + | Error -> 1 + | Signal -> 130 +;; + +let doc = function + | Success -> "on success." + | Error -> "if an error happened." + | Signal -> "if it was interrupted by a signal." +;; + +let info e = Cmdliner.Cmd.Exit.info (code e) ~doc:(doc e) diff --git a/unikernel/duniverse/dune_/bin/exit_code.mli b/unikernel/duniverse/dune_/bin/exit_code.mli new file mode 100644 index 00000000..49ea4a26 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/exit_code.mli @@ -0,0 +1,8 @@ +type t = + | Success + | Error + | Signal + +val all : t list +val info : t -> Cmdliner.Cmd.Exit.info +val code : t -> int diff --git a/unikernel/duniverse/dune_/bin/external_lib_deps.ml b/unikernel/duniverse/dune_/bin/external_lib_deps.ml new file mode 100644 index 00000000..f9d532a2 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/external_lib_deps.ml @@ -0,0 +1,28 @@ +open Import + +let doc = "Moved to dune describe external-lib-deps." + +let man = + [ `S "DESCRIPTION" + ; `P + "This subcommand used to print out an approximate set of external libraries that \ + were required for building a given set of targets, without running the build. \ + While this feature was useful, over time the quality of approximation had \ + degraded and the cost of maintenance had increased, so we decided to remove it.\n" + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "external-lib-deps" ~doc ~man + +let term = + Term.ret + @@ let+ _ = Common.Builder.term + and+ _ = Arg.(value & flag & info [ "missing" ] ~doc:{|unused|}) + and+ _ = Arg.(value & pos_all dep [] & Arg.info [] ~docv:"TARGET") + and+ _ = Arg.(value & flag & info [ "unstable-by-dir" ] ~doc:{|unused|}) + and+ _ = Arg.(value & flag & info [ "sexp" ] ~doc:{|unused|}) in + `Error (false, "This subcommand has been moved to dune describe external-lib-deps.") +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/external_lib_deps.mli b/unikernel/duniverse/dune_/bin/external_lib_deps.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/external_lib_deps.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/fmt.ml b/unikernel/duniverse/dune_/bin/fmt.ml new file mode 100644 index 00000000..3400ea2a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/fmt.ml @@ -0,0 +1,67 @@ +open Import + +let doc = "Format source code." + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune fmt) runs the formatter on the source code. The formatter is + automatically selected. ocamlformat is used to format OCaml source code + ( *.ml and *.mli files) and refmt is used to format Reason source code + ( *.re and *.rei files).|} + ; `Blocks Common.help_secs + ] +;; + +let lock_ocamlformat () = + if Lazy.force Lock_dev_tool.is_enabled + then + (* Note that generating the ocamlformat lockdir here means + that it will be created when a user runs `dune fmt` but not + when a user runs `dune build @fmt`. It's important that + this logic remain outside of `dune build`, as `dune + build` is intended to only build targets, and generating + a lockdir is not building a target. *) + Lock_dev_tool.lock_dev_tool Ocamlformat |> Memo.run + else Fiber.return () +;; + +let run_fmt_command ~(common : Common.t) ~config = + let open Fiber.O in + let once () = + let* () = lock_ocamlformat () in + let request (setup : Import.Main.build_system) = + let dir = Path.(relative root) (Common.prefix_target common ".") in + Alias.in_dir ~name:Dune_rules.Alias.fmt ~recursive:true ~contexts:setup.contexts dir + |> Alias.request + in + Build.run_build_system ~common ~request + >>| function + | Ok () -> () + | Error `Already_reported -> raise Dune_util.Report_error.Already_reported + in + Scheduler.go_with_rpc_server ~common ~config once +;; + +let command = + let term = + let+ builder = Common.Builder.term + and+ no_promote = + Arg.( + value + & flag + & info + [ "preview" ] + ~doc: + "Just print the changes that would be made without actually applying them. \ + This takes precedence over auto-promote as that flag is assumed for this \ + command.") + in + let builder = + Common.Builder.set_promote builder (if no_promote then Never else Automatically) + in + let common, config = Common.init builder in + run_fmt_command ~common ~config + in + Cmd.v (Cmd.info "fmt" ~doc ~man ~envs:Common.envs) term +;; diff --git a/unikernel/duniverse/dune_/bin/fmt.mli b/unikernel/duniverse/dune_/bin/fmt.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/fmt.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/format_dune_file.ml b/unikernel/duniverse/dune_/bin/format_dune_file.ml new file mode 100644 index 00000000..8a9d8b6a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/format_dune_file.ml @@ -0,0 +1,57 @@ +open Import + +let doc = "Format dune files." + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune format-dune-file) reads a dune file and outputs a formatted + version. This is a low-level command, meant to implement editor + support for example. To reformat a dune project, see the "Automatic + formatting" section in the manual.|} + ] +;; + +let info = Cmd.info "format-dune-file" ~doc ~man + +let format_file ~version ~input = + let with_input = + match input with + | Some path -> fun f -> Io.with_lexbuf_from_file path ~f + | None -> + fun f -> + Exn.protect + ~f:(fun () -> f (Lexing.from_channel stdin)) + ~finally:(fun () -> close_in_noerr stdin) + in + match with_input Dune_lang.Format.parse with + | Sexps sexps -> + Format.fprintf + Format.std_formatter + "%a%!" + Pp.to_fmt + (Dune_lang.Format.pp_top_sexps ~version sexps) + | OCaml_syntax loc -> + (match input with + | None -> User_error.raise ~loc [ Pp.text "OCaml syntax is not supported." ] + | Some path -> Io.with_file_in path ~f:(fun ic -> Io.copy_channels ic stdout)) +;; + +let term = + let+ path_opt = + let docv = "FILE" in + let doc = "Path to the dune file to parse." in + Arg.(value & pos 0 (some path) None & info [] ~docv ~doc) + and+ version = + let docv = "VERSION" in + let doc = "Which version of Dune language to use." in + let default = + Dune_lang.Syntax.greatest_supported_version_exn Dune_lang.Stanza.syntax + in + Arg.(value & opt version default & info [ "dune-version" ] ~docv ~doc) + in + let input = Option.map ~f:Arg.Path.path path_opt in + format_file ~version ~input +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/format_dune_file.mli b/unikernel/duniverse/dune_/bin/format_dune_file.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/format_dune_file.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/help.ml b/unikernel/duniverse/dune_/bin/help.ml new file mode 100644 index 00000000..a683b1bf --- /dev/null +++ b/unikernel/duniverse/dune_/bin/help.ml @@ -0,0 +1,128 @@ +open Import + +let config = + ( ("dune-config", 5, "", "Dune", "Dune manual") + , [ `S Manpage.s_name + ; `P {|dune-config - configuring the dune build system|} + ; `S Manpage.s_synopsis + ; `Pre "~/.config/dune/config" + ; `S Manpage.s_description + ; `P + {|Unless $(b,--no-config) or $(b,-p) is passed, Dune will read a + configuration file from the user home directory. This file is used + to control various aspects of the behavior of Dune.|} + ; `P + {|The configuration file is normally $(b,~/.config/dune/config) on + Unix systems and $(b,Local Settings/dune/config) in the User home + directory on Windows. However, it is possible to specify an + alternative configuration file with the $(b,--config-file) option.|} + ; `P + {|The first line of the file must be of the form (lang dune X.Y) + where X.Y is the version of the dune language used in the file.|} + ; `P + {|The rest of the file must be written in S-expression syntax and be + composed of a list of stanzas. The following sections describe + the stanzas available.|} + ; `S "CACHING" + ; `P {|Syntax: $(b,\(cache ENABLED\))|} + ; `P + {| This stanza determines whether dune's build caching is enabled. + See https://dune.readthedocs.io/en/stable/caching.html for details. + Valid values for $(b, ENABLED) are $(b, enabled) or $(b, disabled).|} + ; `S "DISPLAY MODES" + ; `P {|Syntax: $(b,\(display MODE\))|} + ; `P + {|This stanza controls how Dune reports what it is doing to the user. + This parameter can also be set from the command line via $(b,--display MODE). + The following display modes are available:|} + ; `Blocks + (List.map + ~f:(fun (x, desc) -> `I (sprintf "$(b,%s)" x, desc)) + [ ( "progress" + , {|This is the default, Dune shows and update a + status line as build goals are being completed.|} + ) + ; "quiet", {|Only display errors.|} + ; ( "short" + , {|Print one line per command being executed, with the + binary name on the left and the reason it is being executed for + on the right.|} + ) + ; ( "verbose" + , {|Print the full command lines of programs being + executed by Dune, with some colors to help differentiate + programs.|} + ) + ]) + ; `P + {|Note that when the selected display mode is $(b,progress) and the + output is not a terminal then the $(b,quiet) mode is selected + instead. This rule doesn't apply when running Dune inside Emacs. + Dune detects whether it is executed from inside Emacs or not by + looking at the environment variable $(b,INSIDE_EMACS) that is set by + Emacs. If you want the same behavior with another editor, you can set + this variable. If your editor already sets another variable, + please open a ticket on the ocaml/dune GitHub project so that we can + add support for it.|} + ; `S "JOBS" + ; `P {|Syntax: $(b,\(jobs NUMBER\))|} + ; `P + {|Set the maximum number of jobs Dune might run in parallel. + This can also be set from the command line via $(b,-j NUMBER).|} + ; `P {|The default for this value is the number of processors.|} + ; `S "SANDBOXING" + ; `P {|Syntax: $(b,\(sandboxing_preference MODE ...\))|} + ; `P + {|Controls the sandboxing mode preference order used by dune. Dune will +use the earliest item from this list that's allowed by the action dependency +specification, or fall back on the hard-coded default. See $(b,man dune-build) + for the description of individual modes.|} + ; Common.footer + ] ) +;; + +type what = + | Man of Manpage.t + | List_topics + +let commands = [ "config", Man config; "topics", List_topics ] +let doc = "Additional Dune help." + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune help TOPIC) provides additional help on the given topic. + The following topics are available:|} + ; `Blocks + (List.concat_map commands ~f:(fun (s, what) -> + match what with + | List_topics -> [] + | Man ((title, _, _, _, _), _) -> [ `I (sprintf "$(b,%s)" s, title) ])) + ; Common.footer + ] +;; + +let info = Cmd.info "help" ~doc ~man ~envs:Common.envs + +let term = + Term.ret + @@ let+ man_format = Arg.man_format + and+ what = Arg.(value & pos 0 (some (enum commands)) None & info [] ~docv:"TOPIC") + and+ () = Common.build_info in + match what with + | None -> `Help (man_format, Some "help") + | Some (Man man_page) -> + Format.printf "%a@?" (Manpage.print man_format) man_page; + `Ok () + | Some List_topics -> + List.filter_map commands ~f:(fun (s, what) -> + match what with + | List_topics -> None + | _ -> Some s) + |> List.sort ~compare:String.compare + |> String.concat ~sep:"\n" + |> print_endline; + `Ok () +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/help.mli b/unikernel/duniverse/dune_/bin/help.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/help.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/import.ml b/unikernel/duniverse/dune_/bin/import.ml new file mode 100644 index 00000000..bdf6682e --- /dev/null +++ b/unikernel/duniverse/dune_/bin/import.ml @@ -0,0 +1,288 @@ +include Stdune +include Dune_config_file +include Dune_vcs + +include struct + open Dune_engine + module Build_config = Build_config + module Build_system = Build_system + module Build_system_error = Build_system_error + module Load_rules = Load_rules + module Hooks = Hooks + module Action_builder = Dune_rules.Action_builder + module Action = Action + module Dep = Dep + module Action_to_sh = Action_to_sh + module Dpath = Dpath + module Findlib = Dune_rules.Findlib + module Diff_promotion = Diff_promotion + module Targets = Targets + module Context_name = Context_name +end + +module Cached_digest = Dune_digest.Cached_digest + +include struct + open Source + module Source_tree = Source_tree + module Source_dir_status = Source_dir_status + module Workspace = Workspace +end + +include struct + open Dune_rules + module Super_context = Super_context + module Context = Context + module Dune_package = Dune_package + module Resolve = Resolve + module Dune_file = Dune_file + module Library = Library + module Melange = Melange + module Melange_stanzas = Melange_stanzas + module Executables = Executables +end + +include struct + open Cmdliner + module Term = Term + module Manpage = Manpage + + module Cmd = struct + include Cmd + + let default_exits = List.map ~f:Exit_code.info Exit_code.all + + let info ?docs ?doc ?man ?envs ?version name = + info ?docs ?doc ?man ?envs ?version ~exits:default_exits name + ;; + end +end + +module Digest = Dune_digest +module Metrics = Dune_metrics +module Console = Dune_console + +include struct + open Dune_lang + module Stanza = Stanza + module Profile = Profile + module Lib_name = Lib_name + module Package_name = Package_name + module Package = Package + module Package_version = Package_version + module Source_kind = Source_kind + module Package_info = Package_info + module Section = Section + module Dune_project_name = Dune_project_name + module Dune_project = Dune_project +end + +module Log = Dune_util.Log +module Dune_rpc = Dune_rpc_private +module Graph = Dune_graph.Graph +include Common.Let_syntax + +module Main : sig + include module type of struct + include Dune_rules.Main + end + + val setup : unit -> build_system Memo.t Fiber.t +end = struct + include Dune_rules.Main + + let setup () = + let open Fiber.O in + let* scheduler = Dune_engine.Scheduler.t () in + Console.Status_line.set + (Live + (fun () -> + match Fiber.Svar.read Build_system.state with + | Initializing + | Restarting_current_build + | Build_succeeded__now_waiting_for_changes + | Build_failed__now_waiting_for_changes -> Pp.nop + | Building + { Build_system.Progress.number_of_rules_executed = done_ + ; number_of_rules_discovered = total + ; number_of_rules_failed = failed + } -> + Pp.verbatim + (sprintf + "Done: %u%% (%u/%u, %u left%s) (jobs: %u)" + (if total = 0 then 0 else done_ * 100 / total) + done_ + total + (total - done_) + (if failed = 0 then "" else sprintf ", %u failed" failed) + (Dune_engine.Scheduler.running_jobs_count scheduler)))); + Fiber.return (Memo.of_thunk get) + ;; +end + +module Scheduler = struct + include Dune_engine.Scheduler + + let maybe_clear_screen ~details_hum (dune_config : Dune_config.t) = + match Execution_env.inside_dune with + | true -> (* Don't print anything here to make tests less verbose *) () + | false -> + (match dune_config.terminal_persistence with + | Clear_on_rebuild -> Console.reset () + | Clear_on_rebuild_and_flush_history -> Console.reset_flush_history () + | Preserve -> + let message = + sprintf + "********** NEW BUILD (%s) **********" + (String.concat ~sep:", " details_hum) + in + Console.print_user_message + (User_message.make + [ Pp.nop; Pp.tag User_message.Style.Success (Pp.verbatim message); Pp.nop ])) + ;; + + let on_event dune_config _config = function + | Run.Event.Tick -> Console.Status_line.refresh () + | Source_files_changed { details_hum } -> maybe_clear_screen ~details_hum dune_config + | Build_interrupted -> + Console.Status_line.set + (Live + (fun () -> + let progression = + match Fiber.Svar.read Build_system.state with + | Initializing + | Restarting_current_build + | Build_succeeded__now_waiting_for_changes + | Build_failed__now_waiting_for_changes -> Build_system.Progress.init + | Building progress -> progress + in + Pp.seq + (Pp.tag User_message.Style.Error (Pp.verbatim "Source files changed")) + (Pp.verbatim + (sprintf + ", restarting current build... (%u/%u)" + progression.number_of_rules_executed + progression.number_of_rules_discovered)))) + | Build_finish build_result -> + let message = + match build_result with + | Success -> Pp.tag User_message.Style.Success (Pp.verbatim "Success") + | Failure -> + let failure_message = + match + Build_system_error.( + Id.Map.cardinal (Set.current (Fiber.Svar.read Build_system.errors))) + with + | 1 -> Pp.textf "Had 1 error" + | n -> Pp.textf "Had %d errors" n + in + Pp.tag User_message.Style.Error failure_message + in + Console.Status_line.set + (Constant (Pp.seq message (Pp.verbatim ", waiting for filesystem changes..."))) + ;; + + let rpc server = + { Dune_engine.Rpc.run = Dune_rpc_impl.Server.run server + ; stop = Dune_rpc_impl.Server.stop server + ; ready = Dune_rpc_impl.Server.ready server + } + ;; + + let go_without_rpc_server ~(common : Common.t) ~config:dune_config f = + let stats = Common.stats common in + let config = + let watch_exclusions = Common.watch_exclusions common in + Dune_config.for_scheduler + dune_config + stats + ~print_ctrl_c_warning:true + ~watch_exclusions + in + Dune_rules.Clflags.concurrency := config.concurrency; + Run.go config ~on_event:(on_event dune_config) f + ;; + + let go_with_rpc_server ~common ~config f = + let f = + match Common.rpc common with + | `Allow server -> fun () -> Dune_engine.Rpc.with_background_rpc (rpc server) f + | `Forbid_builds -> f + in + go_without_rpc_server ~common ~config f + ;; + + let go_with_rpc_server_and_console_status_reporting + ~(common : Common.t) + ~config:dune_config + run + = + let server = + match Common.rpc common with + | `Allow server -> rpc server + | `Forbid_builds -> Code_error.raise "rpc must be enabled in polling mode" [] + in + let stats = Common.stats common in + let config = + let watch_exclusions = Common.watch_exclusions common in + Dune_config.for_scheduler + dune_config + stats + ~print_ctrl_c_warning:true + ~watch_exclusions + in + Dune_rules.Clflags.concurrency := config.concurrency; + let file_watcher = Common.file_watcher common in + let run () = + let open Fiber.O in + Dune_engine.Rpc.with_background_rpc server + @@ fun () -> + let* () = Dune_engine.Rpc.ensure_ready () in + run () + in + Run.go config ~file_watcher ~on_event:(on_event dune_config) run + ;; +end + +let string_path_relative_to_specified_root (root : Workspace_root.t) path = + if Filename.is_relative path then Filename.concat root.dir path else path +;; + +let restore_cwd_and_execve root prog args env = + let prog = string_path_relative_to_specified_root root prog in + Proc.restore_cwd_and_execve prog args ~env +;; + +(* Adapted from + https://github.com/ocaml/opam/blob/fbbe93c3f67034da62d28c8666ec6b05e0a9b17c/src/client/opamArg.ml#L759 *) +let command_alias ?orig_name cmd term name = + let orig = + match orig_name with + | Some s -> s + | None -> Cmd.name cmd + in + let doc = Printf.sprintf "An alias for $(b,%s)." orig in + let man = + [ `S "DESCRIPTION" + ; `P (Printf.sprintf "$(mname)$(b, %s) is an alias for $(mname)$(b, %s)." name orig) + ; `P (Printf.sprintf "See $(mname)$(b, %s --help) for details." orig) + ; `Blocks Common.help_secs + ] + in + Cmd.v (Cmd.info name ~docs:"COMMAND ALIASES" ~doc ~man) term +;; + +(* The build system has some global state which makes it unsafe for + multiple instances of it to be executed concurrently, so we ensure + serialization by holding this mutex while running the build system. *) +let build_system_mutex = Fiber.Mutex.create () + +let build f = + Hooks.End_of_build.once Promote.Diff_promotion.finalize; + Fiber.Mutex.with_lock build_system_mutex ~f:(fun () -> Build_system.run f) +;; + +let build_exn f = + Hooks.End_of_build.once Promote.Diff_promotion.finalize; + Fiber.Mutex.with_lock build_system_mutex ~f:(fun () -> Build_system.run_exn f) +;; diff --git a/unikernel/duniverse/dune_/bin/init.ml b/unikernel/duniverse/dune_/bin/init.ml new file mode 100644 index 00000000..3ae69d9a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/init.ml @@ -0,0 +1,341 @@ +open Import +open Dune_init + +(** {1 Helper functions} *) + +(** {2 Cmdliner Argument Converters} *) + +let atom_parser s = + match Dune_lang.Atom.parse s with + | Some s -> Ok s + | None -> Error (`Msg "expected a valid dune atom") +;; + +let atom_printer ppf a = Format.pp_print_string ppf (Dune_lang.Atom.to_string a) + +let component_name_parser s = + (* TODO refactor to use Lib_name.Local.conv *) + let err_msg () = + User_error.make + [ Pp.textf "invalid component name `%s'" s; Lib_name.Local.valid_format_doc ] + |> User_message.to_string + |> fun m -> `Msg m + in + let open Result.O in + let* atom = atom_parser s in + let* _ = + match Lib_name.Local.of_string_opt s with + | None -> Error (err_msg ()) + | Some s -> Ok s + in + Ok atom +;; + +let project_name_parser s = + (* TODO refactor Dune_project_name to be Stringlike *) + match Dune_project_name.named Loc.none s with + | v -> Ok v + | exception User_error.E _ -> + User_error.make + [ Pp.textf "invalid project name `%s'" s + ; Pp.text + "Project names must start with a letter and be composed only of letters, \ + numbers, '-' or '_'" + ] + |> User_message.to_string + |> fun m -> Error (`Msg m) +;; + +let project_name_printer ppf p = + Format.pp_print_string ppf (Dune_project_name.to_string_hum p) +;; + +let atom_conv = Arg.conv (atom_parser, atom_printer) +let component_name_conv = Arg.conv (component_name_parser, atom_printer) +let project_name_conv = Arg.conv (project_name_parser, project_name_printer) + +(** {2 Status reporting} *) + +let print_completion kind name = + let open Pp.O in + Console.print_user_message + (User_message.make + [ Pp.tag User_message.Style.Ok (Pp.verbatim "Success") + ++ Pp.textf ": initialized %s component named " kind + ++ Pp.tag User_message.Style.Kwd (Pp.verbatim (Dune_lang.Atom.to_string name)) + ]) +;; + +(** {1 CLI} *) + +let path = + let docv = "PATH" in + Arg.(value & pos 1 (some string) None & info [] ~docv) +;; + +let context_cwd : Init_context.t Term.t = + let+ builder = Common.Builder.term + and+ path = path in + let builder = Common.Builder.set_default_root_is_cwd builder true in + let common, config = Common.init builder in + let project_defaults = config.project_defaults in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + Memo.run (Init_context.make path project_defaults)) +;; + +module Public_name = struct + type t = + | Use_name + | Public_name of Public_name.t + + let public_name_to_string = function + | Use_name -> "" + | Public_name p -> Public_name.to_string p + ;; + + let public_name default_name = function + | None -> None + | Some Use_name -> Some (Public_name.of_name_exn default_name) + | Some (Public_name n) -> Some n + ;; + + let conv = + let parser s = + if String.is_empty s + then Ok Use_name + else ( + match Public_name.of_string_user_error (Loc.none, s) with + | Ok n -> Ok (Public_name n) + | Error e -> Error (`Msg (User_message.to_string e))) + in + let printer ppf public_name = + Format.pp_print_string ppf (public_name_to_string public_name) + in + Arg.conv (parser, printer) + ;; +end + +let libraries = + let docv = "LIBRARIES" in + let doc = "A comma separated list of libraries on which the component depends" in + Arg.(value & opt (list atom_conv) [] & info [ "libs" ] ~docv ~doc) +;; + +let pps = + let docv = "PREPROCESSORS" in + let doc = "A comma separated list of ppx preprocessors used by the component" in + Arg.(value & opt (list atom_conv) [] & info [ "ppx" ] ~docv ~doc) +;; + +let public : Public_name.t option Term.t = + let docv = "PUBLIC_NAME" in + let doc = + "If called with an argument, make the component public under the given PUBLIC_NAME. \ + If supplied without an argument, use NAME." + in + Arg.( + value + & opt ~vopt:(Some Public_name.Use_name) (some Public_name.conv) None + & info [ "public" ] ~docv ~doc) +;; + +let common : Component.Options.Common.t Term.t = + let+ name = + let docv = "NAME" in + Arg.(required & pos 0 (some component_name_conv) None & info [] ~docv) + and+ public = public + and+ libraries = libraries + and+ pps = pps in + let public = Public_name.public_name name public in + { Component.Options.Common.name; public; libraries; pps } +;; + +let project_common : Component.Options.Common.t Term.t = + let+ project_name = + let docv = "NAME" in + Arg.(required & pos 0 (some project_name_conv) None & info [] ~docv) + and+ libraries = libraries + and+ pps = pps in + let public = Dune_project_name.to_string_hum project_name in + let name = + String.map + ~f:(function + | '-' -> '_' + | c -> c) + public + |> Dune_lang.Atom.of_string + in + let public = + Some (Dune_lang.Atom.of_string public |> Dune_init.Public_name.of_name_exn) + in + { Component.Options.Common.name; public; libraries; pps } +;; + +let inline_tests : bool Term.t = + let docv = "USE_INLINE_TESTS" in + let doc = + "Whether to use inline tests. Only applicable for $(b,library) and $(b,project) \ + components." + in + Arg.(value & flag & info [ "inline-tests" ] ~docv ~doc) +;; + +let opt_default ~default term = Term.(const (Option.value ~default) $ term) + +let executable = + let doc = "A binary executable." in + let man = [] in + let kind = "executable" in + Cmd.v (Cmd.info kind ~doc ~man) + @@ let+ context = context_cwd + and+ common = common in + Component.init (Executable { context; common; options = () }); + print_completion kind common.name +;; + +let library = + let doc = "An OCaml library." in + let man = [] in + let kind = "library" in + Cmd.v (Cmd.info kind ~doc ~man) + @@ let+ context = context_cwd + and+ common = common + and+ inline_tests = inline_tests in + Component.init (Library { context; common; options = { inline_tests } }); + print_completion kind common.name +;; + +let test = + let doc = + "A test harness. (For inline tests, use the $(b,--inline-tests) flag along with the \ + other component kinds.)" + in + let man = [] in + let kind = "test" in + Cmd.v (Cmd.info kind ~doc ~man) + @@ let+ context = context_cwd + and+ common = common in + Component.init (Test { context; common; options = () }); + print_completion kind common.name +;; + +let project = + let module Builder = Common.Builder in + let doc = + "A project is a predefined composition of components arranged in a standard \ + directory structure. The kind of project initialized is determined by the value of \ + the $(b,--kind) flag and defaults to an executable project, composed of a library, \ + an executable, and a test component." + in + let man = [] in + Cmd.v (Cmd.info "project" ~doc ~man) + @@ let+ common_builder = Builder.term + and+ path = path + and+ common = project_common + and+ inline_tests = inline_tests + and+ template = + let docv = "PROJECT_KIND" in + let doc = + "The kind of project to initialize. Valid options are $(b,e[xecutable]) or \ + $(b,l[ibrary]). Defaults to $(b,executable). Only applicable for $(b,project) \ + components." + in + opt_default + ~default:Component.Options.Project.Template.Exec + Arg.( + value + & opt (some (enum Component.Options.Project.Template.commands)) None + & info [ "kind" ] ~docv ~doc) + and+ pkg = + let docv = "PACKAGE_MANAGER" in + let doc = + "Which package manager to use. Valid options are $(b,o[pam]) or $(b,e[sy]). \ + Defaults to $(b,opam). Only applicable for $(b,project) components." + in + opt_default + ~default:Component.Options.Project.Pkg.Opam + Arg.( + value + & opt (some (enum Component.Options.Project.Pkg.commands)) None + & info [ "pkg" ] ~docv ~doc) + in + let name = + match common.public with + | None -> Dune_lang.Atom.to_string common.name + | Some public -> Dune_init.Public_name.to_string public + in + let context = + let init_context = Init_context.make path in + let root = + match path with + (* If a path is given, we use that for the root during project + initialization, creating the path to it if needed. *) + | Some path -> path + (* Otherwise we will use the project's given name, and create a + directory accordingly. *) + | None -> name + in + let builder = Builder.set_root common_builder root in + let (_ : Fpath.mkdir_p_result) = Fpath.mkdir_p root in + let common, config = Common.init builder in + let project_defaults = config.project_defaults in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + Memo.run @@ init_context project_defaults) + in + Component.init + (Project { context; common; options = { template; inline_tests; pkg } }); + print_completion "project" (Dune_lang.Atom.of_string name) +;; + +let group = + let doc = "Command group for initializing Dune components." in + let synopsis = + Common.command_synopsis + [ "init project NAME [PATH] [OPTION]... " + ; "init executable NAME [PATH] [OPTION]... " + ; "init library NAME [PATH] [OPTION]... " + ; "init test NAME [PATH] [OPTION]... " + ] + in + let man = + [ `Blocks synopsis + ; `S "DESCRIPTION" + ; `P + {|$(b,dune init COMPONENT NAME [PATH] [OPTION]...) initializes a new dune + configuration for a component of the kind specified by the subcommand + $(b,COMPONENT), named $(b,NAME), with fields determined by the supplied + $(b,OPTION)s.|} + ; `P + {|Run a subcommand with $(b, --help) for for details on it's supported arguments|} + ; `P + {|If the optional $(b,PATH) is provided, it must be a path to a directory, and + the component will be created there. Otherwise, it is created in a child of the + current working directory, called $(b, NAME). To initialize a component in the + current working directory, use `.` as the $(b,PATH).|} + ; `P + {|Any prefix of a $(b,COMMAND)'s name can be supplied in place of + full name (as illustrated in the synopsis).|} + ; `P + {|For more details, see https://dune.readthedocs.io/en/stable/usage.html#initializing-components|} + ; Common.examples + [ ( {|Generate a project skeleton for an executable named `myproj' in a + new directory named `myproj', depending on the bos library and + using inline tests along with ppx_inline_test |} + , {|dune init project myproj --libs bos --ppx ppx_inline_test --inline-tests|} ) + ; ( {|Configure an executable component named `myexe' in a dune file in the + current directory|} + , {|dune init executable myexe|} ) + ; ( {|Configure a library component named `mylib' in a dune file in the ./src + directory depending on the core and cmdliner libraries, the ppx_let + and ppx_inline_test preprocessors, and declared as using inline + tests|} + , {|dune init library mylib src --libs core,cmdliner --ppx ppx_let,ppx_inline_test --inline-tests|} + ) + ; ( {|Configure a test component named `mytest' in a dune file in the + ./test directory that depends on `mylib'|} + , {|dune init test mytest test --libs mylib|} ) + ] + ] + in + Cmd.group (Cmd.info "init" ~doc ~man) [ executable; project; library; test ] +;; diff --git a/unikernel/duniverse/dune_/bin/init.mli b/unikernel/duniverse/dune_/bin/init.mli new file mode 100644 index 00000000..d4c5902f --- /dev/null +++ b/unikernel/duniverse/dune_/bin/init.mli @@ -0,0 +1,3 @@ +open Import + +val group : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/install_uninstall.ml b/unikernel/duniverse/dune_/bin/install_uninstall.ml new file mode 100644 index 00000000..20747da8 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/install_uninstall.ml @@ -0,0 +1,856 @@ +open Import +module Artifact_substitution = Dune_rules.Artifact_substitution + +let synopsis = + [ `P "The installation directories used are defined by priority:" + ; `Noblank + ; `P + "- directories set on the command line of $(i,dune install), or corresponding \ + environment variables" + ; `Noblank + ; `P + "- directories set in dune binary. They are setup before the compilation of dune \ + with $(i,./configure)" + ; `Noblank + ; `P "- inferred from the environment variable $(i,OPAM_SWITCH_PREFIX) if present" + ] +;; + +let print_line ~(verbosity : Dune_engine.Display.t) fmt = + Printf.ksprintf + (fun s -> + match verbosity with + | Quiet -> () + | _ -> Console.print [ Pp.verbatim s ]) + fmt +;; + +let interpret_destdir ~destdir path = + match destdir with + | None -> path + | Some destdir -> Path.append_local destdir (Path.local_part path) +;; + +let get_dirs context ~prefix_from_command_line ~from_command_line = + let open Fiber.O in + let module Roots = Install.Roots in + let prefix_from_command_line = Option.map ~f:Path.of_string prefix_from_command_line in + let+ roots = + match prefix_from_command_line with + | None -> Memo.run (Context.roots context) + | Some prefix -> + Roots.opam_from_prefix prefix ~relative:Path.relative + |> Roots.map ~f:(fun s -> Some s) + |> Fiber.return + in + let roots = Roots.first_has_priority from_command_line roots in + let must_be_defined name v = + match v with + | Some v -> v + | None -> + (* We suggest that the user sets --prefix first rather than the specific + missing option, since this is the most common case. *) + User_error.raise + [ Pp.textf "The %s installation directory is unknown." name ] + ~hints: + [ Pp.concat + ~sep:Pp.space + [ Pp.text "It can be specified with" + ; User_message.command "--prefix" + ; Pp.textf "or by setting" + ; User_message.command (sprintf "--%s" name) + ] + |> Pp.hovbox + ] + in + { Roots.lib_root = must_be_defined "libdir" roots.lib_root + ; libexec_root = must_be_defined "libexecdir" roots.libexec_root + ; bin = must_be_defined "bindir" roots.bin + ; sbin = must_be_defined "sbindir" roots.sbin + ; etc_root = must_be_defined "etcdir" roots.etc_root + ; doc_root = must_be_defined "docdir" roots.doc_root + ; share_root = must_be_defined "datadir" roots.share_root + ; man = must_be_defined "mandir" roots.man + } +;; + +module Workspace = struct + type t = + { packages : Package.t Package.Name.Map.t + ; contexts : Context.t list + } + + let get () = + let open Memo.O in + Memo.run + (let+ packages = Dune_rules.Dune_load.packages () + and+ contexts = Context.DB.all () in + { packages; contexts }) + ;; + + let package_install_file t ~findlib_toolchain pkg = + match Package.Name.Map.find t.packages pkg with + | None -> Error () + | Some p -> + let name = Package.name p in + let dir = Package.dir p in + Ok + (Path.Source.relative + dir + (Dune_rules.Install_rules.install_file ~package:name ~findlib_toolchain)) + ;; +end + +let resolve_package_install workspace ~findlib_toolchain pkg = + match Workspace.package_install_file workspace ~findlib_toolchain pkg with + | Ok path -> path + | Error () -> + let pkg = Package.Name.to_string pkg in + User_error.raise + [ Pp.textf "Unknown package %s!" pkg ] + ~hints: + (User_message.did_you_mean + pkg + ~candidates: + (Package.Name.Map.keys workspace.packages + |> List.map ~f:Package.Name.to_string)) +;; + +let print_unix_error f = + try f () with + | Unix.Unix_error (error, syscall, arg) -> + let error = Unix_error.Detailed.create error ~syscall ~arg in + User_message.prerr (User_error.make [ Unix_error.Detailed.pp error ]) +;; + +module Special_file = struct + type t = + | META + | Dune_package + + let of_entry (e : _ Install.Entry.t) = + match e.section with + | Lib -> + let dst = Install.Entry.Dst.to_string e.dst in + if dst = Dune_findlib.Findlib.Package.meta_fn + then Some META + else if dst = Dune_package.fn + then Some Dune_package + else None + | _ -> None + ;; +end + +type copy_kind = + | Substitute (** Use [Artifact_substitution.copy_file]. Will scan all bytes. *) + | Special of Special_file.t (** Hooks to add version numbers, replace sections, etc *) + +type rmdir_mode = + | Fail + | Warn + +(** Operations that act on real files or just pretend to (for --dry-run) *) +module type File_operations = sig + val copy_file + : src:Path.t + -> dst:Path.t + -> executable:bool + -> kind:copy_kind + -> package:Package.Name.t + -> conf:Artifact_substitution.Conf.t + -> unit Fiber.t + + val mkdir_p : Path.t -> unit + val remove_file_if_exists : Path.t -> unit + val remove_dir_if_exists : if_non_empty:rmdir_mode -> Path.t -> unit +end + +module File_ops_dry_run (Verbosity : sig + val verbosity : Dune_engine.Display.t + end) : File_operations = struct + open Verbosity + + let print_line fmt = print_line ~verbosity fmt + + let copy_file ~src ~dst ~executable ~kind:_ ~package:_ ~conf:_ = + print_line + "Copying %s to %s (executable: %b)" + (Path.to_string_maybe_quoted src) + (Path.to_string_maybe_quoted dst) + executable; + Fiber.return () + ;; + + let mkdir_p path = print_line "Creating directory %s" (Path.to_string_maybe_quoted path) + + let remove_file_if_exists path = + print_line "Removing (if it exists) %s" (Path.to_string_maybe_quoted path) + ;; + + let remove_dir_if_exists ~if_non_empty path = + print_line + "Removing directory (%s if not empty) %s" + (match if_non_empty with + | Fail -> "fail" + | Warn -> "warn") + (Path.to_string_maybe_quoted path) + ;; +end + +module File_ops_real (W : sig + val verbosity : Dune_engine.Display.t + val workspace : Workspace.t + end) : File_operations = struct + open W + + let print_line = print_line ~verbosity + let get_vcs p = Source_tree.nearest_vcs p + + type copy_special_file_status = + | Done + | Use_plain_copy + + let with_ppf oc ~f = + let ppf = Format.formatter_of_out_channel oc in + f ppf; + Format.pp_print_flush ppf () + ;; + + let copy_special_file ~src ~package ~ic ~oc ~f = + let open Fiber.O in + let get_version () = + let* packages = + match Package.Name.Map.find workspace.packages package with + | None -> Fiber.return None + | Some package -> Memo.run (get_vcs (Package.dir package)) + in + match packages with + | None -> Fiber.return None + | Some vcs -> Memo.run (Vcs.describe vcs) + in + try f ~get_version ic ~src oc with + | _ (* XXX should we really be catching everything here? *) -> + User_warning.emit + ~loc:(Loc.in_file src) + [ Pp.text "Failed to parse file, not adding version and locations information." ]; + Fiber.return Use_plain_copy + ;; + + let process_meta ~get_version ic ~src:_ oc = + let module Meta = Dune_findlib.Findlib.Meta in + let lb = Lexing.from_channel ic in + let meta : Meta.t = { name = None; entries = Meta.parse_entries lb } in + let need_more_versions = + try + let (_ : Meta.t) = + Meta.add_versions meta ~get_version:(fun _ -> raise_notrace Exit) + in + false + with + | Exit -> true + in + if not need_more_versions + then Fiber.return Use_plain_copy + else + let open Fiber.O in + let+ version = get_version () in + with_ppf oc ~f:(fun ppf -> + let meta = Meta.add_versions meta ~get_version:(fun _ -> version) in + Pp.to_fmt ppf (Meta.pp meta.entries)); + Done + ;; + + let process_dune_package ~get_version ~get_location ic ~src oc = + let lb = Lexing.from_channel ic in + let dune_version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in + match Dune_package.Or_meta.parse src lb |> User_error.ok_exn with + | Use_meta -> + with_ppf oc ~f:(Dune_package.Or_meta.pp_use_meta ~dune_version); + Fiber.return Done + | Dune_package dp -> + let open Fiber.O in + (* replace sites with external path in the file *) + let dp, replace_info = Dune_package.replace_site_sections ~get_location dp in + (* replace version if needed in the file *) + let need_version = Option.is_none dp.version in + let+ dp = + if need_version + then + let+ version_opt = get_version () in + match version_opt with + | Some version -> { dp with version = Some (Package_version.of_string version) } + | None -> dp + else Fiber.return dp + in + with_ppf oc ~f:(fun ppf -> + (* CR-emillon: we should write absolute paths only if necessary *) + Dune_package.Or_meta.pp + ~dune_version + ppf + (Dune_package dp) + ~encoding:(Absolute replace_info)); + Done + ;; + + let copy_file + ~src + ~dst + ~executable + ~kind + ~package + ~(conf : Artifact_substitution.Conf.t) + = + let chmod = if executable then fun _ -> 0o755 else fun _ -> 0o644 in + let plain_copy () = Io.copy_file ~chmod ~src ~dst () in + match kind with + | Substitute -> Artifact_substitution.copy_file ~conf ~src ~dst ~chmod () + | Special sf -> + let open Fiber.O in + let ic, oc = Io.setup_copy ~chmod ~src ~dst () in + let+ status = + Fiber.finalize + ~finally:(fun () -> + Io.close_both (ic, oc); + Fiber.return ()) + (fun () -> + let f = + match sf with + | META -> process_meta + | Dune_package -> + process_dune_package + ~get_location:(Artifact_substitution.Conf.get_location conf) + in + copy_special_file ~src ~package ~ic ~oc ~f) + in + (match status with + | Done -> () + | Use_plain_copy -> plain_copy ()) + ;; + + let remove_file_if_exists dst = + if Path.exists dst + then ( + print_line "Deleting %s" (Path.to_string_maybe_quoted dst); + print_unix_error (fun () -> Path.unlink_exn dst)) + ;; + + let remove_dir_if_exists ~if_non_empty dir = + match Path.readdir_unsorted dir with + | Error (Unix.ENOENT, _, _) -> () + | Ok [] -> + print_line "Deleting empty directory %s" (Path.to_string_maybe_quoted dir); + print_unix_error (fun () -> Path.rmdir dir) + | Error (e, _, _) -> + User_message.prerr (User_error.make [ Pp.text (Unix.error_message e) ]) + | _ -> + let dir = Path.to_string_maybe_quoted dir in + (match if_non_empty with + | Warn -> + User_message.prerr + (User_error.make + [ Pp.textf "Directory %s is not empty, cannot delete (ignoring)." dir ]) + | Fail -> + User_error.raise + [ Pp.textf "Please delete non-empty directory %s manually." dir ]) + ;; + + let mkdir_p p = + (* CR-someday amokhov: We should really change [Path.mkdir_p dir] to fail if + it turns out that [dir] exists and is not a directory. Even better, make + [Path.mkdir_p] return an explicit variant to deal with. *) + match Fpath.mkdir_p (Path.to_string p) with + | Created -> () + | Already_exists -> + (match Path.is_directory p with + | true -> () + | false -> + User_error.raise + [ Pp.textf "Please delete file %s manually." (Path.to_string_maybe_quoted p) ]) + ;; +end + +module Sections = struct + type t = + | All + | Only of Section.Set.t + + let sections_conv = + let all = + Section.all + |> Section.Set.to_list + |> List.map ~f:(fun section -> Section.to_string section, section) + in + Arg.list ~sep:',' (Arg.enum all) + ;; + + let term = + let doc = "sections that should be installed" in + let open Cmdliner.Arg in + let+ sections = value & opt (some sections_conv) None & info [ "sections" ] ~doc in + match sections with + | None -> All + | Some sections -> Only (Section.Set.of_list sections) + ;; + + let should_install t section = + match t with + | All -> true + | Only set -> Section.Set.mem set section + ;; +end + +let file_operations ~verbosity ~dry_run ~workspace : (module File_operations) = + if dry_run + then + (module File_ops_dry_run (struct + let verbosity = verbosity + end)) + else + (module File_ops_real (struct + let workspace = workspace + let verbosity = verbosity + end)) +;; + +let package_is_vendored (pkg : Package.t) = + let dir = Package.dir pkg in + Memo.run (Source_tree.is_vendored dir) +;; + +type what = + | Install + | Uninstall + +let pp_what fmt = function + | Install -> Format.pp_print_string fmt "Install" + | Uninstall -> Format.pp_print_string fmt "Uninstall" +;; + +let cmd_what = function + | Install -> "install" + | Uninstall -> "uninstall" +;; + +let install_entry + ~ops + ~conf + ~package + ~dir + ~create_install_files + (entry : Path.t Install.Entry.t) + ~dst + ~verbosity + = + let module Ops = (val ops : File_operations) in + let open Fiber.O in + let special_file = Special_file.of_entry entry in + (match special_file with + | _ when not create_install_files -> Fiber.return true + | Some Special_file.META | Some Special_file.Dune_package -> Fiber.return true + | None -> + Artifact_substitution.test_file ~src:entry.src () + >>| (function + | Some_substitution -> true + | No_substitution -> false)) + >>= function + | false -> Fiber.return entry + | true -> + let+ () = + (match Path.is_directory dst with + | true -> Ops.remove_dir_if_exists ~if_non_empty:Fail dst + | false -> Ops.remove_file_if_exists dst); + print_line + ~verbosity + "%s %s" + (if create_install_files then "Copying to" else "Installing") + (Path.to_string_maybe_quoted dst); + Ops.mkdir_p dir; + let executable = Section.should_set_executable_bit entry.section in + let kind = + match special_file with + | Some special -> Special special + | None -> + (* CR-emillon: for most cases we could use a fast copy here, but some + kinds of files do need artifact substitution(at least + executable files and artifacts built from generated sites + modules), but it's too late to know without reading the file. *) + Substitute + in + Ops.copy_file ~src:entry.src ~dst ~executable ~kind ~package ~conf + in + Install.Entry.set_src entry dst +;; + +let run + what + context + common + pkgs + sections + (config : Dune_config.t) + ~dry_run + ~destdir + ~relocatable + ~create_install_files + ~prefix_from_command_line + ~(from_command_line : _ Install.Roots.t) + = + let open Fiber.O in + let* workspace = Workspace.get () in + let contexts = + match context with + | None -> + (match Common.x common with + | Some findlib_toolchain -> + let contexts = + List.filter workspace.contexts ~f:(fun (ctx : Context.t) -> + match Context.findlib_toolchain ctx with + | None -> false + | Some ctx_findlib_toolchain -> + Dune_engine.Context_name.equal ctx_findlib_toolchain findlib_toolchain) + in + contexts + | None -> workspace.contexts) + | Some name -> + (match + List.find workspace.contexts ~f:(fun c -> + Dune_engine.Context_name.equal (Context.name c) name) + with + | Some ctx -> [ ctx ] + | None -> + User_error.raise + [ Pp.textf "Context %S not found!" (Dune_engine.Context_name.to_string name) ]) + in + let* pkgs = + match pkgs with + | _ :: _ -> Fiber.return pkgs + | [] -> + Package.Name.Map.values workspace.packages + |> Fiber.parallel_map ~f:(fun pkg -> + package_is_vendored pkg + >>| function + | true -> None + | false -> Some (Package.name pkg)) + >>| List.filter_opt + in + let install_files, missing_install_files = + List.concat_map pkgs ~f:(fun pkg -> + List.map contexts ~f:(fun (ctx : Context.t) -> + let fn = + let fn = + resolve_package_install + workspace + ~findlib_toolchain:(Context.findlib_toolchain ctx) + pkg + in + Path.append_source (Path.build (Context.build_dir ctx)) fn + in + if Path.exists fn then Left (ctx, (pkg, fn)) else Right fn)) + |> List.partition_map ~f:Fun.id + in + if missing_install_files <> [] + then + User_error.raise + [ Pp.textf "The following .install are missing:" + ; Pp.enumerate missing_install_files ~f:(fun p -> Pp.text (Path.to_string p)) + ] + ~hints: + [ Pp.concat + ~sep:Pp.space + [ Pp.text "try running" + ; User_message.command "dune build [-p ] @install" + ] + |> Pp.hovbox + ]; + (match contexts, prefix_from_command_line, from_command_line.lib_root with + | _ :: _ :: _, Some _, _ | _ :: _ :: _, _, Some _ -> + User_error.raise + [ Pp.concat + ~sep:Pp.space + [ Pp.text "Cannot specify" + ; User_message.command "--prefix" + ; Pp.text "or" + ; User_message.command "--libdir" + ; Pp.text "when installing into multiple contexts!" + ] + ] + | _ -> ()); + let install_files_by_context = + let module CMap = Map.Make (Context) in + CMap.of_list_multi install_files + |> CMap.to_list_map ~f:(fun context install_files -> + let entries_per_package = + List.map install_files ~f:(fun (package, install_file) -> + let entries = + Install.Entry.load_install_file install_file Path.of_local + |> List.filter ~f:(fun (entry : Path.t Install.Entry.t) -> + Sections.should_install sections entry.section) + in + match + List.filter_map entries ~f:(fun entry -> + (* CR rgrinberg: this is ignoring optional entries *) + Option.some_if (not (Path.exists entry.src)) entry.src) + with + | [] -> package, entries + | missing_files -> + User_error.raise + [ Pp.textf + "The following files which are listed in %s cannot be installed \ + because they do not exist:" + (Path.to_string_maybe_quoted install_file) + ; Pp.enumerate missing_files ~f:(fun p -> + Pp.verbatim (Path.to_string_maybe_quoted p)) + ]) + in + context, entries_per_package) + in + let destdir = + Option.map + ~f:Path.of_string + (if create_install_files + then + (* CR-rgrinberg: why are we silently ignoring an argument instead + of erroring given that they mutually exclusive? *) + Some (Option.value ~default:"_destdir" destdir) + else destdir) + in + let relocatable = + if relocatable + then ( + match prefix_from_command_line with + | Some dir -> Some (Path.of_string dir) + | None -> + User_error.raise + [ Pp.concat + ~sep:Pp.space + [ Pp.text "Option" + ; User_message.command "--prefix" + ; Pp.text "is needed with" + ; User_message.command "--relocation" + ] + |> Pp.hovbox + ]) + else None + in + let verbosity = + match config.display with + | Simple display -> display.verbosity + | Tui -> Quiet + in + let open Fiber.O in + let (module Ops) = file_operations ~verbosity ~dry_run ~workspace in + let files_deleted_in = ref Path.Set.empty in + let+ () = + Fiber.sequential_iter + install_files_by_context + ~f:(fun (context, entries_per_package) -> + let* roots = get_dirs context ~prefix_from_command_line ~from_command_line in + let conf = Artifact_substitution.Conf.of_install ~relocatable ~roots ~context in + Fiber.sequential_iter entries_per_package ~f:(fun (package, entries) -> + let+ entries = + (* CR rgrinberg: why don't we install things concurrently? *) + Fiber.sequential_map entries ~f:(fun entry -> + let dst = + let paths = Install.Paths.make ~relative:Path.relative ~package ~roots in + Install.Entry.relative_installed_path entry ~paths + |> interpret_destdir ~destdir + in + let dir = Path.parent_exn dst in + match what with + | Uninstall -> + Ops.remove_file_if_exists dst; + files_deleted_in := Path.Set.add !files_deleted_in dir; + Fiber.return entry + | Install -> + install_entry + ~ops:(module Ops) + ~conf + ~package + ~dir + ~create_install_files + ~dst + ~verbosity + entry) + in + if create_install_files + then ( + let fn = + resolve_package_install + workspace + ~findlib_toolchain:(Context.findlib_toolchain context) + package + in + Install.Entry.gen_install_file entries |> Io.write_file (Path.source fn)))) + in + Path.Set.to_list !files_deleted_in + (* This [List.rev] is to ensure we process children directories before + their parents *) + |> List.rev + |> List.iter ~f:(Ops.remove_dir_if_exists ~if_non_empty:Warn) +;; + +let make ~what = + let doc = Format.asprintf "%a packages defined in the workspace." pp_what what in + let name_ = Arg.info [] ~docv:"PACKAGE" in + let absolute_path = + Arg.conv' + ( (fun path -> + if Filename.is_relative path + then Error "the path must be absolute to avoid ambiguity" + else Ok path) + , Arg.conv_printer Arg.string ) + in + let term = + let+ builder = Common.Builder.term + and+ prefix_from_command_line = + Arg.( + value + & opt (some string) None + & info + [ "prefix" ] + ~env:(Cmd.Env.info "DUNE_INSTALL_PREFIX") + ~docv:"PREFIX" + ~doc: + "Directory where files are copied. For instance binaries are copied into \ + $(i,\\$prefix/bin), library files into $(i,\\$prefix/lib), etc...") + and+ destdir = + Arg.( + value + & opt (some string) None + & info + [ "destdir" ] + ~env:(Cmd.Env.info "DESTDIR") + ~docv:"PATH" + ~doc:"This directory is prepended to all installed paths.") + and+ libdir_from_command_line = + Arg.( + value + & opt (some absolute_path) None + & info + [ "libdir" ] + ~docv:"PATH" + ~doc: + "Directory where library files are copied, relative to $(b,prefix) or \ + absolute. If $(b,--prefix) is specified the default is \ + $(i,\\$prefix/lib). Only absolute path accepted.") + and+ mandir_from_command_line = + let doc = + "Manually override the directory to install man pages. Only absolute path \ + accepted." + in + Arg.(value & opt (some absolute_path) None & info [ "mandir" ] ~docv:"PATH" ~doc) + and+ docdir_from_command_line = + let doc = + "Manually override the directory to install documentation files. Only absolute \ + path accepted." + in + Arg.(value & opt (some absolute_path) None & info [ "docdir" ] ~docv:"PATH" ~doc) + and+ etcdir_from_command_line = + let doc = + "Manually override the directory to install configuration files. Only absolute \ + path accepted." + in + Arg.(value & opt (some absolute_path) None & info [ "etcdir" ] ~docv:"PATH" ~doc) + and+ bindir_from_command_line = + let doc = + "Manually override the directory to install public binaries. Only absolute path \ + accepted." + in + Arg.(value & opt (some absolute_path) None & info [ "bindir" ] ~docv:"PATH" ~doc) + and+ sbindir_from_command_line = + let doc = + "Manually override the directory to install files from sbin section. Only \ + absolute path accepted." + in + Arg.(value & opt (some absolute_path) None & info [ "sbindir" ] ~docv:"PATH" ~doc) + and+ datadir_from_command_line = + let doc = + "Manually override the directory to install files from share section. Only \ + absolute path accepted." + in + Arg.(value & opt (some absolute_path) None & info [ "datadir" ] ~docv:"PATH" ~doc) + and+ libexecdir_from_command_line = + let doc = + "Manually override the directory to install executable library files. Only \ + absolute path accepted." + in + Arg.( + value & opt (some absolute_path) None & info [ "libexecdir" ] ~docv:"PATH" ~doc) + and+ dry_run = + Arg.( + value + & flag + & info + [ "dry-run" ] + ~doc:"Only display the file operations that would be performed.") + and+ relocatable = + Arg.( + value + & flag + & info + [ "relocatable" ] + ~doc: + "Make the binaries relocatable (the installation directory can be moved). \ + The installation directory must be specified with --prefix") + and+ create_install_files = + Arg.( + value + & flag + & info + [ "create-install-files" ] + ~doc: + "Do not directly install, but create install files in the root directory \ + and create substituted files if needed in destdir (_destdir by default).") + and+ pkgs = Arg.(value & pos_all package_name [] name_) + and+ context = + Arg.( + value + & opt (some Arg.context_name) None + & info + [ "context" ] + ~docv:"CONTEXT" + ~doc: + "Select context to install from. By default, install files from all \ + defined contexts.") + and+ sections = Sections.term in + let builder = Common.Builder.forbid_builds builder in + let builder = Common.Builder.disable_log_file builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let from_command_line = + { Install.Roots.lib_root = libdir_from_command_line + ; etc_root = etcdir_from_command_line + ; doc_root = docdir_from_command_line + ; man = mandir_from_command_line + ; bin = bindir_from_command_line + ; sbin = sbindir_from_command_line + ; libexec_root = libexecdir_from_command_line + ; share_root = datadir_from_command_line + } + |> Install.Roots.map ~f:(Option.map ~f:Path.of_string) + |> Install.Roots.complete + in + run + what + context + common + pkgs + sections + config + ~dry_run + ~destdir + ~relocatable + ~create_install_files + ~prefix_from_command_line + ~from_command_line) + in + Cmd.v + (Cmd.info + (cmd_what what) + ~doc + ~man:Manpage.(`S s_synopsis :: (synopsis @ Common.help_secs))) + term +;; + +let install = make ~what:Install +let uninstall = make ~what:Uninstall diff --git a/unikernel/duniverse/dune_/bin/install_uninstall.mli b/unikernel/duniverse/dune_/bin/install_uninstall.mli new file mode 100644 index 00000000..a94d5ae6 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/install_uninstall.mli @@ -0,0 +1,4 @@ +open Import + +val install : unit Cmd.t +val uninstall : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/installed_libraries.ml b/unikernel/duniverse/dune_/bin/installed_libraries.ml new file mode 100644 index 00000000..4a274f38 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/installed_libraries.ml @@ -0,0 +1,76 @@ +open Import + +let doc = "Print out libraries installed on the system." +let info = Cmd.info "installed-libraries" ~doc + +let term = + let+ builder = Common.Builder.term + and+ na = + Arg.( + value + & flag + & info + [ "na"; "not-available" ] + ~doc:"List libraries that are not available and explain why") + in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server + ~common + ~config + (let run () = + let open Memo.O in + let* ctxs = Context.DB.all () in + let ctx = List.hd ctxs in + let* findlib = Findlib.create (Context.name ctx) in + let* all_packages = Findlib.all_packages findlib in + if na + then ( + let+ broken = + Findlib.all_broken_packages findlib + >>| List.map ~f:(fun (name, _) -> + Lib_name.of_package_name name, "invalid dune file") + in + let hidden = + List.filter_map all_packages ~f:(function + | Hidden_library lib -> + Some + ( Dune_package.Lib.info lib |> Dune_rules.Lib_info.name + , "unsatisfied 'exists_if'" ) + | _ -> None) + in + let all = + List.sort (broken @ hidden) ~compare:(fun (a, _) (b, _) -> + Lib_name.compare a b) + in + let longest = String.longest_map all ~f:(fun (n, _) -> Lib_name.to_string n) in + let ppf = Format.std_formatter in + List.iter all ~f:(fun (n, r) -> + Format.fprintf ppf "%-*s -> %s@\n" longest (Lib_name.to_string n) r); + Format.pp_print_flush ppf ()) + else ( + let pkgs = + List.filter all_packages ~f:(function + | Dune_package.Entry.Hidden_library _ -> false + | _ -> true) + in + let max_len = + String.longest_map pkgs ~f:(fun e -> + Lib_name.to_string (Dune_package.Entry.name e)) + in + List.iter pkgs ~f:(fun e -> + let ver_string = + match Dune_package.Entry.version e with + | Some v -> Package_version.to_string v + | _ -> "n/a" + in + Printf.printf + "%-*s (version: %s)\n" + max_len + (Lib_name.to_string (Dune_package.Entry.name e)) + ver_string); + Memo.return ()) + in + fun () -> Memo.run (run ())) +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/installed_libraries.mli b/unikernel/duniverse/dune_/bin/installed_libraries.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/installed_libraries.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/internal.ml b/unikernel/duniverse/dune_/bin/internal.ml new file mode 100644 index 00000000..4d4f46ae --- /dev/null +++ b/unikernel/duniverse/dune_/bin/internal.ml @@ -0,0 +1,12 @@ +open Import + +let latest_lang_version = + Cmd.v + (Cmd.info "latest-lang-version") + (let+ () = Term.const () in + print_endline + (Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax + |> Dune_lang.Syntax.Version.to_string)) +;; + +let group = Cmd.group (Cmd.info "internal") [ Internal_dump.command; latest_lang_version ] diff --git a/unikernel/duniverse/dune_/bin/internal.mli b/unikernel/duniverse/dune_/bin/internal.mli new file mode 100644 index 00000000..d4c5902f --- /dev/null +++ b/unikernel/duniverse/dune_/bin/internal.mli @@ -0,0 +1,3 @@ +open Import + +val group : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/internal_dump.ml b/unikernel/duniverse/dune_/bin/internal_dump.ml new file mode 100644 index 00000000..6a2a6b42 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/internal_dump.ml @@ -0,0 +1,24 @@ +open Import +module Persistent = Dune_util.Persistent + +let doc = "Dump the contents of a file stored in Dune's persistent database." + +let man = + [ `S "DESCRIPTION" + ; `P + {|Dump the contents of a file stored in Dune's persistent database in a human readable format.|} + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "dump" ~doc ~man + +let term = + let+ builder = Common.Builder.term + and+ file = Arg.(required & pos 0 (some Arg.path) None & Arg.info [] ~docv:"FILE") in + let _common, _config = Common.init builder in + let (Persistent.T ((module D), data)) = Persistent.load_exn (Arg.Path.path file) in + Console.print [ Dyn.pp (D.to_dyn data) ] +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/internal_dump.mli b/unikernel/duniverse/dune_/bin/internal_dump.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/internal_dump.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/lock_dev_tool.ml b/unikernel/duniverse/dune_/bin/lock_dev_tool.ml new file mode 100644 index 00000000..38dfd4e3 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/lock_dev_tool.ml @@ -0,0 +1,254 @@ +open Dune_config +open Import +module Lock_dir = Dune_pkg.Lock_dir +module Pin = Dune_pkg.Pin + +let is_enabled = + lazy + (match Config.get Dune_rules.Compile_time.lock_dev_tools with + | `Enabled -> true + | `Disabled -> false) +;; + +(* Returns a version constraint accepting (almost) all versions whose prefix is + the given version. This allows alternative distributions of packages to be + chosen, such as choosing "ocamlformat.0.26.2+binary" when .ocamlformat + contains "version=0.26.2". *) +let relaxed_version_constraint_of_version version = + let open Dune_lang in + let min_version = Package_version.to_string version in + (* The goal here is to add a suffix to [min_version] to construct a version + number higher than than any version number likely to appear with + [min_version] as a prefix. "_" is the highest ascii symbol that can appear + in version numbers, excluding "~" which has a special meaning. It's + conceivable that one or two consecutive "_" characters may be used in a + version, so this appends "___" to [min_version]. + + Read more at: https://opam.ocaml.org/doc/Manual.html#Version-ordering + *) + let max_version = min_version ^ "___MAX_VERSION" in + Package_constraint.And + [ Package_constraint.Uop + (Relop.Gte, Package_constraint.Value.String_literal min_version) + ; Package_constraint.Uop + (Relop.Lte, Package_constraint.Value.String_literal max_version) + ] +;; + +(* The solver satisfies dependencies for local packages, but dev tools + are not local packages. As a workaround, create an empty local package + which depends on the dev tool package. *) +let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version ~extra_dependencies + : Dune_pkg.Local_package.t + = + let dev_tool_pkg_name = Dune_pkg.Dev_tool.package_name dev_tool in + let dependency = + let open Dune_lang in + let open Package_dependency in + let constraint_ = + Option.map dev_tool_version ~f:relaxed_version_constraint_of_version + in + { name = dev_tool_pkg_name; constraint_ } + in + let local_package_name = + Package_name.of_string (Package_name.to_string dev_tool_pkg_name ^ "_dev_tool_wrapper") + in + { Dune_pkg.Local_package.name = local_package_name + ; version = Dune_pkg.Lock_dir.Pkg_info.default_version + ; dependencies = + Dune_pkg.Dependency_formula.of_dependencies (dependency :: extra_dependencies) + ; conflicts = [] + ; depopts = [] + ; pins = Package_name.Map.empty + ; conflict_class = [] + ; loc = Loc.none + ; command_source = Opam_file { build = []; install = [] } + } +;; + +let solve ~dev_tool ~local_packages = + let open Memo.O in + let* solver_env_from_current_system = + Pkg_common.poll_solver_env_from_current_system () + |> Memo.of_reproducible_fiber + >>| Option.some + and* workspace = + let+ workspace = Workspace.workspace () in + match Config.get Dune_rules.Compile_time.bin_dev_tools with + | `Enabled -> + Workspace.add_repo workspace Dune_pkg.Pkg_workspace.Repository.binary_packages + | `Disabled -> workspace + in + let lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in + Memo.of_reproducible_fiber + @@ Lock.solve + workspace + ~local_packages + ~project_pins:Pin.DB.empty + ~solver_env_from_current_system + ~version_preference:None + ~lock_dirs:[ lock_dir ] + ~print_perf_stats:false + ~portable_lock_dir:false +;; + +let compiler_package_name = Package_name.of_string "ocaml" + +(* Some dev tools must be built with the same version of the ocaml + compiler as the project. This function returns the version of the + "ocaml" package used to compile the project in the default build + context. + + TODO: This only makes sure that the version of compiler used to + build the dev tool matches the version of the compiler used to + build this project. This will fail if the project is built with a + custom compiler (e.g. ocaml-variants) since the version of the + compiler will be the same between the project and dev tool while + they still use different compilers. A more robust solution would be + to ensure that the exact compiler package used to build the dev + tool matches the package used to build the compiler. *) +let locked_ocaml_compiler_version () = + let open Memo.O in + let context = + (* Dev tools are only ever built with the default context. *) + Context_name.default + in + let* result = Dune_rules.Lock_dir.get context + and* platform = + Pkg_common.poll_solver_env_from_current_system () |> Memo.of_reproducible_fiber + in + match result with + | Error _ -> + User_error.raise + [ Pp.text "Unable to load the lockdir for the default build context." ] + ~hints: + [ Pp.concat + ~sep:Pp.space + [ Pp.text "Try running"; User_message.command "dune pkg lock" ] + ] + | Ok { packages; _ } -> + let packages = Lock_dir.Packages.pkgs_on_platform_by_name packages ~platform in + (match Package_name.Map.find packages compiler_package_name with + | None -> + User_error.raise + [ Pp.textf + "The lockdir doesn't contain a lockfile for the package %S." + (Package_name.to_string compiler_package_name) + ] + ~hints: + [ Pp.concat + ~sep:Pp.space + [ Pp.textf + "Add a dependency on %S to one of the packages in dune-project and \ + then run" + (Package_name.to_string compiler_package_name) + ; User_message.command "dune pkg lock" + ] + ] + | Some pkg -> Memo.return pkg.info.version) +;; + +(* Returns a dependency constraint on the version of the ocaml + compiler in the lockdir associated with the default context. *) +let locked_ocaml_compiler_constraint () = + let open Dune_lang in + let open Memo.O in + let+ ocaml_compiler_version = locked_ocaml_compiler_version () in + let constraint_ = + Some + (Package_constraint.Uop + (Eq, String_literal (Package_version.to_string ocaml_compiler_version))) + in + { Package_dependency.name = compiler_package_name; constraint_ } +;; + +let extra_dependencies dev_tool = + let open Memo.O in + match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with + | false -> Memo.return [] + | true -> + let+ constraint_ = locked_ocaml_compiler_constraint () in + [ constraint_ ] +;; + +let lockdir_status dev_tool = + let open Memo.O in + let dev_tool_lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in + match Lock_dir.read_disk dev_tool_lock_dir with + | Error _ -> Memo.return `No_lockdir + | Ok { packages; _ } -> + (match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with + | false -> Memo.return `Lockdir_ok + | true -> + let* platform = + Pkg_common.poll_solver_env_from_current_system () |> Memo.of_reproducible_fiber + in + let packages = Lock_dir.Packages.pkgs_on_platform_by_name packages ~platform in + (match Package_name.Map.find packages compiler_package_name with + | None -> Memo.return `No_compiler_lockfile_in_lockdir + | Some { info; _ } -> + let+ ocaml_compiler_version = locked_ocaml_compiler_version () in + (match Package_version.equal info.version ocaml_compiler_version with + | true -> `Lockdir_ok + | false -> + `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed + (User_message.make + [ Pp.textf + "The version of the compiler package (%S) in this project's \ + lockdir has changed to %s (formerly the compiler version was %s). \ + The dev-tool %S will be re-locked and rebuilt with this version \ + of the compiler." + (Package_name.to_string compiler_package_name) + (Package_version.to_string ocaml_compiler_version) + (Package_version.to_string info.version) + (Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string) + ])))) +;; + +(* [lock_dev_tool_at_version dev_tool version] generates the lockdir for the + dev tool [dev_tool]. If [version] is [Some v] then version [v] of the tool + will be chosen by the solver. Otherwise the solver is free to choose the + appropriate version of the tool to install. *) +let lock_dev_tool_at_version dev_tool version = + let open Memo.O in + let* need_to_solve = + lockdir_status dev_tool + >>| function + | `Lockdir_ok -> false + | `No_lockdir -> true + | `No_compiler_lockfile_in_lockdir -> + Console.print + [ Pp.textf + "The lockdir for %s lacks a lockfile for %s. Regenerating..." + (Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string) + (Package_name.to_string compiler_package_name) + ]; + true + | `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed message -> + Console.print_user_message message; + true + in + if need_to_solve + then + let* extra_dependencies = extra_dependencies dev_tool in + let local_pkg = + make_local_package_wrapping_dev_tool + ~dev_tool + ~dev_tool_version:version + ~extra_dependencies + in + let local_packages = Package_name.Map.singleton local_pkg.name local_pkg in + solve ~dev_tool ~local_packages + else Memo.return () +;; + +let lock_ocamlformat () = + let version = Dune_pkg.Ocamlformat.version_of_current_project's_ocamlformat_config () in + lock_dev_tool_at_version Ocamlformat version +;; + +let lock_dev_tool dev_tool = + match (dev_tool : Dune_pkg.Dev_tool.t) with + | Ocamlformat -> lock_ocamlformat () + | other -> lock_dev_tool_at_version other None +;; diff --git a/unikernel/duniverse/dune_/bin/lock_dev_tool.mli b/unikernel/duniverse/dune_/bin/lock_dev_tool.mli new file mode 100644 index 00000000..2f0272e0 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/lock_dev_tool.mli @@ -0,0 +1,4 @@ +open! Import + +val is_enabled : bool Lazy.t +val lock_dev_tool : Dune_pkg.Dev_tool.t -> unit Memo.t diff --git a/unikernel/duniverse/dune_/bin/main.ml b/unikernel/duniverse/dune_/bin/main.ml new file mode 100644 index 00000000..b99de6d0 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/main.ml @@ -0,0 +1,117 @@ +open Import + +let all : _ Cmdliner.Cmd.t list = + let terms = + Runtest.commands + @ [ Installed_libraries.command + ; External_lib_deps.command + ; Build.build + ; Fmt.command + ; Clean.command + ; Install_uninstall.install + ; Install_uninstall.uninstall + ; Exec.command + ; Subst.command + ; Print_rules.command + ; Utop.command + ; Promotion.promote + ; command_alias Printenv.command Printenv.term "printenv" + ; Help.command + ; Format_dune_file.command + ; Upgrade.command + ; Cache.command + ; Top.command + ; Ocaml_merlin.command + ; Shutdown.command + ; Diagnostics.command + ; Monitor.command + ] + in + let groups = + [ Ocaml_cmd.group + ; Coq.group + ; Describe.group + ; Describe.Show.group + ; Rpc.group + ; Internal.group + ; Init.group + ; Promotion.group + ; Pkg.group + ; Pkg.Alias.group + ; Tools.group + ] + in + terms @ groups +;; + +(* Short reminders for the most used and useful commands *) +let common_commands_synopsis = + Common.command_synopsis + [ "build [--watch]" + ; "runtest [--watch]" + ; "exec NAME" + ; "utop [DIR]" + ; "install" + ; "init project NAME [PATH] [--libs=l1,l2 --ppx=p1,p2 --inline-tests]" + ] +;; + +let info = + let doc = "composable build system for OCaml" in + Cmd.info + "dune" + ~doc + ~envs:Common.envs + ~version: + (match Build_info.V1.version () with + | None -> "n/a" + | Some v -> Build_info.V1.Version.to_string v) + ~man: + [ `Blocks common_commands_synopsis + ; `S "DESCRIPTION" + ; `P + {|Dune is a build system designed for OCaml projects only. It + focuses on providing the user with a consistent experience and takes + care of most of the low-level details of OCaml compilation. All you + have to do is provide a description of your project and Dune will + do the rest. + |} + ; `P + {|The scheme it implements is inspired from the one used inside Jane + Street and adapted to the open source world. It has matured over a + long time and is used daily by hundreds of developers, which means + that it is highly tested and productive. + |} + ; `Blocks Common.help_secs + ; Common.examples + [ "Initialise a new project named `foo'", "dune init project foo" + ; "Build all targets in the current source tree", "dune build" + ; "Run the executable named `bar'", "dune exec bar" + ; "Run all tests in the current source tree", "dune runtest" + ; "Install all components defined in the project", "dune install" + ; "Remove all build artefacts", "dune clean" + ] + ] +;; + +let cmd = Cmd.group info all + +let exit_and_flush code = + Console.finish (); + exit (Exit_code.code code) +;; + +let () = + Dune_rules.Colors.setup_err_formatter_colors (); + try + match Cmd.eval_value cmd ~catch:false with + | Ok _ -> exit_and_flush Success + | Error _ -> exit_and_flush Error + with + | Scheduler.Run.Shutdown.E Requested -> exit_and_flush Success + | Scheduler.Run.Shutdown.E (Signal _) -> exit_and_flush Signal + | exn -> + let exn = Exn_with_backtrace.capture exn in + Dune_util.Report_error.report exn; + exit_and_flush Error +;; diff --git a/unikernel/duniverse/dune_/bin/main.mli b/unikernel/duniverse/dune_/bin/main.mli new file mode 100644 index 00000000..170c30e4 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/main.mli @@ -0,0 +1 @@ +(** Main module *) diff --git a/unikernel/duniverse/dune_/bin/monitor.ml b/unikernel/duniverse/dune_/bin/monitor.ml new file mode 100644 index 00000000..f887cfa9 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/monitor.ml @@ -0,0 +1,295 @@ +open Import +open Fiber.O +module Client = Dune_rpc_client.Client +module Version_error = Dune_rpc_private.Version_error + +include struct + open Dune_rpc + module Diagnostic = Diagnostic + module Progress = Progress + module Job = Job + module Sub = Sub + module Conv = Conv +end + +(** Utility module for generating [Map] modules for [Diagnostic]s and [Job]s which use + their [Id] as keys. *) +module Id_map (Id : sig + type t + + val compare : t -> t -> Ordering.t + val sexp : (t, Conv.values) Conv.t + end) = +struct + include Map.Make (struct + include Id + + let to_dyn t = Sexp.to_dyn (Conv.to_sexp Id.sexp t) + end) +end + +module Diagnostic_id_map = Id_map (Diagnostic.Id) +module Job_id_map = Id_map (Job.Id) + +module Event = struct + (** Events that the render loop will process. *) + type t = + | Diagnostics of Diagnostic.Event.t list + | Jobs of Job.Event.t list + | Progress of Progress.t +end + +module State : sig + (** Internal state of the render loop. *) + type t + + (** Initial empty state. *) + val init : unit -> t + + module Update : sig + (** Incremental updates to the state. Computes increments of the state that + will be used for efficient rendering. *) + type t + end + + val update : t -> Event.t -> Update.t + + (** Given a state update, render the update. *) + val render : t -> Update.t -> unit +end = struct + type t = + { mutable diagnostics : Diagnostic.t Diagnostic_id_map.t + ; mutable jobs : Job.t Job_id_map.t + ; mutable progress : Progress.t + } + + let init () = + { diagnostics = Diagnostic_id_map.empty; jobs = Job_id_map.empty; progress = Waiting } + ;; + + let done_status ~complete ~remaining ~failed state = + Pp.textf + "Done: %d%% (%d/%d, %d left%s) (jobs: %d)" + (if complete + remaining = 0 then 0 else complete * 100 / (complete + remaining)) + complete + (complete + remaining) + remaining + (match failed with + | 0 -> "" + | failed -> sprintf ", %d failed" failed) + (Job_id_map.cardinal state.jobs) + ;; + + let waiting_for_file_system_changes message = + Pp.seq message (Pp.verbatim ", waiting for filesystem changes...") + ;; + + let restarting_current_build message = + Pp.seq message (Pp.verbatim ", restarting current build...") + ;; + + let had_errors state = + match Diagnostic_id_map.cardinal state.diagnostics with + | 1 -> Pp.verbatim "Had 1 error" + | n -> Pp.textf "Had %d errors" n + ;; + + let status (state : t) = + Console.Status_line.set + (Live + (fun () -> + match (state.progress : Progress.t) with + | Waiting -> Pp.verbatim "Initializing..." + | In_progress { complete; remaining; failed } -> + done_status ~complete ~remaining ~failed state + | Interrupted -> + Pp.tag User_message.Style.Error (Pp.verbatim "Source files changed") + |> restarting_current_build + | Success -> + Pp.tag User_message.Style.Success (Pp.verbatim "Success") + |> waiting_for_file_system_changes + | Failed -> + Pp.tag User_message.Style.Error (had_errors state) + |> waiting_for_file_system_changes)) + ;; + + module Update = struct + type t = + | Update_status + | Add_diagnostics of Diagnostic.t list + | Refresh + + let jobs state jobs = + let jobs = + List.fold_left jobs ~init:state.jobs ~f:(fun acc job_event -> + match (job_event : Job.Event.t) with + | Start job -> Job_id_map.add_exn acc job.id job + | Stop id -> Job_id_map.remove acc id) + in + state.jobs <- jobs; + Update_status + ;; + + let progress state progress = + state.progress <- progress; + Update_status + ;; + + let diagnostics state diagnostics = + let mode, diagnostics = + List.fold_left + diagnostics + ~init:(`Add_only [], state.diagnostics) + ~f:(fun (mode, acc) diag_event -> + match (diag_event : Diagnostic.Event.t) with + | Remove diag -> `Remove, Diagnostic_id_map.remove acc diag.id + | Add diag -> + ( (match mode with + | `Add_only diags -> `Add_only (diag :: diags) + | `Remove -> `Remove) + , Diagnostic_id_map.add_exn acc diag.id diag )) + in + state.diagnostics <- diagnostics; + match mode with + | `Add_only update -> Add_diagnostics (List.rev update) + | `Remove -> Refresh + ;; + end + + let update state (event : Event.t) = + match event with + | Jobs jobs -> Update.jobs state jobs + | Progress progress -> Update.progress state progress + | Diagnostics diagnostics -> Update.diagnostics state diagnostics + ;; + + let render = + let f d = Console.print_user_message (Diagnostic.to_user_message d) in + fun (state : t) (update : Update.t) -> + (match (update : Update.t) with + | Add_diagnostics diags -> List.iter diags ~f + | Update_status -> () + | Refresh -> + Console.reset (); + Diagnostic_id_map.iter state.diagnostics ~f); + status state + ;; +end + +(* A generic loop that continuously fetches events from a [sub] that it opens a + poll to and writes them to the [event] bus. *) +let fetch_loop ~(event : Event.t Fiber_event_bus.t) ~client ~f sub = + Client.poll client sub + >>= function + | Error version_error -> + let* () = Fiber_event_bus.close event in + User_error.raise [ Pp.verbatim (Version_error.message version_error) ] + | Ok poller -> + let rec loop () = + Fiber.collect_errors (fun () -> Client.Stream.next poller) + >>= (function + | Ok (Some payload) -> Fiber_event_bus.push event (f payload) + | Error _ | Ok None -> Fiber_event_bus.close event >>> Fiber.return `Closed) + >>= function + | `Closed -> Fiber.return () + | `Ok -> loop () + in + loop () +;; + +(* Main render loop *) +let render_loop ~(event : Event.t Fiber_event_bus.t) = + Console.reset (); + let state = State.init () in + let rec loop () = + Fiber_event_bus.pop event + >>= function + | `Closed -> + Console.print_user_message + (User_error.make [ Pp.textf "Lost connection to server." ]); + Fiber.return () + | `Next event -> + let update = State.update state event in + (* CR-someday alizter: If performance of rendering here on every loop is bad we can + instead batch updates. It should be very simple to write a [State.Update.union] + function that can combine incremental updates to be done at once. *) + State.render state update; + loop () + in + loop () +;; + +let monitor ~quit_on_disconnect () = + Fiber.repeat_while ~init:1 ~f:(fun i -> + match Dune_rpc_impl.Where.get () with + | Some where -> + let* connect = Client.Connection.connect_exn where in + let+ () = + Dune_rpc_impl.Client.client + connect + (Dune_rpc.Initialize.Request.create + ~id:(Dune_rpc.Id.make (Sexp.Atom "monitor_cmd"))) + ~f:(fun client -> + let event = Fiber_event_bus.create () in + let module Sub = Dune_rpc_private.Public.Sub in + Fiber.all_concurrently_unit + [ render_loop ~event + ; fetch_loop ~event ~client ~f:(fun x -> Event.Jobs x) Sub.running_jobs + ; fetch_loop ~event ~client ~f:(fun x -> Event.Progress x) Sub.progress + ; fetch_loop ~event ~client ~f:(fun x -> Event.Diagnostics x) Sub.diagnostic + ]) + in + Some i + | None when quit_on_disconnect -> + User_error.raise [ Pp.text "RPC server not running." ] + | None -> + Console.Status_line.set + (Console.Status_line.Live + (fun () -> Pp.verbatim ("Waiting for RPC server" ^ String.make (i mod 4) '.'))); + let+ () = Scheduler.sleep ~seconds:0.3 in + Some (i + 1)) +;; + +let man = + [ `S "DESCRIPTION" + ; `P + "$(b,dune monitor) connects to an RPC server running in the current workspace and \ + displays the build progress and diagnostics. If no server is running or it was \ + disconnected, it will continuously try to reconnect." + ] +;; + +let command = + let info = + let doc = "Connect to a Dune RPC server and monitor it." in + Cmd.info "monitor" ~doc ~man + and term = + let open Import in + let+ builder = Common.Builder.term + and+ quit_on_disconnect = + Arg.( + value + & flag + & info + [ "quit-on-disconnect" ] + ~doc:"Quit if the connection to the server is lost.") + in + let builder = Common.Builder.forbid_builds builder in + let builder = Common.Builder.disable_log_file builder in + let common, config = Common.init builder in + let stats = Common.stats common in + let config = + Dune_config.for_scheduler + config + stats + ~print_ctrl_c_warning:true + ~watch_exclusions:[] + in + Scheduler.Run.go + config + ~on_event:(fun _ _ -> ()) + ~file_watcher:No_watcher + (monitor ~quit_on_disconnect) + in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/monitor.mli b/unikernel/duniverse/dune_/bin/monitor.mli new file mode 100644 index 00000000..54b77188 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/monitor.mli @@ -0,0 +1 @@ +val command : unit Cmdliner.Cmd.t diff --git a/unikernel/duniverse/dune_/bin/ocaml/doc.ml b/unikernel/duniverse/dune_/bin/ocaml/doc.ml new file mode 100644 index 00000000..6a70cc1b --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/doc.ml @@ -0,0 +1,68 @@ +open Import +module Main = Import.Main + +let doc = "Build and view the documentation of an OCaml project" + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune ocaml doc) builds and then opens the documentation of an OCaml project in the users default browser.|} + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "doc" ~doc ~man + +let lock_odoc_if_dev_tool_enabled () = + match Lazy.force Lock_dev_tool.is_enabled with + | false -> Action_builder.return () + | true -> Action_builder.of_memo (Lock_dev_tool.lock_dev_tool Odoc) +;; + +let term = + let+ builder = Common.Builder.term in + let common, config = Common.init builder in + let request (setup : Main.build_system) = + let dir = Path.(relative root) (Common.prefix_target common ".") in + let open Action_builder.O in + let* () = lock_odoc_if_dev_tool_enabled () in + let+ () = + Alias.in_dir ~name:Dune_rules.Alias.doc ~recursive:true ~contexts:setup.contexts dir + |> Alias.request + in + let relative_toplevel_index_path = + let toplevel_index_path = + let is_default ctx = ctx |> Context.name |> Dune_engine.Context_name.is_default in + let doc_ctx = List.find_exn setup.contexts ~f:is_default in + Dune_rules.Odoc.Paths.toplevel_index doc_ctx + in + Path.(toplevel_index_path |> build |> to_string_maybe_quoted) + in + Console.print + [ Pp.textf "Docs built. Index can be found here: %s" relative_toplevel_index_path ]; + match + let open Option.O in + let* cmd_name, args = + match Platform.OS.value with + | Darwin -> Some ("open", []) + | Other | FreeBSD | NetBSD | OpenBSD | Haiku | Linux -> Some ("xdg-open", []) + | Windows -> None + in + let+ open_command = + let path = Env_path.path Env.initial in + Bin.which ~path cmd_name + in + open_command, args @ [ relative_toplevel_index_path ] + with + | Some (cmd, args) -> + Proc.restore_cwd_and_execve (Path.to_absolute_filename cmd) args ~env:Env.initial + | None -> + User_warning.emit + [ Pp.text + "No browser could be found, you will have to open the documentation yourself." + ] + in + Build.run_build_command ~common ~config ~request +;; + +let cmd = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/ocaml/doc.mli b/unikernel/duniverse/dune_/bin/ocaml/doc.mli new file mode 100644 index 00000000..6ab473d9 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/doc.mli @@ -0,0 +1,3 @@ +open! Import + +val cmd : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/ocaml/ocaml_cmd.ml b/unikernel/duniverse/dune_/bin/ocaml/ocaml_cmd.ml new file mode 100644 index 00000000..71a1fc21 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/ocaml_cmd.ml @@ -0,0 +1,16 @@ +open Import + +let info = Cmd.info "ocaml" ~doc:"Command group related to OCaml." + +let group = + Cmdliner.Cmd.group + info + [ Utop.command + ; Ocaml_merlin.command + ; Ocaml_merlin.Dump_dot_merlin.command + ; Top.command + ; Top.module_command + ; Ocaml_merlin.group + ; Doc.cmd + ] +;; diff --git a/unikernel/duniverse/dune_/bin/ocaml/ocaml_cmd.mli b/unikernel/duniverse/dune_/bin/ocaml/ocaml_cmd.mli new file mode 100644 index 00000000..d4c5902f --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/ocaml_cmd.mli @@ -0,0 +1,3 @@ +open Import + +val group : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/ocaml/ocaml_merlin.ml b/unikernel/duniverse/dune_/bin/ocaml/ocaml_merlin.ml new file mode 100644 index 00000000..c9018091 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/ocaml_merlin.ml @@ -0,0 +1,317 @@ +open Import + +module Selected_context = struct + let arg = + let ctx_name_conv = + let parse ctx_name = + match Context_name.of_string_opt ctx_name with + | None -> Error (`Msg (Printf.sprintf "Invalid context name %S" ctx_name)) + | Some ctx_name -> Ok ctx_name + in + let print ppf t = Stdlib.Format.fprintf ppf "%s" (Context_name.to_string t) in + Arg.conv ~docv:"context" (parse, print) + in + Arg.( + value + & opt ctx_name_conv Context_name.default + & info + [ "context" ] + ~docv:"CONTEXT" + ~doc:"Select the Dune build context that will be used to return information") + ;; +end + +module Server : sig + val dump : selected_context:Context_name.t -> string -> unit Fiber.t + val dump_dot_merlin : selected_context:Context_name.t -> string -> unit Fiber.t + + (** Once started the server will wait for commands on stdin, read the + requested merlin dot file and return its content on stdout. The server + will halt when receiving EOF of a bad csexp. *) + val start : selected_context:Context_name.t -> unit -> unit Fiber.t +end = struct + open Fiber.O + + module Merlin_conf = struct + type t = Sexp.t + + let make_error msg = Sexp.(List [ List [ Atom "ERROR"; Atom msg ] ]) + + let to_stdout (t : t) = + Csexp.to_channel stdout t; + flush stdout + ;; + end + + module Commands = struct + type t = + | File of string + | Halt + | Unknown of string + + let read_input in_channel = + match Csexp.input_opt in_channel with + | Ok None -> Halt + | Ok (Some sexp) -> + let open Sexp in + (match sexp with + | Atom "Halt" -> Halt + | List [ Atom "File"; Atom path ] -> File path + | sexp -> + let msg = Printf.sprintf "Bad input: %s" (Sexp.to_string sexp) in + Unknown msg) + | Error err -> + Format.eprintf "Bad input: %s@." err; + Halt + ;; + end + + (* [make_relative_to_root p] will check that [Path.root] is a prefix of the + absolute path [p] and remove it if that is the case. Under Windows and + Cygwin environment both paths are lowarcased before the comparison *) + let make_relative_to_root p = + let p = Path.to_absolute_filename p in + let prefix = Path.(to_absolute_filename root) in + (if Sys.win32 || Sys.cygwin then String.Caseless.drop_prefix else String.drop_prefix) + ~prefix + p + (* After dropping the prefix we need to remove the leading path separator *) + |> Option.map ~f:(fun s -> String.drop s 1) + ;; + + (* Given a path [p] relative to the workspace root, [get_merlin_files_paths p] + navigates to the [_build] directory and reaches this path from the correct + context. Then it returns the list of available Merlin configurations for + this directory. *) + let get_merlin_files_paths dir = + let merlin_path = + Path.Build.relative dir Dune_rules.Merlin_ident.merlin_folder_name + in + Path.build merlin_path + |> Path.readdir_unsorted + |> Result.value ~default:[] + |> List.sort ~compare:String.compare + |> List.map ~f:(fun f -> Path.Build.relative merlin_path f |> Path.build) + ;; + + module Merlin = Dune_rules.Merlin + + let load_merlin_file file = + (* We search for an appropriate merlin configuration in the current + directory and its parents *) + let rec find_closest path = + match + get_merlin_files_paths path + |> List.find_map ~f:(fun file_path -> + (* FIXME we are racing against the build system writing these + files here *) + match Merlin.Processed.load_file file_path with + | Error msg -> Some (Merlin_conf.make_error msg) + | Ok config -> Merlin.Processed.get config ~file) + with + | Some p -> Some p + | None -> + (match Path.Build.parent path with + | None -> None + | Some dir -> find_closest dir) + in + match find_closest (Path.Build.parent_exn file) with + | Some x -> x + | None -> + Path.Build.drop_build_context_exn file + |> Path.Source.to_string_maybe_quoted + |> Printf.sprintf "No config found for file %s. Try calling 'dune build'." + |> Merlin_conf.make_error + ;; + + (* [to_local p] makes path [p] relative to the project's root. [p] can be: - + An absolute path - A path relative to [Path.initial_cwd] *) + let to_local file_path = + let error msg = Error msg in + (* This ensure the path is absolute. If not it is prefixed with + [Path.initial_cwd] *) + let abs_file_path = Path.of_filename_relative_to_initial_cwd file_path in + (* Then we make the path relative to [Path.root] (and not + [Path.initial_cwd]) *) + match make_relative_to_root abs_file_path with + | Some path -> + (try + let path = Path.of_string path in + (* If dune ocaml-merlin is called from within the build dir we must + remove the build context *) + Ok (Path.drop_optional_build_context path |> Path.local_part) + with + | User_error.E mess -> User_message.to_string mess |> error) + | None -> + Printf.sprintf + "Path %s is not in dune workspace (%s)." + (String.maybe_quoted file_path) + (String.maybe_quoted @@ Path.(to_absolute_filename Path.root)) + |> error + ;; + + let to_local ~selected_context file = + match to_local file with + | Error s -> Fiber.return (Error s) + | Ok file -> + (match Dune_engine.Context_name.is_default selected_context with + | false -> + Fiber.return + (Ok (Path.Build.append_local (Context_name.build_dir selected_context) file)) + | true -> + let+ workspace = Memo.run (Workspace.workspace ()) in + (match workspace.merlin_context with + | None -> Error "no merlin context configured" + | Some context -> + Ok (Path.Build.append_local (Context_name.build_dir context) file))) + ;; + + let print_merlin_conf ~selected_context file = + to_local ~selected_context file + >>| (function + | Error s -> Merlin_conf.make_error s + | Ok file -> load_merlin_file file) + >>| Merlin_conf.to_stdout + ;; + + let dump ~selected_context s = + to_local ~selected_context s + >>| function + | Error mess -> Printf.eprintf "%s\n%!" mess + | Ok path -> get_merlin_files_paths path |> List.iter ~f:Merlin.Processed.print_file + ;; + + let dump_dot_merlin ~selected_context s = + to_local ~selected_context s + >>| function + | Error mess -> Printf.eprintf "%s\n%!" mess + | Ok path -> + let files = get_merlin_files_paths path in + Merlin.Processed.print_generic_dot_merlin files + ;; + + let start ~selected_context () = + let open Fiber.O in + let rec main () = + match Commands.read_input stdin with + | Halt -> Fiber.return () + | File path -> + let* () = print_merlin_conf ~selected_context path in + main () + | Unknown msg -> + Merlin_conf.to_stdout (Merlin_conf.make_error msg); + main () + in + main () + ;; +end + +module Dump_config = struct + let info = + Cmd.info + ~doc: + "Print the entire content of the merlin configuration for the given folder in a \ + user friendly form. This is for testing and debugging purposes only and should \ + not be considered as a stable output." + "dump-config" + ;; + + let term = + let+ builder = Common.Builder.term + and+ dir = Arg.(value & pos 0 dir "" & info [] ~docv:"PATH") + and+ selected_context = Selected_context.arg in + let common, config = + let builder = + let builder = Common.Builder.forbid_builds builder in + Common.Builder.disable_log_file builder + in + Common.init builder + in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + Server.dump ~selected_context dir) + ;; + + let command = Cmd.v info term +end + +let doc = "Start a merlin configuration server." + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune ocaml-merlin) starts a server that can be queried to get + .merlin information. It is meant to be used by Merlin itself and does not + provide a user-friendly output.|} + ; `Blocks Common.help_secs + ; Common.footer + ] +;; + +let start_session_info name = Cmd.info name ~doc ~man + +let start_session_term = + let+ builder = Common.Builder.term + and+ selected_context = Selected_context.arg in + let common, config = + let builder = + let builder = Common.Builder.forbid_builds builder in + Common.Builder.disable_log_file builder + in + Common.init builder + in + Scheduler.go_with_rpc_server ~common ~config (Server.start ~selected_context) +;; + +let command = Cmd.v (start_session_info "ocaml-merlin") start_session_term + +module Dump_dot_merlin = struct + let doc = "Print Merlin configuration" + + let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune ocaml dump-dot-merlin) will attempt to read previously + generated configuration in a source folder, merge them and print + it to the standard output in Merlin configuration syntax. The + output of this command should always be checked and adapted to + the project needs afterward.|} + ; Common.footer + ] + ;; + + let info = Cmd.info "dump-dot-merlin" ~doc ~man + + let term = + let+ builder = Common.Builder.term + and+ path = + Arg.( + value + & pos 0 (some string) None + & info + [] + ~docv:"PATH" + ~doc: + "The path to the folder of which the configuration should be printed. \ + Defaults to the current directory.") + and+ selected_context = Selected_context.arg in + let common, config = + let builder = + let builder = Common.Builder.forbid_builds builder in + Common.Builder.disable_log_file builder + in + Common.init builder + in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + match path with + | Some s -> Server.dump_dot_merlin ~selected_context s + | None -> Server.dump_dot_merlin ~selected_context ".") + ;; + + let command = Cmd.v info term +end + +let group = + Cmdliner.Cmd.group + (Cmd.info "merlin" ~doc:"Command group related to merlin") + [ Dump_config.command; Cmd.v (start_session_info "start-session") start_session_term ] +;; diff --git a/unikernel/duniverse/dune_/bin/ocaml/ocaml_merlin.mli b/unikernel/duniverse/dune_/bin/ocaml/ocaml_merlin.mli new file mode 100644 index 00000000..cd32106d --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/ocaml_merlin.mli @@ -0,0 +1,9 @@ +open Import + +val command : unit Cmd.t + +module Dump_dot_merlin : sig + val command : unit Cmd.t +end + +val group : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/ocaml/top.ml b/unikernel/duniverse/dune_/bin/ocaml/top.ml new file mode 100644 index 00000000..4a77c40d --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/top.ml @@ -0,0 +1,248 @@ +open Import + +let doc = + "Print a list of toplevel directives for including directories and loading cma files." +;; + +let man = + [ `S "DESCRIPTION" + ; `P + {|Print a list of toplevel directives for including directories and loading cma files.|} + ; `P + {|The output of $(b,dune top) should be evaluated in a toplevel + to make a library available there.|} + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "top" ~doc ~man + +let link_deps sctx link = + let open Memo.O in + let* lib_config = + let+ ocaml = Super_context.context sctx |> Context.ocaml in + ocaml.lib_config + in + Memo.parallel_map link ~f:(fun t -> + Dune_rules.Lib_flags.link_deps sctx t Dune_rules.Link_mode.Byte lib_config) + >>| List.concat +;; + +let files_to_load_of_requires sctx requires = + let open Memo.O in + let* files = link_deps sctx requires in + let+ () = Memo.parallel_iter files ~f:Build_system.build_file in + List.filter files ~f:(fun p -> + let ext = Path.extension p in + ext = Ocaml.Mode.compiled_lib_ext Byte || ext = Ocaml.Cm_kind.ext Cmo) +;; + +let term = + let+ builder = Common.Builder.term + and+ dir = Arg.(value & pos 0 string "" & Arg.info [] ~docv:"DIR") + and+ ctx_name = Common.context_arg ~doc:{|Select context where to build/run utop.|} in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn (fun () -> + let open Memo.O in + let* setup = setup in + let sctx = + Dune_engine.Context_name.Map.find setup.scontexts ctx_name |> Option.value_exn + in + let context = Super_context.context sctx in + let* libs = + let dir = + let build_dir = Context.build_dir context in + Path.Build.relative build_dir (Common.prefix_target common dir) + in + let* db = + let+ scope = Dune_rules.Scope.DB.find_by_dir dir in + Dune_rules.Scope.libs scope + in + (* TODO why don't we read ppx as well?*) + Dune_rules.Utop.libs_under_dir sctx ~db ~dir:(Path.build dir) + in + let* requires = + Dune_rules.Resolve.Memo.read_memo (Dune_rules.Lib.closure ~linking:true libs) + in + let* lib_config = + let+ ocaml = Context.ocaml context in + ocaml.lib_config + in + let include_paths = + Dune_rules.Lib_flags.L.toplevel_include_paths requires lib_config + in + let+ files_to_load = files_to_load_of_requires sctx requires in + Dune_rules.Toplevel.print_toplevel_init_file + { include_paths; files_to_load; uses = []; pp = None; ppx = None; code = [] })) +;; + +let command = Cmd.v info term + +module Module = struct + let doc = "Print a list of toplevel directives for loading a module into the topevel." + + let man = + [ `S "DESCRIPTION" + ; `P doc + ; `P + "The module's source is evaluated in the toplevel without being sealed by the \ + mli." + ; `P + {|The output of $(b,dune top) should be evaluated in a toplevel + to make the module available there.|} + ; `Blocks Common.help_secs + ] + ;; + + let info = Cmd.info "top-module" ~doc ~man + + let module_directives sctx mod_ = + let ctx = Super_context.context sctx in + let src = Path.Build.append_source (Context.build_dir ctx) mod_ in + let dir = Path.Build.parent_exn src in + let filename = Path.Build.basename src in + if Filename.extension filename = "" + then User_error.raise [ Pp.text "file is missing an extension" ]; + let open Memo.O in + let module_name = + let name = Filename.remove_extension filename in + Dune_rules.Module_name.of_string_user_error (Loc.none, name) |> User_error.ok_exn + in + let* expander = Super_context.expander sctx ~dir in + let* top_module_info = Dune_rules.Top_module.find_module sctx mod_ in + match top_module_info with + | None -> User_error.raise [ Pp.text "no module found" ] + | Some (_, _, _, Melange _) -> + User_error.raise [ Pp.text "Modules belonging to `melange.emit' are not supported" ] + | Some (module_, cctx, merlin, _) -> + let module Compilation_context = Dune_rules.Compilation_context in + let module Obj_dir = Dune_rules.Obj_dir in + let module Top_module = Dune_rules.Top_module in + let* requires = + let* requires = Compilation_context.requires_link cctx in + Dune_rules.Resolve.read_memo requires + in + let private_obj_dir = Top_module.private_obj_dir ctx mod_ in + let include_paths = + let libs = + let lib_config = (Compilation_context.ocaml cctx).lib_config in + Dune_rules.Lib_flags.L.toplevel_include_paths requires lib_config + in + Path.Set.add libs (Path.build (Obj_dir.byte_dir private_obj_dir)) + in + let files_to_load () = + let+ libs, modules = + Memo.fork_and_join + (fun () -> files_to_load_of_requires sctx requires) + (fun () -> + let cmis () = + let glob = + Dune_engine.File_selector.of_glob + ~dir:(Path.build (Obj_dir.byte_dir private_obj_dir)) + (Dune_lang.Glob.of_string_exn Loc.none "*.cmi") + in + let* files = Build_system.eval_pred glob in + Memo.parallel_iter + (Filename_set.to_list files) + ~f:Build_system.build_file + in + let cmos () = + let obj_dir = Compilation_context.obj_dir cctx in + let dep_graph = (Compilation_context.dep_graphs cctx).impl in + let* modules = + let graph = + Dune_rules.Dep_graph.top_closed_implementations dep_graph [ module_ ] + in + let+ modules, _ = Action_builder.evaluate_and_collect_facts graph in + modules + in + let cmos = + let module Module = Dune_rules.Module in + let module Module_name = Dune_rules.Module_name in + let module_obj_name = Module.obj_name module_ in + List.filter_map modules ~f:(fun m -> + let obj_dir = + if Module_name.Unique.equal module_obj_name (Module.obj_name m) + then private_obj_dir + else obj_dir + in + Obj_dir.Module.cm_file obj_dir m ~kind:(Ocaml Cmo) + |> Option.map ~f:Path.build) + in + let+ (_ : Dep.Facts.t) = + Build_system.build_deps (Dep.Set.of_files cmos) + in + cmos + in + Memo.fork_and_join_unit cmis cmos) + in + libs @ modules + in + let pps () = + let module Merlin = Dune_rules.Merlin in + let pps = Merlin.pp_config merlin ctx ~expander in + let+ pps, _ = Action_builder.evaluate_and_collect_facts pps in + let pp = Dune_rules.Module_name.Per_item.get pps module_name in + match pp with + | None -> None, None + | Some pp_flags -> + let args = Merlin.Processed.pp_args pp_flags in + (match Merlin.Processed.pp_kind pp_flags with + | Pp -> Some args, None + | Ppx -> None, Some args) + in + let+ (pp, ppx), files_to_load = Memo.fork_and_join pps files_to_load in + let code = + let modules = Dune_rules.Compilation_context.modules cctx in + let opens_ = Dune_rules.Modules.With_vlib.local_open modules module_ in + List.map opens_ ~f:(fun name -> + sprintf "open %s" (Dune_rules.Module_name.to_string name)) + in + { Dune_rules.Toplevel.files_to_load; pp; ppx; include_paths; uses = []; code } + ;; + + let term = + let+ builder = Common.Builder.term + and+ module_path = + Arg.( + required + & pos 0 (some string) None + & Arg.info [] ~docv:"MODULE" ~doc:"Path to an OCaml module.") + and+ ctx_name = Common.context_arg ~doc:{|Select context where to build/run utop.|} in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn (fun () -> + let open Memo.O in + let* setup = setup in + let sctx = + Dune_engine.Context_name.Map.find setup.scontexts ctx_name |> Option.value_exn + in + let+ directives = + let module_path = + if Filename.is_relative module_path + then Path.Local.of_string module_path + else ( + let root = + (Common.root common).dir + |> Path.of_string + |> Path.to_absolute_filename + |> Path.of_string + in + match Path.drop_prefix ~prefix:root (Path.of_string module_path) with + | Some module_path -> module_path + | None -> + User_error.raise + [ Pp.text "Module path not a descendent of workspace root." ]) + in + module_directives sctx (Path.Source.of_local module_path) + in + Dune_rules.Toplevel.print_toplevel_init_file directives)) + ;; +end + +let module_command = Cmd.v Module.info Module.term diff --git a/unikernel/duniverse/dune_/bin/ocaml/top.mli b/unikernel/duniverse/dune_/bin/ocaml/top.mli new file mode 100644 index 00000000..7a9de18c --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/top.mli @@ -0,0 +1,4 @@ +open Import + +val command : unit Cmd.t +val module_command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/ocaml/utop.ml b/unikernel/duniverse/dune_/bin/ocaml/utop.ml new file mode 100644 index 00000000..678d0049 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/utop.ml @@ -0,0 +1,107 @@ +open Import +module Utop = Dune_rules.Utop + +let doc = "Load library in utop." + +let man = + [ `S "DESCRIPTION" + ; `P {|$(b,dune utop DIR) build and run utop toplevel with libraries defined in DIR|} + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "utop" ~doc ~man + +let lock_utop_if_dev_tool_enabled () = + match Lazy.force Lock_dev_tool.is_enabled with + | false -> Memo.return () + | true -> Lock_dev_tool.lock_dev_tool Utop +;; + +let term = + let+ builder = Common.Builder.term + and+ dir = Arg.(value & pos 0 string "" & Arg.info [] ~docv:"DIR") + and+ ctx_name = Common.context_arg ~doc:{|Select context where to build/run utop.|} + and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in + let common, config = Common.init builder in + let dir = Common.prefix_target common dir in + if not (Path.is_directory (Path.of_string dir)) + then User_error.raise [ Pp.textf "cannot find directory: %s" (String.maybe_quoted dir) ]; + let env, utop_path = + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn (fun () -> + let open Memo.O in + let* setup = setup in + let context = Import.Main.find_context_exn setup ~name:ctx_name in + let utop_target_path filename = + Path.build + (Path.Build.relative + (Context.build_dir context) + (Filename.concat dir filename)) + in + let utop_exe = utop_target_path Utop.utop_exe in + let utop_findlib_conf = utop_target_path Utop.utop_findlib_conf in + let* () = + (* Calling [Build_system.file_exists] has the side effect of checking + and memoizing whether or not the utop dev tool lockdir exists. + thus if we generate the lockdir any later than this point, dune + will not observe the fact that it now exists. *) + lock_utop_if_dev_tool_enabled () + in + Build_system.file_exists utop_exe + >>= function + | false -> + User_error.raise + [ Pp.textf "no library is defined in %s" (String.maybe_quoted dir) ] + | true -> + let* () = Build_system.build_file utop_exe in + let* utop_dev_tool_lock_dir_exists = + Memo.Lazy.force Utop.utop_dev_tool_lock_dir_exists + in + let* () = + if utop_dev_tool_lock_dir_exists + then + (* Generate the custom findlib.conf file needed when utop is run + as a dev tool. *) + Build_system.build_file utop_findlib_conf + else Memo.return () + in + let sctx = Import.Main.find_scontext_exn setup ~name:ctx_name in + let* requires = + let dir = Path.Build.relative (Context.build_dir context) dir in + Utop.requires_under_dir sctx ~dir + in + let+ requires = Resolve.read_memo requires + and+ lib_config = + let+ ocaml = Context.ocaml context in + ocaml.lib_config + and+ env = Super_context.context_env sctx in + let env = + Dune_rules.Lib_flags.L.toplevel_ld_paths requires lib_config + |> Path.Set.fold + ~f:(fun dir env -> + Env_path.cons ~var:Ocaml.Env.caml_ld_library_path env ~dir) + ~init:env + in + let env = + if utop_dev_tool_lock_dir_exists + then + (* If there's a utop lockdir then dune will have built utop as a + dev tool. In order for it to run correctly dune needed to + generate a custom findlib.conf that contains the locations of + all of utop's dependencies within the project's _build + directory. Setting this environment variable causes the custom + findlib.conf file to be used instead of the default + findlib.conf. *) + Env.add env ~var:"OCAMLFIND_CONF" ~value:(Path.to_string utop_findlib_conf) + else env + in + env, Path.to_string utop_exe)) + in + Hooks.End_of_build.run (); + restore_cwd_and_execve (Common.root common) utop_path args env +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/ocaml/utop.mli b/unikernel/duniverse/dune_/bin/ocaml/utop.mli new file mode 100644 index 00000000..54b77188 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/ocaml/utop.mli @@ -0,0 +1 @@ +val command : unit Cmdliner.Cmd.t diff --git a/unikernel/duniverse/dune_/bin/pkg/lock.ml b/unikernel/duniverse/dune_/bin/pkg/lock.ml new file mode 100644 index 00000000..2dc9f9f1 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/lock.ml @@ -0,0 +1,380 @@ +open Dune_config +open Import +open Pkg_common +module Package_version = Dune_pkg.Package_version +module Opam_repo = Dune_pkg.Opam_repo +module Lock_dir = Dune_pkg.Lock_dir +module Pin_stanza = Dune_lang.Pin_stanza +module Pin = Dune_pkg.Pin + +module Progress_indicator = struct + module Per_lockdir = struct + module State = struct + module Repository = Dune_pkg.Pkg_workspace.Repository + + type t = + | Updating_repos of Repository.Name.t list + | Solving + + let pp = function + | Updating_repos repo_names -> + Pp.textf + "Updating package repos %s..." + (List.map repo_names ~f:(fun repo_name -> + Repository.Name.to_string repo_name |> String.quoted) + |> String.enumerate_and) + | Solving -> Pp.text "Solving..." + ;; + end + + type t = + { lockdir_path : Path.Source.t + ; state : State.t option ref + } + + let create lockdir_path = { lockdir_path; state = ref None } + end + + (* The progress indicator for the entire lock operation, which may + involve generating multiple lockdirs *) + type t = Per_lockdir.t list + + let pp (t : t) = + (* Only display the first non-done lockdir state, since the status + line can only consist of a single line. *) + List.find_map t ~f:(fun { Per_lockdir.lockdir_path; state } -> + Option.map !state ~f:(fun state -> + Pp.concat + [ Pp.textf "Locking %s: " (Path.Source.to_string_maybe_quoted lockdir_path) + ; Per_lockdir.State.pp state + ])) + |> Option.value ~default:Pp.nop + ;; + + let add_overlay (t : t) = Console.Status_line.add_overlay (Live (fun () -> pp t)) +end + +let project_and_package_pins project = + let dir = Dune_project.root project in + let pins = Dune_project.pins project in + let packages = Dune_project.packages project in + Pin.DB.add_opam_pins (Pin.DB.of_stanza ~dir pins) packages +;; + +(* For recursive pins, we must traverse the pinned sources. The [project_pins] + are the initial pins that we have in our project. *) +let resolve_project_pins project_pins = + let scan_project ~read ~files = + let read file = Memo.of_reproducible_fiber (read file) in + let open Memo.O in + (* Opam files may never contain recursive pins, so don't both reading them *) + Dune_project.gen_load + ~read + ~files + ~dir:Path.Source.root + ~infer_from_opam_files:false + ~load_opam_file_with_contents:Dune_pkg.Opam_file.load_opam_file_with_contents + >>| Option.map ~f:(fun project -> + let packages = Dune_project.packages project in + let pins = project_and_package_pins project in + pins, packages) + |> Memo.run + in + Pin.resolve project_pins ~scan_project +;; + +let solve_multiple_platforms + base_solver_env + version_preference + repos + ~pins + ~local_packages + ~constraints + ~selected_depopts + ~solve_for_platforms + ~portable_lock_dir + = + let open Fiber.O in + let solve_for_env env = + Dune_pkg.Opam_solver.solve_lock_dir + env + version_preference + repos + ~pins + ~local_packages + ~constraints + ~selected_depopts + ~portable_lock_dir + in + let portable_solver_env = + Dune_pkg.Solver_env.unset_multi + base_solver_env + Dune_lang.Package_variable_name.platform_specific + in + let+ results = + Fiber.parallel_map solve_for_platforms ~f:(fun platform_env -> + let solver_env = Dune_pkg.Solver_env.extend portable_solver_env platform_env in + solve_for_env solver_env) + in + let solver_results, errors = + List.partition_map results ~f:(function + | Ok result -> Left result + | Error (`Diagnostic_message message) -> Right message) + in + match solver_results, errors with + | [], [] -> Code_error.raise "Solver did not run for any platforms." [] + | [], errors -> `All_error errors + | x :: xs, errors -> + let merged_solver_result = + List.fold_left xs ~init:x ~f:Dune_pkg.Opam_solver.Solver_result.merge + in + if List.is_empty errors + then `All_ok merged_solver_result + else `Partial (merged_solver_result, errors) +;; + +let solve_lock_dir + workspace + ~local_packages + ~project_pins + ~print_perf_stats + ~portable_lock_dir + version_preference + solver_env_from_current_system + lock_dir_path + progress_state + = + let open Fiber.O in + let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in + let project_pins, solve_for_platforms = + match lock_dir with + | None -> project_pins, Dune_pkg.Solver_env.popular_platform_envs + | Some lock_dir -> + let workspace = + Pin.DB.Workspace.of_stanza workspace.pins + |> Pin.DB.Workspace.extract ~names:lock_dir.pins + in + Pin.DB.combine_exn workspace project_pins, lock_dir.solve_for_platforms + in + let solver_env_from_context = + Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.solver_env) + in + let solver_env = + solver_env + ~solver_env_from_context + ~solver_env_from_current_system + ~unset_solver_vars_from_context: + (unset_solver_vars_of_workspace workspace ~lock_dir_path) + in + let solve_for_platforms = + match portable_lock_dir with + | true -> + (match solver_env_from_context with + | Some solver_env_from_context -> + List.map solve_for_platforms ~f:(fun platform_env -> + Dune_pkg.Solver_env.extend solver_env_from_context platform_env) + | None -> solve_for_platforms) + | false -> [ solver_env ] + in + let time_start = Unix.gettimeofday () in + let* repos = + let repo_map = repositories_of_workspace workspace in + let repo_names = + Dune_pkg.Pkg_workspace.Repository.Name.Map.keys repo_map + |> List.sort ~compare:Dune_pkg.Pkg_workspace.Repository.Name.compare + in + progress_state + := Some (Progress_indicator.Per_lockdir.State.Updating_repos repo_names); + get_repos repo_map ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path) + in + let* pins = resolve_project_pins project_pins in + let time_solve_start = Unix.gettimeofday () in + progress_state := Some Progress_indicator.Per_lockdir.State.Solving; + let* result = + solve_multiple_platforms + solver_env + (Pkg_common.Version_preference.choose + ~from_arg:version_preference + ~from_context: + (Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.version_preference))) + repos + ~pins + ~local_packages: + (Package_name.Map.map local_packages ~f:Dune_pkg.Local_package.for_solver) + ~constraints:(constraints_of_workspace workspace ~lock_dir_path) + ~selected_depopts:(depopts_of_workspace workspace ~lock_dir_path) + ~solve_for_platforms + ~portable_lock_dir + in + let solver_result = + match result with + | `All_error messages -> Error messages + | `All_ok solver_result -> Ok (solver_result, []) + | `Partial (solver_result, errors) -> + Log.info errors; + Ok + ( solver_result + , [ Pp.nop + ; Pp.text + "No solution was found for some platforms. See the log or run with \ + --verbose for more details." + |> Pp.tag User_message.Style.Warning + ] ) + in + match solver_result with + | Error messages -> Fiber.return (Error (lock_dir_path, messages)) + | Ok (solver_result, maybe_unsolved_platforms_message) -> + let { Dune_pkg.Opam_solver.Solver_result.lock_dir + ; files + ; pinned_packages + ; num_expanded_packages + } + = + solver_result + in + let time_end = Unix.gettimeofday () in + let maybe_perf_stats = + if print_perf_stats + then + [ Pp.nop + ; Pp.textf "Expanded packages: %d" num_expanded_packages + ; Pp.textf "Updated repos in: %.2fs" (time_solve_start -. time_start) + ; Pp.textf "Solved dependencies in: %.2fs" (time_end -. time_solve_start) + ] + else [] + in + let summary_message = + User_message.make + ((Pp.tag + User_message.Style.Success + (Pp.textf + "Solution for %s:" + (Path.Source.to_string_maybe_quoted lock_dir_path)) + :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with + | [] -> + Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)" + | packages -> pp_packages packages) + :: maybe_perf_stats) + @ maybe_unsolved_platforms_message) + in + progress_state := None; + let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in + Ok + ( Lock_dir.Write_disk.prepare ~portable_lock_dir ~lock_dir_path ~files lock_dir + , summary_message ) +;; + +let solve + workspace + ~local_packages + ~project_pins + ~solver_env_from_current_system + ~version_preference + ~lock_dirs + ~print_perf_stats + ~portable_lock_dir + = + let open Fiber.O in + (* a list of thunks that will perform all the file IO side + effects after performing validation so that if materializing any + lockdir would fail then no side effect takes place. *) + (let+ errors, solutions = + let progress_indicator = + List.map lock_dirs ~f:Progress_indicator.Per_lockdir.create + in + let overlay = Progress_indicator.add_overlay progress_indicator in + let+ result = + Fiber.finalize + ~finally:(fun () -> + Console.Status_line.remove_overlay overlay; + Fiber.return ()) + (fun () -> + Fiber.parallel_map progress_indicator ~f:(fun { lockdir_path; state } -> + solve_lock_dir + workspace + ~local_packages + ~project_pins + ~print_perf_stats + ~portable_lock_dir + version_preference + solver_env_from_current_system + lockdir_path + state)) + in + List.partition_map result ~f:Result.to_either + in + match errors with + | [] -> Ok solutions + | _ -> Error errors) + >>| function + | Error errors -> + User_error.raise + ([ Pp.text "Unable to solve dependencies for the following lock directories:" ] + @ List.concat_map errors ~f:(fun (path, messages) -> + [ Pp.textf "Lock directory %s:" (Path.Source.to_string_maybe_quoted path) + ; Pp.hovbox (Pp.concat ~sep:Pp.newline messages) + ])) + | Ok write_disks_with_summaries -> + let write_disk_list, summary_messages = List.split write_disks_with_summaries in + List.iter summary_messages ~f:Console.print_user_message; + (* All the file IO side effects happen here: *) + List.iter write_disk_list ~f:Lock_dir.Write_disk.commit +;; + +let project_pins = + let open Memo.O in + Dune_rules.Dune_load.projects () + >>| List.fold_left ~init:Pin.DB.empty ~f:(fun acc project -> + let pins = project_and_package_pins project in + Pin.DB.combine_exn acc pins) +;; + +let lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir = + let open Fiber.O in + let* solver_env_from_current_system = + poll_solver_env_from_current_system () >>| Option.some + and* workspace, local_packages, project_pins = + Memo.run + @@ + let open Memo.O in + let+ workspace = Workspace.workspace () + and+ local_packages = find_local_packages + and+ project_pins = project_pins in + workspace, local_packages, project_pins + in + let lock_dirs = + Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace + in + solve + workspace + ~local_packages + ~project_pins + ~solver_env_from_current_system + ~version_preference + ~lock_dirs + ~print_perf_stats + ~portable_lock_dir +;; + +let term = + let+ builder = Common.Builder.term + and+ version_preference = Version_preference.term + and+ lock_dirs_arg = Pkg_common.Lock_dirs_arg.term + and+ print_perf_stats = Arg.(value & flag & info [ "print-perf-stats" ]) in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let portable_lock_dir = + match Config.get Dune_rules.Compile_time.portable_lock_dir with + | `Enabled -> true + | `Disabled -> false + in + lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir) +;; + +let info = + let doc = "Create a lockfile" in + Cmd.info "lock" ~doc +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/pkg/lock.mli b/unikernel/duniverse/dune_/bin/pkg/lock.mli new file mode 100644 index 00000000..ea7f4520 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/lock.mli @@ -0,0 +1,15 @@ +open Import + +val solve + : Workspace.t + -> local_packages:Dune_pkg.Local_package.t Package_name.Map.t + -> project_pins:Dune_pkg.Pin.DB.t + -> solver_env_from_current_system:Dune_pkg.Solver_env.t option + -> version_preference:Dune_pkg.Version_preference.t option + -> lock_dirs:Path.Source.t list + -> print_perf_stats:bool + -> portable_lock_dir:bool + -> unit Fiber.t + +(** Command to create lock directory *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/pkg/outdated.ml b/unikernel/duniverse/dune_/bin/pkg/outdated.ml new file mode 100644 index 00000000..943548d2 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/outdated.ml @@ -0,0 +1,103 @@ +open Import +open Pkg_common + +let find_outdated_packages ~transitive ~lock_dirs_arg () = + let open Fiber.O in + let+ pps, not_founds = + let* workspace = Memo.run (Workspace.workspace ()) in + Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace + |> Fiber.parallel_map ~f:(fun lock_dir_path -> + (* updating makes sense when checking for outdated packages *) + let* repos = + get_repos + (repositories_of_workspace workspace) + ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path) + and+ local_packages = Memo.run find_local_packages + and+ platform = solver_env_from_system_and_context ~lock_dir_path in + let lock_dir = Dune_pkg.Lock_dir.read_disk_exn lock_dir_path in + let packages = + Dune_pkg.Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform + in + let+ results = Dune_pkg.Outdated.find ~repos ~local_packages packages in + ( Dune_pkg.Outdated.pp ~transitive ~lock_dir_path results + , ( Dune_pkg.Outdated.packages_that_were_not_found results + |> Package_name.Set.of_list + |> Package_name.Set.to_list + , lock_dir_path + , repos ) )) + >>| List.split + in + (match pps with + | [ _ ] -> Console.print pps + | _ -> Console.print [ Pp.enumerate ~f:Fun.id pps ]); + let error_messages = + List.filter_map not_founds ~f:(function + | [], _, _ -> None + | packages, lock_dir_path, repos -> + Pp.concat + ~sep:Pp.space + [ Pp.textf + "When checking %s, the following packages:" + (Path.Source.to_string_maybe_quoted lock_dir_path) + |> Pp.hovbox + ; Pp.concat + ~sep:Pp.space + [ Pp.enumerate packages ~f:(fun name -> + Dune_lang.Package_name.to_string name |> Pp.verbatim) + ; Pp.text "were not found in the following opam repositories:" |> Pp.hovbox + ; Pp.enumerate repos ~f:(fun repo -> + (* CR-rgrinberg: why are we outputting [Dyn.t] in error + messages? *) + Dune_pkg.Opam_repo.serializable repo + |> Dyn.option Dune_pkg.Opam_repo.Serializable.to_dyn + |> Dyn.pp) + ] + |> Pp.vbox + ] + |> Pp.hovbox + |> Option.some) + in + match error_messages with + | [] -> () + | error_messages -> + User_error.raise (Pp.text "Some packages could not be found." :: error_messages) +;; + +let term = + let+ builder = Common.Builder.term + and+ transitive = + Arg.( + value + & flag + & info + [ "transitive" ] + ~doc:"Check for outdated packages in transitive dependencies") + and+ lock_dirs_arg = Pkg_common.Lock_dirs_arg.term in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ find_outdated_packages ~transitive ~lock_dirs_arg +;; + +let info = + let doc = "Check for outdated packages" in + let man = + [ `S "DESCRIPTION" + ; `P + "List packages in from lock directory that have newer versions available. By \ + default, only direct dependencies are checked. The $(b,--transitive) flag can \ + be used to check transitive dependencies as well." + ; `P "For example:" + ; `Pre " \\$ dune pkg outdated" + ; `Noblank + ; `Pre " 1/2 packages in dune.lock are outdated." + ; `Noblank + ; `Pre " - ocaml 4.14.1 < 5.1.0" + ; `Noblank + ; `Pre " - dune 3.7.1 < 3.11.0" + ] + in + Cmd.info "outdated" ~doc ~man +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/pkg/outdated.mli b/unikernel/duniverse/dune_/bin/pkg/outdated.mli new file mode 100644 index 00000000..1e7a5a52 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/outdated.mli @@ -0,0 +1,4 @@ +open Import + +(** Command to print outdated packages *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/pkg/pkg.ml b/unikernel/duniverse/dune_/bin/pkg/pkg.ml new file mode 100644 index 00000000..54ae3538 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/pkg.ml @@ -0,0 +1,28 @@ +open Import + +let man = + [ `S "DESCRIPTION" + ; `P {|Commands for OCaml package management|} + ; `Blocks Common.help_secs + ] +;; + +let subcommands = + [ Lock.command + ; Print_solver_env.command + ; Outdated.command + ; Validate_lock_dir.command + ; Pkg_enabled.command + ] +;; + +let info name = + let doc = "Experimental package management" in + Cmd.info name ~doc ~man +;; + +let group = Cmd.group (info "pkg") subcommands + +module Alias = struct + let group = Cmd.group (info "package") subcommands +end diff --git a/unikernel/duniverse/dune_/bin/pkg/pkg.mli b/unikernel/duniverse/dune_/bin/pkg/pkg.mli new file mode 100644 index 00000000..4614acfa --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/pkg.mli @@ -0,0 +1,7 @@ +open Import + +val group : unit Cmd.t + +module Alias : sig + val group : unit Cmd.t +end diff --git a/unikernel/duniverse/dune_/bin/pkg/pkg_common.ml b/unikernel/duniverse/dune_/bin/pkg/pkg_common.ml new file mode 100644 index 00000000..ff05f8cf --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/pkg_common.ml @@ -0,0 +1,228 @@ +open Import +module Lock_dir = Dune_pkg.Lock_dir +module Solver_env = Dune_pkg.Solver_env +module Package_variable_name = Dune_lang.Package_variable_name +module Variable_value = Dune_pkg.Variable_value + +let solver_env + ~solver_env_from_current_system + ~solver_env_from_context + ~unset_solver_vars_from_context + = + let solver_env = + [ solver_env_from_current_system; solver_env_from_context ] + |> List.filter_opt + |> List.fold_left ~init:Solver_env.with_defaults ~f:Solver_env.extend + in + match unset_solver_vars_from_context with + | None -> solver_env + | Some unset_solver_vars -> Solver_env.unset_multi solver_env unset_solver_vars +;; + +let poll_solver_env_from_current_system () = + Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial) + |> Dune_pkg.Sys_poll.solver_env_from_current_system +;; + +let get_lock_dir_from_context ~lock_dir_path = + Memo.run + @@ + let open Memo.O in + let+ workspace = Workspace.workspace () in + Workspace.find_lock_dir workspace lock_dir_path +;; + +let get_solver_env_from_context ~lock_dir_path = + let open Fiber.O in + let+ lock_dir = get_lock_dir_from_context ~lock_dir_path in + Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.solver_env) +;; + +let get_unset_solver_vars_from_context ~lock_dir_path = + let open Fiber.O in + let+ lock_dir = get_lock_dir_from_context ~lock_dir_path in + Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.unset_solver_vars) +;; + +let solver_env_from_system_and_context ~lock_dir_path = + let open Fiber.O in + let+ solver_env_from_current_system = + poll_solver_env_from_current_system () >>| Option.some + and+ solver_env_from_context = get_solver_env_from_context ~lock_dir_path + and+ unset_solver_vars_from_context = + get_unset_solver_vars_from_context ~lock_dir_path + in + solver_env + ~solver_env_from_current_system + ~solver_env_from_context + ~unset_solver_vars_from_context +;; + +module Version_preference = struct + include Dune_pkg.Version_preference + + let term = + let all_strings = List.map all_by_string ~f:fst in + let doc = + sprintf + "Whether to prefer the newest compatible version of a package or the oldest \ + compatible version of packages while solving dependencies. This overrides any \ + setting in the current workspace. The default is %s." + (to_string default) + in + let docv = String.concat ~sep:"|" all_strings |> sprintf "(%s)" in + Arg.( + value + & opt (some (enum all_by_string)) None + & info [ "version-preference" ] ~doc ~docv) + ;; + + let choose ~from_arg ~from_context = + match from_arg, from_context with + | Some from_arg, _ -> from_arg + | None, Some from_context -> from_context + | None, None -> default + ;; +end + +let repositories_of_workspace (workspace : Workspace.t) = + List.map workspace.repos ~f:(fun repo -> + Dune_pkg.Pkg_workspace.Repository.name repo, repo) + |> Dune_pkg.Pkg_workspace.Repository.Name.Map.of_list_exn +;; + +let constraints_of_workspace (workspace : Workspace.t) ~lock_dir_path = + match Workspace.find_lock_dir workspace lock_dir_path with + | None -> [] + | Some lock_dir -> lock_dir.constraints +;; + +let depopts_of_workspace (workspace : Workspace.t) ~lock_dir_path = + match Workspace.find_lock_dir workspace lock_dir_path with + | None -> [] + | Some lock_dir -> lock_dir.depopts |> List.map ~f:snd +;; + +let repositories_of_lock_dir workspace ~lock_dir_path = + match Workspace.find_lock_dir workspace lock_dir_path with + | Some lock_dir -> lock_dir.repositories + | None -> + List.map workspace.repos ~f:(fun repo -> + let name = Dune_pkg.Pkg_workspace.Repository.name repo in + let loc = Loc.none in + loc, name) +;; + +let unset_solver_vars_of_workspace workspace ~lock_dir_path = + let open Option.O in + let* lock_dir = Workspace.find_lock_dir workspace lock_dir_path in + lock_dir.unset_solver_vars +;; + +let get_repos repos ~repositories = + let module Repository = Dune_pkg.Pkg_workspace.Repository in + repositories + |> Fiber.parallel_map ~f:(fun (loc, name) -> + match Repository.Name.Map.find repos name with + | None -> + User_error.raise + ~loc + [ Pp.textf "Repository '%s' is not a known repository" + @@ Repository.Name.to_string name + ] + | Some repo -> + let loc, opam_url = Repository.opam_url repo in + let module Opam_repo = Dune_pkg.Opam_repo in + (match Dune_pkg.OpamUrl.classify opam_url loc with + | `Git -> Opam_repo.of_git_repo loc opam_url + | `Path path -> Fiber.return @@ Opam_repo.of_opam_repo_dir_path loc path + | `Archive -> + User_error.raise + ~loc + [ Pp.textf "Repositories stored in archives (%s) are currently unsupported" + @@ OpamUrl.to_string opam_url + ])) +;; + +let find_local_packages = + let open Memo.O in + Dune_rules.Dune_load.packages () + >>| Package.Name.Map.map ~f:Dune_pkg.Local_package.of_package +;; + +let pp_package { Lock_dir.Pkg.info = { Lock_dir.Pkg_info.name; version; avoid; _ }; _ } = + let warn = + if avoid + then Pp.tag User_message.Style.Warning (Pp.text " (this version should be avoided)") + else Pp.nop + in + let open Pp.O in + Pp.verbatim + (Package_name.to_string name ^ "." ^ Dune_pkg.Package_version.to_string version) + ++ warn +;; + +let pp_packages packages = Pp.enumerate packages ~f:pp_package + +module Lock_dirs_arg = struct + type t = + | All + | Selected of Path.Source.t list + + let all = All + + let term = + Common.one_of + (let+ arg = + Arg.( + value + & pos_all string [] + & info + [] + ~docv:"LOCKDIRS" + ~doc: + "Lock directories to check for outdated packages. Defaults to dune.lock.") + in + Selected (List.map arg ~f:Path.Source.of_string)) + (let+ _all = + Arg.( + value + & flag + & info + [ "all" ] + ~doc:"Check all lock directories in the workspace for outdated packages.") + in + All) + ;; + + let lock_dirs_of_workspace t (workspace : Workspace.t) = + let workspace_lock_dirs = + Lock_dir.default_path + :: List.map workspace.lock_dirs ~f:(fun (lock_dir : Workspace.Lock_dir.t) -> + lock_dir.path) + |> Path.Source.Set.of_list + |> Path.Source.Set.to_list + in + match t with + | All -> workspace_lock_dirs + | Selected [] -> [ Lock_dir.default_path ] + | Selected chosen_lock_dirs -> + let workspace_lock_dirs_set = Path.Source.Set.of_list workspace_lock_dirs in + let chosen_lock_dirs_set = Path.Source.Set.of_list chosen_lock_dirs in + if Path.Source.Set.is_subset chosen_lock_dirs_set ~of_:workspace_lock_dirs_set + then chosen_lock_dirs + else ( + let unknown_lock_dirs = + Path.Source.Set.diff chosen_lock_dirs_set workspace_lock_dirs_set + |> Path.Source.Set.to_list + in + let f x = Path.pp (Path.source x) in + User_error.raise + [ Pp.text + "The following directories are not lock directories in this workspace:" + ; Pp.enumerate unknown_lock_dirs ~f + ; Pp.text "This workspace contains the following lock directories:" + ; Pp.enumerate workspace_lock_dirs ~f + ]) + ;; +end diff --git a/unikernel/duniverse/dune_/bin/pkg/pkg_common.mli b/unikernel/duniverse/dune_/bin/pkg/pkg_common.mli new file mode 100644 index 00000000..fb15d43a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/pkg_common.mli @@ -0,0 +1,92 @@ +open Import + +(** Create a [Dune_pkg.Solver_env.t] by combining variables taken from the + current system and variables taken from the current context, with priority + being given to the latter. Some variables are initialized to default values + (which can be overridden by the arguments to this function): + - "with-doc" is set to "false" + - "opam-version" is set to the version of opam vendored in dune *) +val solver_env + : solver_env_from_current_system:Dune_pkg.Solver_env.t option + -> solver_env_from_context:Dune_pkg.Solver_env.t option + -> unset_solver_vars_from_context:Dune_lang.Package_variable_name.Set.t option + -> Dune_pkg.Solver_env.t + +val poll_solver_env_from_current_system : unit -> Dune_pkg.Solver_env.t Fiber.t + +val solver_env_from_system_and_context + : lock_dir_path:Path.Source.t + -> Dune_pkg.Solver_env.t Fiber.t + +module Version_preference : sig + type t := Dune_pkg.Version_preference.t + + val term : Dune_pkg.Version_preference.t option Term.t + val choose : from_arg:t option -> from_context:t option -> t +end + +val unset_solver_vars_of_workspace + : Workspace.t + -> lock_dir_path:Path.Source.t + -> Dune_lang.Package_variable_name.Set.t option + +val repositories_of_workspace + : Workspace.t + -> Dune_pkg.Pkg_workspace.Repository.t Dune_pkg.Pkg_workspace.Repository.Name.Map.t + +val repositories_of_lock_dir + : Workspace.t + -> lock_dir_path:Path.Source.t + -> (Loc.t * Dune_pkg.Pkg_workspace.Repository.Name.t) list + +val constraints_of_workspace + : Workspace.t + -> lock_dir_path:Path.Source.t + -> Dune_lang.Package_dependency.t list + +val depopts_of_workspace + : Workspace.t + -> lock_dir_path:Path.Source.t + -> Package_name.t list + +val get_repos + : Dune_pkg.Pkg_workspace.Repository.t Dune_pkg.Pkg_workspace.Repository.Name.Map.t + -> repositories:(Loc.t * Dune_pkg.Pkg_workspace.Repository.Name.t) list + -> Dune_pkg.Opam_repo.t list Fiber.t + +val find_local_packages : Dune_pkg.Local_package.t Package_name.Map.t Memo.t + +module Lock_dirs_arg : sig + (** [Lock_dirs_arg.t] is the type of lock directory arguments. This can be + created with [Lock_dirs_arg.term] and used with + [Lock_dirs_arg.lock_dirs_of_workspace]. *) + type t + + (** Select all lockdirs *) + val all : t + + (** [Lock_dirs_arg.term] is a command-line argument that can be used to + specify the lock directories to consider. This can then be passed to + [Lock_dirs_arg.lock_dirs_of_workspace]. + + There are two mutually exclusive cases: + - The user passed a list of lick directories as positional + arguments.contents + - The user passed the ["--all"] flag, in which case all lock directories + of the workspace are considered. *) + val term : t Term.t + + (** [Lock_dirs_arg.lock_dirs_of_workspace t workspace] returns the list of + lock directories that should be considered for various operations. + + The [workspace] argument is used to determine the list of all lock lock + directories. + + A user error is raised if the list of positional arguments used when + creating [t] is not a subset of the lock directories of the workspace. *) + val lock_dirs_of_workspace : t -> Workspace.t -> Path.Source.t list +end + +(** [pp_packages lock_dir] returns a list of pretty-printed packages occurring in + [lock_dir]. *) +val pp_packages : Dune_pkg.Lock_dir.Pkg.t list -> User_message.Style.t Pp.t diff --git a/unikernel/duniverse/dune_/bin/pkg/pkg_enabled.ml b/unikernel/duniverse/dune_/bin/pkg/pkg_enabled.ml new file mode 100644 index 00000000..e4493644 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/pkg_enabled.ml @@ -0,0 +1,36 @@ +open Import + +let term = + let+ builder = Common.Builder.term in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + Memo.run + @@ + let open Memo.O in + let+ workspace = Workspace.workspace () in + let lock_dir_paths = + Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace + Pkg_common.Lock_dirs_arg.all + workspace + in + let any_lockdir_exists = + List.exists lock_dir_paths ~f:(fun lock_dir_path -> + Path.exists (Path.source lock_dir_path)) + in + (* CR-Leonidas-from-XIV: change this logic when we stop detecting lock + directories in the source tree *) + let enabled = any_lockdir_exists || workspace.config.pkg_enabled in + match enabled with + | true -> () + | false -> exit 1) +;; + +let info = + let doc = + "Check if the project indicates that dune's package management features should be \ + enabled. Exits with 0 if package management is enabled and 1 otherwise." + in + Cmd.info "enabled" ~doc +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/pkg/pkg_enabled.mli b/unikernel/duniverse/dune_/bin/pkg/pkg_enabled.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/pkg_enabled.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/pkg/print_solver_env.ml b/unikernel/duniverse/dune_/bin/pkg/print_solver_env.ml new file mode 100644 index 00000000..d875cc16 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/print_solver_env.ml @@ -0,0 +1,56 @@ +open Import +open Pkg_common + +let print_solver_env_for_lock_dir workspace ~solver_env_from_current_system lock_dir_path = + let solver_env_from_context = + Option.bind (Workspace.find_lock_dir workspace lock_dir_path) ~f:(fun lock_dir -> + lock_dir.solver_env) + in + let solver_env = + solver_env + ~solver_env_from_current_system + ~solver_env_from_context + ~unset_solver_vars_from_context: + (Pkg_common.unset_solver_vars_of_workspace workspace ~lock_dir_path) + in + Console.print + [ Pp.textf + "Solver environment for lock directory %s:" + (Path.Source.to_string_maybe_quoted lock_dir_path) + ; Dune_pkg.Solver_env.pp solver_env + ] +;; + +let print_solver_env ~lock_dirs_arg = + let open Fiber.O in + let+ workspace = Memo.run (Workspace.workspace ()) + and+ solver_env_from_current_system = + Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial) + |> Dune_pkg.Sys_poll.solver_env_from_current_system + >>| Option.some + in + let lock_dirs = Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace in + List.iter + lock_dirs + ~f:(print_solver_env_for_lock_dir workspace ~solver_env_from_current_system) +;; + +let term = + let+ builder = Common.Builder.term + and+ lock_dirs_arg = Lock_dirs_arg.term in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> print_solver_env ~lock_dirs_arg) +;; + +let info = + let doc = + "Print a description of the environment that would be used to solve dependencies and \ + then exit without attempting to solve the dependencies or generate the lockfile. \ + Intended to be used to debug situations where no solution can be found to a \ + project's dependencies." + in + Cmd.info "print-solver-env" ~doc +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/pkg/print_solver_env.mli b/unikernel/duniverse/dune_/bin/pkg/print_solver_env.mli new file mode 100644 index 00000000..0f30aae9 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/print_solver_env.mli @@ -0,0 +1,4 @@ +open Import + +(** Command to print solver environment *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.ml b/unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.ml new file mode 100644 index 00000000..1cdfb8d8 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.ml @@ -0,0 +1,88 @@ +open! Import +open Pkg_common +module Package_universe = Dune_pkg.Package_universe +module Lock_dir = Dune_pkg.Lock_dir +module Opam_repo = Dune_pkg.Opam_repo +module Package_version = Dune_pkg.Package_version +module Opam_solver = Dune_pkg.Opam_solver + +let info = + let doc = "Validate that a lockdir contains a solution for local packages" in + let man = [ `S "DESCRIPTION"; `P doc ] in + Cmd.info "validate-lockdir" ~doc ~man +;; + +(* CR-someday alizter: The logic here is a little more complicated than it needs + to be and can be simplified. *) + +let enumerate_lock_dirs_by_path ~lock_dirs () = + let open Memo.O in + let+ per_contexts = + Workspace.workspace () >>| Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs + in + List.filter_map per_contexts ~f:(fun lock_dir_path -> + if Path.exists (Path.source lock_dir_path) + then ( + try Some (Ok (lock_dir_path, Lock_dir.read_disk_exn lock_dir_path)) with + | User_error.E e -> Some (Error (lock_dir_path, `Parse_error e))) + else None) +;; + +let validate_lock_dirs ~lock_dirs () = + let open Fiber.O in + let* lock_dirs_by_path, local_packages = + Memo.both (enumerate_lock_dirs_by_path ~lock_dirs ()) Pkg_common.find_local_packages + |> Memo.run + in + if List.is_empty lock_dirs_by_path + then + let+ () = Fiber.return () in + Console.print [ Pp.text "No lockdirs to validate." ] + else + let+ universes = + Fiber.parallel_map lock_dirs_by_path ~f:(function + | Error e -> Fiber.return (Some e) + | Ok (lock_dir_path, lock_dir) -> + let+ platform = solver_env_from_system_and_context ~lock_dir_path in + (match Package_universe.create ~platform local_packages lock_dir with + | Ok _ -> None + | Error e -> Some (lock_dir_path, `Lock_dir_out_of_sync e))) + >>| List.filter_opt + in + match universes with + | [] -> () + | errors_by_path -> + List.iter errors_by_path ~f:(fun (path, error) -> + match error with + | `Parse_error error -> + User_message.prerr + (User_message.make + [ Pp.textf + "Failed to parse lockdir %s:" + (Path.Source.to_string_maybe_quoted path) + ; User_message.pp error + ]) + | `Lock_dir_out_of_sync error -> + User_message.prerr + (User_message.make + [ Pp.textf + "Lockdir %s does not contain a solution for local packages:" + (Path.Source.to_string path) + ]); + User_message.prerr error); + User_error.raise + [ Pp.text "Some lockdirs do not contain solutions for local packages:" + ; Pp.enumerate errors_by_path ~f:(fun (path, _) -> + Pp.text (Path.Source.to_string path)) + ] +;; + +let term = + let+ builder = Common.Builder.term + and+ lock_dirs = Pkg_common.Lock_dirs_arg.term in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config @@ validate_lock_dirs ~lock_dirs +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.mli b/unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.mli new file mode 100644 index 00000000..1523b5bd --- /dev/null +++ b/unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.mli @@ -0,0 +1,4 @@ +open Import + +(** Command to check if local packages and lockdir agree *) +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/print_rules.ml b/unikernel/duniverse/dune_/bin/print_rules.ml new file mode 100644 index 00000000..840ff6fd --- /dev/null +++ b/unikernel/duniverse/dune_/bin/print_rules.ml @@ -0,0 +1,306 @@ +open Import + +let doc = "Dump rules." + +let man = + [ `S "DESCRIPTION" + ; `P + {|Dump Dune rules for the given targets. + If no targets are given, dump all the rules.|} + ; `P + {|By default the output is a list of S-expressions, + one S-expression per rule. Each S-expression is of the form:|} + ; `Pre + " ((deps ())\n\ + \ (targets ())\n\ + \ (context )\n\ + \ (action ))" + ; `P + {|$(b,) is the context is which the action is executed. + It is omitted if the action is independent from the context.|} + ; `P + {|$(b,) is the action following the same syntax as user actions, + as described in the manual.|} + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "rules" ~doc ~man + +let print_rule_makefile ppf (rule : Dune_engine.Reflection.Rule.t) = + let action = + Action.For_shell.Progn + [ Mkdir (Path.to_string (Path.build rule.targets.root)) + ; Action.for_shell rule.action + ] + in + (* Makefiles seem to allow directory targets, so we include them. *) + let targets = + Filename.Set.union rule.targets.files rule.targets.dirs + |> Filename.Set.to_list_map ~f:(fun basename -> + Path.Build.relative rule.targets.root basename |> Path.build) + in + Format.fprintf + ppf + "@[@{%a:%t@}@]@,@<0>\t@{%a@}\n" + (Format.pp_print_list ~pp_sep:Format.pp_print_space (fun ppf p -> + Format.pp_print_string ppf (Path.to_string p))) + targets + (fun ppf -> + Path.Set.iter rule.expanded_deps ~f:(fun dep -> + Format.fprintf ppf "@ %s" (Path.to_string dep))) + Pp.to_fmt + (Action_to_sh.pp action) +;; + +let rec encode : Action.For_shell.t -> Dune_lang.t = + let module Outputs = Dune_lang.Action.Outputs in + let module File_perm = Dune_lang.Action.File_perm in + let module Inputs = Dune_lang.Action.Inputs in + let open Dune_lang in + let program = Encoder.string in + let string = Encoder.string in + let path = Encoder.string in + let target = Encoder.string in + function + | Run (a, xs) -> + List (atom "run" :: program a :: List.map (Array.Immutable.to_list xs) ~f:string) + | With_accepted_exit_codes (pred, t) -> + List + [ atom "with-accepted-exit-codes" + ; Predicate_lang.encode Dune_sexp.Encoder.int pred + ; encode t + ] + | Dynamic_run (a, xs) -> List (atom "run_dynamic" :: program a :: List.map xs ~f:string) + | Chdir (a, r) -> List [ atom "chdir"; path a; encode r ] + | Setenv (k, v, r) -> List [ atom "setenv"; string k; string v; encode r ] + | Redirect_out (outputs, fn, perm, r) -> + List + [ atom (sprintf "with-%s-to%s" (Outputs.to_string outputs) (File_perm.suffix perm)) + ; target fn + ; encode r + ] + | Redirect_in (inputs, fn, r) -> + List [ atom (sprintf "with-%s-from" (Inputs.to_string inputs)); path fn; encode r ] + | Ignore (outputs, r) -> + List [ atom (sprintf "ignore-%s" (Outputs.to_string outputs)); encode r ] + | Progn l -> List (atom "progn" :: List.map l ~f:encode) + | Concurrent l -> List (atom "concurrent" :: List.map l ~f:encode) + | Echo xs -> List (atom "echo" :: List.map xs ~f:string) + | Cat xs -> List (atom "cat" :: List.map xs ~f:path) + | Copy (x, y) -> List [ atom "copy"; path x; target y ] + | Symlink (x, y) -> List [ atom "symlink"; path x; target y ] + | Hardlink (x, y) -> List [ atom "hardlink"; path x; target y ] + | Bash x -> List [ atom "bash"; string x ] + | Write_file (x, perm, y) -> + List [ atom ("write-file" ^ File_perm.suffix perm); target x; string y ] + | Rename (x, y) -> List [ atom "rename"; target x; target y ] + | Remove_tree x -> List [ atom "remove-tree"; target x ] + | Mkdir x -> List [ atom "mkdir"; target x ] + | Pipe (outputs, l) -> + List (atom (sprintf "pipe-%s" (Outputs.to_string outputs)) :: List.map l ~f:encode) + | Extension ext -> List [ atom "ext"; Dune_sexp.Quoted_string (Sexp.to_string ext) ] +;; + +let encode_path p = + let make constr arg = + Dune_sexp.List [ Dune_sexp.atom constr; Dune_sexp.atom_or_quoted_string arg ] + in + let open Path in + match p with + | In_build_dir p -> make "In_build_dir" (Path.Build.to_string p) + | In_source_tree p -> make "In_source_tree" (Path.Source.to_string p) + | External p -> make "External" (Path.External.to_string p) +;; + +let encode_file_selector file_selector = + let open Dune_sexp.Encoder in + let module File_selector = Dune_engine.File_selector in + let dir = File_selector.dir file_selector in + let predicate = File_selector.predicate file_selector in + let only_generated_files = File_selector.only_generated_files file_selector in + record + [ "dir", encode_path dir + ; "predicate", Predicate_lang.Glob.encode predicate + ; "only_generated_files", bool only_generated_files + ] +;; + +let encode_alias alias = + let open Dune_sexp.Encoder in + let dir = Dune_engine.Alias.dir alias in + let name = Dune_engine.Alias.name alias in + record + [ "dir", encode_path (Path.build dir) + ; "name", Dune_sexp.atom_or_quoted_string (Dune_util.Alias_name.to_string name) + ] +;; + +let encode_dep_set deps = + Dune_sexp.List + (Dep.Set.to_list_map + deps + ~f: + (let open Dune_sexp.Encoder in + function + | File_selector g -> pair string encode_file_selector ("glob", g) + | Env e -> pair string string ("Env", e) + | File f -> pair string encode_path ("File", f) + | Alias a -> pair string encode_alias ("Alias", a) + | Universe -> string "Universe")) +;; + +let print_rule_sexp ppf (rule : Dune_engine.Reflection.Rule.t) = + let sexp_of_action action = Action.for_shell action |> encode in + let paths ps = + Dune_sexp.Encoder.list + (fun p -> + Path.Build.relative rule.targets.root p + |> Path.Build.to_string + |> Dune_sexp.atom_or_quoted_string) + (Filename.Set.to_list ps) + in + let sexp = + Dune_sexp.Encoder.record + (List.concat + [ [ "deps", encode_dep_set rule.deps + ; ( "targets" + , Dune_sexp.Encoder.record + [ "files", paths rule.targets.files + ; "directories", paths rule.targets.dirs + ] ) + ] + ; (match Path.Build.extract_build_context rule.targets.root with + | None -> [] + | Some (c, _) -> [ "context", Dune_sexp.atom_or_quoted_string c ]) + ; [ "action", sexp_of_action rule.action ] + ]) + in + Format.fprintf ppf "%a@," Pp.to_fmt (Dune_lang.pp sexp) +;; + +module Syntax = struct + type t = + | Makefile + | Sexp + + let term = + let doc = "Output the rules in Makefile syntax." in + let+ makefile = Arg.(value & flag & info [ "m"; "makefile" ] ~doc) in + if makefile then Makefile else Sexp + ;; + + let print_rule = function + | Makefile -> print_rule_makefile + | Sexp -> print_rule_sexp + ;; + + type formatter_state = + | In_atom + | In_makefile_action + | In_makefile_stuff + + let prepare_formatter ppf = + let state = ref [] in + Format.pp_set_mark_tags ppf true; + let ofuncs = Format.pp_get_formatter_out_functions ppf () in + let tfuncs = Format.pp_get_formatter_stag_functions ppf () in + Format.pp_set_formatter_stag_functions + ppf + { tfuncs with + mark_open_stag = + (function + | Format.String_tag "atom" -> + state := In_atom :: !state; + "" + | Format.String_tag "makefile-action" -> + state := In_makefile_action :: !state; + "" + | Format.String_tag "makefile-stuff" -> + state := In_makefile_stuff :: !state; + "" + | s -> tfuncs.mark_open_stag s) + ; mark_close_stag = + (function + | Format.String_tag "atom" + | Format.String_tag "makefile-action" + | Format.String_tag "makefile-stuff" -> + state := List.tl !state; + "" + | s -> tfuncs.mark_close_stag s) + }; + Format.pp_set_formatter_out_functions + ppf + { ofuncs with + out_newline = + (fun () -> + match !state with + | [ In_atom; In_makefile_action ] -> ofuncs.out_string "\\\n\t" 0 3 + | [ In_atom ] -> ofuncs.out_string "\\\n" 0 2 + | [ In_makefile_action ] -> ofuncs.out_string " \\\n\t" 0 4 + | [ In_makefile_stuff ] -> ofuncs.out_string " \\\n" 0 3 + | [] -> ofuncs.out_string "\n" 0 1 + | _ -> assert false) + ; out_spaces = + (fun n -> + ofuncs.out_spaces + (match !state with + | In_atom :: _ -> max 0 (n - 2) + | _ -> n)) + } + ;; + + let print_rules syntax ppf rules = + prepare_formatter ppf; + Format.pp_open_vbox ppf 0; + Format.pp_print_list (print_rule syntax) ppf rules; + Format.pp_print_flush ppf () + ;; +end + +let term = + let+ builder = Common.Builder.term + and+ out = + Arg.( + value + & opt (some string) None + & info [ "o" ] ~docv:"FILE" ~doc:"Output to a file instead of stdout.") + and+ recursive = + Arg.( + value + & flag + & info + [ "r"; "recursive" ] + ~doc: + "Print all rules needed to build the transitive dependencies of the given \ + targets.") + and+ syntax = Syntax.term + and+ targets = Arg.(value & pos_all dep [] & Arg.info [] ~docv:"TARGET") in + let common, config = Common.init builder in + let out = Option.map ~f:Path.of_string out in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn (fun () -> + let open Memo.O in + let* setup = setup in + let* request = + match targets with + | [] -> + Target.all_direct_targets None + >>| Path.Build.Map.foldi ~init:[] ~f:(fun p _ acc -> Path.build p :: acc) + >>| Action_builder.paths + | _ -> + Memo.return (Target.interpret_targets (Common.root common) config setup targets) + in + let+ rules = Dune_engine.Reflection.eval ~request ~recursive in + let print oc = + let ppf = Format.formatter_of_out_channel oc in + Syntax.print_rules syntax ppf rules + in + match out with + | None -> print stdout + | Some fn -> Io.with_file_out fn ~f:print)) +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/print_rules.mli b/unikernel/duniverse/dune_/bin/print_rules.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/print_rules.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/printenv.ml b/unikernel/duniverse/dune_/bin/printenv.ml new file mode 100644 index 00000000..7e56c3a5 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/printenv.ml @@ -0,0 +1,140 @@ +open Import + +let dump sctx ~dir = + (* TODO all of this printing functions should probably be inlined here as + well *) + let module Env_node = Dune_rules.Env_node in + let module Link_flags = Dune_rules.Link_flags in + let module Ocaml_flags = Dune_rules.Ocaml_flags in + let open Action_builder.O in + let+ o_dump = + Dune_rules.Ocaml_flags_db.ocaml_flags_env ~dir + |> Action_builder.of_memo + >>= Ocaml_flags.dump + and+ c_dump = + let* foreign_flags = + Dune_rules.Foreign_rules.foreign_flags_env ~dir |> Action_builder.of_memo + in + let+ c_flags = foreign_flags.c + and+ cxx_flags = foreign_flags.cxx in + List.map + ~f:Dune_lang.Encoder.(pair string (list string)) + [ "c_flags", c_flags; "cxx_flags", cxx_flags ] + and+ link_flags_dump = + Action_builder.of_memo (Dune_rules.Ocaml_flags_db.link_env ~dir) >>= Link_flags.dump + and+ menhir_dump = + Dune_rules.Menhir_rules.menhir_env ~dir + |> Action_builder.of_memo + >>= Dune_lang.Menhir_env.dump + and+ coq_dump = Dune_rules.Coq.Coq_rules.coq_env ~dir >>| Dune_rules.Coq.Coq_flags.dump + and+ jsoo_js_dump = + let module Js_of_ocaml = Dune_lang.Js_of_ocaml in + let* jsoo = Action_builder.of_memo (Dune_rules.Jsoo_rules.jsoo_env ~dir ~mode:JS) in + Js_of_ocaml.Flags.dump ~mode:JS jsoo.flags + and+ jsoo_wasm_dump = + let module Js_of_ocaml = Dune_lang.Js_of_ocaml in + let* jsoo = Action_builder.of_memo (Dune_rules.Jsoo_rules.jsoo_env ~dir ~mode:Wasm) in + Js_of_ocaml.Flags.dump ~mode:Wasm jsoo.flags + in + let env = + List.concat + [ o_dump + ; c_dump + ; link_flags_dump + ; menhir_dump + ; coq_dump + ; jsoo_js_dump + ; jsoo_wasm_dump + ] + in + Super_context.context sctx |> Context.name, env +;; + +let pp ppf ~fields sexps = + let fields = String.Set.of_list fields in + List.iter sexps ~f:(fun sexp -> + let do_print = + String.Set.is_empty fields + || + match sexp with + | Dune_lang.List (Atom (A name) :: _) -> String.Set.mem fields name + | _ -> false + in + if do_print + then ( + let version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in + Dune_lang.Ast.add_loc sexp ~loc:Loc.none + |> Dune_lang.Cst.concrete + |> List.singleton + |> Dune_lang.Format.pp_top_sexps ~version + |> Format.fprintf ppf "%a@?" Pp.to_fmt)) +;; + +let term = + let+ builder = Common.Builder.term + and+ dir = Arg.(value & pos 0 dir "" & info [] ~docv:"PATH") + and+ fields = + Arg.( + value + & opt_all string [] + & info + [ "field" ] + ~docv:"FIELD" + ~doc: + "Only print this field. This option can be repeated multiple times to print \ + multiple fields.") + in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + let* setup = Memo.run setup in + let dir = Path.of_string dir in + let checked = Util.check_path setup.contexts dir in + let request = + Action_builder.all + (match checked with + | In_build_dir (ctx, _) -> + let sctx = + Dune_engine.Context_name.Map.find_exn setup.scontexts (Context.name ctx) + in + [ dump sctx ~dir:(Path.as_in_build_dir_exn dir) ] + | In_source_dir dir -> + Dune_engine.Context_name.Map.values setup.scontexts + |> List.map ~f:(fun sctx -> + let dir = + Path.Build.append_source + (Context.build_dir (Super_context.context sctx)) + dir + in + dump sctx ~dir) + | In_private_context _ | External _ -> + User_error.raise [ Pp.text "Environment is not defined for external paths" ] + | In_install_dir _ -> + User_error.raise [ Pp.text "Environment is not defined in install dirs" ]) + in + build_exn (fun () -> + let open Memo.O in + let+ res, _facts = Action_builder.evaluate_and_collect_facts request in + res) + >>| function + | [ (_, env) ] -> Format.printf "%a" (pp ~fields) env + | l -> + List.iter l ~f:(fun (name, env) -> + Format.printf + "@[Environment for context %s:@,%a@]@." + (Dune_engine.Context_name.to_string name) + (pp ~fields) + env)) +;; + +let command = + let doc = "Print the environment of a directory." in + let man = + [ `S "DESCRIPTION" + ; `P {|$(b,dune show env DIR) prints the environment of a directory|} + ; `Blocks Common.help_secs + ] + in + Cmd.v (Cmd.info "env" ~doc ~man) term +;; diff --git a/unikernel/duniverse/dune_/bin/printenv.mli b/unikernel/duniverse/dune_/bin/printenv.mli new file mode 100644 index 00000000..f8235361 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/printenv.mli @@ -0,0 +1,4 @@ +open Import + +val term : unit Term.t +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/promotion.ml b/unikernel/duniverse/dune_/bin/promotion.ml new file mode 100644 index 00000000..8230b307 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/promotion.ml @@ -0,0 +1,118 @@ +open Import +module Diff_promotion = Promote.Diff_promotion + +let files_to_promote ~common files : Dune_rpc.Files_to_promote.t = + match files with + | [] -> All + | _ -> + let files = + List.map files ~f:(fun fn -> Path.Source.of_string (Common.prefix_target common fn)) + in + let on_missing fn = + User_warning.emit + [ Pp.textf "Nothing to promote for %s." (Path.Source.to_string_maybe_quoted fn) ] + in + These (files, on_missing) +;; + +let display_files files_to_promote = + let open Fiber.O in + Diff_promotion.load_db () + |> Diff_promotion.filter_db files_to_promote + |> Fiber.parallel_map ~f:(fun file -> + Diff_promotion.diff_for_file file + >>| function + | Ok _ -> Some file + | Error _ -> None) + >>| List.filter_opt + >>| List.sort ~compare:(fun file file' -> Diff_promotion.File.compare file file') + >>| List.iter ~f:(fun (file : Diff_promotion.File.t) -> + Console.printf "%s" (Diff_promotion.File.source file |> Path.Source.to_string)) +;; + +module Apply = struct + let info = + let doc = "Promote files from the last run" in + let man = + [ `S Cmdliner.Manpage.s_description + ; `P + {|Considering all actions of the form $(b,(diff a b)) that failed + in the last run of dune, $(b,dune promotion apply) does the following: + + If $(b,a) is present in the source tree but $(b,b) isn't, $(b,b) is + copied over to $(b,a) in the source tree. The idea behind this is that + you might use $(b,(diff file.expected file.generated)) and then call + $(b,dune promote) to promote the generated file. + |} + ; `Blocks Common.help_secs + ] + in + Cmd.info ~doc ~man "apply" + ;; + + let term = + let+ builder = Common.Builder.term + and+ files = Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") in + let common, config = Common.init builder in + let files_to_promote = files_to_promote ~common files in + match Dune_util.Global_lock.lock ~timeout:None with + | Ok () -> + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let open Fiber.O in + let+ () = Fiber.return () in + Diff_promotion.promote_files_registered_in_last_run files_to_promote) + | Error lock_held_by -> + Rpc_common.run_via_rpc + ~builder + ~common + ~config + lock_held_by + (Rpc_common.fire_request + ~name:"promote_many" + ~wait:true + Dune_rpc_private.Procedures.Public.promote_many) + files_to_promote + ;; + + let command = Cmd.v info term +end + +module Diff = struct + let info = Cmd.info ~doc:"List promotions to be applied" "diff" + + let term = + let+ builder = Common.Builder.term + and+ files = Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") in + let common, config = Common.init builder in + let files_to_promote = files_to_promote ~common files in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + Diff_promotion.display files_to_promote) + ;; + + let command = Cmd.v info term +end + +module Files = struct + let info = Cmd.info ~doc:"List promotions files" "list" + + let term = + let+ builder = Common.Builder.term + and+ files = Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") in + let common, config = Common.init builder in + let files_to_promote = files_to_promote ~common files in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + display_files files_to_promote) + ;; + + let command = Cmd.v info term +end + +let info = + Cmd.info ~doc:"Control how changes are propagated back to source code." "promotion" +;; + +let group = Cmd.group info [ Files.command; Apply.command; Diff.command ] + +let promote = + command_alias ~orig_name:"promotion apply" Apply.command Apply.term "promote" +;; diff --git a/unikernel/duniverse/dune_/bin/promotion.mli b/unikernel/duniverse/dune_/bin/promotion.mli new file mode 100644 index 00000000..d87081ca --- /dev/null +++ b/unikernel/duniverse/dune_/bin/promotion.mli @@ -0,0 +1,4 @@ +open Import + +val group : unit Cmd.t +val promote : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc.ml b/unikernel/duniverse/dune_/bin/rpc/rpc.ml new file mode 100644 index 00000000..5867b103 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc.ml @@ -0,0 +1,16 @@ +open Import + +let info = + let doc = "Dune's RPC mechanism. Experimental." in + let man = + [ `S "DESCRIPTION" + ; `P {|This is experimental. do not use|} + ; `Blocks Common.help_secs + ] + in + Cmd.info "rpc" ~doc ~man +;; + +let group = Cmd.group info [ Rpc_status.cmd; Rpc_build.cmd; Rpc_ping.cmd ] + +module Build = Rpc_build diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc.mli b/unikernel/duniverse/dune_/bin/rpc/rpc.mli new file mode 100644 index 00000000..31ec5712 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc.mli @@ -0,0 +1,4 @@ +(** dune rpc command group *) +val group : unit Cmdliner.Cmd.t + +module Build = Rpc_build diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_build.ml b/unikernel/duniverse/dune_/bin/rpc/rpc_build.ml new file mode 100644 index 00000000..81dd5d06 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_build.ml @@ -0,0 +1,37 @@ +open Import + +let build ~wait targets = + let targets = + List.map targets ~f:(fun target -> + let sexp = Dune_lang.Dep_conf.encode target in + Dune_lang.to_string sexp) + in + Rpc_common.fire_request ~name:"build" ~wait Dune_rpc_impl.Decl.build targets +;; + +let term = + let name_ = Arg.info [] ~docv:"TARGET" in + let+ (builder : Common.Builder.t) = Common.Builder.term + and+ wait = Rpc_common.wait_term + and+ targets = Arg.(value & pos_all string [] name_) in + Rpc_common.client_term builder + @@ fun () -> + let open Fiber.O in + let+ response = + Rpc_common.fire_request ~name:"build" ~wait Dune_rpc_impl.Decl.build targets + in + match response with + | Error (error : Dune_rpc.Response.Error.t) -> + Printf.eprintf "Error: %s\n%!" (Dyn.to_string (Dune_rpc.Response.Error.to_dyn error)) + | Ok Success -> print_endline "Success" + | Ok (Failure _) -> print_endline "Failure" +;; + +let info = + let doc = + "build a given target (requires dune to be running in passive watching mode)" + in + Cmd.info "build" ~doc +;; + +let cmd = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_build.mli b/unikernel/duniverse/dune_/bin/rpc/rpc_build.mli new file mode 100644 index 00000000..73b1a078 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_build.mli @@ -0,0 +1,13 @@ +open! Import + +(** Sends a command to an RPC server to build the specified targets and wait + for the build to complete or fail. If [wait] is true then wait until an RPC + server is running before making the request. Otherwise if no RPC server is + running then raise a [User_error]. *) +val build + : wait:bool + -> Dune_lang.Dep_conf.t list + -> (Dune_rpc.Build_outcome_with_diagnostics.t, Dune_rpc.Response.Error.t) result Fiber.t + +(** dune rpc build command *) +val cmd : unit Cmdliner.Cmd.t diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_common.ml b/unikernel/duniverse/dune_/bin/rpc/rpc_common.ml new file mode 100644 index 00000000..edc0f5f9 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_common.ml @@ -0,0 +1,125 @@ +open Import +module Client = Dune_rpc_client.Client +module Rpc_error = Dune_rpc.Response.Error + +let active_server () = + match Dune_rpc_impl.Where.get () with + | Some p -> Ok p + | None -> Error (User_error.make [ Pp.text "RPC server not running." ]) +;; + +let active_server_exn () = active_server () |> User_error.ok_exn + +(* cwong: Should we put this into [dune-rpc]? *) +let interpret_kind = function + | Rpc_error.Invalid_request -> "Invalid_request" + | Code_error -> "Code_error" + | Connection_dead -> "Connection_dead" +;; + +let raise_rpc_error (e : Rpc_error.t) = + User_error.raise + [ Pp.text "Server returned error: " + ; Pp.textf "%s (error kind: %s)" e.message (interpret_kind e.kind) + ] +;; + +let request_exn client witness n = + let open Fiber.O in + let* decl = Client.Versioned.prepare_request client witness in + match decl with + | Error e -> raise (Dune_rpc.Version_error.E e) + | Ok decl -> Client.request client decl n +;; + +let client_term builder f = + let builder = Common.Builder.forbid_builds builder in + let builder = Common.Builder.disable_log_file builder in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config f +;; + +let wait_term = + let doc = "poll until server starts listening and then establish connection." in + Arg.(value & flag & info [ "wait" ] ~doc) +;; + +let establish_connection () = + match active_server () with + | Error e -> Fiber.return (Error e) + | Ok where -> Client.Connection.connect where +;; + +let establish_connection_exn () = + let open Fiber.O in + establish_connection () >>| User_error.ok_exn +;; + +let establish_connection_with_retry () = + let open Fiber.O in + let pause_between_retries_s = 0.2 in + let rec loop () = + establish_connection () + >>= function + | Ok x -> Fiber.return x + | Error _ -> + let* () = Scheduler.sleep ~seconds:pause_between_retries_s in + loop () + in + loop () +;; + +let establish_client_session ~wait = + if wait then establish_connection_with_retry () else establish_connection_exn () +;; + +let fire_request ~name ~wait request arg = + let open Fiber.O in + let* connection = establish_client_session ~wait in + Dune_rpc_impl.Client.client + connection + (Dune_rpc.Initialize.Request.create ~id:(Dune_rpc.Id.make (Sexp.Atom name))) + ~f:(fun client -> request_exn client (Dune_rpc.Decl.Request.witness request) arg) +;; + +let wrap_build_outcome_exn ~print_on_success f args () = + let open Fiber.O in + let+ response = f args in + match response with + | Error (error : Rpc_error.t) -> + Printf.eprintf "Error: %s\n%!" (Dyn.to_string (Rpc_error.to_dyn error)) + | Ok Dune_rpc.Build_outcome_with_diagnostics.Success -> + if print_on_success + then + Console.print_user_message + (User_message.make [ Pp.text "Success" |> Pp.tag User_message.Style.Success ]) + | Ok (Failure errors) -> + List.iter errors ~f:(fun { Dune_rpc.Compound_user_error.main; _ } -> + Console.print_user_message main); + User_error.raise + [ (match List.length errors with + | 0 -> + Code_error.raise + "Build via RPC failed, but the RPC server did not send an error message." + [] + | 1 -> Pp.textf "Build failed with 1 error." + | n -> Pp.textf "Build failed with %d errors." n) + ] +;; + +let run_via_rpc ~builder ~common ~config lock_held_by f args = + if not (Common.Builder.equal builder Common.Builder.default) + then + User_warning.emit + [ Pp.textf + "Your build request is being forwarded to a running Dune instance%s. Note that \ + certain command line arguments may be ignored." + (match lock_held_by with + | Dune_util.Global_lock.Lock_held_by.Unknown -> "" + | Pid_from_lockfile pid -> sprintf " (pid: %d)" pid) + ]; + Scheduler.go_without_rpc_server + ~common + ~config + (wrap_build_outcome_exn ~print_on_success:true f args) +;; diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_common.mli b/unikernel/duniverse/dune_/bin/rpc/rpc_common.mli new file mode 100644 index 00000000..771977df --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_common.mli @@ -0,0 +1,52 @@ +open Import + +(** The current active RPC server, raising an exception if no RPC server is + currently running. *) +val active_server_exn : unit -> Dune_rpc.Where.t + +(** Raise an RPC response error. *) +val raise_rpc_error : Dune_rpc.Response.Error.t -> 'a + +(** Make a request and raise an exception if the preparation for the request + fails in any way. Returns an [Error] if the response errors. *) +val request_exn + : Dune_rpc_client.Client.t + -> ('a, 'b) Dune_rpc.Decl.Request.witness + -> 'a + -> ('b, Dune_rpc.Response.Error.t) result Fiber.t + +(** Cmdliner term for a generic RPC client. *) +val client_term : Common.Builder.t -> (unit -> 'a Fiber.t) -> 'a + +(** Cmdliner argument for a wait flag. *) +val wait_term : bool Cmdliner.Term.t + +(** Send a request to the RPC server. If [wait], it will poll forever until a server is listening. + Should be scheduled by a scheduler that does not come with a RPC server on its own. *) +val fire_request + : name:string + -> wait:bool + -> ('a, 'b) Dune_rpc.Decl.request + -> 'a + -> ('b, Dune_rpc.Response.Error.t) result Fiber.t + +val wrap_build_outcome_exn + : print_on_success:bool + -> ('a + -> (Dune_rpc.Build_outcome_with_diagnostics.t, Dune_rpc.Response.Error.t) result + Fiber.t) + -> 'a + -> unit + -> unit Fiber.t + +(** Schedule a fiber to run via RPC, wrapping any errors. *) +val run_via_rpc + : builder:Common.Builder.t + -> common:Common.t + -> config:Dune_config_file.Dune_config.t + -> Dune_util.Global_lock.Lock_held_by.t + -> ('a + -> (Dune_rpc.Build_outcome_with_diagnostics.t, Dune_rpc.Response.Error.t) result + Fiber.t) + -> 'a + -> unit diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_ping.ml b/unikernel/duniverse/dune_/bin/rpc/rpc_ping.ml new file mode 100644 index 00000000..3a855610 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_ping.ml @@ -0,0 +1,33 @@ +open Import +module Client = Dune_rpc_client.Client + +let send_ping cli = + let open Fiber.O in + let+ response = Rpc_common.request_exn cli Dune_rpc_private.Public.Request.ping () in + match response with + | Ok () -> Console.print [ Pp.text "Server appears to be responding normally" ] + | Error e -> Rpc_common.raise_rpc_error e +;; + +let exec () = + let open Fiber.O in + let where = Rpc_common.active_server_exn () in + let* conn = Client.Connection.connect_exn where in + Dune_rpc_impl.Client.client + conn + ~f:send_ping + (Dune_rpc_private.Initialize.Request.create + ~id:(Dune_rpc_private.Id.make (Sexp.Atom "ping_cmd"))) +;; + +let info = + let doc = "Ping the build server running in the current directory" in + Cmd.info "ping" ~doc +;; + +let term = + let+ (builder : Common.Builder.t) = Common.Builder.term in + Rpc_common.client_term builder exec +;; + +let cmd = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_ping.mli b/unikernel/duniverse/dune_/bin/rpc/rpc_ping.mli new file mode 100644 index 00000000..6aff0add --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_ping.mli @@ -0,0 +1,2 @@ +(** dune rpc ping command *) +val cmd : unit Cmdliner.Cmd.t diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_status.ml b/unikernel/duniverse/dune_/bin/rpc/rpc_status.ml new file mode 100644 index 00000000..8fc8d54a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_status.ml @@ -0,0 +1,146 @@ +open Import +module Client = Dune_rpc_client.Client + +let ( let** ) x f = + let open Fiber.O in + let* x = x in + match x with + | Ok s -> f s + | Error e -> Fiber.return (Error e) +;; + +let ( let++ ) x f = + let open Fiber.O in + let+ x = x in + match x with + | Ok s -> Ok (f s) + | Error e -> Error e +;; + +(** Get the status of a server at a given location and apply a function to the + list of clients *) +let server_response_map ~where ~f = + (* TODO: add timeout for status check *) + let open Fiber.O in + let** conn = + Client.Connection.connect where >>| Result.map_error ~f:User_message.to_string + in + Dune_rpc_impl.Client.client + conn + (Dune_rpc.Initialize.Request.create ~id:(Dune_rpc.Id.make (Sexp.Atom "status"))) + ~f:(fun session -> + let open Fiber.O in + let++ response = + let** decl = + Client.Versioned.prepare_request + session + (Dune_rpc_private.Decl.Request.witness Dune_rpc_impl.Decl.status) + >>| Result.map_error ~f:Dune_rpc_private.Version_error.message + in + Client.request session decl () + >>| Result.map_error ~f:Dune_rpc.Response.Error.message + in + f response.Dune_rpc_impl.Decl.Status.clients) +;; + +(** Get a list of registered Dunes from the RPC registry *) +let registered_dunes () : Dune_rpc.Registry.Dune.t list Fiber.t = + let config = Dune_rpc_private.Registry.Config.create (Lazy.force Dune_util.xdg) in + let registry = Dune_rpc_private.Registry.create config in + let open Fiber.O in + let+ _result = Dune_rpc_impl.Poll_active.poll registry in + Dune_rpc_private.Registry.current registry +;; + +(** The type of server statuses *) +type status = + { root : string + ; pid : Pid.t + ; result : (int, string) result + } + +(** Fetch the status of a single Dune instance *) +let get_status (dune : Dune_rpc.Registry.Dune.t) = + let root = Dune_rpc_private.Registry.Dune.root dune in + let pid = Dune_rpc_private.Registry.Dune.pid dune |> Pid.of_int in + let where = Dune_rpc_private.Registry.Dune.where dune in + let open Fiber.O in + let+ result = server_response_map ~where ~f:List.length in + { root; pid; result } +;; + +(** Print a list of statuses to the console *) +let print_statuses statuses = + List.sort statuses ~compare:(fun x y -> String.compare x.root y.root) + |> Pp.concat_map ~sep:Pp.space ~f:(fun { root; pid; result } -> + Pp.concat + ~sep:Pp.space + [ Pp.textf "root: %s" root + ; Pp.enumerate + ~f:Fun.id + [ Pp.textf "pid: %d" (Pid.to_int pid) + ; Pp.textf + "clients: %s" + (match result with + | Ok n -> string_of_int n + | Error e -> e) + ] + ]) + |> Pp.vbox + |> List.singleton + |> Console.print +;; + +let term = + let+ builder = Common.Builder.term + and+ all = + Arg.( + value + & flag + & info + [ "all" ] + ~doc: + "Show all running Dune instances together with their root, pids and number \ + of clients.") + in + Rpc_common.client_term builder + @@ fun () -> + let open Fiber.O in + if all + then + let* dunes = registered_dunes () in + let+ statuses = Fiber.parallel_map ~f:get_status dunes in + print_statuses statuses + else ( + let where = Rpc_common.active_server_exn () in + Console.print + [ Pp.textf "Server is listening on %s" (Dune_rpc.Where.to_string where) + ; Pp.text "Connected clients (including this one):" + ]; + server_response_map ~where ~f:(fun clients -> + List.iter clients ~f:(fun (client, menu) -> + let id = + let sexp = Dune_rpc.Conv.to_sexp Dune_rpc.Id.sexp client in + Sexp.to_string sexp + in + let message = + match (menu : Dune_rpc_impl.Decl.Status.Menu.t) with + | Uninitialized -> [ Pp.textf "Client [%s], conducting version negotiation" id ] + | Menu menu -> + [ Pp.textf "Client [%s] with the following RPC versions:" id + ; Pp.enumerate menu ~f:(fun (method_, version) -> + Pp.textf "%s: %d" method_ version) + ] + in + Console.print message)) + >>| function + | Ok () -> () + | Error e -> Printf.printf "Error: %s\n" e) +;; + +let info = + let doc = "show active connections" in + Cmd.info "status" ~doc +;; + +let cmd = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/rpc/rpc_status.mli b/unikernel/duniverse/dune_/bin/rpc/rpc_status.mli new file mode 100644 index 00000000..3eb896f3 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/rpc/rpc_status.mli @@ -0,0 +1,2 @@ +(** dune rpc status command *) +val cmd : unit Cmdliner.Cmd.t diff --git a/unikernel/duniverse/dune_/bin/runtest.ml b/unikernel/duniverse/dune_/bin/runtest.ml new file mode 100644 index 00000000..cd8d88d6 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/runtest.ml @@ -0,0 +1,164 @@ +open Import + +let runtest_info = + let doc = "Run tests." in + let man = + [ `S "DESCRIPTION" + ; `P "Run the given tests. The [TEST] argument can be either:" + ; `I + ( "-" + , "A directory: If a directory is provided, dune will recursively run all tests \ + within that directory." ) + ; `I + ( "-" + , "A file name: If a specific file name is provided, dune will run the tests \ + with that name." ) + ; `P + "If no [TEST] is provided, dune will run all tests in the current directory and \ + its subdirectories." + ; `P "See EXAMPLES below for additional information on use cases." + ; `Blocks Common.help_secs + ; Common.examples + [ "Run all tests in a given directory", "dune runtest path/to/dir/" + ; "Run a specific cram test", "dune runtest path/to/mytest.t" + ; ( "Run all tests in the current source tree (including those that passed on \ + the last run)" + , "dune runtest --force" ) + ; ( "Run tests sequentially without output buffering" + , "dune runtest --no-buffer -j 1" ) + ; "Run tests in a specific build context", "dune runtest _build/my_context/" + ] + ] + in + Cmd.info "runtest" ~doc ~man ~envs:Common.envs +;; + +let find_cram_test path ~parent_dir = + let open Memo.O in + Source_tree.nearest_dir parent_dir + >>= Dune_rules.Cram_rules.cram_tests + (* We ignore the errors we get when searching for cram tests as they will + be reported during building anyway. We are only interested in the + presence of cram tests. *) + >>| List.filter_map ~f:Result.to_option + (* We search our list of known cram tests for the test we are looking + for. *) + >>| List.find ~f:(fun (test : Source.Cram_test.t) -> + let src = + match test with + | File src -> src + | Dir { dir = src; _ } -> src + in + Path.Source.equal path src) +;; + +let explain_unsuccessful_search path ~parent_dir = + let open Memo.O in + (* If the user misspelled the test name, we give them a hint. *) + let+ hints = + (* We search for all files and directories in the parent directory and + suggest them as possible candidates. *) + let+ candidates = + let+ file_candidates = + let+ files = Source_tree.files_of parent_dir in + Path.Source.Set.to_list_map files ~f:Path.Source.to_string + and+ dir_candidates = + let* parent_source_dir = Source_tree.find_dir parent_dir in + match parent_source_dir with + | None -> Memo.return [] + | Some parent_source_dir -> + let dirs = Source_tree.Dir.sub_dirs parent_source_dir in + String.Map.to_list dirs + |> Memo.List.map ~f:(fun (_candidate, candidate_path) -> + Source_tree.Dir.sub_dir_as_t candidate_path + >>| Source_tree.Dir.path + >>| Path.Source.to_string) + in + List.concat [ file_candidates; dir_candidates ] + in + User_message.did_you_mean (Path.Source.to_string path) ~candidates + in + User_error.raise + ~hints + [ Pp.textf "%S does not match any known test." (Path.Source.to_string path) ] +;; + +(* [disambiguate_test_name path] is a function that takes in a + directory [path] and classifies it as either a cram test or a directory to + run tests in. *) +let disambiguate_test_name path = + match Path.Source.parent path with + | None -> Memo.return @@ `Runtest (Path.source Path.Source.root) + | Some parent_dir -> + let open Memo.O in + find_cram_test path ~parent_dir + >>= (function + | Some test -> + (* If we find the cram test, then we request that is run. *) + Memo.return (`Test (parent_dir, Source.Cram_test.name test)) + | None -> + (* If we don't find it, then we assume the user intended a directory for + @runtest to be used. *) + Source_tree.find_dir path + >>= (function + (* We need to make sure that this directory or file exists. *) + | Some _ -> Memo.return (`Runtest (Path.source path)) + | None -> explain_unsuccessful_search path ~parent_dir)) +;; + +let runtest_term = + let name = Arg.info [] ~docv:"TEST" in + let+ builder = Common.Builder.term + and+ dirs = Arg.(value & pos_all string [ "." ] name) in + let common, config = Common.init builder in + let request (setup : Import.Main.build_system) = + let contexts = setup.contexts in + List.map dirs ~f:(fun dir -> + let dir = Path.of_string dir |> Path.Expert.try_localize_external in + let open Action_builder.O in + let* contexts, alias_kind = + match (Util.check_path contexts dir : Util.checked) with + | In_build_dir (context, dir) -> + let+ res = Action_builder.of_memo (disambiguate_test_name dir) in + [ context ], res + | In_source_dir dir -> + (* We need to adjust the path here to make up for the current working directory. *) + let { Workspace_root.to_cwd; _ } = Common.root common in + let dir = + Path.Source.L.relative Path.Source.root (to_cwd @ Path.Source.explode dir) + in + let+ res = Action_builder.of_memo (disambiguate_test_name dir) in + contexts, res + | In_private_context _ | In_install_dir _ -> + User_error.raise + [ Pp.textf + "This path is internal to dune: %s" + (Path.to_string_maybe_quoted dir) + ] + | External _ -> + User_error.raise + [ Pp.textf + "This path is outside the workspace: %s" + (Path.to_string_maybe_quoted dir) + ] + in + Alias.request + @@ + match alias_kind with + | `Test (dir, alias_name) -> + Alias.in_dir + ~name:(Dune_engine.Alias.Name.of_string alias_name) + ~recursive:false + ~contexts + (Path.source dir) + | `Runtest dir -> + Alias.in_dir ~name:Dune_rules.Alias.runtest ~recursive:true ~contexts dir) + |> Action_builder.all_unit + in + Build.run_build_command ~common ~config ~request +;; + +let commands = + let command = Cmd.v runtest_info runtest_term in + [ command; command_alias command runtest_term "test" ] +;; diff --git a/unikernel/duniverse/dune_/bin/runtest.mli b/unikernel/duniverse/dune_/bin/runtest.mli new file mode 100644 index 00000000..00de8796 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/runtest.mli @@ -0,0 +1,3 @@ +open Import + +val commands : unit Cmd.t list diff --git a/unikernel/duniverse/dune_/bin/shutdown.ml b/unikernel/duniverse/dune_/bin/shutdown.ml new file mode 100644 index 00000000..a037de44 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/shutdown.ml @@ -0,0 +1,37 @@ +open Import +module Client = Dune_rpc_client.Client + +let send_shutdown cli = + let open Fiber.O in + let* decl = + Client.Versioned.prepare_notification + cli + Dune_rpc_private.Public.Notification.shutdown + in + match decl with + | Ok decl -> Client.notification cli decl () + | Error e -> raise (Dune_rpc_private.Version_error.E e) +;; + +let exec () = + let open Fiber.O in + let where = Rpc_common.active_server_exn () in + let* conn = Client.Connection.connect_exn where in + Dune_rpc_impl.Client.client + conn + ~f:send_shutdown + (Dune_rpc_private.Initialize.Request.create + ~id:(Dune_rpc_private.Id.make (Sexp.Atom "shutdown_cmd"))) +;; + +let info = + let doc = "Cancel and shutdown any builds in the current workspace." in + Cmd.info "shutdown" ~doc +;; + +let term = + let+ builder = Common.Builder.term in + Rpc_common.client_term builder exec +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/shutdown.mli b/unikernel/duniverse/dune_/bin/shutdown.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/shutdown.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/subst.ml b/unikernel/duniverse/dune_/bin/subst.ml new file mode 100644 index 00000000..b8d5d18f --- /dev/null +++ b/unikernel/duniverse/dune_/bin/subst.ml @@ -0,0 +1,538 @@ +open Import + +let is_path_a_source_file path = + match Path.extension (Path.source path) with + | ".flv" + | ".gif" + | ".ico" + | ".jpeg" + | ".jpg" + | ".mov" + | ".mp3" + | ".mp4" + | ".otf" + | ".pdf" + | ".png" + | ".ttf" + | ".woff" -> false + | _ -> true +;; + +let is_kind_a_source_file path = + match Path.stat (Path.source path) with + | Ok st -> st.st_kind = S_REG + | Error (ENOENT, "stat", _) -> + (* broken symlink *) + false + | Error e -> Unix_error.Detailed.raise e +;; + +let is_a_source_file path = is_path_a_source_file path && is_kind_a_source_file path + +let subst_string s path ~map = + let len = String.length s in + let longest_var = String.longest (String.Map.keys map) in + let double_percent_len = String.length "%%" in + let loc_of_offset ~ofs ~len = + let rec loop lnum bol i = + if i = ofs + then ( + let pos = + { Lexing.pos_fname = Path.to_string path + ; pos_cnum = i + ; pos_lnum = lnum + ; pos_bol = bol + } + in + Loc.create ~start:pos ~stop:{ pos with pos_cnum = pos.pos_cnum + len }) + else ( + match s.[i] with + | '\n' -> loop (lnum + 1) (i + 1) (i + 1) + | _ -> loop lnum bol (i + 1)) + in + loop 1 0 0 + in + let rec loop i acc = + if i = len + then acc + else ( + match s.[i] with + | '%' -> after_percent (i + 1) acc + | _ -> loop (i + 1) acc) + and after_percent i acc = + if i = len + then acc + else ( + match s.[i] with + | '%' -> after_double_percent ~start:(i - 1) (i + 1) acc + | _ -> loop (i + 1) acc) + and after_double_percent ~start i acc = + if i = len + then acc + else ( + match s.[i] with + | '%' -> after_double_percent ~start:(i - 1) (i + 1) acc + | 'A' .. 'Z' | '_' -> in_var ~start (i + 1) acc + | _ -> loop (i + 1) acc) + and in_var ~start i acc = + if i - start > longest_var + double_percent_len + then loop i acc + else if i = len + then acc + else ( + match s.[i] with + | '%' -> end_of_var ~start (i + 1) acc + | 'A' .. 'Z' | '_' -> in_var ~start (i + 1) acc + | _ -> loop (i + 1) acc) + and end_of_var ~start i acc = + if i = len + then acc + else ( + match s.[i] with + | '%' -> + let var = String.sub s ~pos:(start + 2) ~len:(i - start - 3) in + (match String.Map.find map var with + | None -> in_var ~start:(i - 1) (i + 1) acc + | Some (Ok repl) -> + let acc = (start, i + 1, repl) :: acc in + loop (i + 1) acc + | Some (Error msg) -> + let loc = loc_of_offset ~ofs:start ~len:(i + 1 - start) in + User_error.raise ~loc [ Pp.text msg ]) + | _ -> loop (i + 1) acc) + in + match List.rev (loop 0 []) with + | [] -> None + | repls -> + let result_len = + List.fold_left repls ~init:(String.length s) ~f:(fun acc (a, b, repl) -> + acc - (b - a) + String.length repl) + in + let buf = Buffer.create result_len in + let pos = + List.fold_left repls ~init:0 ~f:(fun pos (a, b, repl) -> + Buffer.add_substring buf s pos (a - pos); + Buffer.add_string buf repl; + b) + in + Buffer.add_substring buf s pos (len - pos); + Some (Buffer.contents buf) +;; + +let subst_file path ~map opam_package_files = + match Io.with_file_in (Path.source path) ~f:Io.read_all_unless_large with + | Error () -> + let hints = + if Sys.word_size = 32 + then + [ Pp.textf + "Dune has been built as a 32-bit binary so the maximum size \"dune subst\" \ + can operate on is 16MiB." + ] + else [] + in + User_warning.emit + ~hints + [ Pp.textf "Ignoring large file: %s" (Path.Source.to_string path) ] + | Ok s -> + let version = + if Path.Source.Set.mem opam_package_files path + then ( + try + subst_string ("version: \"%%" ^ "VERSION_NUM" ^ "%%\"") ~map (Path.source path) + with + | User_error.E _ -> None) + else None + in + let path = Path.source path in + let subst = subst_string s ~map path in + let contents = + match version, subst with + | None, None -> None + | Some x, None -> Some (x ^ "\n" ^ s) + | None, Some x -> Some x + | Some x, Some y -> Some (x ^ "\n" ^ y) + in + Option.iter contents ~f:(Io.write_file path) +;; + +(* Extending the Dune_project APIs, but adding capability to modify *) +module Dune_project = struct + include Dune_project + + type 'a simple_field = + { loc : Loc.t + ; loc_of_arg : Loc.t + ; arg : 'a + } + + type t = + { contents : string + ; project_file : Path.Source.t + ; name : Package.Name.t simple_field option + ; version : string simple_field option + ; project : Dune_project.t + } + + let filename = Path.Source.of_string Dune_project.filename + + let load ~dir ~files ~infer_from_opam_files = + let open Memo.O in + let+ project = + Dune_project.load + ~dir + ~files + ~infer_from_opam_files + ~load_opam_file_with_contents:Dune_pkg.Opam_file.load_opam_file_with_contents + in + let open Option.O in + let* project = project in + let* project_file = Dune_project.file project in + let project_file = project_file in + let contents = Io.read_file (Path.source project_file) in + let sexp = + let lb = Lexbuf.from_string contents ~fname:(Path.Source.to_string project_file) in + Dune_lang.Parser.parse lb ~mode:Many_as_one + in + let parser = + let open Dune_lang.Decoder in + let simple_field name arg = + let+ loc, x = located (field_o name (located arg)) in + Option.map x ~f:(fun (loc_of_arg, arg) -> { loc; loc_of_arg; arg }) + in + enter + (fields + (let+ name = simple_field "name" Package.Name.decode + and+ version = simple_field "version" string + and+ () = junk_everything in + Some { contents; name; version; project; project_file })) + in + Dune_lang.Decoder.parse parser Univ_map.empty sexp + ;; + + let project t = t.project + + let subst t ~map ~version = + let s = + match version with + | None -> t.contents + | Some version -> + let replace_text start_ofs stop_ofs repl = + sprintf + "%s%s%s" + (String.sub t.contents ~pos:0 ~len:start_ofs) + repl + (String.sub + t.contents + ~pos:stop_ofs + ~len:(String.length t.contents - stop_ofs)) + in + (match t.version with + | Some v -> + (* There is a [version] field, overwrite its argument *) + replace_text + (Loc.start v.loc_of_arg).pos_cnum + (Loc.stop v.loc_of_arg).pos_cnum + (Dune_lang.to_string (Dune_lang.atom_or_quoted_string version)) + | None -> + let version_field = + Dune_lang.to_string + (List [ Dune_lang.atom "version"; Dune_lang.atom_or_quoted_string version ]) + ^ "\n" + in + let ofs = + ref + (match t.name with + | Some { loc; _ } -> + (* There is no [version] field but there is a [name] one, add + the version after it *) + (Loc.stop loc).pos_cnum + | None -> + (* If all else fails, add the [version] field after the first + line of the file *) + 0) + in + let len = String.length t.contents in + while !ofs < len && t.contents.[!ofs] <> '\n' do + incr ofs + done; + if !ofs < len && t.contents.[!ofs] = '\n' + then ( + incr ofs; + replace_text !ofs !ofs version_field) + else replace_text !ofs !ofs ("\n" ^ version_field)) + in + let s = Option.value (subst_string s ~map (Path.source filename)) ~default:s in + if s <> t.contents then Io.write_file (Path.source filename) s + ;; +end + +let make_watermark_map ~commit ~version ~dune_project ~info = + let dune_project = Dune_project.project dune_project in + let version = + match version with + | Some _ -> version + | None -> Option.map ~f:Package_version.to_string (Dune_project.version dune_project) + in + let version_num = + let open Option.O in + let+ version = version in + Option.value ~default:version (String.drop_prefix version ~prefix:"v") + in + let name = Dune_project.name dune_project in + (* XXX these error messages aren't particularly good as these values do not + necessarily come from the project file. It's possible for them to be + defined in the .opam file directly*) + let make_value name = function + | None -> Error (sprintf "variable %S not found in dune-project file" name) + | Some value -> Ok value + in + let make_separated name sep = function + | None -> Error (sprintf "variable %S not found in dune-project file" name) + | Some value -> Ok (String.concat ~sep value) + in + let make_dev_repo_value = function + | Some (Source_kind.Host h) -> Ok (Source_kind.Host.homepage h) + | Some (Source_kind.Url url) -> Ok url + | None -> Error (sprintf "variable dev-repo not found in dune-project file") + in + let make_version = function + | Some s -> Ok s + | None -> Error "repository does not contain any version information" + in + String.Map.of_list_exn + [ "NAME", Ok (Dune_project_name.to_string_hum name) + ; "VERSION", make_version version + ; "VERSION_NUM", make_version version_num + ; ( "VCS_COMMIT_ID" + , match commit with + | None -> Error "repository does not contain any commits" + | Some s -> Ok s ) + ; "PKG_MAINTAINER", make_separated "maintainer" ", " @@ Package_info.maintainers info + ; "PKG_AUTHORS", make_separated "authors" ", " @@ Package_info.authors info + ; "PKG_HOMEPAGE", make_value "homepage" @@ Package_info.homepage info + ; "PKG_ISSUES", make_value "bug-reports" @@ Package_info.bug_reports info + ; "PKG_DOC", make_value "doc" @@ Package_info.documentation info + ; "PKG_LICENSE", make_separated "license" ", " @@ Package_info.license info + ; "PKG_REPO", make_dev_repo_value @@ Package_info.source info + ] +;; + +let subst vcs = + let open Memo.O in + (match vcs with + | Some vcs -> + let+ version = Vcs.describe vcs + and+ commit_id = Vcs.commit_id vcs + and+ files = Vcs.files vcs in + Some (version, commit_id, files) + | None -> + let* root = Source_tree.root () in + let project = Source_tree.Dir.project root in + if Dune_project.dune_version project < (3, 17) + then Memo.return None + else + let+ files = + let module Map_reduce = + Source_tree.Dir.Make_map_reduce (Memo) (Monoid.Union (Path.Source.Set)) + in + Source_tree.root () + >>= Map_reduce.map_reduce + ~traverse:Source_dir_status.Set.all + ~trace_event_name:"Subst" + ~f:(fun dir -> + Source_tree.Dir.filenames dir + |> Filename.Set.fold ~init:Path.Source.Set.empty ~f:(fun fname acc -> + Path.Source.relative (Source_tree.Dir.path dir) fname + |> Path.Source.Set.add acc) + |> Memo.return) + in + Some (None, None, Path.Source.Set.to_list files)) + >>| Option.bind ~f:(fun ((_, _, files) as s) -> + match files with + | [] -> None + | _ :: _ -> Some s) + >>= Memo.Option.iter ~f:(fun (version, commit, files) -> + let+ (dune_project : Dune_project.t) = + (* CR-soon rgrinberg: unify this check with the above version check *) + (let files = + (* Filter-out files form sub-directories *) + List.fold_left files ~init:String.Set.empty ~f:(fun acc fn -> + let fn = Path.source fn in + if Path.is_root (Path.parent_exn fn) + then String.Set.add acc (Path.to_string fn) + else acc) + in + Dune_project.load ~dir:Path.Source.root ~files ~infer_from_opam_files:true) + >>| function + | Some dune_project -> dune_project + | None -> + User_error.raise + ~loc:(Loc.in_dir (Path.source Path.Source.root)) + [ Pp.text + "There is no dune-project file in the current directory, please add one \ + with a (name ) field in it." + ] + ~hints: + [ Pp.concat + ~sep:Pp.space + [ User_message.command "dune subst" + ; Pp.text "must be executed from the root of the project." + ] + |> Pp.hovbox + ] + in + (let loc, subst_config = Dune_project.subst_config dune_project.project in + match subst_config with + | `Enabled -> () + | `Disabled -> + User_error.raise + ~loc + [ Pp.concat + ~sep:Pp.space + [ User_message.command "dune subst" + ; Pp.text "has been disabled in this project. Any use of it is forbidden." + ] + ] + ~hints: + [ Pp.text + "If you wish to re-enable it, change to (subst enabled) in the \ + dune-project file." + ]); + let info = + let loc, name = + match dune_project.name with + | None -> + User_error.raise + ~loc:(Loc.in_file (Path.source dune_project.project_file)) + [ Pp.textf + "The project name is not defined, please add a (name ) field to \ + your dune-project file." + ] + | Some n -> n.loc_of_arg, n.arg + in + let package_named_after_project = + let packages = Dune_project.including_hidden_packages dune_project.project in + Package.Name.Map.find packages name + in + let metadata_from_dune_project () = Dune_project.info dune_project.project in + let metadata_from_matching_package () = + match package_named_after_project with + | Some pkg -> Ok (Package.info pkg) + | None -> + Error + (User_error.make + ~loc + [ Pp.textf "Package %s doesn't exist." (Package.Name.to_string name) ]) + in + let version = Dune_project.dune_version dune_project.project in + if version >= (3, 0) + then metadata_from_dune_project () + else if version >= (2, 8) + then ( + match metadata_from_matching_package () with + | Ok p -> p + | Error _ -> metadata_from_dune_project ()) + else User_error.ok_exn (metadata_from_matching_package ()) + in + let watermarks = make_watermark_map ~commit ~version ~dune_project ~info in + Dune_project.subst ~map:watermarks ~version dune_project; + let opam_package_files = + Dune_project.packages dune_project.project + |> Package.Name.Map.fold ~init:Path.Source.Set.empty ~f:(fun package acc -> + Path.Source.Set.add acc (Package.opam_file package)) + in + List.iter files ~f:(fun path -> + if is_a_source_file path && not (Path.Source.equal path Dune_project.filename) + then subst_file path ~map:watermarks opam_package_files)) +;; + +let subst () = Source_tree.nearest_vcs Path.Source.root |> Memo.bind ~f:subst |> Memo.run + +(** A string that is "3.20.2" but not expanded by [dune subst] *) +let literal_version = "%%" ^ "VERSION%%" + +let doc = "Substitute watermarks in source files." + +let man = + let var name desc = `Blocks [ `Noblank; `P ("- $(b,%%" ^ name ^ "%%), " ^ desc) ] in + let opam field = + var + ("PKG_" ^ String.uppercase field) + ("contents of the $(b," ^ field ^ ":) field from the opam file") + in + [ `S "DESCRIPTION" + ; `P + {|Substitute $(b,%%ID%%) strings in source files, in a similar fashion to + what topkg does in the default configuration.|} + ; `P + ({|This command is only meant to be called when a user pins a package to + its development version. Especially it replaces $(b,|} + ^ literal_version + ^ {|) strings by the version obtained from the vcs. Currently only git is + supported and the version is obtained from the output of:|} + ) + ; `Pre {| \$ git describe --always --dirty --abbrev=7|} + ; `P + {|$(b,dune subst) substitutes the variables that topkg substitutes with + the default configuration:|} + ; var "NAME" "the name of the project (from the dune-project file)" + ; var "VERSION" "output of $(b,git describe --always --dirty --abbrev=7)" + ; var + "VERSION_NUM" + ("same as $(b," + ^ literal_version + ^ ") but with a potential leading 'v' or 'V' dropped") + ; var "VCS_COMMIT_ID" "commit hash from the vcs" + ; opam "maintainer" + ; opam "authors" + ; opam "homepage" + ; opam "issues" + ; opam "doc" + ; opam "license" + ; opam "repo" + ; `P + {|In order to call $(b,dune subst) when your package is pinned, add this line + to the $(b,build:) field of your opam file:|} + ; `Pre {| [dune "subst"] {pinned}|} + ; `P + {|Note that this command is meant to be called only from opam files and + behaves a bit differently from other dune commands. In particular it + doesn't try to detect the root and must be called from the root of + the project.|} + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "subst" ~doc ~man + +let term = + let+ () = Common.build_info + and+ debug_backtraces = Common.debug_backtraces in + let config : Dune_config.t = + { Dune_config.default with + display = Dune_config.Display.quiet + ; concurrency = Fixed 1 + } + in + (* We have to do this because scanning the source tree evaluates [-p]. + That's because [-p] is needed to interpret packages in dune projects + correctly. It should not be necessary, so we should probably make the + package loading lazier. *) + Dune_rules.Only_packages.Clflags.set No_restriction; + Dune_engine.Clflags.debug_backtraces debug_backtraces; + Path.set_root (Path.External.cwd ()); + Path.Build.set_build_dir (Path.Outside_build_dir.of_string Common.default_build_dir); + Dune_config.init config ~watch:false; + Log.init_disabled (); + Dune_engine.Scheduler.Run.go + ~on_event:(fun _ _ -> ()) + (Dune_config.for_scheduler + config + ~watch_exclusions:[] + None + ~print_ctrl_c_warning:false) + subst +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/subst.mli b/unikernel/duniverse/dune_/bin/subst.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/subst.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/target.ml b/unikernel/duniverse/dune_/bin/target.ml new file mode 100644 index 00000000..e7d5ee30 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/target.ml @@ -0,0 +1,266 @@ +open Import +open Action_builder.O + +module Request = struct + (* CR-someday amokhov: Split [File] into [File] and [Dir] for clarity. *) + type t = + | File of Path.t + | Alias of Alias.t +end + +let request targets = + List.fold_left targets ~init:(Action_builder.return ()) ~f:(fun acc target -> + acc + >>> + match (target : Request.t) with + | File path -> Action_builder.path path + | Alias a -> Alias.request a) +;; + +module Target_type = struct + type t = + | File + | Directory +end + +module All_targets = struct + type t = Target_type.t Path.Build.Map.t + + include Monoid.Make (struct + type nonrec t = t + + let empty = Path.Build.Map.empty + let combine = Path.Build.Map.union_exn + end) +end + +module Source_tree_map_reduce = Source_tree.Dir.Make_map_reduce (Memo) (All_targets) + +let all_direct_targets dir = + let open Memo.O in + let* root = + match dir with + | None -> Source_tree.root () + | Some dir -> Source_tree.nearest_dir dir + and* contexts = Memo.Lazy.force (Build_config.get ()).contexts in + Context_name.Map.values contexts + |> List.filter_map ~f:(fun (ctx, (ctx_type : Build_config.Gen_rules.Context_type.t)) -> + match ctx_type with + | Empty -> None + | With_sources -> Some ctx) + |> Memo.parallel_map ~f:(fun (ctx : Dune_engine.Build_context.t) -> + Source_tree_map_reduce.map_reduce + root + ~traverse:Source_dir_status.Set.all + ~trace_event_name:"All direct targets" + ~f:(fun dir -> + Dune_engine.Load_rules.load_dir + ~dir: + (Path.build + (Path.Build.append_source ctx.build_dir (Source_tree.Dir.path dir))) + >>| function + | External _ | Source _ -> All_targets.empty + | Build { rules_here; _ } -> + All_targets.combine + (Path.Build.Map.map rules_here.by_file_targets ~f:(fun _ -> Target_type.File)) + (Path.Build.Map.map rules_here.by_directory_targets ~f:(fun _ -> + Target_type.Directory)) + | Build_under_directory_target _ -> All_targets.empty)) + >>| All_targets.reduce +;; + +let target_hint (_setup : Dune_rules.Main.build_system) path = + let open Memo.O in + let sub_dir = Option.value ~default:path (Path.parent path) in + (* CR-someday amokhov: + + We currently provide the same hint for all targets. It would be nice to + indicate whether a hint corresponds to a file or to a directory target. *) + let root = + match sub_dir with + | External e -> + Code_error.raise "target_hint: external path" [ "path", Path.External.to_dyn e ] + | In_source_tree d -> d + | In_build_dir d -> Path.Build.drop_build_context_exn d + in + let+ candidates = all_direct_targets (Some root) >>| Path.Build.Map.keys in + let candidates = + if Path.is_in_build_dir path + then List.map ~f:Path.build candidates + else + List.map candidates ~f:(fun path -> + match Path.Build.extract_build_context path with + | None -> Path.build path + | Some (_, path) -> Path.source path) + in + let candidates = + (* Only suggest hints for the basename, otherwise it's slow when there are + lots of files *) + List.filter_map candidates ~f:(fun path -> + if Path.equal (Path.parent_exn path) sub_dir + then Some (Path.to_string path) + else None) + in + let candidates = String.Set.of_list candidates |> String.Set.to_list in + User_message.did_you_mean (Path.to_string path) ~candidates +;; + +let resolve_path path ~(setup : Dune_rules.Main.build_system) + : (Request.t list, _) result Memo.t + = + let open Memo.O in + let checked = Util.check_path setup.contexts path in + let can't_build path = + let+ hint = target_hint setup path in + Error hint + in + let as_source_dir src = + Source_tree.find_dir src + >>| Option.map ~f:(fun _ -> + [ Request.Alias + (Alias.in_dir + ~name:Dune_engine.Alias.Name.default + ~recursive:true + ~contexts:setup.contexts + path) + ]) + in + let matching_targets src = + Memo.parallel_map setup.contexts ~f:(fun ctx -> + let path = Path.append_source (Path.build (Context.build_dir ctx)) src in + Load_rules.is_target path + >>| function + | Yes _ | Under_directory_target_so_cannot_say -> Some (Request.File path) + | No -> None) + >>| List.filter_opt + in + let matching_target () = + Load_rules.is_target path + >>| function + | Yes _ | Under_directory_target_so_cannot_say -> Some [ Request.File path ] + | No -> None + in + match checked with + | External _ -> Memo.return (Ok [ Request.File path ]) + | In_source_dir src -> + matching_targets src + >>= (function + | [] -> + as_source_dir src + >>= (function + | Some res -> Memo.return (Ok res) + | None -> can't_build path) + | l -> Memo.return (Ok l)) + | In_build_dir (_ctx, src) -> + matching_target () + >>= (function + | Some res -> Memo.return (Ok res) + | None -> + as_source_dir src + >>= (function + | Some res -> Memo.return (Ok res) + | None -> can't_build path)) + | In_private_context _ | In_install_dir _ -> + matching_target () + >>= (function + | Some res -> Memo.return (Ok res) + | None -> can't_build path) +;; + +let expand_path_from_root (root : Workspace_root.t) sctx sv = + let+ s = + let* expander = + let dir = + let ctx = Super_context.context sctx in + Path.Build.relative + (Context.build_dir ctx) + (String.concat ~sep:Filename.dir_sep root.to_cwd) + in + Action_builder.of_memo (Dune_rules.Super_context.expander sctx ~dir) + in + Dune_rules.Expander.expand_str expander sv + in + root.reach_from_root_prefix ^ s +;; + +let expand_path root sctx sv = + let+ s = expand_path_from_root root sctx sv in + Path.relative Path.root s +;; + +let resolve_alias root ~recursive sv ~(setup : Dune_rules.Main.build_system) = + match Dune_lang.String_with_vars.text_only sv with + | Some s -> + Ok [ Request.Alias (Alias.of_string root ~recursive s ~contexts:setup.contexts) ] + | None -> Error [ Pp.text "alias cannot contain variables" ] +;; + +let resolve_target root ~setup target = + match (target : Dune_lang.Dep_conf.t) with + | Alias sv as dep -> + Action_builder.return + (Result.map_error + ~f:(fun hints -> dep, hints) + (resolve_alias root ~recursive:false sv ~setup)) + | Alias_rec sv as dep -> + Action_builder.return + (Result.map_error + ~f:(fun hints -> dep, hints) + (resolve_alias root ~recursive:true sv ~setup)) + | File sv as dep -> + let f ctx = + let sctx = + Dune_engine.Context_name.Map.find_exn setup.scontexts (Context.name ctx) + in + let* path = expand_path root sctx sv in + Action_builder.of_memo (resolve_path path ~setup) + >>| Result.map_error ~f:(fun hints -> dep, hints) + in + Action_builder.List.map setup.contexts ~f >>| Result.List.concat_map ~f:Fun.id + | dep -> Action_builder.return (Error (dep, [])) +;; + +let resolve_targets + root + (config : Dune_config.t) + (setup : Dune_rules.Main.build_system) + user_targets + = + match user_targets with + | [] -> Action_builder.return [] + | _ -> + let+ targets = Action_builder.List.map user_targets ~f:(resolve_target root ~setup) in + (match config.display with + | Simple { verbosity = Verbose; _ } -> + Log.info + [ Pp.text "Actual targets:" + ; Pp.enumerate + (List.concat_map targets ~f:(function + | Ok targets -> targets + | Error _ -> [])) + ~f:(function + | File p -> Pp.verbatim (Path.to_string_maybe_quoted p) + | Alias a -> Alias.pp a) + ] + | _ -> ()); + targets +;; + +let resolve_targets_exn root config setup user_targets = + resolve_targets root config setup user_targets + >>| List.concat_map ~f:(function + | Error (dep, hints) -> + User_error.raise + [ Pp.textf "Don't know how to build %s" (Arg.Dep.to_string_maybe_quoted dep) ] + ~hints + | Ok targets -> targets) +;; + +let interpret_targets root config setup user_targets = + let* () = Action_builder.return () in + resolve_targets_exn root config setup user_targets >>= request +;; + +type target_type = Target_type.t = + | File + | Directory diff --git a/unikernel/duniverse/dune_/bin/target.mli b/unikernel/duniverse/dune_/bin/target.mli new file mode 100644 index 00000000..03a1e551 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/target.mli @@ -0,0 +1,25 @@ +open Import + +type target_type = + | File + | Directory + +(** List of all buildable direct targets. This does not include files and + directories produced under a directory target. + + If argument is [None], load the root, otherwise only load targets from the + nearest subdirectory. *) +val all_direct_targets : Path.Source.t option -> target_type Path.Build.Map.t Memo.t + +val interpret_targets + : Workspace_root.t + -> Dune_config.t + -> Dune_rules.Main.build_system + -> Arg.Dep.t list + -> unit Dune_engine.Action_builder.t + +val expand_path_from_root + : Workspace_root.t + -> Dune_rules.Super_context.t + -> Dune_lang.String_with_vars.t + -> string Dune_engine.Action_builder.t diff --git a/unikernel/duniverse/dune_/bin/tools/tools.ml b/unikernel/duniverse/dune_/bin/tools/tools.ml new file mode 100644 index 00000000..760c9696 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/tools/tools.ml @@ -0,0 +1,34 @@ +open! Import + +module Exec = struct + let doc = "Command group for running wrapped tools." + let info = Cmd.info ~doc "exec" + + let group = + Cmd.group + info + (List.map [ Ocamlformat; Ocamllsp; Ocamlearlybird ] ~f:Tools_common.exec_command) + ;; +end + +module Install = struct + let doc = "Command group for installing wrapped tools." + let info = Cmd.info ~doc "install" + + let group = + Cmd.group info (List.map Dune_pkg.Dev_tool.all ~f:Tools_common.install_command) + ;; +end + +module Which = struct + let doc = "Command group for printing the path to wrapped tools." + let info = Cmd.info ~doc "which" + + let group = + Cmd.group info (List.map Dune_pkg.Dev_tool.all ~f:Tools_common.which_command) + ;; +end + +let doc = "Command group for wrapped tools." +let info = Cmd.info ~doc "tools" +let group = Cmd.group info [ Exec.group; Install.group; Which.group ] diff --git a/unikernel/duniverse/dune_/bin/tools/tools.mli b/unikernel/duniverse/dune_/bin/tools/tools.mli new file mode 100644 index 00000000..d4c5902f --- /dev/null +++ b/unikernel/duniverse/dune_/bin/tools/tools.mli @@ -0,0 +1,3 @@ +open Import + +val group : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/tools/tools_common.ml b/unikernel/duniverse/dune_/bin/tools/tools_common.ml new file mode 100644 index 00000000..99e9449a --- /dev/null +++ b/unikernel/duniverse/dune_/bin/tools/tools_common.ml @@ -0,0 +1,136 @@ +open! Import +module Pkg_dev_tool = Dune_rules.Pkg_dev_tool + +let add_dev_tools_to_path env = + List.fold_left Pkg_dev_tool.all ~init:env ~f:(fun acc tool -> + let dir = Pkg_dev_tool.exe_path tool |> Path.Build.parent_exn |> Path.build in + Env_path.cons acc ~dir) +;; + +let dev_tool_exe_path dev_tool = Path.build @@ Pkg_dev_tool.exe_path dev_tool + +let dev_tool_build_target dev_tool = + Dune_lang.Dep_conf.File + (Dune_lang.String_with_vars.make_text + Loc.none + (Path.to_string (dev_tool_exe_path dev_tool))) +;; + +let build_dev_tool_directly common dev_tool = + let open Fiber.O in + let+ result = + Build.run_build_system ~common ~request:(fun _build_system -> + Action_builder.path (dev_tool_exe_path dev_tool)) + in + match result with + | Error `Already_reported -> raise Dune_util.Report_error.Already_reported + | Ok () -> () +;; + +let build_dev_tool_via_rpc dev_tool = + let target = dev_tool_build_target dev_tool in + Build.build_via_rpc_server ~print_on_success:false ~targets:[ target ] +;; + +let lock_and_build_dev_tool ~common ~config dev_tool = + let open Fiber.O in + match Dune_util.Global_lock.lock ~timeout:None with + | Error _lock_held_by -> + Scheduler.go_without_rpc_server ~common ~config (fun () -> + let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in + build_dev_tool_via_rpc dev_tool) + | Ok () -> + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in + build_dev_tool_directly common dev_tool) +;; + +let run_dev_tool workspace_root dev_tool ~args = + let exe_name = Pkg_dev_tool.exe_name dev_tool in + let exe_path_string = Path.to_string (dev_tool_exe_path dev_tool) in + Console.print_user_message + (Dune_rules.Pkg_build_progress.format_user_message + ~verb:"Running" + ~object_:(User_message.command (String.concat ~sep:" " (exe_name :: args)))); + Console.finish (); + let env = add_dev_tools_to_path Env.initial in + restore_cwd_and_execve workspace_root exe_path_string args env +;; + +let lock_build_and_run_dev_tool ~common ~config dev_tool ~args = + lock_and_build_dev_tool ~common ~config dev_tool; + run_dev_tool (Common.root common) dev_tool ~args +;; + +let which_command dev_tool = + let exe_path = dev_tool_exe_path dev_tool in + let exe_name = Pkg_dev_tool.exe_name dev_tool in + let term = + let+ builder = Common.Builder.term + and+ allow_not_installed = + Arg.( + value + & flag + & info + [ "allow-not-installed" ] + ~doc: + (sprintf + "If %s is not installed as a dev tool, still print where it would be \ + installed." + exe_name)) + in + let _ : Common.t * Dune_config_file.Dune_config.t = Common.init builder in + if allow_not_installed || Path.exists exe_path + then print_endline (Path.to_string exe_path) + else User_error.raise [ Pp.textf "%s is not installed as a dev tool" exe_name ] + in + let info = + let doc = + sprintf + "Prints the path to the %s dev tool executable if it exists, errors out \ + otherwise." + exe_name + in + Cmd.info exe_name ~doc + in + Cmd.v info term +;; + +let install_command dev_tool = + let exe_name = Pkg_dev_tool.exe_name dev_tool in + let term = + let+ builder = Common.Builder.term in + let common, config = Common.init builder in + lock_and_build_dev_tool ~common ~config dev_tool + in + let info = + let doc = sprintf "Install %s as a dev tool" exe_name in + Cmd.info exe_name ~doc + in + Cmd.v info term +;; + +let exec_command dev_tool = + let exe_name = Pkg_dev_tool.exe_name dev_tool in + let term = + let+ builder = Common.Builder.term + and+ args = Arg.(value & pos_all string [] (info [] ~docv:"ARGS")) in + let common, config = Common.init builder in + lock_build_and_run_dev_tool ~common ~config dev_tool ~args + in + let info = + let doc = + sprintf + {|Wrapper for running %s intended to be run automatically + by a text editor. All positional arguments will be passed to the + %s executable (pass flags to %s after the '--' + argument, such as 'dune tools exec %s -- --help').|} + exe_name + exe_name + exe_name + exe_name + in + Cmd.info exe_name ~doc + in + Cmd.v info term +;; diff --git a/unikernel/duniverse/dune_/bin/tools/tools_common.mli b/unikernel/duniverse/dune_/bin/tools/tools_common.mli new file mode 100644 index 00000000..bcdefc44 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/tools/tools_common.mli @@ -0,0 +1,15 @@ +open! Import + +(** Generate a lockdir for a dev tool, build the dev tool, then run the dev + tool. If a step is unnecessary then it is skipped. This function does not + return, but starts running the dev tool in place of the current process. *) +val lock_build_and_run_dev_tool + : common:Common.t + -> config:Dune_config_file.Dune_config.t + -> Dune_pkg.Dev_tool.t + -> args:string list + -> 'a + +val which_command : Dune_pkg.Dev_tool.t -> unit Cmd.t +val install_command : Dune_pkg.Dev_tool.t -> unit Cmd.t +val exec_command : Dune_pkg.Dev_tool.t -> unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/upgrade.ml b/unikernel/duniverse/dune_/bin/upgrade.ml new file mode 100644 index 00000000..7d5e3d50 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/upgrade.ml @@ -0,0 +1,22 @@ +open Import + +let doc = "Upgrade projects across major Dune versions." + +let man = + [ `S "DESCRIPTION" + ; `P + "$(b,dune upgrade) upgrades all the projects in the workspace to the latest major \ + version of Dune" + ; `Blocks Common.help_secs + ] +;; + +let info = Cmd.info "upgrade" ~doc ~man + +let term = + let+ builder = Common.Builder.term in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config (fun () -> Dune_upgrader.upgrade ()) +;; + +let command = Cmd.v info term diff --git a/unikernel/duniverse/dune_/bin/upgrade.mli b/unikernel/duniverse/dune_/bin/upgrade.mli new file mode 100644 index 00000000..8c78dc31 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/upgrade.mli @@ -0,0 +1,3 @@ +open Import + +val command : unit Cmd.t diff --git a/unikernel/duniverse/dune_/bin/util.ml b/unikernel/duniverse/dune_/bin/util.ml new file mode 100644 index 00000000..12638ec7 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/util.ml @@ -0,0 +1,55 @@ +open Import + +type checked = + | In_build_dir of (Context.t * Path.Source.t) + | In_private_context of Path.Build.t + | In_install_dir of (Context.t * Path.Source.t) + | In_source_dir of Path.Source.t + | External of Path.External.t + +let check_path contexts = + let contexts = + Dune_engine.Context_name.Map.of_list_map_exn contexts ~f:(fun c -> Context.name c, c) + in + fun path -> + let internal_path () = + User_error.raise + [ Pp.textf "This path is internal to dune: %s" (Path.to_string_maybe_quoted path) + ] + in + let context_exn ctx = + match Dune_engine.Context_name.Map.find contexts ctx with + | Some context -> context + | None -> + User_error.raise + [ Pp.textf + "%s refers to unknown build context: %s" + (Path.to_string_maybe_quoted path) + (Dune_engine.Context_name.to_string ctx) + ] + ~hints: + (User_message.did_you_mean + (Dune_engine.Context_name.to_string ctx) + ~candidates: + (Dune_engine.Context_name.Map.keys contexts + |> List.map ~f:Dune_engine.Context_name.to_string)) + in + match path with + | External e -> External e + | In_source_tree s -> In_source_dir s + | In_build_dir path -> + (match Dune_engine.Dpath.analyse_target path with + | Other _ -> internal_path () + | Alias (_, _) -> internal_path () + | Anonymous_action _ -> internal_path () + | Regular (name, src) -> + (match Install.Context.analyze_path name src with + | Invalid -> internal_path () + | Install (ctx, path) -> In_install_dir (context_exn ctx, path) + | Normal (ctx, path) -> + if Context_name.equal ctx Dune_rules.Private_context.t.name + then + In_private_context + (Path.Build.append_source Dune_rules.Private_context.t.build_dir path) + else In_build_dir (context_exn ctx, path))) +;; diff --git a/unikernel/duniverse/dune_/bin/util.mli b/unikernel/duniverse/dune_/bin/util.mli new file mode 100644 index 00000000..e0855ad4 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/util.mli @@ -0,0 +1,10 @@ +open Import + +type checked = + | In_build_dir of (Context.t * Path.Source.t) + | In_private_context of Path.Build.t + | In_install_dir of (Context.t * Path.Source.t) + | In_source_dir of Path.Source.t + | External of Path.External.t + +val check_path : Context.t list -> Path.t -> checked diff --git a/unikernel/duniverse/dune_/bin/workspace_root.ml b/unikernel/duniverse/dune_/bin/workspace_root.ml new file mode 100644 index 00000000..c6f266a3 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/workspace_root.ml @@ -0,0 +1,126 @@ +open Stdune + +module Kind = struct + type t = + | Explicit + | Dune_workspace + | Dune_project + | Cwd + + let priority = function + | Explicit -> 0 + | Dune_workspace -> 1 + | Dune_project -> 2 + | Cwd -> 3 + ;; + + let lowest_priority = max_int + + let of_dir_contents files = + if String.Set.mem files Source.Workspace.filename + then Some Dune_workspace + else if Filename.Set.mem files Dune_lang.Dune_project.filename + then Some Dune_project + else None + ;; +end + +type t = + { dir : string + ; to_cwd : string list + ; reach_from_root_prefix : string + ; kind : Kind.t + } + +module Candidate = struct + type t = + { dir : string + ; to_cwd : string list + ; kind : Kind.t + } +end + +let find () = + let cwd = Sys.getcwd () in + let rec loop counter ~(candidate : Candidate.t option) ~to_cwd dir : Candidate.t option = + match Sys.readdir dir with + | exception Sys_error msg -> + User_warning.emit + [ Pp.textf + "Unable to read directory %s. Will not look for root in parent directories." + dir + ; Pp.textf "Reason: %s" msg + ; Pp.text "To remove this warning, set your root explicitly using --root." + ]; + candidate + | files -> + let files = String.Set.of_list (Array.to_list files) in + let candidate = + let candidate_priority = + match candidate with + | Some c -> Kind.priority c.kind + | None -> Kind.lowest_priority + in + match Kind.of_dir_contents files with + | Some kind when Kind.priority kind <= candidate_priority -> + Some { Candidate.kind; dir; to_cwd } + | _ -> candidate + in + cont counter ~candidate dir ~to_cwd + and cont counter ~candidate ~to_cwd dir = + if counter > String.length cwd + then candidate + else ( + let parent = Filename.dirname dir in + if parent = dir + then candidate + else ( + let base = Filename.basename dir in + loop (counter + 1) parent ~candidate ~to_cwd:(base :: to_cwd))) + in + loop 0 ~to_cwd:[] cwd ~candidate:None +;; + +let create ~default_is_cwd ~specified_by_user = + match + match specified_by_user with + | Some dn -> Some { Candidate.kind = Explicit; dir = dn; to_cwd = [] } + | None -> + let cwd = { Candidate.kind = Cwd; dir = "."; to_cwd = [] } in + if Execution_env.inside_dune + then Some cwd + else ( + match find () with + | Some s -> Some s + | None -> if default_is_cwd then Some cwd else None) + with + | Some { Candidate.dir; to_cwd; kind } -> + Ok + { kind + ; dir + ; to_cwd + ; reach_from_root_prefix = + String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/")) + } + | None -> + Error + User_error.( + make + [ Pp.text "I cannot find the root of the current workspace/project." + ; Pp.text "If you would like to create a new dune project, you can type:" + ; Pp.nop + ; Pp.verbatim " dune init project NAME" + ; Pp.nop + ; Pp.text + "Otherwise, please make sure to run dune inside an existing project or \ + workspace. For more information about how dune identifies the root of the \ + current workspace/project, please refer to \ + https://dune.readthedocs.io/en/stable/usage.html#finding-the-root" + ]) +;; + +let create_exn ~default_is_cwd ~specified_by_user = + match create ~default_is_cwd ~specified_by_user with + | Ok x -> x + | Error e -> raise (User_error.E e) +;; diff --git a/unikernel/duniverse/dune_/bin/workspace_root.mli b/unikernel/duniverse/dune_/bin/workspace_root.mli new file mode 100644 index 00000000..c28c94b7 --- /dev/null +++ b/unikernel/duniverse/dune_/bin/workspace_root.mli @@ -0,0 +1,26 @@ +open! Stdune + +(** Finding the root of the workspace *) + +module Kind : sig + type t = + | Explicit + | Dune_workspace + | Dune_project + | Cwd +end + +type t = + { dir : string + ; to_cwd : string list (** How to reach the cwd from the root *) + ; reach_from_root_prefix : string + (** Prefix filenames with this to reach them from the root *) + ; kind : Kind.t + } + +val create + : default_is_cwd:bool + -> specified_by_user:string option + -> (t, User_message.t) result + +val create_exn : default_is_cwd:bool -> specified_by_user:string option -> t diff --git a/unikernel/duniverse/dune_/boot/bootstrap.ml b/unikernel/duniverse/dune_/boot/bootstrap.ml new file mode 100644 index 00000000..7b7ebbf0 --- /dev/null +++ b/unikernel/duniverse/dune_/boot/bootstrap.ml @@ -0,0 +1,118 @@ +open StdLabels +open Printf + +(* This program performs version checking of the compiler and switches to the + secondary compiler if necessary. The script should execute in OCaml 4.08! *) + +let min_supported_natively = 4, 08, 0 + +let keep_generated_files = + let anon s = raise (Arg.Bad (sprintf "don't know what to do with %s\n" s)) in + let keep_generated_files = ref false in + Arg.parse + [ "-j", Arg.Int ignore, "JOBS Concurrency" + ; "--verbose", Arg.Unit ignore, " Set the display mode" + ; "--keep-generated-files", Arg.Set keep_generated_files, " Keep generated files" + ; "--debug", Arg.Unit ignore, " Enable various debugging options" + ; ( "--force-byte-compilation" + , Arg.Unit ignore + , " Force bytecode compilation even if ocamlopt is available" ) + ; "--static", Arg.Unit ignore, " Build a static binary" + ; "--boot-dir", Arg.String (fun _ -> ()), " set the boot directory" + ] + anon + "Usage: ocaml bootstrap.ml \nOptions are:"; + !keep_generated_files +;; + +let modules = [ "boot/libs"; "boot/duneboot" ] +let duneboot = ".duneboot" +let prog = duneboot ^ ".exe" + +let () = + at_exit (fun () -> + Array.iter (Sys.readdir "boot") ~f:(fun fn -> + let fn = Filename.concat "boot" fn in + if Filename.check_suffix fn ".cmi" || Filename.check_suffix fn ".cmo" + then ( + try Sys.remove fn with + | Sys_error _ -> ()))); + if not keep_generated_files + then + at_exit (fun () -> + Array.iter (Sys.readdir ".") ~f:(fun fn -> + if + String.length fn >= String.length duneboot + && String.sub fn ~pos:0 ~len:(String.length duneboot) = duneboot + then ( + try Sys.remove fn with + | Sys_error _ -> ()))) +;; + +let runf fmt = + ksprintf + (fun cmd -> + prerr_endline cmd; + Sys.command cmd) + fmt +;; + +let exit_if_non_zero = function + | 0 -> () + | n -> exit n +;; + +let read_file fn = + let ic = open_in_bin fn in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s +;; + +let () = + let v = Scanf.sscanf Sys.ocaml_version "%d.%d.%d" (fun a b c -> a, b, c) in + let compiler, which = + if v >= min_supported_natively + then "ocamlc", None + else ( + let compiler = "ocamlfind -toolchain secondary ocamlc" in + let output_fn, out = Filename.open_temp_file "duneboot" "ocamlfind-output" in + let n = runf "%s 2>%s" compiler output_fn in + let s = read_file output_fn in + close_out out; + prerr_endline s; + if n <> 0 || s <> "" + then ( + Format.eprintf + "@[%a@]@." + Format.pp_print_text + (let a, b, _ = min_supported_natively in + sprintf + "The ocamlfind's secondary toolchain does not seem to be correctly installed.\n\ + Dune requires OCaml %d.%02d or later to compile.\n\ + Please either upgrade your compile or configure a secondary OCaml compiler \ + (in opam, this can be done by installing the ocamlfind-secondary package)." + a + b); + exit 2); + compiler, Some "--secondary") + in + exit_if_non_zero + (runf + "%s %s -g -o %s -I boot %sunix.cma %s" + compiler + (* Make sure to produce a self-contained binary as dlls tend to cause + issues *) + (if v < (4, 10, 1) then "-custom" else "-output-complete-exe") + prog + (if v >= (5, 0, 0) then "-I +unix " else "") + (List.map modules ~f:(fun m -> m ^ ".ml") |> String.concat ~sep:" ")); + let args = List.tl (Array.to_list Sys.argv) in + let args = + match which with + | None -> args + | Some x -> x :: args + in + let args = Filename.concat "." prog :: args in + exit (runf "%s" (String.concat ~sep:" " args)) +;; diff --git a/unikernel/duniverse/dune_/boot/configure.ml b/unikernel/duniverse/dune_/boot/configure.ml new file mode 100644 index 00000000..9c714c14 --- /dev/null +++ b/unikernel/duniverse/dune_/boot/configure.ml @@ -0,0 +1,148 @@ +#!/usr/bin/env ocaml + +open StdLabels +open Printf + +let list f l = sprintf "[%s]" (String.concat ~sep:"; " (List.map l ~f)) +let string s = sprintf "%S" s + +let option f = function + | None -> "None" + | Some x -> sprintf "Some %s" (f x) +;; + +let out = + match Sys.getenv_opt "DUNE_CONFIGURE_OUTPUT" with + | None -> "src/dune_rules/setup.ml" + | Some out -> out +;; + +let default_toggles : (string * [ `Disabled | `Enabled ]) list = + [ "toolchains", `Enabled + ; "pkg_build_progress", `Disabled + ; "lock_dev_tool", `Disabled + ; "bin_dev_tools", `Disabled + ; "portable_lock_dir", `Disabled + ] +;; + +let toggles = ref default_toggles + +let toggle name v = + toggles := List.map !toggles ~f:(fun (x, y) -> x, if x = name then v else y) +;; + +let toggle = + let toggles = [ "enable", `Enabled; "disable", `Disabled ] in + let options = List.map toggles ~f:fst in + fun name -> Arg.Symbol (options, fun s -> List.assoc s toggles |> toggle name) +;; + +let () = + let bad fmt = ksprintf (fun s -> raise (Arg.Bad s)) fmt in + let prefix = ref None in + let library_path = ref [] in + let library_destdir = ref None in + let mandir = ref None in + let docdir = ref None in + let etcdir = ref None in + let bindir = ref None in + let sbindir = ref None in + let libexecdir = ref None in + let datadir = ref None in + let cwd = lazy (Sys.getcwd ()) in + let dir_of_string s = + if Filename.is_relative s then Filename.concat (Lazy.force cwd) s else s + in + let set_libdir s = + let dir = dir_of_string s in + library_path := dir :: !library_path; + library_destdir := Some dir + in + let set_dir v s = + let dir = dir_of_string s in + v := Some dir + in + let args = + [ "--prefix", Arg.String (set_dir prefix), "DIR where files are copied" + ; ( "--libdir" + , Arg.String set_libdir + , "DIR where public libraries are looked up in the default build context. Can be \ + specified multiple times new one taking precedence. The last is used as default \ + destination directory for public libraries." ) + ; ( "--bindir" + , Arg.String (set_dir bindir) + , "DIR where public binaries are installed for the default build context" ) + ; ( "--sbindir" + , Arg.String (set_dir sbindir) + , "DIR where files for sbin section are installed for the default build context" ) + ; ( "--mandir" + , Arg.String (set_dir mandir) + , "DIR where man pages are installed for the default build context" ) + ; ( "--docdir" + , Arg.String (set_dir docdir) + , "DIR where documentation is installed for the default build context" ) + ; ( "--etcdir" + , Arg.String (set_dir etcdir) + , "DIR where configuration files are installed for the default build context" ) + ; ( "--libexecdir" + , Arg.String (set_dir libexecdir) + , "DIR where files for the libexec_root section are installed for the default \ + build context. Use --libdir if specified" ) + ; ( "--datadir" + , Arg.String (set_dir datadir) + , "DIR where files for the share_root section are installed for the default build \ + context" ) + ; ( "--toolchains" + , toggle "toolchains" + , " Enable the toolchains behaviour, allowing dune to install the compiler in a \ + user-wide directory." ) + ; ( "--pkg-build-progress" + , toggle "pkg_build_progress" + , " Enable the displaying of package build progress.\n\ + \ This flag is experimental and shouldn't be relied on by packagers." ) + ; ( "--lock-dev-tool" + , toggle "lock_dev_tool" + , " Enable ocamlformat dev-tool, allows 'dune fmt' to build ocamlformat and use \ + it, independently from the project dependencies.\n\ + \ This flag is experimental and shouldn't be relied on by packagers." ) + ; ( "--bin-dev-tools" + , toggle "bin_dev_tools" + , " Enable obtaining dev-tools binarys from the binary package opam repository. \ + Allows fast installation of dev-tools. \n\ + \ This flag is experimental and shouldn't be relied on by packagers." ) + ; ( "--portable-lock-dir" + , toggle "portable_lock_dir" + , "Generate portable lock dirs. If this feature is disabled then lock dirs will be \ + specialized to the machine where they are generated." ) + ] + in + let anon s = bad "Don't know what to do with %s" s in + Arg.parse (Arg.align args) anon "Usage: ocaml configure.ml [OPTIONS]\nOptions are:"; + (match !libexecdir with + | None -> libexecdir := !library_destdir + | Some _ -> ()); + let oc = open_out out in + let pr fmt = fprintf oc (fmt ^^ "\n") in + pr "let library_path = %s\n" ((list string) !library_path); + pr "let roots : string option Install.Roots.t ="; + pr " { lib_root = %s" (option string !library_destdir); + pr " ; man = %s" (option string !mandir); + pr " ; doc_root = %s" (option string !docdir); + pr " ; etc_root = %s" (option string !etcdir); + pr " ; share_root = %s" (option string !datadir); + pr " ; bin = %s" (option string !bindir); + pr " ; sbin = %s" (option string !sbindir); + pr " ; libexec_root = %s" (option string !libexecdir); + pr " }"; + pr ""; + pr "let prefix : string option = %s" (option string !prefix); + List.iter !toggles ~f:(fun (name, value) -> + pr + "let %s = `%s" + name + (match value with + | `Enabled -> "Enabled" + | `Disabled -> "Disabled")); + close_out oc +;; diff --git a/unikernel/duniverse/dune_/boot/dune b/unikernel/duniverse/dune_/boot/dune new file mode 100644 index 00000000..d85b110b --- /dev/null +++ b/unikernel/duniverse/dune_/boot/dune @@ -0,0 +1,34 @@ +(rule + (mode promote) + (action + (copy ../bin/bootstrap-info libs.ml))) + +(alias + (name runtest) + (deps libs.ml)) + +(alias + (name check) + (deps libs.ml)) + +(executable + (name duneboot) + (modules :standard \ configure bootstrap) + (libraries unix)) + +(executable + (name configure) + (preprocess + (action + (run tail -n +2 %{input-file}))) + (modules configure)) + +(executable + (name bootstrap) + (modules bootstrap)) + +;; For unused value warnings. We don't write a plain empty +;; duneboot.mli to simplify ../bootstrap.ml + +(rule + (with-stdout-to duneboot.mli (progn))) diff --git a/unikernel/duniverse/dune_/boot/duneboot.ml b/unikernel/duniverse/dune_/boot/duneboot.ml new file mode 100644 index 00000000..9280e711 --- /dev/null +++ b/unikernel/duniverse/dune_/boot/duneboot.ml @@ -0,0 +1,1442 @@ +(** {2 Command line} *) + +let concurrency, verbose, debug, secondary, force_byte_compilation, static, build_dir = + let build_dir = ref "_boot" in + let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in + let concurrency = ref None in + let verbose = ref false in + let prog = Filename.basename Sys.argv.(0) in + let debug = ref false in + let secondary = ref false in + let force_byte_compilation = ref false in + let static = ref false in + Arg.parse + [ "-j", Int (fun n -> concurrency := Some n), "JOBS Concurrency" + ; "--verbose", Set verbose, " Set the display mode" + ; "--keep-generated-files", Unit ignore, " Keep generated files" + ; "--debug", Set debug, " Enable various debugging options" + ; "--secondary", Set secondary, " Use the secondary compiler installation" + ; ( "--force-byte-compilation" + , Set force_byte_compilation + , " Force bytecode compilation even if ocamlopt is available" ) + ; "--static", Set static, " Build a static binary" + ; "--boot-dir", Set_string build_dir, " Set the boot directory" + ] + anon + (Printf.sprintf "Usage: %s \nOptions are:" prog); + !concurrency, !verbose, !debug, !secondary, !force_byte_compilation, !static, !build_dir +;; + +(** {2 General configuration} *) + +type task = + { target : string * string + ; external_libraries : string list + ; local_libraries : Libs.library list + } + +let task = + { target = "dune", "bin/main.ml" + ; external_libraries = Libs.external_libraries + ; local_libraries = Libs.local_libraries + } +;; + +(** {2 Utility functions} *) + +open StdLabels +open Printf + +module String = struct + include String + module Set = Set.Make (String) + module Map = Map.Make (String) + + let is_suffix t ~suffix = Filename.check_suffix t suffix + + let is_prefix t ~prefix = + let len_s = length t + and len_pre = length prefix in + let rec aux i = + if i = len_pre + then true + else if unsafe_get t i <> unsafe_get prefix i + then false + else aux (i + 1) + in + len_s >= len_pre && aux 0 + ;; +end + +module List = struct + include List + + let partition_map_skip t ~f = + let rec loop l m r = function + | [] -> l, m, r + | x :: xs -> + (match f x with + | `Skip -> loop l m r xs + | `Left x -> loop (x :: l) m r xs + | `Middle x -> loop l (x :: m) r xs + | `Right x -> loop l m (x :: r) xs) + in + let l, m, r = loop [] [] [] t in + rev l, rev m, rev r + ;; + + let rec filter_map l ~f = + match l with + | [] -> [] + | x :: l -> + (match f x with + | None -> filter_map l ~f + | Some x -> x :: filter_map l ~f) + ;; +end + +let ( ^/ ) = Filename.concat + +let fatal fmt = + ksprintf + (fun s -> + prerr_endline s; + exit 2) + fmt +;; + +module Status_line = struct + let num_jobs = ref 0 + let num_jobs_finished = ref 0 + let displayed = ref "" + + let display_status_line = + Unix.(isatty stdout) + || + match Sys.getenv "INSIDE_EMACS" with + | (_ : string) -> true + | exception Not_found -> false + ;; + + let update jobs = + if display_status_line && !num_jobs > 0 + then ( + let new_displayed = + sprintf "Done: %d/%d (jobs: %d)" !num_jobs_finished !num_jobs jobs + in + Printf.printf "\r%*s\r%s%!" (String.length !displayed) "" new_displayed; + displayed := new_displayed) + ;; + + let clear () = Printf.printf "\r*s\r%!" + let () = at_exit (fun () -> Printf.printf "\r%*s\r" (String.length !displayed) "") +end + +(* Return a sorted list of entries in [path] as [path/entry] *) +let readdir path = + Sys.readdir path + |> Array.to_list + |> List.map ~f:(fun entry -> path ^/ entry) + |> List.sort ~cmp:String.compare +;; + +let open_out file = + if Sys.file_exists file then fatal "%s already exists" file; + open_out file +;; + +let input_lines ic = + let rec loop ic acc = + match input_line ic with + | line -> loop ic (line :: acc) + | exception End_of_file -> List.rev acc + in + loop ic [] +;; + +let read_lines fn = + let ic = open_in fn in + let lines = input_lines ic in + close_in ic; + lines +;; + +let read_file fn = + let ic = open_in_bin fn in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s +;; + +let split_lines s = + let rec loop ~last_is_cr ~acc i j = + if j = String.length s + then ( + let acc = + if j = i || (j = i + 1 && last_is_cr) + then acc + else String.sub s ~pos:i ~len:(j - i) :: acc + in + List.rev acc) + else ( + match s.[j] with + | '\r' -> loop ~last_is_cr:true ~acc i (j + 1) + | '\n' -> + let line = + let len = if last_is_cr then j - i - 1 else j - i in + String.sub s ~pos:i ~len + in + loop ~acc:(line :: acc) (j + 1) (j + 1) ~last_is_cr:false + | _ -> loop ~acc i (j + 1) ~last_is_cr:false) + in + loop ~acc:[] 0 0 ~last_is_cr:false +;; + +let do_then_copy ~f a b = + if Sys.file_exists b then fatal "%s already exists" b; + let ic = open_in_bin a in + let len = in_channel_length ic in + let s = really_input_string ic len in + close_in ic; + let oc = open_out_bin b in + f oc; + output_string oc s; + close_out oc +;; + +(* copy a file - fails if the file exists *) +let copy a b = do_then_copy ~f:(fun _ -> ()) a b + +(* copy a file and insert a header - fails if the file exists *) +let copy_with_header ~header a b = do_then_copy ~f:(fun oc -> output_string oc header) a b + +(* copy a file and insert a directive - fails if the file exists *) +let copy_with_directive ~directive a b = + do_then_copy ~f:(fun oc -> fprintf oc "#%s 1 %S\n" directive a) a b +;; + +let path_sep = if Sys.win32 then ';' else ':' + +let split_path s = + let rec loop i j = + if j = String.length s + then [ String.sub s ~pos:i ~len:(j - i) ] + else if s.[j] = path_sep + then String.sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1) + else loop i (j + 1) + in + loop 0 0 +;; + +let path = + match Sys.getenv "PATH" with + | exception Not_found -> [] + | s -> split_path s +;; + +let find_prog ~f = + let rec search = function + | [] -> None + | dir :: rest -> + (match f dir with + | None -> search rest + | Some fn -> Some (dir, fn)) + in + search path +;; + +let exe = if Sys.win32 then ".exe" else "" + +(** {2 Concurrency level} *) + +let concurrency = + let try_run_and_capture_line (prog, args) = + match + find_prog ~f:(fun dir -> if Sys.file_exists (dir ^/ prog) then Some prog else None) + with + | None -> None + | Some (dir, prog) -> + let path = dir ^/ prog in + let args = Array.of_list @@ (path :: args) in + let ic, oc, ec = Unix.open_process_args_full path args (Unix.environment ()) in + let line = + match input_line ic with + | s -> Some s + | exception End_of_file -> None + in + (match Unix.close_process_full (ic, oc, ec), line with + | WEXITED 0, Some s -> Some s + | _ -> None) + in + match concurrency with + | Some n -> n + | None -> + (* If no [-j] was given, try to autodetect the number of processors *) + if Sys.win32 + then ( + match Sys.getenv_opt "NUMBER_OF_PROCESSORS" with + | None -> 1 + | Some s -> + (match int_of_string s with + | exception _ -> 1 + | n -> n)) + else ( + let commands = + [ "nproc", [] + ; "getconf", [ "_NPROCESSORS_ONLN" ] + ; "getconf", [ "NPROCESSORS_ONLN" ] + ] + in + let rec loop = function + | [] -> 1 + | cmd :: rest -> + (match try_run_and_capture_line cmd with + | None -> loop rest + | Some s -> + (match int_of_string (String.trim s) with + | n -> n + | exception _ -> loop rest)) + in + loop commands) +;; + +(** {2 Fibers} *) + +module Fiber : sig + (** Fibers *) + + (** This module is similar to the one in [../src/fiber] except that it is much + less optimised and much easier to understand. You should look at the + documentation of the other module to understand the API. *) + + type 'a t + + val return : 'a -> 'a t + + module O : sig + val ( >>> ) : unit t -> 'a t -> 'a t + val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t + val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t + end + + module Future : sig + type 'a fiber + type 'a t + + val wait : 'a t -> 'a fiber + end + with type 'a fiber := 'a t + + val fork : (unit -> 'a t) -> 'a Future.t t + val fork_and_join : (unit -> 'a t) -> (unit -> 'b t) -> ('a * 'b) t + val fork_and_join_unit : (unit -> unit t) -> (unit -> 'a t) -> 'a t + val parallel_map : 'a list -> f:('a -> 'b t) -> 'b list t + val parallel_iter : 'a list -> f:('a -> unit t) -> unit t + + module Process : sig + val run : ?cwd:string -> string -> string list -> unit t + val run_and_capture : ?cwd:string -> string -> string list -> string t + val try_run_and_capture : ?cwd:string -> string -> string list -> string option t + end + + val run : 'a t -> 'a +end = struct + open MoreLabels + + type 'a t = ('a -> unit) -> unit + + let return x k = k x + + module O = struct + let ( >>> ) a b k = a (fun () -> b k) + let ( >>= ) t f k = t (fun x -> f x k) + let ( >>| ) t f k = t (fun x -> k (f x)) + end + + open O + + let both a b = a >>= fun a -> b >>= fun b -> return (a, b) + + module Ivar = struct + type 'a state = + | Full of 'a + | Empty of ('a -> unit) Queue.t + + type 'a t = { mutable state : 'a state } + + let create () = { state = Empty (Queue.create ()) } + + let fill t x = + match t.state with + | Full _ -> failwith "Fiber.Ivar.fill" + | Empty q -> + t.state <- Full x; + Queue.iter (fun f -> f x) q + ;; + + let read t k = + match t.state with + | Full x -> k x + | Empty q -> Queue.push k q + ;; + end + + module Future = struct + type 'a t = 'a Ivar.t + + let wait = Ivar.read + end + + let fork f k = + let ivar = Ivar.create () in + f () (fun x -> Ivar.fill ivar x); + k ivar + ;; + + let fork_and_join f g = + fork f >>= fun a -> fork g >>= fun b -> both (Future.wait a) (Future.wait b) + ;; + + let fork_and_join_unit f g = + fork f >>= fun a -> fork g >>= fun b -> Future.wait a >>> Future.wait b + ;; + + let rec parallel_map l ~f = + match l with + | [] -> return [] + | x :: l -> + fork (fun () -> f x) + >>= fun future -> + parallel_map l ~f >>= fun l -> Future.wait future >>= fun x -> return (x :: l) + ;; + + let rec parallel_iter l ~f = + match l with + | [] -> return () + | x :: l -> + fork (fun () -> f x) + >>= fun future -> parallel_iter l ~f >>= fun () -> Future.wait future + ;; + + module Temp = struct + module Files = Set.Make (String) + + let tmp_files = ref Files.empty + + let () = + at_exit (fun () -> + let fns = !tmp_files in + tmp_files := Files.empty; + Files.iter fns ~f:(fun fn -> + try Sys.remove fn with + | _ -> ())) + ;; + + let file prefix suffix = + let fn = Filename.temp_file prefix suffix in + tmp_files := Files.add fn !tmp_files; + fn + ;; + + let destroy_file fn = + (try Sys.remove fn with + | _ -> ()); + tmp_files := Files.remove fn !tmp_files + ;; + end + + module Process = struct + let running = Hashtbl.create concurrency + + exception Finished of int * Unix.process_status + + let rec wait_win32 () = + match + Hashtbl.iter running ~f:(fun ~key:pid ~data:_ -> + let pid, status = Unix.waitpid [ WNOHANG ] pid in + if pid <> 0 then raise_notrace (Finished (pid, status))) + with + | () -> + ignore (Unix.select [] [] [] 0.001); + wait_win32 () + | exception Finished (pid, status) -> pid, status + ;; + + let wait = if Sys.win32 then wait_win32 else Unix.wait + let waiting_for_slot = Queue.create () + + let throttle () = + if Hashtbl.length running >= concurrency + then ( + let ivar = Ivar.create () in + Queue.push ivar waiting_for_slot; + Ivar.read ivar) + else return () + ;; + + let restart_throttled () = + while + Hashtbl.length running < concurrency && not (Queue.is_empty waiting_for_slot) + do + Ivar.fill (Queue.pop waiting_for_slot) () + done + ;; + + let open_temp_file () = + let out = Temp.file "duneboot-" ".output" in + let fd = + Unix.openfile out [ O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE; O_CLOEXEC ] 0o666 + in + out, fd + ;; + + let read_temp fn = + let s = read_file fn in + Temp.destroy_file fn; + s + ;; + + let initial_cwd = Sys.getcwd () + + let run_process ?cwd prog args ~split = + throttle () + >>= fun () -> + let stdout_fn, stdout_fd = open_temp_file () in + let stderr_fn, stderr_fd = + if split then open_temp_file () else stdout_fn, stdout_fd + in + (match cwd with + | Some x -> Sys.chdir x + | None -> ()); + let pid = + Unix.create_process + prog + (Array.of_list (prog :: args)) + Unix.stdin + stdout_fd + stderr_fd + in + (match cwd with + | Some _ -> Sys.chdir initial_cwd + | None -> ()); + Unix.close stdout_fd; + if split then Unix.close stderr_fd; + let ivar = Ivar.create () in + Hashtbl.add running ~key:pid ~data:ivar; + Ivar.read ivar + >>= fun (status : Unix.process_status) -> + let stdout_s = read_temp stdout_fn in + let stderr_s = if split then read_temp stderr_fn else stdout_s in + if stderr_s <> "" || status <> WEXITED 0 || verbose + then ( + let cmdline = String.concat ~sep:" " (prog :: args) in + let cmdline = + match cwd with + | Some x -> sprintf "cd %s && %s" x cmdline + | None -> cmdline + in + Status_line.clear (); + prerr_endline cmdline; + prerr_string stderr_s; + flush stderr); + match status with + | WEXITED 0 -> return (Ok stdout_s) + | WEXITED n -> return (Error n) + | WSIGNALED _ -> return (Error 255) + | WSTOPPED _ -> assert false + ;; + + let run ?cwd prog args = + run_process ?cwd prog args ~split:false + >>| function + | Ok _ -> () + | Error n -> exit n + ;; + + let run_and_capture ?cwd prog args = + run_process ?cwd prog args ~split:true + >>| function + | Ok x -> x + | Error n -> exit n + ;; + + let try_run_and_capture ?cwd prog args = + run_process ?cwd prog args ~split:true + >>| function + | Ok x -> Some x + | Error _ -> None + ;; + end + + let run t = + let result = ref None in + t (fun x -> result := Some x); + let rec loop () = + if Hashtbl.length Process.running > 0 + then ( + Status_line.update (Hashtbl.length Process.running); + let pid, status = Process.wait () in + let ivar = Hashtbl.find Process.running pid in + Hashtbl.remove Process.running pid; + Ivar.fill ivar status; + Process.restart_throttled (); + loop ()) + else ( + match !result with + | Some x -> x + | None -> fatal "bootstrap got stuck!") + in + loop () + ;; +end + +open Fiber.O +module Process = Fiber.Process + +(** {2 OCaml tools} *) + +module Mode = struct + type t = + | Byte + | Native +end + +module Config : sig + val compiler : string + val ocamldep : string + val ocamllex : string + val ocamlyacc : string + val mode : Mode.t + val ocaml_archive_ext : string + val ocaml_config : unit -> string String.Map.t Fiber.t + val output_complete_obj_arg : string + val unix_library_flags : string list +end = struct + let ocaml_version = Scanf.sscanf Sys.ocaml_version "%d.%d" (fun a b -> a, b) + let prog_not_found prog = fatal "Program %s not found in PATH" prog + + let best_prog dir prog = + let fn = dir ^/ prog ^ ".opt" ^ exe in + if Sys.file_exists fn + then Some fn + else ( + let fn = dir ^/ prog ^ exe in + if Sys.file_exists fn then Some fn else None) + ;; + + let find_prog prog = find_prog ~f:(fun dir -> best_prog dir prog) + + let get_prog dir prog = + match best_prog dir prog with + | None -> prog_not_found prog + | Some fn -> fn + ;; + + let bin_dir, ocamlc = + if secondary + then ( + let s = + Fiber.run + (Process.run_and_capture + "ocamlfind" + [ "-toolchain"; "secondary"; "query"; "ocaml" ]) + in + match split_lines s with + | [] | _ :: _ :: _ -> fatal "Unexpected output locating secondary compiler" + | [ bin_dir ] -> + (match best_prog bin_dir "ocamlc" with + | None -> fatal "Failed to locate secondary ocamlc" + | Some x -> bin_dir, x)) + else ( + match find_prog "ocamlc" with + | None -> prog_not_found "ocamlc" + | Some x -> x) + ;; + + let ocamlyacc = get_prog bin_dir "ocamlyacc" + let ocamllex = get_prog bin_dir "ocamllex" + let ocamldep = get_prog bin_dir "ocamldep" + + let compiler, mode, ocaml_archive_ext = + match force_byte_compilation, best_prog bin_dir "ocamlopt" with + | true, _ | _, None -> ocamlc, Mode.Byte, ".cma" + | false, Some path -> path, Mode.Native, ".cmxa" + ;; + + let ocaml_config () = + Process.run_and_capture ocamlc [ "-config" ] + >>| fun s -> + List.fold_left (split_lines s) ~init:String.Map.empty ~f:(fun acc line -> + match Scanf.sscanf line "%[^:]: %s" (fun k v -> k, v) with + | k, v -> String.Map.add k v acc + | exception _ -> + fatal "invalid line in output of 'ocamlc -config': %s" (String.escaped line)) + ;; + + let output_complete_obj_arg = + if ocaml_version < (4, 10) then "-custom" else "-output-complete-exe" + ;; + + let unix_library_flags = if ocaml_version >= (5, 0) then [ "-I"; "+unix" ] else [] +end + +let insert_header fn ~header = + match header with + | "" -> () + | h -> + let s = read_file fn in + let oc = open_out_bin fn in + output_string oc h; + output_string oc s; + close_out oc +;; + +let copy_lexer ~header src dst = + let dst = Filename.remove_extension dst ^ ".ml" in + Process.run Config.ocamllex [ "-q"; "-o"; dst; src ] + >>| fun () -> insert_header dst ~header +;; + +let copy_parser ~header src dst = + let dst = Filename.remove_extension dst in + Process.run Config.ocamlyacc [ "-b"; dst; src ] + >>| fun () -> + insert_header (dst ^ ".ml") ~header; + insert_header (dst ^ ".mli") ~header +;; + +(** {2 Handling of the dune-build-info library} *) + +(** {2 Preparation of library files} *) +module Build_info = struct + let get_version () = + let from_dune_project = + match read_lines "dune-project" with + | exception _ -> None + | lines -> + let rec loop = function + | [] -> None + | line :: lines -> + (match Scanf.sscanf line "(version %[^)])" (fun v -> v) with + | exception _ -> loop lines + | v -> Some v) + in + loop lines + in + match from_dune_project with + | Some _ -> Fiber.return from_dune_project + | None -> + if not (Sys.file_exists ".git") + then Fiber.return None + else + Process.try_run_and_capture + "git" + [ "describe"; "--always"; "--dirty"; "--abbrev=7" ] + >>| (function + | Some s -> Some (String.trim s) + | None -> None) + ;; + + let gen_data_module oc = + let pr fmt = fprintf oc fmt in + let prlist name l ~f = + match l with + | [] -> pr "let %s = []\n" name + | x :: l -> + pr "let %s =\n" name; + pr " [ "; + f x; + List.iter l ~f:(fun x -> + pr " ; "; + f x); + pr " ]\n" + in + get_version () + >>| fun version -> + pr + "let version = %s\n" + (match version with + | None -> "None" + | Some v -> sprintf "Some %S" v); + pr "\n"; + let libs = + List.map task.local_libraries ~f:(fun (lib : Libs.library) -> lib.path, "version") + @ List.map task.external_libraries ~f:(fun name -> + name, {|Some "[distributed with OCaml]"|}) + |> List.sort ~cmp:(fun (a, _) (b, _) -> String.compare a b) + in + prlist "statically_linked_libraries" libs ~f:(fun (name, v) -> pr "%S, %s\n" name v) + ;; +end + +(* module OCaml_file = struct module Kind = struct type t = Impl | Intf end + + type t = { kind : Kind.t ; module_name = end *) + +module Library = struct + module File_kind = struct + type asm = + { syntax : [ `Gas | `Intel ] + ; arch : [ `Amd64 ] option + ; os : [ `Win | `Unix ] option + ; assembler : [ `C_comp | `Msvc_asm ] + } + + type c = + { arch : [ `Arm64 | `X86 ] option + ; flags : string list + } + + type t = + | Header + | C of c + | Asm of asm + | Ml + | Mli + | Mll + | Mly + + let analyse file = + let fn = Filename.basename file in + let i = + try String.index fn '.' with + | Not_found -> String.length fn + in + match String.sub fn ~pos:i ~len:(String.length fn - i) with + | (".S" | ".asm") as ext -> + let syntax = if ext = ".S" then `Gas else `Intel in + let os, arch, assembler = + let fn = Filename.remove_extension fn in + let check suffix = String.is_suffix fn ~suffix in + if check "x86-64_unix" + then Some `Unix, Some `Amd64, `C_comp + else if check "x86-64_windows_gnu" + then Some `Win, Some `Amd64, `C_comp + else if check "x86-64_windows_msvc" + then Some `Win, Some `Amd64, `Msvc_asm + else None, None, `C_comp + in + Some (Asm { syntax; arch; os; assembler }) + | ".c" -> + let arch, flags = + let fn = Filename.remove_extension fn in + let check suffix = String.is_suffix fn ~suffix in + let x86 gnu _msvc = + (* CR rgrinberg: select msvc flags on windows *) + Some `X86, gnu + in + if check "_sse2" + then x86 [ "-msse2" ] [ "/arch:SSE2" ] + else if check "_sse41" + then x86 [ "-msse4.1" ] [ "/arch:AVX" ] + else if check "_avx2" + then x86 [ "-mavx2" ] [ "/arch:AVX2" ] + else if check "_avx512" + then x86 [ "-mavx512f"; "-mavx512vl"; "-mavx512bw" ] [ "/arch:AVX512" ] + else if String.is_suffix fn ~suffix:"_neon" + then Some `Arm64, [] + else None, [] + in + Some (C { arch; flags }) + | ".h" -> Some Header + | ".ml" -> Some Ml + | ".mli" -> Some Mli + | ".mll" -> Some Mll + | ".mly" -> Some Mly + | ".defaults.ml" -> + let fn' = String.sub fn ~pos:0 ~len:i ^ ".ml" in + let dn = Filename.dirname file in + if Sys.file_exists (dn ^/ fn') then None else Some Ml + | _ -> None + ;; + end + + type source = + { file : string + ; kind : File_kind.t + } + + type c_file = + { name : string + ; flags : string list + } + + type asm_file = + { assembler : [ `C_comp | `Msvc_asm ] + ; flags : string list + ; out_file : string + } + + module Wrapper = struct + type t = + { toplevel_module : string + ; alias_module : string + } + + let make ~namespace ~modules = + match namespace with + | None -> None + | Some namespace -> + let namespace = String.capitalize_ascii namespace in + if String.Set.equal modules (String.Set.singleton namespace) + then None + else if String.Set.mem namespace modules + then Some { toplevel_module = namespace; alias_module = namespace ^ "__" } + else Some { toplevel_module = namespace; alias_module = namespace } + ;; + + let mangle_filename t ({ file; kind } : source) = + let base = Filename.basename file in + match kind with + | Asm _ | C _ | Header -> base + | Mll | Mly | Ml | Mli -> + let ext = + match kind with + | Mli -> ".mli" + | _ -> ".ml" + in + let base = + String.sub base ~pos:0 ~len:(String.index base '.') |> String.uncapitalize_ascii + in + (match t with + | None -> base ^ ext + | Some t -> + if String.capitalize_ascii base = t.toplevel_module + then base ^ ext + else ( + let base = String.capitalize_ascii base in + String.uncapitalize_ascii t.toplevel_module ^ "__" ^ base ^ ext)) + ;; + + let header t = + match t with + | None -> "" + | Some t -> sprintf "open! %s\n" t.alias_module + ;; + + let generate_wrapper t modules = + match t with + | None -> None + | Some t -> + let fn = String.uncapitalize_ascii t.alias_module ^ ".ml" in + let oc = open_out (build_dir ^/ fn) in + String.Set.iter + (fun m -> + if m <> t.toplevel_module + then fprintf oc "module %s = %s__%s\n" m t.toplevel_module m) + modules; + close_out oc; + Some fn + ;; + end + + (* Collect source files *) + let scan ~dir ~scan_subdirs = + let rec loop files acc = + match files with + | [] -> acc + | file :: files -> + let acc = + if Sys.is_directory file + then if scan_subdirs then loop (readdir file) acc else acc + else ( + match File_kind.analyse file with + | Some kind -> { file; kind } :: acc + | None -> acc) + in + loop files acc + in + loop (readdir dir) [] + ;; + + type t = + { ocaml_files : string list + ; alias_file : string option + ; c_files : c_file list + ; asm_files : asm_file list + } + + let keep_asm + { File_kind.syntax; arch; os; assembler = _ } + ~ccomp_type + ~architecture + ~os_type + = + (match os with + | Some `Unix -> String.equal os_type "Unix" + | Some `Win -> String.equal os_type "Win32" + | None -> true) + && (match syntax, ccomp_type with + | `Intel, "msvc" -> true + | `Gas, "msvc" -> false + | `Gas, _ -> true + | `Intel, _ -> false) + && + match arch, architecture with + | None, _ -> true + | Some `Amd64, "amd64" -> true + | Some `Amd64, _ -> false + ;; + + let keep_c { File_kind.arch; flags = _ } ~architecture = + match arch with + | None -> true + | Some `Arm64 -> architecture = "arm64" + | Some `X86 -> architecture = "amd64" || architecture = "x86_64" + ;; + + let process + { Libs.path = dir + ; main_module_name = namespace + ; include_subdirs_unqualified = scan_subdirs + ; special_builtin_support = build_info_module + } + ~ocaml_config + ~word_size + ~os_type + = + let files = scan ~dir ~scan_subdirs in + let modules = + let modules = + List.fold_left files ~init:String.Set.empty ~f:(fun acc { file = fn; kind } -> + match (kind : File_kind.t) with + | Asm _ | Header | C _ -> acc + | Ml | Mli | Mll | Mly -> + let module_name = + let fn = Filename.basename fn in + String.sub fn ~pos:0 ~len:(String.index fn '.') |> String.capitalize_ascii + in + String.Set.add module_name acc) + in + match build_info_module with + | None -> modules + | Some m -> String.Set.add (String.capitalize_ascii m) modules + in + let wrapper = Wrapper.make ~namespace ~modules in + let header = Wrapper.header wrapper in + Fiber.fork_and_join + (fun () -> + Fiber.parallel_map files ~f:(fun ({ file = fn; kind } as source) -> + let mangled = Wrapper.mangle_filename wrapper source in + let dst = build_dir ^/ mangled in + (match kind with + | Asm _ -> + copy fn dst; + Fiber.return [ mangled ] + | Header | C _ -> + copy_with_directive ~directive:"line" fn dst; + Fiber.return [ mangled ] + | Ml | Mli -> + copy_with_header ~header fn dst; + Fiber.return [ mangled ] + | Mll -> copy_lexer fn dst ~header >>> Fiber.return [ mangled ] + | Mly -> + (* CR rgrinberg: what if the parser already has an mli? *) + copy_parser fn dst ~header >>> Fiber.return [ mangled; mangled ^ "i" ]) + >>| function + | mangled -> List.map mangled ~f:(fun m -> source, m))) + (fun () -> + match build_info_module with + | None -> Fiber.return None + | Some m -> + let src = + let fn = String.uncapitalize_ascii m ^ ".ml" in + { file = fn; kind = Ml } + in + let mangled = Wrapper.mangle_filename wrapper src in + let oc = open_out (build_dir ^/ mangled) in + Build_info.gen_data_module oc + >>| fun () -> + close_out oc; + Some (src, mangled)) + >>| fun (files, build_info_file) -> + let alias_file = Wrapper.generate_wrapper wrapper modules in + let c_files, ocaml_files, asm_files = + let files = + let files = List.concat files in + match build_info_file with + | None -> files + | Some fn -> fn :: files + in + let ext_obj = + try String.Map.find "ext_obj" ocaml_config with + | Not_found -> ".o" + in + let ccomp_type = String.Map.find "ccomp_type" ocaml_config in + let architecture = String.Map.find "architecture" ocaml_config in + List.partition_map_skip files ~f:(fun (src, fn) -> + match src.kind with + | C c -> + if keep_c c ~architecture + then ( + let extra_flags = + if String.is_prefix ~prefix:"blake3_" fn + then + if String.equal os_type "Cygwin" || String.equal word_size "32" + then + [ "-DBLAKE3_NO_SSE2" + ; "-DBLAKE3_NO_SSE41" + ; "-DBLAKE3_NO_AVX2" + ; "-DBLAKE3_NO_AVX512" + ] + else [] + else [] + in + `Left { flags = extra_flags @ c.flags; name = fn }) + else `Skip + | Ml | Mli | Mly | Mll -> `Middle fn + | Header -> `Skip + | Asm asm -> + if keep_asm asm ~ccomp_type ~architecture ~os_type + then ( + let out_file = Filename.chop_extension fn ^ ext_obj in + `Right + { flags = + (match asm.assembler with + | `C_comp -> [ "-c"; fn; "-o"; out_file ] + | `Msvc_asm -> [ "/nologo"; "/quiet"; "/Fo" ^ out_file; "/c"; fn ]) + ; assembler = asm.assembler + ; out_file + }) + else `Skip) + in + { ocaml_files; alias_file; c_files; asm_files } + ;; +end + +let ocamldep args = + Process.run_and_capture Config.ocamldep ("-modules" :: args) ~cwd:build_dir + >>| fun s -> + List.map (split_lines s) ~f:(fun line -> + let colon = String.index line ':' in + let filename = String.sub line ~pos:0 ~len:colon in + let modules = + if colon = String.length line - 1 + then [] + else ( + let modules = + String.sub line ~pos:(colon + 2) ~len:(String.length line - colon - 2) + in + String.split_on_char ~sep:' ' modules) + in + filename, modules) + |> List.sort ~cmp:compare +;; + +let mk_flags arg l = List.map l ~f:(fun m -> [ arg; m ]) |> List.flatten + +let convert_dependencies ~all_source_files (file, dependencies) = + let is_mli = Filename.check_suffix file ".mli" in + let convert_module module_name = + let filename = String.uncapitalize_ascii module_name in + if filename = Filename.chop_extension file + then (* Self-reference *) + None + else if String.Set.mem (filename ^ ".mli") all_source_files + then + if (not is_mli) && String.Set.mem (filename ^ ".ml") all_source_files + then + (* We need to build the .ml for inlining info *) + Some [ filename ^ ".mli"; filename ^ ".ml" ] + else (* .mli files never depend on .ml files *) + Some [ filename ^ ".mli" ] + else if String.Set.mem (filename ^ ".ml") all_source_files + then + (* If there's no .mli, then we must always depend on the .ml *) + Some [ filename ^ ".ml" ] + else (* This is a module coming from an external library *) + None + in + let dependencies = + let dependencies = List.concat (List.filter_map ~f:convert_module dependencies) in + (* .ml depends on .mli, if it exists *) + if (not is_mli) && String.Set.mem (file ^ "i") all_source_files + then (file ^ "i") :: dependencies + else dependencies + in + file, dependencies +;; + +let write_args file args = + let ch = open_out (build_dir ^/ file) in + output_string ch (String.concat ~sep:"\n" args); + close_out ch +;; + +let get_dependencies libraries = + let alias_files = + List.fold_left libraries ~init:[] ~f:(fun acc (lib : Library.t) -> + match lib.alias_file with + | None -> acc + | Some fn -> fn :: acc) + in + let all_source_files = + List.map ~f:(fun (lib : Library.t) -> lib.ocaml_files) libraries |> List.concat + in + write_args "source_files" all_source_files; + ocamldep (mk_flags "-map" alias_files @ [ "-args"; "source_files" ]) + >>| fun dependencies -> + let all_source_files = + List.fold_left + alias_files + ~init:(String.Set.of_list all_source_files) + ~f:(fun acc fn -> String.Set.add fn acc) + in + let deps = + List.rev_append + ((* Alias files have no dependencies *) + List.rev_map + alias_files + ~f:(fun fn -> fn, [])) + (List.rev_map dependencies ~f:(convert_dependencies ~all_source_files)) + in + if debug + then ( + eprintf "***** Dependencies *****\n"; + List.iter deps ~f:(fun (fn, deps) -> + eprintf "%s: %s\n" fn (String.concat deps ~sep:" ")); + eprintf "**********\n"); + deps +;; + +let assemble_libraries + { local_libraries; target = _, main; _ } + ~ocaml_config + ~word_size + ~os_type + = + (* In order to assemble all the sources in one place, the executables + modules are also put in a namespace *) + let task_lib = + let dir = Filename.dirname main in + let namespace = + String.capitalize_ascii (Filename.chop_extension (Filename.basename main)) + in + { Libs.path = dir + ; main_module_name = Some namespace + ; include_subdirs_unqualified = true + ; special_builtin_support = None + } + in + local_libraries @ [ task_lib ] + |> Fiber.parallel_map ~f:(Library.process ~ocaml_config ~word_size ~os_type) +;; + +type status = + | Not_started of (unit -> unit Fiber.t) + | Initializing + | Started of unit Fiber.Future.t + +let resolve_externals external_libraries = + let external_libraries, external_includes = + let convert = function + | "threads" -> "threads" ^ Config.ocaml_archive_ext, [ "-I"; "+threads" ] + | "unix" -> "unix" ^ Config.ocaml_archive_ext, Config.unix_library_flags + | s -> fatal "unhandled external library %s" s + in + List.map ~f:convert external_libraries |> List.split + in + let external_includes = List.concat external_includes in + external_libraries, external_includes +;; + +let sort_files dependencies ~main = + let deps_by_file = Hashtbl.create (List.length dependencies) in + List.iter dependencies ~f:(fun (file, deps) -> Hashtbl.add deps_by_file file deps); + let seen = ref String.Set.empty in + let res = ref [] in + let rec loop file = + if not (String.Set.mem file !seen) + then ( + seen := String.Set.add file !seen; + List.iter (Hashtbl.find deps_by_file file) ~f:loop; + res := file :: !res) + in + loop (Filename.basename main); + List.rev !res +;; + +let common_build_args name ~external_includes ~external_libraries = + List.concat + [ [ "-o"; name ^ ".exe"; "-g" ] + ; (match Config.mode with + | Byte -> [ Config.output_complete_obj_arg ] + | Native -> []) + ; external_includes + ; external_libraries + ] +;; + +let allow_unstable_sources = [ "-alert"; "-unstable" ] + +let ocaml_warnings = + let warnings = + [ (* Warning 49 [no-cmi-file]: no cmi file was found in path for module *) + "-49" + ; (* Warning 23: all the fields are explicitly listed in this record: the + 'with' clause is useless. + + In order to stay version independent, we use a trick with `with` by + creating a dummy value and filling in the fields available in every + OCaml version. forced_major_collections is the one missing in versions + older than 4.12. We therefore disable warning 23 for our purposes. *) + "-23" + ; (* Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear + in this context + + Any .mli files that begin wtih [@@@alert] will cause the compiler to + emit warning 53 due to the way we alias modules with an `open!`. It may + be possible to use the command line flag `-open` instead, however this + complicates dependency tracking so disabling this warning instead is + suitable for our purposes. *) + "-53" + ] + in + [ "-w"; String.concat ~sep:"" warnings ] +;; + +let build + ~ocaml_config + ~dependencies + ~c_files + ~asm_files + ~build_flags + ~link_flags + { target = name, main; external_libraries; _ } + = + let c_compiler = String.Map.find "c_compiler" ocaml_config in + let ext_obj = + try String.Map.find "ext_obj" ocaml_config with + | Not_found -> ".o" + in + let num_dependencies = List.length dependencies in + let table = Hashtbl.create num_dependencies in + Status_line.num_jobs := num_dependencies; + let build m = + match Hashtbl.find table m with + | Not_started f -> + Hashtbl.replace table m Initializing; + Fiber.fork f + >>= fun fut -> + Hashtbl.replace table m (Started fut); + Fiber.Future.wait fut >>| fun () -> incr Status_line.num_jobs_finished + | Initializing -> fatal "dependency cycle!" + | Started fut -> Fiber.Future.wait fut + | exception Not_found -> fatal "file not found: %s" m + in + let external_libraries, external_includes = resolve_externals external_libraries in + List.iter dependencies ~f:(fun (file, deps) -> + Hashtbl.add + table + file + (Not_started + (fun () -> + Fiber.parallel_iter deps ~f:build + >>= fun () -> + Process.run + ~cwd:build_dir + Config.compiler + (List.concat + [ [ "-c"; "-g"; "-no-alias-deps" ] + ; ocaml_warnings + ; allow_unstable_sources + ; external_includes + ; [ file ] + ])))); + Fiber.fork_and_join_unit + (fun () -> build (Filename.basename main)) + (fun () -> + (Fiber.fork_and_join (fun () -> + Fiber.parallel_map c_files ~f:(fun { Library.name = file; flags } -> + let flags = + List.map flags ~f:(fun flag -> [ "-ccopt"; flag ]) |> List.concat + in + Process.run + ~cwd:build_dir + Config.compiler + (List.concat + [ [ "-c"; "-g" ]; external_includes; build_flags; [ file ]; flags ]) + >>| fun () -> Filename.chop_extension file ^ ext_obj))) + (fun () -> + Fiber.parallel_map asm_files ~f:(fun { Library.assembler; flags; out_file } -> + Process.run + ~cwd:build_dir + (match assembler with + | `C_comp -> c_compiler + | `Msvc_asm -> "ml64.exe") + flags + >>| fun () -> out_file)) + >>| fun (x, y) -> x @ y) + >>= fun obj_files -> + let compiled_ml_files = + let compiled_ml_ext = + match Config.mode with + | Byte -> ".cmo" + | Native -> ".cmx" + in + List.filter_map (sort_files dependencies ~main) ~f:(fun fn -> + match Filename.extension fn with + | ".ml" -> Some (Filename.remove_extension fn ^ compiled_ml_ext) + | _ -> None) + in + write_args "compiled_ml_files" compiled_ml_files; + Process.run + ~cwd:build_dir + Config.compiler + (let static_flags = if static then [ "-ccopt"; "-static" ] else [] in + List.concat + [ common_build_args name ~external_includes ~external_libraries + ; obj_files + ; [ "-args"; "compiled_ml_files" ] + ; link_flags + ; static_flags + ; allow_unstable_sources + ]) +;; + +let rec rm_rf fn = + match Unix.lstat fn with + | { st_kind = S_DIR; _ } -> + clear fn; + Unix.rmdir fn + | _ -> Unix.unlink fn + | exception Unix.Unix_error (ENOENT, _, _) -> () + +and clear dir = List.iter (readdir dir) ~f:rm_rf + +let rec get_flags system = function + | (set, f) :: r -> if List.mem system ~set then f else get_flags system r + | [] -> [] +;; + +(** {2 Bootstrap process} *) +let main () = + (try clear build_dir with + | Sys_error _ -> ()); + (try Unix.mkdir build_dir 0o777 with + | Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + Config.ocaml_config () + >>= fun ocaml_config -> + let word_size = String.Map.find "word_size" ocaml_config in + let os_type = String.Map.find "os_type" ocaml_config in + assemble_libraries ~ocaml_config ~word_size ~os_type task + >>= fun libraries -> + let c_files = + List.map ~f:(fun (lib : Library.t) -> lib.c_files) libraries |> List.concat + in + let asm_files = + List.map ~f:(fun (lib : Library.t) -> lib.asm_files) libraries |> List.concat + in + get_dependencies libraries + >>= fun dependencies -> + let ocaml_system = + match String.Map.find_opt "system" ocaml_config with + | None -> assert false + | Some s -> s + in + let build_flags = get_flags ocaml_system Libs.build_flags in + let link_flags = get_flags ocaml_system Libs.link_flags in + build ~ocaml_config ~dependencies ~asm_files ~c_files ~build_flags ~link_flags task +;; + +let () = Fiber.run (main ()) diff --git a/unikernel/duniverse/dune_/boot/libs.ml b/unikernel/duniverse/dune_/boot/libs.ml new file mode 100644 index 00000000..12db5518 --- /dev/null +++ b/unikernel/duniverse/dune_/boot/libs.ml @@ -0,0 +1,429 @@ + +type library = + { path : string + ; main_module_name : string option + ; include_subdirs_unqualified : bool + ; special_builtin_support : string option + } + +let external_libraries = [ "unix"; "threads" ] + +let local_libraries = + [ { path = "otherlibs/ordering" + ; main_module_name = Some "Ordering" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/pp/src" + ; main_module_name = Some "Pp" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dyn" + ; main_module_name = Some "Dyn" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/csexp/src" + ; main_module_name = Some "Csexp" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/stdune/src" + ; main_module_name = Some "Stdune" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_graph" + ; main_module_name = Some "Dune_graph" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/incremental-cycles/src" + ; main_module_name = Some "Incremental_cycles" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dag" + ; main_module_name = Some "Dag" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/fiber/src" + ; main_module_name = Some "Fiber" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_console" + ; main_module_name = Some "Dune_console" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/memo" + ; main_module_name = Some "Memo" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_config" + ; main_module_name = Some "Dune_config" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_async_io" + ; main_module_name = Some "Dune_async_io" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/re/src" + ; main_module_name = Some "Dune_re" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dune-glob/src" + ; main_module_name = Some "Dune_glob" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_metrics" + ; main_module_name = Some "Dune_metrics" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/ocaml-blake3-mini" + ; main_module_name = Some "Blake3_mini" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/chrome-trace/src" + ; main_module_name = Some "Chrome_trace" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/spawn/src" + ; main_module_name = Some "Dune_spawn" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_stats" + ; main_module_name = Some "Dune_stats" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/xdg" + ; main_module_name = Some "Xdg" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/build_path_prefix_map/src" + ; main_module_name = Some "Build_path_prefix_map" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/uutf" + ; main_module_name = Some "Dune_uutf" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_sexp" + ; main_module_name = Some "Dune_sexp" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_util" + ; main_module_name = Some "Dune_util" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_digest" + ; main_module_name = Some "Dune_digest" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/predicate_lang" + ; main_module_name = Some "Predicate_lang" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/fiber_util" + ; main_module_name = Some "Fiber_util" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_cache_storage" + ; main_module_name = Some "Dune_cache_storage" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_targets" + ; main_module_name = Some "Dune_targets" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_cache" + ; main_module_name = Some "Dune_cache" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/ocamlc-loc/src" + ; main_module_name = Some "Ocamlc_loc" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dune-rpc/private" + ; main_module_name = Some "Dune_rpc_private" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dune-action-plugin/src" + ; main_module_name = Some "Dune_action_plugin" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_output_truncation" + ; main_module_name = Some "Dune_output_truncation" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/csexp_rpc" + ; main_module_name = Some "Csexp_rpc" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_rpc_client" + ; main_module_name = Some "Dune_rpc_client" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_thread_pool" + ; main_module_name = Some "Dune_thread_pool" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/fsevents" + ; main_module_name = Some "Fsevents" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/ocaml-inotify/src" + ; main_module_name = Some "Ocaml_inotify" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/async_inotify_for_dune" + ; main_module_name = Some "Async_inotify_for_dune" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/fswatch_win" + ; main_module_name = Some "Fswatch_win" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_file_watcher" + ; main_module_name = Some "Dune_file_watcher" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_engine" + ; main_module_name = Some "Dune_engine" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/action_ext" + ; main_module_name = Some "Action_ext" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/promote" + ; main_module_name = Some "Promote" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/ocaml-config" + ; main_module_name = Some "Ocaml_config" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/ocaml" + ; main_module_name = Some "Ocaml" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/sha" + ; main_module_name = None + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/opam/src/core" + ; main_module_name = None + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/opam-file-format" + ; main_module_name = None + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/opam/src/format" + ; main_module_name = None + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dune-private-libs/section" + ; main_module_name = Some "Dune_section" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_lang" + ; main_module_name = Some "Dune_lang" + ; include_subdirs_unqualified = true + ; special_builtin_support = None + } + ; { path = "src/fiber_event_bus" + ; main_module_name = Some "Fiber_event_bus" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dune-private-libs/meta_parser" + ; main_module_name = Some "Dune_meta_parser" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/fs" + ; main_module_name = Some "Fs" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_findlib" + ; main_module_name = Some "Dune_findlib" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_vcs" + ; main_module_name = Some "Dune_vcs" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dune-build-info/src" + ; main_module_name = Some "Build_info" + ; include_subdirs_unqualified = false + ; special_builtin_support = Some "Build_info_data" + } + ; { path = "src/sat" + ; main_module_name = Some "Sat" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_pkg" + ; main_module_name = Some "Dune_pkg" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/install" + ; main_module_name = Some "Install" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_threaded_console" + ; main_module_name = Some "Dune_threaded_console" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/lwd/lwd" + ; main_module_name = None + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/notty/src" + ; main_module_name = None + ; include_subdirs_unqualified = true + ; special_builtin_support = None + } + ; { path = "vendor/notty/src-unix" + ; main_module_name = None + ; include_subdirs_unqualified = true + ; special_builtin_support = None + } + ; { path = "vendor/lwd/nottui" + ; main_module_name = None + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_tui" + ; main_module_name = Some "Dune_tui" + ; include_subdirs_unqualified = true + ; special_builtin_support = None + } + ; { path = "src/dune_config_file" + ; main_module_name = Some "Dune_config_file" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_patch" + ; main_module_name = Some "Dune_patch" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "otherlibs/dune-site/src/private" + ; main_module_name = Some "Dune_site_private" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/scheme" + ; main_module_name = Some "Scheme" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/source" + ; main_module_name = Some "Source" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_rules" + ; main_module_name = Some "Dune_rules" + ; include_subdirs_unqualified = true + ; special_builtin_support = None + } + ; { path = "src/upgrader" + ; main_module_name = Some "Dune_upgrader" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "vendor/cmdliner/src" + ; main_module_name = None + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_rpc_server" + ; main_module_name = Some "Dune_rpc_server" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_rpc_impl" + ; main_module_name = Some "Dune_rpc_impl" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ; { path = "src/dune_rules_rpc" + ; main_module_name = Some "Dune_rules_rpc" + ; include_subdirs_unqualified = false + ; special_builtin_support = None + } + ] + +let build_flags = + [ ([ "win32"; "win64"; "mingw"; "mingw64" ], + [ "-ccopt"; "-D_UNICODE"; "-ccopt"; "-DUNICODE" ]) + ] + +let link_flags = + [ ([ "macosx" ], + [ "-cclib" + ; "-framework CoreFoundation" + ; "-cclib" + ; "-framework CoreServices" + ]) + ; ([ "win32"; "win64"; "mingw"; "mingw64" ], + [ "-cclib"; "-lshell32"; "-cclib"; "-lole32"; "-cclib"; "-luuid" ]) + ; ([ "beos" ], [ "-cclib"; "-lbsd" ]) + ] diff --git a/unikernel/duniverse/dune_/chrome-trace.opam b/unikernel/duniverse/dune_/chrome-trace.opam new file mode 100644 index 00000000..cd521d26 --- /dev/null +++ b/unikernel/duniverse/dune_/chrome-trace.opam @@ -0,0 +1,34 @@ +version: "3.20.2" +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "Chrome trace event generation library" +description: + "This library offers no backwards compatibility guarantees. Use at your own risk." +maintainer: ["Jane Street Group, LLC "] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml/dune" +doc: "https://dune.readthedocs.io/" +bug-reports: "https://github.com/ocaml/dune/issues" +depends: [ + "dune" {>= "3.20"} + "ocaml" {>= "4.08.0"} + "odoc" {with-doc} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +x-maintenance-intent: ["(latest)"] +build: [ + ["dune" "subst"] {dev} + ["rm" "-rf" "vendor/csexp"] + ["rm" "-rf" "vendor/pp"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@doc" {with-doc} + ] +] \ No newline at end of file diff --git a/unikernel/duniverse/dune_/configure b/unikernel/duniverse/dune_/configure new file mode 100755 index 00000000..efc50aa3 --- /dev/null +++ b/unikernel/duniverse/dune_/configure @@ -0,0 +1,2 @@ +#!/bin/sh +exec ocaml boot/configure.ml "$@" diff --git a/unikernel/duniverse/dune_/doc/advanced/custom-cmxs.rst b/unikernel/duniverse/dune_/doc/advanced/custom-cmxs.rst new file mode 100644 index 00000000..94ace7c5 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/advanced/custom-cmxs.rst @@ -0,0 +1,30 @@ +Building an Ad Hoc ``.cmxs`` +---------------------------- + +.. TODO(diataxis) howto: Building an Ad Hoc ``.cmxs`` + +In the model exposed by Dune, a ``.cmxs`` target is created for each +library. However, the ``.cmxs`` format itself is more flexible and is +capable to containing arbitrary ``.cmxa`` and ``.cmx`` files. + +For the specific cases where this extra flexibility is needed, one can use +:ref:`variables-for-artifacts` to write explicit rules to build ``.cmxs`` files +not associated to any library. + +Below is an example where we build ``my.cmxs`` containing ``foo.cmxa`` and +``d.cmx``. Note how we use a :doc:`/reference/dune/library` stanza to set +up the compilation of ``d.cmx``. + +.. code:: dune + + (library + (name foo) + (modules a b c)) + + (library + (name dummy) + (modules d)) + + (rule + (targets my.cmxs) + (action (run %{ocamlopt} -shared -o %{targets} %{cmxa:foo} %{cmx:d}))) diff --git a/unikernel/duniverse/dune_/doc/advanced/findlib-dynamic.rst b/unikernel/duniverse/dune_/doc/advanced/findlib-dynamic.rst new file mode 100644 index 00000000..c1282681 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/advanced/findlib-dynamic.rst @@ -0,0 +1,58 @@ +Dynamic Loading of Packages with Findlib +======================================== + +.. TODO(diataxis) this is an howto + +The preferred way for new development is to use :ref:`plugins`. + +Dune supports the ``findlib.dynload`` package from `Findlib +`_ that enables +dynamically-loading packages and their dependencies (using the OCaml Dynlink module). +Adding the ability for an application to have plugins just requires adding +``findlib.dynload`` to the set of library dependencies: + +.. code:: dune + + (library + (name mytool) + (public_name mytool) + (modules ...) + ) + + (executable + (name main) + (public_name mytool) + (libraries mytool findlib.dynload) + (modules ...) + ) + + +Use ``Fl_dynload.load_packages l`` in your application to load +the list ``l`` of packages. The packages are loaded +only once, so trying to load a package statically linked does nothing. + +A plugin creator just needs to link to your library: + +.. code:: dune + + (library + (name mytool_plugin_a) + (public_name mytool-plugin-a) + (libraries mytool) + ) + +For clarity, choose a naming convention. For example, all the plugins of +``mytool`` should start with ``mytool-plugin-``. You can automatically +load all the plugins installed for your tool by listing the existing packages: + +.. code:: ocaml + + let () = Findlib.init () + let () = + let pkgs = Fl_package_base.list_packages () in + let pkgs = + List.filter + (fun pkg -> 14 <= String.length pkg && String.sub pkg 0 14 = "mytool-plugin-") + pkgs + in + Fl_dynload.load_packages pkgs diff --git a/unikernel/duniverse/dune_/doc/advanced/index.rst b/unikernel/duniverse/dune_/doc/advanced/index.rst new file mode 100644 index 00000000..ddc575b1 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/advanced/index.rst @@ -0,0 +1,14 @@ +Advanced Topics +=============== + +These documents describe some advanced or very specific features of Dune. + +.. toctree:: + :maxdepth: 1 + + findlib-dynamic + profiling-dune + package-version + ocaml-syntax + variables-artifacts + custom-cmxs diff --git a/unikernel/duniverse/dune_/doc/advanced/ocaml-syntax.rst b/unikernel/duniverse/dune_/doc/advanced/ocaml-syntax.rst new file mode 100644 index 00000000..feb0e837 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/advanced/ocaml-syntax.rst @@ -0,0 +1,21 @@ +OCaml Syntax +============ + +.. TODO(diataxis) + - reference: files + - howto: using dynamic features + +If a ``dune`` file starts with ``(* -*- tuareg -*- *)``, then it is +interpreted as an OCaml script that generates the ``dune`` file as described +in the rest of this section. The code in the script will have access to a +`Jbuild_plugin +`__ +module containing details about the build context it's executed in. + +The OCaml syntax gives you an escape hatch for when the S-expression +syntax is not enough. It isn't clear whether the OCaml syntax will be +supported in the long term, as it doesn't work well with incremental +builds. It is possible that it will be replaced by just an ``include`` +stanza where one can include a generated file. + +Consequently **you must not** build complex systems based on it. diff --git a/unikernel/duniverse/dune_/doc/advanced/package-version.rst b/unikernel/duniverse/dune_/doc/advanced/package-version.rst new file mode 100644 index 00000000..e60178c6 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/advanced/package-version.rst @@ -0,0 +1,16 @@ +Package Version +=============== + +.. TODO(diataxis) + - reference: environment - packages + +Dune determines a package's version by looking at the ``version`` field in the +:doc:`/reference/dune-project/package`. If the version field isn't set, +it looks at the toplevel ``version`` field in the ``dune-project`` field. If +neither are set, Dune assumes that we are in development mode and reads the +version from the VCS, if any. The way it obtains the version from the VCS is +described in :ref:`the build-info section `. + +When installing the files of a package on the system, Dune +automatically inserts the package version into various metadata files +such as ``META`` and ``dune-package`` files. diff --git a/unikernel/duniverse/dune_/doc/advanced/profiling-dune.rst b/unikernel/duniverse/dune_/doc/advanced/profiling-dune.rst new file mode 100644 index 00000000..d4a8f239 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/advanced/profiling-dune.rst @@ -0,0 +1,15 @@ +Profiling Dune +============== + +.. TODO(diataxis) + - reference: the CLI + - howto: profiling a dune build + +If ``--trace-file FILE`` is passed, Dune will write detailed data about internal +operations, such as the timing of commands that Dune runs. + +The format is compatible with `Catapult trace-viewer`_. In particular, these +files can be loaded into Chromium's ``chrome://tracing``. Note that the exact +format is subject to change between versions. + +.. _Catapult trace-viewer: https://github.com/catapult-project/catapult/blob/master/tracing/README.md diff --git a/unikernel/duniverse/dune_/doc/advanced/variables-artifacts.rst b/unikernel/duniverse/dune_/doc/advanced/variables-artifacts.rst new file mode 100644 index 00000000..025fb46e --- /dev/null +++ b/unikernel/duniverse/dune_/doc/advanced/variables-artifacts.rst @@ -0,0 +1,32 @@ +.. _variables-for-artifacts: + +Variables for Artifacts +----------------------- + +.. TODO(diataxis) move to :doc:`../concepts/variables` + +For specific situations where one needs to refer to individual compilation +artifacts, special variables (see :doc:`../concepts/variables`) are provided, +so the user doesn't need to be aware of the particular naming conventions or +directory layout implemented by Dune. + +These variables can appear wherever a :doc:`../concepts/dependency-spec` is +expected and also inside :doc:`../reference/actions/index`. When used inside +:doc:`../reference/actions/index`, they implicitly declare a dependency on the +corresponding artifact. + +The variables have the form ``%{:}``, where ```` is +interpreted relative to the current directory: + +- ``cmo:``, ``cmx:``, and ``cmi:`` expand to the corresponding + artifact's path for the module specified by ````. The basename of + ```` should be the name of a module as specified in a ``(modules)`` + field. + +- ``cma:`` and ``cmxa:`` expands to the corresponding + artifact's path for the library specified by ````. The basename of ```` + should be the name of the library as specified in the ``(name)`` field of a + ``library`` stanza (*not* its public name). + +In each case, the expansion of the variable is a path pointing inside the build +context (i.e., ``_build/``). diff --git a/unikernel/duniverse/dune_/doc/assets/imgs/dune_logo_459x116.png b/unikernel/duniverse/dune_/doc/assets/imgs/dune_logo_459x116.png new file mode 100644 index 00000000..9bc02c1b Binary files /dev/null and b/unikernel/duniverse/dune_/doc/assets/imgs/dune_logo_459x116.png differ diff --git a/unikernel/duniverse/dune_/doc/caching.rst b/unikernel/duniverse/dune_/doc/caching.rst new file mode 100644 index 00000000..9278e10a --- /dev/null +++ b/unikernel/duniverse/dune_/doc/caching.rst @@ -0,0 +1,111 @@ +********** +Dune Cache +********** + +.. TODO(diataxis) This is reference material with some explanation. + +Dune implements a cache of build results that is shared across different +workspaces. Before executing a build rule, Dune looks it up in the shared +cache, and if it finds a matching entry, Dune skips the rule's execution and +restores the results in the current build directory. This can greatly speed up +builds when different workspaces share code, as well as when switching branches +or simply undoing some changes within the same workspace. + + +Configuration +============= + +There are three ways to configure the Dune cache. Choose the one that is more +convenient for you: + +* Add ``(cache )`` to your Dune configuration file + (``~/.config/dune/config`` by default). +* Set the environment variable ``DUNE_CACHE`` to ```` +* Run Dune with the ``--cache=`` flag. + +Here, ```` must be one of: + +* ``disabled``: disables the Dune cache completely. + +* ``enabled-except-user-rules``: enables the Dune cache, but excludes + user-written rules. This setting is a conservative choice that can avoid + breaking rules whose dependencies are not correctly specified. Currently the + default. + +* ``enabled``: enables the Dune cache unconditionally. + +By default, Dune stores the cache in your ``XDG_CACHE_HOME`` directory on \*nix +systems and ``%LOCALAPPDATA%\Microsoft\Windows\Temporary Internet Files\dune`` on Windows. +You can change the default location by setting the environment variable +``DUNE_CACHE_ROOT``. + + +Cache Storage Mode +================== + +Dune supports two modes of storing and restoring cache entries: `hardlink` and +`copy`. If your file system supports hard links, we recommend that you use the +`hardlink` mode, which is generally more efficient and reliable. + +The `hardlink` Mode +------------------- + +By default, Dune uses hard links when storing and restoring cache entries. This +is fast and has zero disk space overhead for files that still live in a build +directory. There are two disadvantages of this mode: + +* The cache storage must be on the same partition as the build tree. +* A cache entry can be corrupted by modifying the hard link that points to it + from the build directory. To reduce the risk of cache corruption, Dune + systematically removes write permissions from all build results. It is worth + noting that modifying files in the build directory is a bad practice anyway. + +The `copy` Mode +--------------- + +If you specify ``(cache-storage-mode copy)`` in the configuration file, Dune +will copy files to and from the cache instead of using hard links. This mode is +slower and has higher disk space usage. On the positive side, it is more +portable and doesn't have the disadvantages of the `hardlink` mode (see above). + +You can also set or override the storage mode via the environment variable +``DUNE_CACHE_STORAGE_MODE`` and the command line flag ``--cache-storage-mode``. + +Trimming the Cache +================== + +Storing all historically produced build results in the cache is infeasible, so +you'll need to occasionally trim the cache. To do that, run the ``dune cache +trim --size=BYTES`` command. This will remove the oldest used cache entries to +keep the cache overhead below the specified size. By "overhead" we mean the +cache entries whose hard link count is equal to 1, i.e., which aren't used in +any build directory. Trimming cache entries whose hard link count is greater +than 1 would not free any disk space. + +Note that previous versions of Dune, cache provided a "cache daemon" that could +periodically trim the cache. The current version doesn't require an additional +daemon process, so this automated trimming functionality is no longer provided. + + +Reproducibility +=============== + +Reproducibility Check +--------------------- + +While the main purpose of Dune cache is to speed up build times, it can also be +used to check build reproducibility. By specifying ``(cache-check-probability +FLOAT)`` in the configuration file, or running Dune with the +``--cache-check-probability=FLOAT`` flag, you instruct Dune to re-execute +randomly chosen build rules and compare their results with those stored in the +cache. If the results differ, the rule is not reproducible, and Dune will print +out a corresponding warning. + +Non-Reproducible Rules +---------------------- + +Some build rules are inherently not reproducible because they involve running +non-deterministic commands that, for example, depend on the current time or +download files from the Internet. To prevent Dune from caching such rules, mark +them as non-reproducible by using ``(deps (universe))``. Please see +:doc:`concepts/dependency-spec`. diff --git a/unikernel/duniverse/dune_/doc/changes/.gitkeep b/unikernel/duniverse/dune_/doc/changes/.gitkeep new file mode 100644 index 00000000..e69de29b diff --git a/unikernel/duniverse/dune_/doc/concepts/dependency-spec.rst b/unikernel/duniverse/dune_/doc/concepts/dependency-spec.rst new file mode 100644 index 00000000..14904bf0 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/concepts/dependency-spec.rst @@ -0,0 +1,152 @@ +Dependency Specification +======================== + +.. TODO(diataxis) + - reference - dependency spec + - reference - globbing + +Dependencies in ``dune`` files can be specified using one of the following: + +.. _source_tree: + +- ``(:name )`` will bind the list of dependencies to the + ``name`` variable. This variable will be available as ``%{name}`` in actions. +- ``(file )``, or simply ````, depend on this file. +- ``(alias )`` depends on the construction of this alias. For + instance: ``(alias src/runtest)``. +- ``(alias_rec )`` depends on the construction of this + alias recursively in all children directories wherever it is + defined. For instance: ``(alias_rec src/runtest)`` might depend on + ``(alias src/runtest)``, ``(alias src/foo/bar/runtest)``, etc. +- ``(glob_files )`` depends on all files matched by ````. See the + :ref:`glob ` for details. +- ``(glob_files_rec )`` is the recursive version of + ``(glob_files )``. See the :ref:`glob ` for details. +- ``(source_tree )`` depends on all source files in the subtree with root + ````. +- ``(universe)`` depends on everything in the universe. This is for + cases where dependencies are too hard to specify. Note that Dune + will not be able to cache the result of actions that depend on the + universe. In any case, this is only for dependencies in the + :term:`installed world`. You must still specify all dependencies that come + from the workspace. +- ``(package )`` depends on all files installed by ````, as well + as on the transitive package dependencies of ````. This can be used + to test a command against the files that will be installed. +- ``(env_var )`` depends on the value of the environment variable ````. + If this variable becomes set, becomes unset, or changes value, the target + will be rebuilt. +- ``(sandbox )`` requires a particular sandboxing configuration. + ```` can be one (or many) of: + + - ``always``: the action requires a clean environment + - ``none``: the action must run in the build directory + - ``preserve_file_kind``: the action needs the files it reads to look + like normal files (so Dune won't use symlinks for sandboxing) +- ``(include )`` read the s-expression in ```` and interpret it as + additional dependencies. The s-expression is expected to be a list of the + same constructs enumerated here. + +In all these cases, the argument supports :doc:`variables`. + +Named Dependencies +------------------ + +Dune allows a user to organize dependency lists by naming them. The user is +allowed to assign a group of dependencies a name that can later be referred to +in actions (like the ``%{deps}``, ``%{target}``, and ``%{targets}`` built in variables). + +One instance where this is useful is for naming globs. Here's an +example of an imaginary bundle command: + +.. code:: dune + + (rule + (target archive.tar) + (deps + index.html + (:css (glob_files *.css)) + (:js foo.js bar.js) + (:img (glob_files *.png) (glob_files *.jpg))) + (action + (run %{bin:bundle} index.html -css %{css} -js %{js} -img %{img} -o %{target}))) + +Note that a named dependency list can also include unnamed +dependencies (like ``index.html`` in the example above). Also, such +user defined names will shadow build in variables, so +``(:workspace_root x)`` will shadow the built-in ``%{workspace_root}`` +variable. + +.. _glob: + +Glob +---- + +You can use globs to declare dependencies on a set of files. Note that globs +will match files that exist in the source tree as well as buildable targets, so +for instance you can depend on ``*.cmi``. + +Dune supports globbing files in a single directory via ``(glob_files +...)`` and, starting with Dune 3.0, in all subdirectories recursively via ``(glob_files_rec +...)``. The glob is interpreted as follows: + +- anything before the last ``/`` is taken as a literal path +- anything after the last ``/``, or everything if the glob contains no ``/``, is + interpreted using the glob syntax + +Absolute paths are permitted in the ``(glob_files ...)`` term only. It's an error to pass +an absolute path (i.e., a path beginning with a ``/``) to ``(glob_files_rec ...)```. + +The glob syntax is interpreted as follows: + +- ``\`` matches exactly ````, even if it's a special character + (``*``, ``?``, ...). +- ``*`` matches any sequence of characters, except if it comes first, in which + case it matches any character that is not ``.`` followed by anything. +- ``**`` matches any character that is not ``.`` followed by anything, except if + it comes first, in which case it matches anything. +- ``?`` matches any single character. +- ``[]`` matches any character that is part of ````. +- ``[!]`` matches any character that is not part of ````. +- ``{,,...,}`` matches any string that is matched by one of + ````, ````, etc. + +.. list-table:: Glob syntax examples + :header-rows: 1 + + * - Syntax + - Files matched + - Files not matched + * - ``x`` + - ``x`` + - ``y`` + * - ``\*`` + - ``*`` + - ``x`` + * - ``file*.txt`` + - ``file1.txt``, ``file2.txt`` + - ``f.txt`` + * - ``*.txt`` + - ``f.txt`` + - ``.hidden.txt`` + * - ``a**`` + - ``aml`` + - ``a.ml`` + * - ``**`` + - ``a/b``, ``a.b`` + - (none) + * - ``a?.txt`` + - ``a1.txt``, ``a2.txt`` + - ``b1.txt``, ``a10.txt`` + * - ``f[xyz].txt`` + - ``fx.txt``, ``fy.txt``, ``fz.txt`` + - ``f2.txt``, ``f.txt`` + * - ``f[!xyz].txt`` + - ``f2.txt``, ``fa.txt`` + - ``fx.txt``, ``f.txt`` + * - ``a.{ml,mli}`` + - ``a.ml``, ``a.mli`` + - ``a.txt``, ``b.ml`` + * - ``../a.{ml,mli}`` + - ``../a.ml``, ``../a.mli`` + - ``a.ml`` diff --git a/unikernel/duniverse/dune_/doc/concepts/locks.rst b/unikernel/duniverse/dune_/doc/concepts/locks.rst new file mode 100644 index 00000000..77ab8ff2 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/concepts/locks.rst @@ -0,0 +1,53 @@ +Locks +===== + +.. TODO(diataxis) + - howto: testing in general (note about concurrency) + - reference: locks + +Given two rules that are independent, Dune will assume that their +associated actions can be run concurrently. Two rules are considered +independent if neither of them depend on the other, either directly or +through a chain of dependencies. This basic assumption allows Dune to +parallelize the build. + +However, it is sometimes the case that two independent rules cannot be +executed concurrently. For instance, this can happen for more +complicated tests. In order to prevent Dune from running the +actions at the same time, you can specify that both actions take the +same lock: + +.. code:: dune + + (rule + (alias runtest) + (deps foo) + (locks m) + (action (run test.exe %{deps}))) + + (alias + (rule runtest) + (deps bar) + (locks m) + (action (run test.exe %{deps}))) + +Dune will make sure that the executions of ``test.exe foo`` and +``test.exe bar`` are serialized. + +Although they don't live in the filesystem, lock names are interpreted as file +names. So for instance, ``(with-lock m ...)`` in ``src/dune`` and ``(with-lock +../src/m)`` in ``test/dune`` refer to the same lock. + +Note also that locks are per build context. So if your workspace has two build +contexts setup, the same rule might still be executed concurrently between the +two build contexts. If you want a lock that is global to all build contexts, +simply use an absolute filename: + +.. code:: dune + + (rule + (alias runtest) + (deps foo) + (locks /tcp-port/1042) + (action (run test.exe %{deps}))) + diff --git a/unikernel/duniverse/dune_/doc/concepts/ocaml-flags.rst b/unikernel/duniverse/dune_/doc/concepts/ocaml-flags.rst new file mode 100644 index 00000000..363a6318 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/concepts/ocaml-flags.rst @@ -0,0 +1,22 @@ +OCaml Flags +=========== + +In ``library``, ``executable``, ``executables``, and ``env`` stanzas, +you can specify OCaml compilation flags using the following fields: + +- ``(flags )`` to specify flags passed to both ``ocamlc`` and + ``ocamlopt`` +- ``(ocamlc_flags )`` to specify flags passed to ``ocamlc`` only +- ``(ocamlopt_flags )`` to specify flags passed to ``ocamlopt`` only + +For all these fields, ```` is specified in the +:doc:`../reference/ordered-set-language`. +These fields all support ``(:include ...)`` forms. + +The default value for ``(flags ...)`` is taken from the environment, +as a result it's recommended to write ``(flags ...)`` fields as +follows: + +.. code:: dune + + (flags (:standard )) diff --git a/unikernel/duniverse/dune_/doc/concepts/package-spec.rst b/unikernel/duniverse/dune_/doc/concepts/package-spec.rst new file mode 100644 index 00000000..d8173530 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/concepts/package-spec.rst @@ -0,0 +1,147 @@ +Package Specification +===================== + +.. TODO(diataxis) + - reference: packages + - howto: preparing an opam package + - tutorial: from zero to opam + +Installation is the process of copying freshly built libraries, +binaries, and other files from the build directory to the system. Dune +offers two ways of doing this: via opam or directly via the ``install`` +command. In particular, the installation model implemented by Dune +was copied from opam. Opam is the standard OCaml package manager. + +In both cases, Dune only know how to install whole packages. A +package being a collection of executables, libraries, and other files. +In this section, we'll describe how to define a package, how to +"attach" various elements to it, and how to proceed with installing it +on the system. + +.. _declaring-a-package: + +Declaring a Package +------------------- + +To declare a package, simply add a ``package`` stanza to your +``dune-project`` file: + +.. code:: dune + + (package + (name mypackage) + (synopsis "My first Dune package!") + (description "\| This is my first attempt at creating + "\| a project with Dune. + )) + +Once you have done this, Dune will know about the package named +``mypackage`` and you will be able to attach various elements to it. +The ``package`` stanza accepts more fields, such as dependencies. + +Note that package names are in a global namespace, so the name you choose must +be universally unique. In particular, package managers never allow users to +release two packages with the same name. + +.. TODO: describe this more in details + +In older projects using Dune, packages were defined by manually writing a file +called ``.opam`` at the root of the project. However, it's not +recommended to use this method in new projects, as we expect to deprecate it in +the future. The right way to define a package is with a ``package`` stanza in +the ``dune-project`` file. + +See :doc:`../howto/opam-file-generation` for instructions on configuring Dune +to automatically generate ``.opam`` files based on the ``package`` stanzas. + +Attaching Elements to a Package +------------------------------- + +Attaching an element to a package means declaring to Dune that this +element is part of the said package. The method to attach an element +to a package depends on the kind of the element. In this subsection, +we will go through the various kinds of elements and describe how to +attach each of them to a package. + +In the rest of this section, ```` refers to the directory in +which the user chooses to install packages. When installing via opam, +it's opam that sets this directory. When calling ``dune install``, +the installation directory is either guessed or can be manually +specified by the user. Defaults directories which replace guessing +can be set during the compilation of dune. + +Sites of a Package +------------------ + +When packages need additional resources outside their binary, their location +could be hard to find. Moreover, some packages could add resources to another +package, e.g., in the case of plugins. These locations are called sites in +Dune. One package can define them. During execution, one site corresponds to a +list of directories. They are like layers, and the first directories have a higher +priority. Examples and precisions are available at :ref:`sites`. + + +Libraries +^^^^^^^^^ + +In order to attach a library to a package, merely add a +``public_name`` field to your library. This is the name that external +users of your libraries must use in order to refer to it. Dune +requires that a library's public name is either the name of the +package it is part of or start with the package name followed by a dot +character. + +For instance: + +.. code:: dune + + (library + (name mylib) + (public_name mypackage.mylib)) + +After you have added a public name to a library, Dune will know to +install it as part of the package it is attached to. Dune installs +the library files in a directory ``/lib/``. + +If the library name contains dots, the full directory in which the +library files are installed is ``lib//``, +where ````, ````, ... ```` are the dot-separated +component of the public library name. By definition, ```` is +always the package name. + +Executables +^^^^^^^^^^^ + +Similar to libraries, to attach an executable to a package simply +add a ``public_name`` field to your ``executable`` stanza or a +``public_names`` field for ``executables`` stanzas. Designate this +name to match the available executables through the installed ``PATH`` +(i.e., the name users must type in their shell to execute +the program), because Dune cannot guess an executable's relevant package +from its public name. It's also necessary to add a ``package`` field +unless the project contains a single package, in which case the executable +will be attached to this package. + +For instance: + +.. code:: dune + + (executable + (name main) + (public_name myprog) + (package mypackage)) + +Once ``mypackage`` is installed on the system, the user will be able +to type the following in their shell: + +.. code:: console + + $ myprog + +to execute the program. + +Other Files +^^^^^^^^^^^ + +For all other kinds of elements, you must attach them manually via +an :doc:`/reference/dune/install` stanza. diff --git a/unikernel/duniverse/dune_/doc/concepts/promotion.rst b/unikernel/duniverse/dune_/doc/concepts/promotion.rst new file mode 100644 index 00000000..5e3a9f8a --- /dev/null +++ b/unikernel/duniverse/dune_/doc/concepts/promotion.rst @@ -0,0 +1,109 @@ +Diffing and Promotion +===================== + +You can use Diffing and Promotion flows to compare the outputs of your build in +the build directory with the source tree and/or copy the result of the rules +into your source tree to store the changes. + +Diffing +======= + +You can use the ``(diff )`` directive in a rule to compare +its output with the version in your source tree. It is useful when +your tests produce a file output and you want to make sure that output has +not changed. + +.. TODO(diataxis) + - howto: diffing and promotion + - reference: diffing + +``(diff )`` is very similar to ``(run diff +)``. In particular it behaves in the same way: + +- When ```` and ```` are equal, it does nothing. +- When they are not, the differences are shown and the action fails. + +However, it is different for the following reason: + +- The exact command used for diff files can be configured via the + ``--diff-command`` command line argument. Note that it's only + called when the files are not byte equals + +- By default, it will use ``patdiff`` if it is installed. ``patdiff`` + is a better diffing program. You can install it via opam with: + + .. code:: console + + $ opam install patdiff + +- On Windows, both ``(diff a b)`` and ``(diff? a b)`` normalize + end-of-line characters before comparing the files. + +- Since ``(diff a b)`` is a built-in action, Dune knows that ``a`` + and ``b`` are needed, so you don't need to specify them + explicitly as dependencies. + +- You can use ``(diff? a b)`` after a command that might or might not + produce ``b``, for cases where commands optionally produce a + *corrected* file + +- If ```` doesn't exist, it will compare with the empty file. + +- It allows promotion. See below. + +Note that ``(cmp a b)`` does no end-of-line normalization and doesn't +print a diff when the files differ. ``cmp`` is meant to be used with +binary files. + +Promotion +========= + +Promotion relates to copying the output of a Dune rule to your source tree. +Common uses include updating rule output after a failed diff (e.g., from a +test) or committing output to source control to cut down on dependencies +during packaging. + +Promoting Test or Rule Output After Diffing +------------------------------------------- + +Whenever an action ``(diff )`` or ``(diff? +)`` fails because the two files are different, Dune allows +you to promote ```` as ```` if ```` is a source +file and ```` is a generated file. + +More precisely, let's consider the following Dune file: + +.. code:: dune + + (rule + (with-stdout-to data.out (run ./test.exe))) + + (rule + (alias runtest) + (action (diff data.expected data.out))) + +Where ``data.expected`` is a file committed in the source +repository. You can use the following workflow to update your test: + +- Update the code of your test. +- Run ``dune runtest``. The diff action will fail and a diff will + be printed. +- Check the diff to make sure it's what you expect. This diff can be displayed + again by running ``dune promotion diff``. +- Run ``dune promote``. This will copy the generated ``data.out`` + file to ``data.expected`` directly in the source tree. + +You can also use ``dune runtest --auto-promote``, which will +automatically do the promotion. + +Automatically Promoting Rule Output Into the Source Tree +-------------------------------------------------------- + +Dune rules support a ``(mode promote)`` directive that will automatically +copy their output into your source tree. This approach suits, for example, code +documentation generation flows where output needs to be committed to source +code control to enable easier browsing, or eliminate dependencies on a code +generation step during opam package installation. + +More information, including customising when the source is copied, can be found +in :doc:`../reference/dune/rule`. diff --git a/unikernel/duniverse/dune_/doc/concepts/sandboxing.rst b/unikernel/duniverse/dune_/doc/concepts/sandboxing.rst new file mode 100644 index 00000000..4eccb12a --- /dev/null +++ b/unikernel/duniverse/dune_/doc/concepts/sandboxing.rst @@ -0,0 +1,76 @@ +Sandboxing +========== + +.. TODO(diataxis) + - explanation: sandboxing + - reference: sandboxing + +The user actions that run external commands (``run``, ``bash``, ``system``) +are opaque to Dune, so Dune has to rely on manual specification of dependencies +and targets. One problem with manual specification is that it's error-prone. +It's often hard to know in advance what files the command will read, +and knowing a correct set of dependencies is very important for build +reproducibility and incremental build correctness. + +To help with this problem Dune supports sandboxing. +An idealized view of sandboxing is that it runs the action in an environment +where it can't access anything except for its declared dependencies. + +In practice, we have to make compromises and have some trade-offs between +simplicity, information leakage, performance, and portability. + +The way sandboxing is currently implemented is that for each sandboxed action +we build a separate directory tree (sandbox directory) that mirrors the build +directory, filtering it to only contain the files that were declared as +dependencies. We run the action in that directory, and then we copy +the targets back to the build directory. + +You can configure Dune to use sandboxing modes ``symlink``, ``hardlink``, or +``copy``, which determine how the individual files are populated (they will be +symlinked, hardlinked, or copied into the sandbox directory). + +This approach is very simple and portable, but that comes with +certain limitations: + +- The actions in the sandbox can use absolute paths to refer to anywhere outside + the sandbox. This means that only dependencies on relative paths in the build + tree can be enforced/detected by sandboxing. +- The sandboxed actions still run with full permissions of Dune itself, so + sandboxing is not a security feature. It won't prevent network access either. +- We don't erase the environment variables of the sandboxed + commands. This is something we want to change. +- Performance impact is usually small, but it can get noticeable for + fast actions with very large sets of dependencies. + +Per-Action Sandboxing Configuration +----------------------------------- + +Some actions may rely on sandboxing to work correctly. +For example, an action may need the input directory to contain nothing +except the input files, or the action might create temporary files that +break other build actions. + +Some other actions may refuse to work with Sandboxing. For example, +if they rely on absolute path to the build directory staying fixed, +or if they deliberately use some files without declaring dependencies +(this is usually a very bad idea, by the way). + +Generally it's better to improve the action so it works with or without +sandboxing (especially with), but sometimes you just can't do that. + +Things like this can be described using the "sandbox" field in the dependency +specification language (see :doc:`dependency-spec`). + +Global Sandboxing Configuration +------------------------------- + +Dune always respects per-action sandboxing specification. +You can configure it globally to prefer a certain sandboxing mode if +the action allows it. + +This is controlled by: + +- ``dune --sandbox <...>`` CLI flag (see ``man dune-build``) +- ``DUNE_SANDBOX`` environment (see ``man dune-build``) +- ``(sandboxing_preference ..)`` field in the configuration file (see ``man + dune-config``) diff --git a/unikernel/duniverse/dune_/doc/concepts/variables.rst b/unikernel/duniverse/dune_/doc/concepts/variables.rst new file mode 100644 index 00000000..387deda8 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/concepts/variables.rst @@ -0,0 +1,241 @@ +Variables +========= + +.. TODO(diataxis) + - reference: variables + - explanation: rule loading + +Some fields can contains variables that are expanded by Dune. +The syntax of variables is as follows: + +.. code:: + + %{var} + +or, for more complex forms that take an argument: + +.. code:: + + %{fun:arg} + +In order to write a plain ``%{``, you need to write ``\%{`` in a +string. + +Dune supports the following variables: + +- ``project_root`` is the root of the current project. It is typically the root + of your project, and as long as you have a ``dune-project`` file there, + ``project_root`` is independent of the workspace configuration. +- ``workspace_root`` is the root of the current workspace. Note that + the value of ``workspace_root`` isn't constant and depends on + whether your project is vendored or not. +- ``cc`` is the C compiler command line (list made of the compiler + name followed by its flags) that will be used to compile foreign code. For + more details about its content, please see :doc:`/reference/foreign-flags`. +- ``cxx`` is the C++ compiler command line being used in the + current build context. +- ``ocaml_bin`` is the path where ``ocamlc`` lives. +- ``ocaml`` is the ``ocaml`` binary. +- ``ocamlc`` is the ``ocamlc`` binary. +- ``ocamlopt`` is the ``ocamlopt`` binary. +- ``ocaml_version`` is the version of the compiler used in the + current build context. +- ``ocaml_where`` is the output of ``ocamlc -where``. +- ``arch_sixtyfour`` is ``true`` if using a compiler that targets a + 64-bit architecture and ``false`` otherwise. +- ``null`` is ``/dev/null`` on Unix or ``nul`` on Windows. +- ``ext_obj``, ``ext_asm``, ``ext_lib``, ``ext_dll``, and ``ext_exe`` + are the file extensions used for various artifacts. +- ``ext_plugin`` is ``.cmxs`` if ``natdynlink`` is supported and + ``.cma`` otherwise. +- ``ocaml-config:v`` is for every variable ``v`` in the output of + ``ocamlc -config``. Note that Dune processes the output + of ``ocamlc -config`` in order to make it a bit more stable across + versions, so the exact set of variables accessible this way might + not be exactly the same as what you can see in the output of + ``ocamlc -config``. In particular, variables added in new OCaml versions + need to be registered in Dune before they can be used. +- ``profile`` is the profile selected via ``--profile``. +- ``context_name`` is the name of the context (``default``, or defined in the + workspace file) +- ``os_type`` is the type of the OS the build is targeting. This is + the same as ``ocaml-config:os_type``. +- ``architecture`` is the type of the architecture the build is targeting. This + is the same as ``ocaml-config:architecture``. +- ``model`` is the type of the CPU the build is targeting. This is + the same as ``ocaml-config:model``. +- ``system`` is the name of the OS the build is targeting. This is the same as + ``ocaml-config:system``. +- ``ignoring_promoted_rules`` is ``true`` if + ``--ignore-promoted-rules`` was passed on the command line and + ``false`` otherwise. +- ``:`` where ```` is one of ``cmo``, ``cmi``, ``cma``, + ``cmx``, or ``cmxa``. See :ref:`variables-for-artifacts`. +- ``env:=``, or ```` if it does not exist. + For example, ``%{env:BIN=/usr/bin}``. + Available since Dune 1.4.0. +- There are some Coq-specific variables detailed in :ref:`coq-variables`. + +In addition, ``(action ...)`` fields support the following special variables: + +- ``target`` expands to the one target. +- ``targets`` expands to the list of target. +- ``deps`` expands to the list of dependencies. +- ``^`` expands to the list of dependencies, separated by spaces. +- ``dep:`` expands to ```` (and adds ```` as a dependency of + the action). +- ``exe:`` is the same as ````, except when cross-compiling, in + which case it will expand to ```` from the host build context. +- ``bin:`` expands ```` to ``program``. If ``program`` + is installed by a workspace package (see :doc:`/reference/dune/install` + stanzas), the locally built binary will be used, otherwise it will be + searched in the ```` of the current build context. Note that ``(run + %{bin:program} ...)`` and ``(run program ...)`` behave in the same way. + ``%{bin:...}`` is only necessary when you are using ``(bash ...)`` or + ``(system ...)``. +- ``bin-available:`` expands to ``true`` or ``false``, depending + on whether ```` is available or not. +- ``file-available:`` expands to ``true`` or ``false``, depending on + whether the file at ```` is available in the current workspace. +- ``lib::`` expands to the file's installation path + ```` in the library ````. If + ```` is available in the current workspace, the local + file will be used, otherwise the one from the :term:`installed world` will be + used. +- ``lib-private::`` expands to the file's build path + ```` in the library ````. Both public and private library + names are allowed as long as they refer to libraries within the same project. +- ``libexec::`` is the same as ``lib:...``, except + when cross-compiling, in which case it will expand to the file from the host + build context. +- ``libexec-private::`` is the same as ``lib-private:...`` + except when cross-compiling, in which case it will expand to the file from the + host build context. +- ``lib-available:`` expands to ``true`` or ``false`` depending on + whether the library is available or not. A library is available if at least + one of the following conditions holds: + + - It's part the :term:`installed world`. + - It's available locally and is not optional. + - It's available locally, and all its library dependencies are + available. + +- ``version:`` expands to the version of the given + package. Packages defined in the current scope have priority over the + public packages. Public packages that don't install any libraries + will not be detected. How Dune determines the version + of a package is described :doc:`here <../advanced/package-version>`. +- ``read:`` expands to the contents of the given file. +- ``read-lines:`` expands to the list of lines in the given + file. +- ``read-strings:`` expands to the list of lines in the given + file, unescaped using OCaml lexical convention. + +The ``%{:...}`` forms are what allows you to write custom rules that work +transparently, whether things are installed or not. + +Note that aliases are ignored by ``%{deps}`` + +The intent of this last form is to reliably read a list of strings +generated by an OCaml program via: + +.. code:: ocaml + + List.iter (fun s -> print_string (String.escaped s)) l + +#. Dealing with circular dependencies introduced by variables + +If you ever see Dune reporting a dependency cycle that involves a +variable such as `%{read:}`, try to move `` to a different +directory. + +The reason you might see such dependency cycle is because Dune is +trying to evaluate the `%{read:}` too early. For instance, let's +consider the following example: + +.. code:: dune + + (rule + (targets x) + (enabled_if %{read:y}) + (action ...)) + + (rule + (with-stdout-to y (...))) + +When Dune loads and interprets this file, it decides whether the +first rule is enabled by evaluating ``%{read:y}``. To +evaluate ``%{read:y}``, it must build ``y``. To build ``y``, it must +figure out the build rule that produces ``y``, and in order to do that, it must +first load and evaluate the above ``dune`` file. You can see how this +creates a cycle. + +Some cycles might be more complex. In any case, when you see such an +error, the easiest thing to do is move the file that's being read +to a different directory, preferably a standalone one. You can use the +:doc:`/reference/dune/subdir` stanza to keep the logic self-contained in +the same ``dune`` file: + +.. code:: dune + + (rule + (targets x) + (enabled_if %{read:dir-for-y/y}) + (action ...)) + + (subdir + dir-for-y + (rule + (with-stdout-to y (...)))) + +Expansion of Lists +------------------ + +Forms that expand to a list of items, such as ``%{cc}``, ``%{deps}``, +``%{targets}``, or ``%{read-lines:...}``, are suitable to be used in +``(run )``. For instance in: + +.. code:: dune + + (run foo %{deps}) + +If there are two dependencies, ``a`` and ``b``, the produced command +will be equivalent to the shell command: + +.. code:: console + + $ foo "a" "b" + +If you want both dependencies to be passed as a single argument, +you must quote the variable: + +.. code:: dune + + (run foo "%{deps}") + +which is equivalent to the following shell command: + +.. code:: console + + $ foo "a b" + +(The items of the list are concatenated with space.) +Please note: since ``%{deps}`` is a list of items, the first one may be +used as a program name. For instance: + +.. code:: dune + + (rule + (targets result.txt) + (deps foo.exe (glob_files *.txt)) + (action (run %{deps}))) + +Here is another example: + +.. code:: dune + + (rule + (target foo.exe) + (deps foo.c) + (action (run %{cc} -o %{target} %{deps} -lfoolib))) diff --git a/unikernel/duniverse/dune_/doc/conf.py b/unikernel/duniverse/dune_/doc/conf.py new file mode 100644 index 00000000..530d9713 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/conf.py @@ -0,0 +1,174 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- +# +# dune documentation build configuration file, created by +# sphinx-quickstart on Tue Apr 11 21:24:42 2017. +# +# This file is execfile()d with the current directory set to its +# containing dir. +# +# Note that not all possible configuration values are present in this +# autogenerated file. +# +# All configuration values have a default; values that are commented out +# serve to show the default. + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. + +import os +import sys +sys.path.append(os.path.abspath('exts')) + +from sphinx.highlighting import lexers +from dune_lexer import DuneLexer +from opam_lexer import OpamLexer +from cram_lexer import CramLexer + +lexers[DuneLexer.name] = DuneLexer(startinline=True) +lexers[OpamLexer.name] = OpamLexer() +lexers[CramLexer.name] = CramLexer() + +# -- General configuration ------------------------------------------------ + +# If your documentation needs a minimal Sphinx version, state it here. +# +# needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +extensions = [ + 'sphinx_copybutton', + 'sphinx_design', + 'myst_parser', +] + +myst_enable_extensions = ["colon_fence"] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix(es) of source filenames. +# You can specify multiple suffix as a list of string: +# +# source_suffix = ['.rst', '.md'] +source_suffix = '.rst' + +# The master toctree document. +master_doc = 'index' + +# General information about the project. +project = 'Dune' +copyright = u'2017 - 2025, Jérémie Dimino & the Dune maintainers' +author = u'Jérémie Dimino & the Dune maintainers' + +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +# +# This is also used if you do content translation via gettext catalogs. +# Usually you set "language" from the command line for these cases. +language = "en" + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This patterns also effect to html_static_path and html_extra_path +exclude_patterns = [ + '_build', + 'Thumbs.db', + '.DS_Store', + 'dev', + 'papers', + 'changes', +] + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'friendly' + +# If true, `todo` and `todoList` produce output, else they produce nothing. +todo_include_todos = False + + +# -- Options for HTML output ---------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = 'furo' + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +# +html_theme_options = {} + +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +# html_static_path = ['_static'] + + +# -- Options for HTMLHelp output ------------------------------------------ + +# Output file base name for HTML help builder. +htmlhelp_basename = 'dunedoc' + + +# -- Options for LaTeX output --------------------------------------------- + +latex_elements = { + # The paper size ('letterpaper' or 'a4paper'). + # + # 'papersize': 'letterpaper', + + # The font size ('10pt', '11pt' or '12pt'). + # + # 'pointsize': '10pt', + + # Additional stuff for the LaTeX preamble. + # + # 'preamble': '', + + # Latex figure (float) alignment + # + # 'figure_align': 'htbp', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, +# author, documentclass [howto, manual, or own class]). +latex_documents = [ + (master_doc, 'dune.tex', 'Dune Documentation', + u'Jérémie Dimino', 'manual'), +] + + +# -- Options for manual page output --------------------------------------- + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + (master_doc, 'dune', 'Dune Documentation', + [author], 1) +] + + +# -- Options for Texinfo output ------------------------------------------- + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + (master_doc, 'dune', 'Dune Documentation', + author, 'dune', 'One line description of project.', + 'Miscellaneous'), +] + +html_context = { + 'display_github': True, + 'github_user': 'ocaml', + 'github_repo': 'dune', + 'github_version': 'main', + 'conf_py_path': '/doc/', +} diff --git a/unikernel/duniverse/dune_/doc/coq.rst b/unikernel/duniverse/dune_/doc/coq.rst new file mode 100644 index 00000000..e2b42998 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/coq.rst @@ -0,0 +1,851 @@ +.. _coq: + +*** +Coq +*** + +.. TODO(diataxis) + + This looks like there are several components in there: + + - reference info for stanzas and variables + - tutorials (the examples part) + +Introduction +------------ + +Dune can build Coq theories and plugins with additional support for extraction +and ``.mlg`` file preprocessing. + +A *Coq theory* is a collection of ``.v`` files that define Coq modules whose +names share a common prefix. The module names reflect the directory hierarchy. + +Coq theories may be defined using :ref:`coq.theory` stanzas, or be +auto-detected by Dune by inspecting Coq's install directories. + +A *Coq plugin* is an OCaml :doc:`/reference/dune/library` that Coq can +load dynamically at runtime. Plugins are typically linked with the Coq OCaml +API. + +Since Coq 8.16, plugins need to be "public" libraries in Dune's terminology, +that is to say, they must declare a ``public_name`` field. + +A *Coq project* is an informal term for a +:doc:`/reference/dune-project/index` containing a collection of Coq +theories and plugins. + +The ``.v`` files of a theory need not be present as source files. They may also +be Dune targets of other rules. + +To enable Coq support in a Dune project, specify the :ref:`Coq language +version` in the :doc:`/reference/dune-project/index` file. For +example, adding + +.. code:: dune + + (using coq 0.8) + +to a :doc:`/reference/dune-project/index` file enables using the +``coq.theory`` stanza and other ``coq.*`` stanzas. See the :ref:`Dune Coq +language` section for more details. + +.. _coq-theory: + +coq.theory +---------- + +The Coq theory stanza is very similar in form to the OCaml +:doc:`/reference/dune/library` stanza: + +.. code:: dune + + (coq.theory + (name ) + (package ) + (synopsis ) + (modules ) + (plugins ) + (flags ) + (modules_flags ) + (coqdep_flags ) + (coqdoc_flags ) + (stdlib ) + (mode ) + (theories )) + +The stanza builds all the ``.v`` files in the given directory and its +subdirectories if the :ref:`include-subdirs ` stanza is +present. + +For usage of this stanza, see the :ref:`examples`. + +The semantics of the fields are: + +- ```` is a dot-separated list of valid Coq module names and + determines the module scope under which the theory is compiled (this + corresponds to Coq's ``-R`` option). + + For example, if ```` is ``foo.Bar``, the theory modules are + named ``foo.Bar.module1``, ``foo.Bar.module2``, etc. Note that modules in the + same theory don't see the ``foo.Bar`` prefix in the same way that OCaml + ``wrapped`` libraries do. + + For compatibility, :ref:`Coq lang 1.0` installs a theory named + ``foo.Bar`` under ``foo/Bar``. Also note that Coq supports composing a module + path from different theories, thus you can name a theory ``foo.Bar`` and a + second one ``foo.Baz``, and Dune composes these properly. See an example of + :ref:`a multi-theory` Coq project for this. + +- The ``modules`` field allows one to constrain the set of modules included in + the theory, similar to its OCaml counterpart. Modules are specified in Coq + notation. That is to say, ``A/b.v`` is written ``A.b`` in this field. + +- If the ``package`` field is present, Dune generates install rules for the + ``.vo`` files of the theory. ``pkg_name`` must be a valid package name. + + Note that :ref:`Coq lang 1.0` will use the Coq legacy install + setup, where all packages share a common root namespace and install directory, + ``lib/coq/user-contrib/``, as is customary in the Make-based + Coq package ecosystem. + + For compatibility, Dune also installs, under the ``user-contrib`` prefix, the + ``.cmxs`` files that appear in ````. This will be dropped in + future versions. + +- ```` are passed to ``coqc`` as command-line options. ``:standard`` + is taken from the value set in the ``(coq (flags ))`` field in ``env`` + profile. See :doc:`/reference/dune/env` for more information. + +- ```` is a list of pairs of valid Coq module names and a + list of ````. Note that if a module is present here, the + ``:standard`` variable will be bound to the value of ```` + effective for the theory. This way it is possible to override the + default flags for particular files of the theory, for example: + + .. code:: dune + + (coq.theory + (name Foo) + (modules_flags + (bar (:standard \ -quiet)))) + + + It is more common to just use this field to *add* some particular + flags, but that should be done using ``(:standard + ...)`` as to propagate the default flags. (Appeared in :ref:`Coq + lang 0.9`) + +- ```` are extra user-configurable flags passed to ``coqdep``. The + default value for ``:standard`` is empty. This field exists for transient + use-cases, in particular disabling ``coqdep`` warnings, but it should not be + used in normal operations. (Appeared in :ref:`Coq lang 0.10`) + + +- ```` are extra user-configurable flags passed to ``coqdoc``. The + default value for ``:standard`` is ``--toc``. The ``--html`` or ``--latex`` + flags are passed separately depending on which mode is target. See the section + on :ref:`documentation using coqdoc` for more information. + +- ```` can either be ``yes`` or ``no``, currently defaulting to + ``yes``. When set to ``no``, Coq's standard library won't be visible from this + theory, which means the ``Coq`` prefix won't be bound, and + ``Coq.Init.Prelude`` won't be imported by default. + +- If the ``plugins`` field is present, Dune will pass the corresponding flags to + Coq so that ``coqdep`` and ``coqc`` can find the corresponding OCaml libraries + declared in ````. This allows a Coq theory to depend on OCaml + plugins. Starting with ``(lang coq 0.6)``, ```` must contain + public library names. + +- Your Coq theory can depend on other theories --- globally installed or defined + in the current workspace --- by adding the theories names to the + ```` field. Then, Dune will ensure that the depended theories + are present and correctly registered with Coq. + + See :ref:`Locating Theories` for more information on how + Coq theories are located by Dune. + +- If Coq has been configured with ``-native-compiler yes`` or ``ondemand``, Dune + will always build the ``cmxs`` files together with the ``vo`` files. This only + works on Coq versions after 8.13 in which the option was introduced. + + You may override this by specifying ``(mode native)`` or ``(mode vo)``. + + Before :ref:`Coq lang 0.7`, the native mode had to be manually + specified, and Coq did not use Coq's configuration + + Versions of Dune < 3.7.0 would disable native compilation if the ``dev`` + profile was selected. + +- If the ``(mode vos)`` field is present, only Coq compiled interface files + ``.vos`` will be produced for the theory. This is mainly useful in conjunction + with ``dune coq top``, since this makes the compilation of dependencies much + faster, at the cost of skipping proof checking. (Appeared in :ref:`Coq lang + 0.8`). + +Coq Dependencies +~~~~~~~~~~~~~~~~ + +When a Coq file ``a.v`` depends on another file ``b.v``, Dune is able to build +them in the correct order, even if they are in separate theories. Under the +hood, Dune asks coqdep how to resolve these dependencies, which is why it is +called once per theory. + +.. _coqdoc: + +Coq Documentation +~~~~~~~~~~~~~~~~~ + +Given a :ref:`coq-theory` stanza with ``name A``, Dune will produce two +*directory targets*, ``A.html/`` and ``A.tex/``. HTML or LaTeX documentation for +a Coq theory may then be built by running ``dune build A.html`` or ``dune build +A.tex``, respectively (if the :doc:`dune file ` for the +theory is the current directory). + +There are also two aliases :doc:`/reference/aliases/doc` and ``@doc-latex`` +that will respectively build the HTML or LaTeX documentation when called. These +will determine whether or not Dune passes a ``--html`` or ``--latex`` flag to +``coqdoc``. + +Further flags can also be configured using the ``(coqdoc_flags)`` field in the +``coq.theory`` stanza. These will be passed to ``coqdoc`` and the default value +is ``:standard`` which is ``--toc``. Extra flags can therefore be passed by +writing ``(coqdoc_flags :standard --body-only)`` for example. + +.. _include-subdirs-coq: + +Recursive Qualification of Modules +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +If you add: + +.. code:: dune + + (include_subdirs qualified) + +to a :doc:`/reference/dune/index` file, Dune considers all the modules in +the directory and its subdirectories, adding a prefix to the module name in the +usual Coq style for subdirectories. For example, file ``A/b/C.v`` becomes the +module ``A.b.C``. + +.. _locating-theories: + +How Dune Locates and Builds theories +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Dune organises it's knowledge about Coq theories in 3 databases: + +- Scope database: A Dune *scope* is a part of the project sharing a single + common ``dune-project`` file. In a single scope, any theory in the database + can depend on any other theory in that database as long as their visibilities + are compatible. A public theory for example cannot depend on a private + theory. + +- Public theory database: The set of all scopes that Dune knows about is termed + a *workspace*. Only public theories coming from scopes are added to the + database of all public theories in the current workspace. + + The public theory database allows theories to depend on theories that are in + a different scope. Thus, you can depend on theories belonging to another + :doc:`/reference/dune-project/index` as long as they share a common + scope under another :doc:`/reference/dune-project/index` file or a + :doc:`/reference/dune-workspace/index` file. + + Doing so is usually as simple as placing a Coq project within the scope of + another. This process is termed *composition*. See the :ref:`interproject + composition` example. + + Inter-project composition allows Dune to compute module dependencies using a + fine granularity. In practice, this means that Dune will only build the parts + of a depended theory that are needed by your project. + + Inter-project composition has been available since :ref:`Coq lang + 0.4`. + +- Installed theory database: If a theory cannot be found in the list of + workspace-public theories, Dune will try to locate the theory in the list of + installed locations Coq knows about. + + This list is built using the output of ``coqc --config`` in order to infer + the ``COQLIB`` and ``COQPATH`` environment variables. Each path in ``COQPATH`` + and ``COQLIB/user-contrib`` is used to build the database of installed + theories. + + Note that, for backwards compatibility purposes, installed theories do not + have to be installed or built using Dune. Dune tries to infer the name of the + theory from the installed layout. This is ambiguous in the sense that a + file-system layout of `a/b` will provide theory names ``a`` and ``a.b``. + + Resolving this ambiguity in a backwards-compatible way is not possible, but + future versions of Dune Coq support will provide a way to improve this. + + Coq's standard library gets a special status in Dune. The location at + ``COQLIB/theories`` will be assigned a entry with the theory name ``Coq``, and + added to the dependency list implicitly. This can be disabled with the + ``(stdlib no)`` field in the ``coq.theory`` stanza. + + The ``Coq`` prefix can then be used to depend on Coq's stdlib in a regular, + qualified way. We recommend setting ``(stdlib no)`` and adding ``(theories + Coq)`` explicitly. + + Composition with installed theories has been available since :ref:`Coq lang + 0.8`. + +The databases above are used to locate a theory dependencies. Note that Dune has +a complete global view of every file involved in the compilation of your theory +and will therefore rebuild if any changes are detected. + +.. _public-private-theory: + +Public and Private Theories +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A *public theory* is a :ref:`coq-theory` stanza that is visible outside the +scope of a :doc:`/reference/dune-project/index` file. + +A *private theory* is a :ref:`coq-theory` stanza that is limited to the scope +of the :doc:`/reference/dune-project/index` file it is in. + +A private theory may depend on both private and public theories; however, a +public theory may only depend on other public theories. + +By default, all :ref:`coq-theory` stanzas are considered private by Dune. In +order to make a private theory into a public theory, the ``(package )`` field +must be specified. + +.. code:: dune + + (coq.theory + (name private_theory)) + + (coq.theory + (name private_theory) + (package coq-public-theory)) + +Limitations +~~~~~~~~~~~ + +- ``.v`` files always depend on the native OCaml version of the Coq binary and + its plugins, unless the natively compiled versions are missing. + +.. _limitation-mlpack: + +- A ``foo.mlpack`` file must the present in directories of locally defined + plugins for things to work. ``coqdep``, which is used internally by Dune, will + recognize a plugin by looking at the existence of an ``.mlpack`` file, as it + cannot access (for now) Dune's library database. This is a limitation of + ``coqdep``. See the :ref:`example plugin` or the `this + template `_. + + This limitation will be lifted soon, as newer versions of ``coqdep`` can use + findlib's database to check the existence of OCaml libraries. + +.. _coq-lang: + +Coq Language Version +~~~~~~~~~~~~~~~~~~~~ + +The Coq lang can be modified by adding the following to a +:doc:`/reference/dune-project/index` file: + +.. code:: dune + + (using coq 0.8) + +The supported Coq language versions (not the version of Coq) are: + +- ``0.10``: Support for the ``(coqdep_flags ...)`` field. +- ``0.9``: Support for per-module flags with the ``(module_flags ...)``` field. +- ``0.8``: Support for composition with installed Coq theories; + support for ``vos`` builds. + +Deprecated experimental Coq language versions are: + +- ``0.1``: Basic Coq theory support. +- ``0.2``: Support for the ``theories`` field and composition of theories in the + same scope. +- ``0.3``: Support for ``(mode native)`` requires Coq >= 8.10 (and Dune >= 2.9 + for Coq >= 8.14). +- ``0.4``: Support for interproject composition of theories. +- ``0.5``: ``(libraries ...)`` field deprecated in favor of ``(plugins ...)`` + field. +- ``0.6``: Support for ``(stdlib no)``. +- ``0.7``: ``(mode )`` is automatically detected from the configuration of Coq + and ``(mode native)`` is deprecated. The ``dev`` profile also no longer + disables native compilation. + +.. _coq-lang-1.0: + +Coq Language Version 1.0 +~~~~~~~~~~~~~~~~~~~~~~~~ + +Guarantees with respect to stability are not yet provided, but we +intend that the ``(0.8)`` version of the language becomes ``1.0``. +The ``1.0`` version of Coq lang will commit to a stable set of +functionality. All the features below are expected to reach ``1.0`` +unchanged or minimally modified. + +.. _coq-extraction: + +coq.extraction +-------------- + +Coq may be instructed to *extract* OCaml sources as part of the compilation +process by using the ``coq.extraction`` stanza: + +.. code:: dune + + (coq.extraction + (prelude ) + (extracted_modules ) + ) + +- ``(prelude )`` refers to the Coq source that contains the extraction + commands. + +- ``(extracted_modules )`` is an exhaustive list of OCaml modules + extracted. + +- ```` are ``flags``, ``stdlib``, ``theories``, and + ``plugins``. All of these fields have the same meaning as in the + ``coq.theory`` stanza. + +The extracted sources can then be used in ``executable`` or ``library`` stanzas +as any other sources. + +Note that the sources are extracted to the directory where the ``prelude`` file +lives. Thus the common placement for the ``OCaml`` stanzas is in the same +:doc:`/reference/dune/index` file. + +**Warning**: using Coq's ``Cd`` command to work around problems with the output +directory is not allowed when using extraction from Dune. Moreover the ``Cd`` +command has been deprecated in Coq 8.12. + +.. _coq-pp: + +coq.pp +------ + +Authors of Coq plugins often need to write ``.mlg`` files to extend the Coq +grammar. Such files are preprocessed with the ``coqpp`` binary. To help plugin +authors avoid writing boilerplate, we provide a ``(coq.pp ...)`` stanza: + +.. code:: dune + + (coq.pp + (modules )) + +This will run the ``coqpp`` binary on all the ``.mlg`` files in +````. + +.. _examples: + +Examples of Coq Projects +------------------------ + +Here we list some examples of some basic Coq project setups in order. + +.. _example-simple: + +Simple Project +~~~~~~~~~~~~~~ + +Let us start with a simple project. First, make sure we have a +:doc:`/reference/dune-project/index` file with a :ref:`Coq +lang` stanza present: + +.. code:: dune + + (lang dune 3.20) + (using coq 0.8) + +Next we need a :doc:`/reference/dune/index` file with a :ref:`coq-theory` +stanza: + +.. code:: dune + + (coq.theory + (name myTheory)) + + +Finally, we need a Coq ``.v`` file which we name ``A.v``: + + +.. code:: coq + + (** This is my def *) + Definition mydef := nat. + +Now we run ``dune build``. After this is complete, we get the following files: + +.. code:: + + . + ├── A.v + ├── _build + │ ├── default + │ │ ├── A.glob + │ │ ├── A.v + │ │ └── A.vo + │ └── log + ├── dune + └── dune-project + +.. _example-multi-theory: + +Multi-Theory Project +~~~~~~~~~~~~~~~~~~~~ + +Here is an example of a more complicated setup: + +.. code:: + + . + ├── A + │ ├── AA + │ │ └── aa.v + │ ├── AB + │ │ └── ab.v + │ └── dune + ├── B + │ ├── b.v + │ └── dune + └── dune-project + +Here are the :doc:`/reference/dune/index` files: + +.. code:: dune + + ; A/dune + (include_subdirs qualified) + (coq.theory + (name A)) + + ; B/dune + (coq.theory + (name B) + (theories A)) + +Notice the ``theories`` field in ``B`` allows one :ref:`coq-theory` to depend on +another. Another thing to note is the inclusion of the +:doc:`/reference/dune/include_subdirs` stanza. This allows our theory to +have :ref:`multiple subdirectories`. + +Here are the contents of the ``.v`` files: + +.. code:: coq + + (* A/AA/aa.v is empty *) + + (* A/AB/ab.v *) + Require Import AA.aa. + + (* B/b.v *) + From A Require Import AB.ab. + +This causes a dependency chain ``b.v -> ab.v -> aa.v``. Now we might be +interested in building theory ``B``, so all we have to do is run ``dune build +B``. Dune will automatically build the theory ``A`` since it is a dependency. + +.. _example-interproject-theory: + +Composing Projects +~~~~~~~~~~~~~~~~~~ + +To demonstrate the composition of Coq projects, we can take our previous two +examples and put them in project which has a theory that depends on theories in +both projects. + +.. code:: + + . + ├── CombinedWork + │ ├── comb.v + │ └── dune + ├── DeeperTheory + │ ├── A + │ │ ├── AA + │ │ │ └── aa.v + │ │ ├── AB + │ │ │ └── ab.v + │ │ └── dune + │ ├── B + │ │ ├── b.v + │ │ └── dune + │ ├── Deep.opam + │ └── dune-project + ├── dune-project + └── SimpleTheory + ├── A.v + ├── dune + ├── dune-project + └── Simple.opam + +The file ``comb.v`` looks like: + +.. code:: coq + + (* Files from DeeperTheory *) + From A.AA Require Import aa. + (* In Coq, partial prefixes for theory names are enough *) + From A Require Import ab. + From B Require Import b. + + (* Files from SimpleTheory *) + From myTheory Require Import A. + +We are referencing Coq modules from all three of our previously defined +theories. + +Our :doc:`/reference/dune/index` file in ``CombinedWork`` looks like: + +.. code:: dune + + (coq.theory + (name Combined) + (theories myTheory A B)) + +As you can see, there are dependencies on all the theories we mentioned. + +All three of the theories we defined before were *private theories*. In order to +depend on them, we needed to make them *public theories*. See the section on +:ref:`public-private-theory`. + +Composing With Installed Theories +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We can also compose with theories that are installed. If we wanted to have a +theory that depends on the Coq theory ``mathcomp.ssreflect`` we can add the +following to our stanza: + +.. code:: dune + + (coq.theory + (name my_mathcomp_theory) + (theories mathcomp.ssreflect)) + +Note that ``mathcomp`` on its own would also work, since there would be a +``matchcomp`` directory in ``user-contrib``, however it would not compose +locally with a ``coq.theory`` stanza with the ``mathcomp.ssreflect`` name (in +case one exists). So it is advisable to use the actual theory name. Dune is not +able to validate theory names that have been installed since they do not include +their Dune metadata. + +Building Documentation +~~~~~~~~~~~~~~~~~~~~~~ + +Following from our last example, we might wish to build the HTML documentation +for ``A``. We simply do ``dune build A/A.html/``. This will produce the +following files: + +.. code:: + + A + ├── AA + │ ├── aa.glob + │ ├── aa.v + │ └── aa.vo + ├── AB + │ ├── ab.glob + │ ├── ab.v + │ └── ab.vo + └── A.html + ├── A.AA.aa.html + ├── A.AB.ab.html + ├── coqdoc.css + ├── index.html + └── toc.html + +We may also want to build the LaTeX documentation of the theory ``B``. For this +we can call ``dune build B/B.tex/``. If we want to build all the HTML +documentation targets, we can use the :doc:`/reference/aliases/doc` alias as in +``dune build @doc``. If we want to build all the LaTeX documentation then we +use the ``@doc-latex`` alias instead. + +.. _example plugin: + +Coq Plugin Project +~~~~~~~~~~~~~~~~~~ + +Let us build a simple Coq plugin to demonstrate how Dune can handle this setup. + +.. code:: + + . + ├── dune-project + ├── src + │ ├── dune + │ ├── hello_world.ml + │ ├── my_plugin.mlpack + │ └── syntax.mlg + └── theories + ├── dune + └── UsingMyPlugin.v + +Our :doc:`/reference/dune-project/index` will need to have a package for +the plugin to sit in, otherwise Coq will not be able to find it. + +.. code:: dune + + (lang dune 3.20) + (using coq 0.8) + + (package + (name my-coq-plugin) + (synopsis "My Coq Plugin") + (depends coq-core)) + +Now we have two directories, ``src/`` and ``theories/`` each with their own +:doc:`/reference/dune/index` file. Let us begin with the plugin +:doc:`/reference/dune/index` file: + +.. code:: dune + + (library + (name my_plugin) + (public_name my-coq-plugin.plugin) + (synopsis "My Coq Plugin") + (flags :standard -rectypes -w -27) + (libraries coq-core.vernac)) + + (coq.pp + (modules syntax)) + +Here we define a library using the :doc:`/reference/dune/library` stanza. +Importantly, we declared which external libraries we rely on and gave the +library a ``public_name``, as starting with Coq 8.16, Coq will identify plugins +using their corresponding findlib public name. + +The :ref:`coq-pp` stanza allows ``src/syntax.mlg`` to be preprocessed, which for +reference looks like: + +.. code:: ocaml + + DECLARE PLUGIN "my-coq-plugin.plugin" + + VERNAC COMMAND EXTEND Hello CLASSIFIED AS QUERY + | [ "Hello" ] -> { Feedback.msg_notice Pp.(str Hello_world.hello_world) } + END + +Together with ``hello_world.ml``: + +.. code:: ocaml + + let hello_world = "hello world!" + +They make up the plugin. There is one more important ingredient here and that is +the ``my_plugin.mlpack`` file, needed to signal ``coqdep`` the existence of +``my_plugin`` in this directory. An empty file suffices. See :ref:`this note on +.mlpack files`. + +The file for ``theories/`` is a standard :ref:`coq-theory` stanza with an +included ``libraries`` field allowing Dune to see ``my-coq-plugin.plugin`` as a +dependency. + +.. code:: dune + + (coq.theory + (name MyPlugin) + (package my-coq-plugin) + (plugins my-coq-plugin.plugin)) + +Finally, our .v file will look something like this: + +.. code:: coq + + (* For Coq < 8.16 *) + Declare ML Module "my_plugin". + + (* For Coq = 8.16 *) + Declare ML Module "my_plugin:my-coq-plugin.plugin". + + (* At some point Coq 8.17 or 8.18 will transition to the syntax below, check Coq's manual *) + Declare ML Module "my-coq-plugin.plugin". + + Hello. + +Running ``dune build`` will build everything correctly. + +.. _running-coq-top: + +Running a Coq Toplevel +---------------------- + +Dune supports running a Coq toplevel binary such as ``coqtop``, which is +typically used by editors such as CoqIDE or Proof General to interact with Coq. + +The following command: + +.. code:: console + + $ dune coq top -- + +runs a Coq toplevel (``coqtop`` by default) on the given Coq file ````, +after having recompiled its dependencies as necessary. The given arguments +```` are forwarded to the invoked command. For example, this can be used +to pass a ``-emacs`` flag to ``coqtop``. + +A different toplevel can be chosen with ``dune coq top --toplevel CMD ``. +Note that using ``--toplevel echo`` is one way to observe what options are +actually passed to the toplevel. These options are computed based on the options +that would be passed to the Coq compiler if it was invoked on the Coq file +````. + +In certain situations, it is desirable to not rebuild dependencies for a ``.v`` +files but still pass the correct flags to the toplevel. For this reason, a +``--no-build`` flag can be passed to ``dune coq top`` which will skip any +building of dependencies. + +Limitations +~~~~~~~~~~~ + +* Only files that are part of a stanza can be loaded in a Coq toplevel. +* When a file is created, it must be written to the file system before the Coq + toplevel is started. +* When new dependencies are added to a file (via a Coq ``Require`` vernacular + command), it is in principle required to save the file and restart to Coq + toplevel process. + +.. _coq-variables: + +Coq-Specific Variables +---------------------- + +There are some special variables that can be used to access data about the Coq +configuration. These are: + +- ``%{coq:version}`` the version of Coq. +- ``%{coq:version.major}`` the major version of Coq (e.g., ``8.15.2`` gives + ``8``). +- ``%{coq:version.minor}`` the minor version of Coq (e.g., ``8.15.2`` gives + ``15``). +- ``%{coq:version.suffix}`` the suffix version of Coq (e.g., ``8.15.2`` gives + ``.2`` and ``8.15+rc1`` gives ``+rc1``). +- ``%{coq:ocaml-version}`` the version of OCaml used to compile Coq. +- ``%{coq:coqlib}`` the output of ``COQLIB`` from ``coqc -config``. +- ``%{coq:coq_native_compiler_default}`` the output of + ``COQ_NATIVE_COMPILER_DEFAULT`` from ``coqc -config``. + +See :doc:`concepts/variables` for more information on variables supported by +Dune. + + +.. _coq-env: + +Coq Environment Fields +---------------------- + +The :doc:`/reference/dune/env` stanza has a ``(coq )`` field +with the following values for ````: + +- ``(flags )``: The default flags passed to ``coqc``. The default value + is ``-q``. Values set here become the ``:standard`` value in the + ``(coq.theory (flags ))`` field. +- ``(coqdep_flags )``: The default flags passed to ``coqdep``. The default + value is empty. Values set here become the ``:standard`` value in the + ``(coq.theory (coqdep_flags ))`` field. As noted in the documentation + of the ``(coq.theory (coqdep_flags ))`` field, changing the ``coqdep`` + flags is discouraged. +- ``(coqdoc_flags )``: The default flags passed to ``coqdoc``. The default + value is ``--toc``. Values set here become the ``:standard`` value in the + ``(coq.theory (coqdoc_flags ))`` field. diff --git a/unikernel/duniverse/dune_/doc/cross-compilation.rst b/unikernel/duniverse/dune_/doc/cross-compilation.rst new file mode 100644 index 00000000..3aeee5f5 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/cross-compilation.rst @@ -0,0 +1,104 @@ +.. _cross-compilation: + +***************** +Cross-Compilation +***************** + +.. TODO(diataxis) + + This can be turned into an how-to guide. + +Dune allows for cross-compilation by defining build contexts with multiple +targets. Targets are specified by adding a ``targets`` field to the build +context definition. + +``targets`` takes a list of target name. It can be either: + +- ``native``, the native tools that can build binaries to run on the machine + doing the build + +- the name of an alternative toolchain + +Note that at the moment, there is no official support for cross-compilation in +OCaml. Dune supports the `opam-cross-` repositories from the `OCaml-cross +organization on GitHub `_, such as: + +- `opam-cross-windows `_ +- `opam-cross-android `_ +- `opam-cross-ios `_ + +In particular: + +- to build Windows binaries using opam-cross-windows, write ``windows`` in the + list of targets +- to build Android binaries using opam-cross-android, write ``android`` in the + list of targets +- to build IOS binaries using opam-cross-ios, write ``ios`` in the list of + targets + +For example, the following workspace file defines three different targets for +the ``default`` build context: + +.. code:: dune + + (context (default (targets native windows android))) + +This configuration defines three build contexts: + +- ``default`` +- ``default.windows`` +- ``default.android`` + +Note that the ``native`` target is always implicitly added when not present; +however, ``dune build @install`` will skip this context, i.e., ``default`` will +only be used for building executables needed by the other contexts. + +With such a setup, calling ``dune build @install`` will build all the packages +three times. + +Note that instead of writing a ``dune-workspace`` file, you can also use the +``-x`` command line option. Passing ``-x foo`` to ``dune`` without having a +``dune-workspace`` file is the same as writing the following ``dune-workspace`` +file: + +.. code:: dune + + (context (default (targets foo))) + +If you have a ``dune-workspace`` and pass a ``-x foo`` option, ``foo`` will be +added as target of all context stanzas. + +How Does it Work? +================= + +In such a setup, binaries that need to be built and executed in the +``default.windows`` or ``default.android`` contexts as part of the build will +no longer be executed. Instead, all the binaries that will be executed come +from the ``default`` context. One consequence of this is that all preprocessing +(PPX or otherwise) will be done using binaries built in the ``default`` +context. + +To clarify this with an example, let's assume that you have the following +``src/dune`` file: + +.. code:: dune + + (executable (name foo)) + (rule (with-stdout-to blah (run ./foo.exe))) + +When building ``_build/default/src/blah``, dune will resolve ``./foo.exe`` to +``_build/default/src/foo.exe`` as expected. However, for +``_build/default.windows/src/blah`` dune will resolve ``./foo.exe`` to +``_build/default/src/foo.exe`` + +Assuming that the right packages are installed or that your workspace has no +external dependencies, Dune will be able to cross-compile a given package +without doing anything special. + +Some packages might still have to be updated to support cross-compilation. For +instance if the ``foo.exe`` program in the previous example was using +``Sys.os_type``, it should instead take it as a command line argument: + +.. code:: dune + + (rule (with-stdout-to blah (run ./foo.exe -os-type %{os_type}))) diff --git a/unikernel/duniverse/dune_/doc/dev/README.md b/unikernel/duniverse/dune_/doc/dev/README.md new file mode 100644 index 00000000..3543f938 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dev/README.md @@ -0,0 +1,5 @@ +# Developer documentation + +We use `doc/dev` for storing developer documentation, including specification, +design and implementation notes. Anything that should be user-facing should go +into the `doc` folder instead. diff --git a/unikernel/duniverse/dune_/doc/dev/cache.md b/unikernel/duniverse/dune_/doc/dev/cache.md new file mode 100644 index 00000000..f8df3a90 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dev/cache.md @@ -0,0 +1,279 @@ +# Dune cache: design and implementation notes + +This document describes main ideas behind the Dune cache as well as a few +subtleties of the implementation. This is a working document and it will be +updated as part of on-going development. Some of the described features are +currently still in development or unused, in particular, here we describe +support for two types of cache entries – artifacts and values – but +Dune currently doesn't store any value entries in the cache. + +The design and implementation are based on a non-trivial assumption that there +are no hash collisions, for instance, that we will never come across two files +with different contents but with the same content hash. While this assumption is +common in the world of build systems and package managers, and is highly +unlikely to be violated by chance, one can manufacture hash collisions on +purpose, especially when using a weak hash like MD5. + +## What we store in the cache + +The cache stores build _artifacts_ and _values_. + +* An _artifact_ is a file produced by a build rule. As any file, it has a name + as well as content. Note that we treat a file's executable permission bit as + part of its content. + +* A _value_ is anything else produced during a build that is not written to a + file but which is worth storing persistently between successive builds. A + common example is a string written to the standard output by a build action. + Such output-producing actions may run as part of a build rule or at an earlier + stage when generating rules. Unlike artifacts, values have no names, yet they + still have content. + +## How we use the cache + +The build system uses the cache to _store_ and _restore_ build artifacts and +values. Here is a typical interaction sequence for the case of artifacts: + +* The build system is executing a build rule and has already identified all of + its dependencies, thereby obtaining the _rule hash_. It uses it to make a + _restore request_ to the cache. + +* Now there are two cases: + + - The cache successfully restores all the artifacts of the rule, placing + them into the build directory and returning their content hashes. The + build system can skip building the artifacts and can use the obtained + content hashes for deciding whether any dependent build rules need to be + rerun. **This successful scenario is the only reason we use the cache.** + + - The cache fails to restore the artifacts, either because of an error or + because it doesn't have an entry for the given rule hash. In this case, + the build system needs to build the artifacts itself. On completion, it + makes a _store request_ to the cache, providing a list of build artifacts + (_file names_ in the build directory) as well as their _content hashes_. + The cache stores the artifacts and after that the build system is allowed + to continue with the build (but not before, since the cache requires + exclusive access to the artifacts in the build directory). There can be a + rare situation where the store request is declined because the given entry + is already in the cache. How could this happen? We did try to restore it + first! The reason is that the cache can be populated concurrently by + multiple build systems and by the distributed cache daemon, so there can + be a race between multiple systems adding the same entry to the cache. In + this case, the cache will perform _deduplication_ of build artifacts by + replacing them with hard links to the copies already stored in the cache + (this is an example where the exclusive access is needed). + +Build values are handled similarly; the main difference is that to identify a +cache entry we use the corresponding _action hash_ rather than the _rule hash_. +The only difference between rule hashes and action hashes is that the former +include the names of the produced artifacts into the hash, while the latter +do not, since values have no names. + +## Cache storage format + +Let `root` stand for the cache root directory. It has three main subdirectories. + +* `root/meta/v3` stores _metadata files_, one per each historically executed + build rule or value-producing action. (While this is a convenient mental + model, in reality we need to occasionally remove some outdated metadata files + to free disk space – see the section on cache trimming.) +

+ A metadata file corresponding to a build rule is named by the rule hash and + stores file names and content hashes of all artifacts produced by the rule. +

+ A metadata file corresponding to a value-producing action is named by the + action hash and stores the hash of the resulting value. +

+ It is important to guarantee that rule and action hashes do not accidentally + overlap, which may happen if one simply hashes their in-memory representations + because a rule and an action might happen to be represented by the same + sequence of bytes in memory. + +* `root/files/v3` is a storage for artifacts, where files named by content + hashes store the matching contents. We will create hard links to these files + from build directories and rely on the hard link count, as well as on the last + change time as useful metrics during cache trimming. + +* `root/values/v3` is a storage for values. As in the case of `files`, we store + the values in the files named by their content hashes. However, these files + will always have the hard link count equal to 1, because they do not appear + anywhere in build directories. By storing them in a separate directory, we + simplify the job of the cache trimmer. + +* `root/temp` contains temporary files used for atomic file operations needed + when adding new entries to the cache, as will be described below. + +Note that since this document was first written, some of the above paths have +changed due to version bumps (to `v4` and beyond). + +## Adding entries to the cache + +To add entries to the cache, we use the functions `store_artifacts` and +`store_value` described in the corresponding sections below. Setting possible +errors aside, these functions can succeed in two ways. + +* They return `Stored` if the given entry is new and it has been successfully + stored in the cache. + +* They return `Already_present` if the given entry has already been present in + the cache and can therefore be discarded. This is a rare scenario where + multiple systems race to add the same entry, and only one of them will receive + the glory of the `Stored` response. + +### Atomic writing to the cache + +As mentioned above, the cache can be modified concurrently by multiple systems, +so to prevent collisions on individual files, we need to create new files +atomically. To do that, we first create a temporary file in the `temp` +directory, then create a hard link to it from the cache (this operation will +fail if another process managed to create the cache entry earlier), and then +unlink the temporary file. + +From now on, whenever we say "create a file", we mean create a file atomically. +If two systems attempt to create a file with the same name simultaneously, one +of them will win the competition and the contents it writes will remain in the +cache until it is deleted during cache trimming. + +Note that it is possible for a metadata file with a given name to have multiple +possible contents due to _non-determinism_, and the cache implementation should +not assume otherwise. + +### Storing artifacts + +To store artifacts produced by a build rule, we perform the following sequence +of steps. + +* Create a metadata file in the `meta` directory, listing all the artifacts. + If the file already exists (which should be a rare case), verify that it + contains the expected list of artifacts (both file names and content hashes). + If it doesn't, we have found a non-deterministic build rule and report an + error. + +* For each artifact, we store it in the `files` directory using the artifact's + content hash as the name. In each case, there are two scenarios: + + - If the artifact is already in the cache, we perform + deduplication by replacing the artifact in the build directory + with a hard link to the file stored in the cache. We assume that + the build system will wait for `store_artifacts` to complete before + starting any further actions that might read these artifacts from + the build directory and thus interfere with the deduplication. + + - Otherwise, we create a hard link to the artifact from the `files` + directory. + +The function returns `Already_present` if the metadata file and all of the +artifacts were already in the cache; otherwise, it returns `Stored`. + +### Storing values + +Storing a value is simpler than storing artifacts because there is no need +for deduplication. The steps are: + +* Create a metadata file in the `meta` directory, recording the value's hash. + If the file already exists (which should be a rare case), verify that it + contains the same hash. If it doesn't, we have found a non-deterministic build + action and report an error. + +* Store the value as a file in the `values` directory using the value's hash as + the file name. If the file is already in the cache, we don't need to do + anything. + +The function returns `Already_present` if the metadata file and the value were +already in the cache; otherwise, it returns `Stored`. + +## Restoring entries from the cache + +To restore entries from the cache, we use the functions `restore_artifacts` and +`restore_value` described in the corresponding sections below. Setting possible +errors aside, these functions either fail to find the entry in the cache and +return `Not_found_in_cache`, or succeed and return `Restored` along with some +information about the restored entry. + +### Restoring artifacts + +Given a rule hash, the function `restore_artifacts` performs the following +steps. + +* Look up the corresponding metadata file in the `meta` directory. If it doesn't + exist, return `Not_found_in_cache`. Otherwise, read the list of artifacts, + i.e. the list of file names and their content hashes from the metadata file. + +* For each artifact, lookup the content hash in the `files` directory. If it + doesn't exist, return `Not_found_in_cache`. Otherwise: (i) delete the + corresponding (most likely stale) file in the build directory, and then (ii) + create a hard link with the same name, pointing to the file in the cache. + +If the above succeeds for every artifact in the list, the function returns +`Restored` along with the obtained list of file name and content hash pairs. + +### Restoring values + +Given an action hash, the function `restore_value` performs the following steps. + +* Look up the corresponding metadata file in the `meta` directory. If it doesn't + exist, return `Not_found_in_cache`. Otherwise, read the hash of the value. + +* Look up the hash in the `values` directory. If it doesn't exist, return + `Not_found_in_cache`. Otherwise, return `Restored` along with the value read + from the stored file. + +## Trimming the cache + +Storing all historically produced artifacts and values is infeasible, so the +cache needs to be regularly trimmed. The current trimming algorithm performs the +following steps. + +* Scan the `files` directory to find all currently unused artifact entries. An + artifact is _unused_ if its hard link count is equal to 1. There is no point in + trimming other entries, since they appear in at least one build directory. In + fact, trimming them is potentially harmful because if the same entries were to + be added to the cache again from a new directory, we would have been unable to + perform the deduplication, thus losing some sharing opportunities. + +* Scan the `values` directory to find all value entries. We have no information + about their current usage, so we conservatively allow all of them to be + trimmed and recomputed in the next build if needed. + +* Sort the entries according to the following criteria: + + - Type: artifacts precede values in the trimming list since artifacts are + generally larger and we know for sure that they are unused; + + - The time of last change: entries that became unused more recently go later + in the list. + +* Traverse the list and delete the corresponding entries until the trimming goal + has been met. Right before deleting an artifact entry, double check that its + hard link count is still equal to 1. A build system running concurrently might + have created a hard link to it after we collected the information, so deleting + this file from the cache could lead to a loss of sharing between different + build directories. + +* Finally, traverse the `meta` directory and remove all _broken_ metadata files, + i.e. the files that refer to content hashes with no corresponding entries in + the `files` and `values` directories. This step does not need to be done on + every trimming. It is expensive but metadata files are generally small and + there is no harm in keeping broken metadata files in the cache. In fact, the + information contained in broken metadata files can be utilised by the build + system for so-called _shallow builds_ where intermediate build artifacts are + not materialised on the disk and it is sufficient to only know their hashes, + which are listed in the metadata files. + +To enable more sophisticated trimming strategies, we could augment the metadata +stored in the cache with information about the _cost_ of producing cache +entries, i.e. the time it would take to execute the corresponding rule or action +to restore the entry if needed. For deterministic build rules, we can do _local +cost reasoning_, i.e. we do not need to take the cost of rebuilding their +dependents into account, since such rebuilding would be unnecessary due to the +early cut-off optimisation. + +Another promising idea is to add support for incremental cache trimming where +the build system informs the cache that a previously added entry has become +obsolete, letting the cache trim it early if it meets the trimming criteria. + +### Interaction with the previous cache versions + +Note also that as the new cache format evolves further and we, for example, move +from `files/v3` to `files/v4`, the cache trimmer will need to evolve too, to be +able to cope with entries of all currently supported versions. diff --git a/unikernel/duniverse/dune_/doc/dev/directory-targets.md b/unikernel/duniverse/dune_/doc/dev/directory-targets.md new file mode 100644 index 00000000..e2afbfd0 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dev/directory-targets.md @@ -0,0 +1,64 @@ +# Directory targets + +A **directory target** corresponds to a file tree rooted at a specified root +directory, for example, `docs/*`. Typical examples of rules producing directory +targets are: unpacking an archive, running `make` in a vendored package, and +building files with non-deterministic names (e.g. including the current date). + +## Declaring a directory target + +To declare a directory target `docs/*`, use the syntax `(target (dir docs))` in +a rule stanza. The corresponding rule should create the directory `docs` and is +free to populate it with an arbitrary number of files and/or subdirectories. + +Like file targets, directory targets can be promoted to the source tree by +adding `(mode promote)` to the rule stanza. + +## Depending on a directory target + +There are two ways to depend on a directory target: + +* An **opaque dependency** on the whole file tree `docs/*`. Opaque dependencies + are invalidated if the contents of the tree is changed in any way. To declare + an opaque dependency on `docs/*`, use the syntax `(dep (dir docs))` in a rule + stanza. + +* A **projection dependency** on a specific file in the tree, e.g. + `docs/html/index.html`. A projection dependency is declared using the standard + syntax `(dep docs/html/index.html)` and works like a dependency on a normal + file target. For example, if the `docs/*` directory is rebuilt and only + `docs/html/logo.png` is modified, then the dependency on `docs/html/index.html` + is considered to be up-to-date. Note that it is easy to make a mistake with + such projection dependencies, for example, by forgetting that `index.html` + actually does include the image `docs/html/logo.png`. In such cases, + sandboxing will help since only the requested projection dependencies will be + available in the sandbox (i.e., not the whole directory target). + +## Building a directory target + +Users can request building whole directory targets or individual files via +`dune build docs` and `dune build docs/html/index.html` commands. + +## Current limitations + +* It is not allowed to have two rules with the same directory target. That is, + like file targets, directory targets are **exclusive** (but see _shared + directory targets_ below). + +* Directory targets cannot have nested file or directory targets, i.e. other + rules are not allowed to declare targets within the file tree of a directory + target. + +## Possible future extensions + +Here are some possible extensions to consider: + +* **Opaque directory targets**: a rule may declare that its directory target is + opaque, in which case projection dependencies on its content will be + disallowed. One can also consider only partially opaque directory targets, + where the contents of the directory is only partially visible. + +* **Shared directory targets**: we can allow multiple rules to write to the same + directory target, as long as they do not write to the same files. In this + case, depending on a directory target would mean depending on all of the rules + that declare it as a target. diff --git a/unikernel/duniverse/dune_/doc/dev/rev-store.md b/unikernel/duniverse/dune_/doc/dev/rev-store.md new file mode 100644 index 00000000..852a870e --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dev/rev-store.md @@ -0,0 +1,106 @@ +The Revision Store +================== + +The revision store is the place where Git data that is relevant to the Dune +package management is cached. + +The Concepts +------------ + +The revision store uses Git in the way of its original slogan, as a +content-addressable file system. A lot of data (code) and meta-data (opam files) +is stored in Git repositories that are often forked from each other, hence to +save space Dune has a Git object cache. + +Git is implemented as a way to store revisions and being able to address them. +However, these revisions do not have to have a common ancestor and given Git +uses SHA1 hashes for addressing it is possible to join multiple repositories in +one single Git repository without clashing. A fairly common usecase outside of +Dune are `gh-pages` branches to serve documentation on Github, which do not +share a common parent with the main branch of the repository. + +The revision store exploits this feature by putting all revisions of all +repositories into one single large repository to take advantage of caching +effects. + +The Advantages +-------------- + +This way of organizing means that all revisions shared between multiple forks +of a Git repository can reuse the same Git objects that are in common and don't +need to download them nor store them again. Updating repositories can be done +incrementally, as Git knows which revisions are available locally and which +ones need to be fetched. + +It is also possible to refer to previous states easily as the commits are part +of a Git repo and checking out an older version is as simple as checking out +the current version of the files. + +Considerations and Compromises +------------------------------ + +An important consideration was that the management of the revision store should +be entirely transparent to the user, they should not need to do any steps to +create nor maintain it. It should get created automatically if needed and all +the steps that are necessary to keep it updated should happen in the +background. The store should always work like a cache that can be discarded +safely without causing data loss. + +The revision store should always give out the most recent version of data, +unless explicitly instructed otherwise. This means that : + + * If only a Git source is specified, then the revision store will + automatically get the newest revision + * If the source specifies a tag or branch, then the revision store will + automatically update to the newest revision + * It a revision is specified, the revision store will only update if the + revision is not yet cached, otherwise the cached version can be used + +The final consideration means that an offline usage is possible if all +repositories specified are specified with their hash. + +Due to the fact that the revision store is a Git repository it means that the +data sources that can be added to it also have to be available via Git. This +means that adding repositories that use different version control systems +aren't supported at the moment nor are plain HTTP sources supported. + +Support for other kinds of VCSes is a possible extension by replicating similar +concepts with other version control systems, provided they allow for similar +flexibility as the Git way of storing revisions. However at the moment most +users have settled on using Git, hence this version should be able to +accommodate the needs for most users. + +Another compromise is that old repositories with long histories and large sizes +have to be cloned before use, thus increasing the size of the initial download +compared to the same metadata downloaded as a compressed tarball. Despite Git +compressing objects, the history of the repositories to be added does increase +the overhead. + +A solution to this could be shallow clones which only contain the latest +revisions, however these have [shown to be +problematic](https://blog.cocoapods.org/Master-Spec-Repo-Rate-Limiting-Post-Mortem/) +thus for time being we are fetching the complete histories. + +Implementation +-------------- + +This section describes the current way the revision store is implemented. + +As the revision store is not project specific, it is stored in the user's cache +directory (using the [freedesktop.org](https://www.freedesktop.org/wiki/) +specifications, the directory specified by `XDG_CACHE_HOME`), with all dune +instances sharing one single revision store. + +The revision store itself is a `bare` Git repository without a worktree. This +is because all repositories in the revision store are equal and checking out +one particular revision would be a waste of disk space as the Git tooling can +be used to construct any revisions out of the bare repository anyway. + +Thus every source that is added to the revision store as a remote that tracks +the default branch (or, if a branch is specified explicitly, then that +branch) and fetched, thus storing the required revisions in the revision store. + +The implementation of these features is a mix of calling the `git` binary and +implementing parts in OCaml. This means that the `git` binary is required on +the system. Possible future improvements could be using +[ocaml-git](https://github.com/mirage/ocaml-git) to avoid the dependency. diff --git a/unikernel/duniverse/dune_/doc/dev/rpc-versioning.md b/unikernel/duniverse/dune_/doc/dev/rpc-versioning.md new file mode 100644 index 00000000..79b752b7 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dev/rpc-versioning.md @@ -0,0 +1,180 @@ +# Runtime RPC versioning implementation notes + +This document describes the versioning protocol used to ensure two-way +compatibility between different versions of the API. + +The approach is loosely inspired by the `Both_converts` model used by +[Versioned_rpc](https://ocaml.janestreet.com/ocaml-core/latest/doc/async_rpc_kernel/Async_rpc_kernel/index.html#module-Versioned_rpc) +in `Async`, in which both parties maintain a "menu" of supported RPC +versions, which is used to negotiate a common protocol for each +method. + +This is a working document and will be updated as the design evolves. + +## Terms + +- A **procedure** is a common term encompassing *notifications* + (one-way messages) and *requests* (a communication to which + a response is expected). + +- A **model** is the logical payload type for one direction of + a procedure. Note that this is a per-actor entity; the ultimate + goal of runtime RPC versioning is to allow clients and servers to + disagree on a model type without preventing them from interacting. + +- A **wire type** for a procedure is the logical type sent "over the + wire" for one direction of a procedure. The end result of + negotiating a version for a procedure is to select a wire type + known to both the client and the server. Typically, the older of + the two model types will be chosen as the wire type, + +- A **generation** of a procedure is the set of wire types + corresponding to each direction of a procedure, along with the + de/serialisation logic and upgrade and downgrade functions + transforming the wire types to the model types and vice versa. + Each generation is associated with a *version number*, which + should be unique within a procedure. + +- The **menu** is a mapping from method names to the particular + generations that will be used for each procedure for a particular + session. In the source code, this term is overloaded to also refer + to a mapping from method names to *all known* generations of + a procedure. + +- The **declaration** of a procedure lists its model types and all + known generations, along with its method name. Multiple + declarations of the same procedure is allowed, so long as they do + not overlap version numbers. + +- The **implementation** of a declaration is the actual behavior of + a procedure, which acts on the model types. Typically, this will + be on the server, but in the future there may also be a use for + server-to-client requests. This document is not concerned with the + internals of any given implementation, only whether such an + implementation exists at all. + +## Background + +Previously, there was no distinction between model and wire types. +This meant that any change to a model type required both build servers +and clients to upgrade in lockstep, as otherwise the receiver would be +unable to deserialize the payload of a procedure. + +Unfortunately, most lighter-weight solutions (such as modifying the +de/serialization logic to be resilient to, e.g., extra/missing fields +or variants in types) are insufficient. Early designs of the +diagnostic API, for example, reported targets as strings, but was +changed to give structured information instead. + +Similarly, requirements like "the client must always be older than the +server" (or the reverse) don't work in environments like Jane Street, +where the same editor plugin must be able to interact seamlessly with +multiple iterations of Dune (which may be older or newer than the +editor plugin itself). + +The main goal of the system, then, is to ensure that both the server +and client applications can be programmed against the current model +types for each procedure, with all backwards- or forwards- conversions +happening under the hood. + +## Protocol + +At session initialization time, the client will first send an +initialization request to the server containing a single version +number corresponding to the overall RPC version the client will use. +If this number is determined to be versioning-compatible (see +[Session versioning](#session-versioning)), the server will respond +with a token instructing the client to initiate version negotiation. +Otherwise, the server will respond with an error. + +Upon receiving this token, the client will initiate version +negotiation by sending a list of `(method-name, generations)` +pairs, where `method-name` is the name of each declared procedure, and +`generations` is the list of version numbers for that procedure's +generations. + +Upon receiving a list of supported versions from the client, the +server will compare it to its list of *implemented* versions, +selecting the greatest common generation for each procedure. If the +client and server do not share any generations for a procedure, it is +omitted entirely. If there is at least one method for which a common +version exists, then the server responds with a list of `(method-name, +selected-version)` pairs, where `selected-version` is the version +number of the greatest common generation. This list is then used by +both parties to construct the version menu. Otherwise, if there are no +common versions for any methods, an error is returned to the client +and the session is invalidated. + +Note that we do not currently require declared/implemented versions to +span a contiguous range of version numbers. This can have a few uses, +such as preventing clients from using a known-bugged generation of +a procedure. + +When executing a procedure, the sender first looks up the correct +generation in the menu (see [Error handling](#error-handling)), and +downgrades the payload from the sender-side model type to the wire +type. Upon receipt, the server performs the same lookup to deserialize, +then upgrade the payload to the receiver-side model type, then the +procedure implementation is performed, producing a response in the +case of requests. If necessary, the same transformations are then +performed in reverse, sending the value back to the sender, completing +the procedure. + +Barring strange circumstances (such as a client declaring a generation +with a newer version number than the type exposed in `dune_rpc.mli`), it +is always the case that the transformation from wire to model types will +be the identity function on the side that is older. + +## Miscellaneous implementation notes + +### Session versioning + +In addition to version numbers existing for each procedure version, +there are two further version numbers associated with the session as +a whole which are sent as part of session initialization. + +The first is the version of Dune each side purports to be as +a `MAJOR.MINOR` number (serialized as an `int * int` pair). This is +not currently checked. + +Next is a version of the initial handshake protocol to be used. This +takes the form of a single `int`. In the future, if the initial +negotiation protocol changes, this value can be adjusted and checked to +account for this. + +### Error handling + +Handling of versioning errors has become more complex, as we need to +distinguish between "no such method exists" and "the server and client +do not share any common generations for this method". Secondly, this +means that the initiation of a procedure can now fail, which +complicates one-way communications (for example, the server must +swallow errors and clients must be upgraded to handle version errors +on notifications, which were previously infallible). + +Finally, the versioning protocol itself must be either versioned +separately or stabilised (see [Session versioning](#session-versioning)). + +### Tweaks + +- We currently send the entire version menu from client to server and + back twice, once for the client to inform the server of all + supported versions, and again for the server to inform the client + of the common versions. This can lead to large messages being + passed at session initialization, which may become a performance + bottleneck. + + - The size of the version negotiation messages is proportional to + the number of all known generations for all procedures, which + can be approximated by `number-of-procedures` times + `number-of-supported-generations`. In practice, I do not + expect this number to be large (I would be surprised if this + number is ever on the order of 100). + + - One alternative is to perform per-procedure negotiation, where + the initiator of a procedure first sends its known version + ranges, the recipient sends the selected version (or an + error), then the procedure proceeds as before. This approach + trades startup and lookup overhead for a constant + per-communication overhead. It also makes distinguishing "no + such method exists" and "no common versions" simpler. diff --git a/unikernel/duniverse/dune_/doc/dev/rule-production.md b/unikernel/duniverse/dune_/doc/dev/rule-production.md new file mode 100644 index 00000000..4a4f97cb --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dev/rule-production.md @@ -0,0 +1,176 @@ +# Rule production + +This document describes how rule production works in Dune. It was originally +written by Jérémie Dimino as part of the +[streaming RFC](https://github.com/ocaml/dune/pull/5251), but moved +into the dev documentation as it provides a great overview on how this part of +Dune works at present. + +## How does rule production works? + +### `Dune_engine.Load_rules` + +The production of rules is driven by the module `Load_rules` in the +`dune_engine` library. This library is the build system core of +Dune. It is meant as a general purpose library for writing build +systems, and the Dune software is built on top of it. In theory, +`dune_engine` shouldn't know about `dune` or `dune-project` +files. However, for historical reason this is not the case yet and +`dune_engine` still knows some things about them. + +As we work on Dune, we expect that `dune_engine` will become more and +more agnostic. Even though it is not completely agnostic, we have +successfully been using it to build Jane Street code base, using the +Jane Street rules on top of this core. So it's already more general +than Dune itself. + +For the purpose of this design doc, we will treat `dune_engine` as a +completely general library that doesn't know about `dune` files. + +The main feature of `Load_rules` is the `Load_rules.load_dir` function: + +```ocaml +val load_dir : dir:Path.t -> Loaded.t Memo.t +``` + +`Loaded.t` represents a "loaded" set of rules for a particular +directory. It can also be thought as a "compiled" set of rules. A +`Loaded.t` contains all the rules in existence that produce targets in +`dir`. For instance, given a `Loaded.t` we can figure out all the +files that would be produced in `dir` if we were building everything +that could be built. While `dir` is a build directory, this also +includes files present in the source tree. This is because +`Load_rules.load_dir` implicitly adds copy rules for all source files +present in the source directory that correspond to the build directory +`dir`. For instance, if `dir` is `_build/default/src`, Dune will +implicitly add rules to copy files in `src` to `_build/default/src`. +Except for rules that have the special `promote` or `fallback` modes. + +This is in fact how Dune evaluates globs during the build. Indeed, +when writing `dune` files we work in an imaginary world where both the +source files and the generated files are present. So when we write +`(deps (glob_files *.txt))`, this `*.txt` denotes both `.txt` files +that are present on disk in the source tree but also as the ones that +can be generated by the build. + +In practice, to evaluate `(glob_files *.txt)` in directory `d`, Dune +calls `Load_rules.load_dir ~dir:d` and filter the list of files that can +be built. Similarly, when Dune needs to build a file +`_build/default/src/x`, it first calls `Load_rules.load_dir` with +`_build/default/src` and then looks up a rule that has `x` has +target in the returned `Loaded.t`. The `Load_rules.load_dir` is +memoised, so it can be called multiple times during the build without +guilt. + +While `Load_rules` is responsible for driving the production of rules, +it is part of `dune_engine` which doesn't know about `dune` files and +doesn't know about OCaml libraries or OCaml compilation in general. So +it is not responsible for actually producing the build rules that +allow to build Dune projects. Instead, `Load_rules` defers the actual +production of rules to a callback that it obtains via +`Build_config`. Inside Dune, this callback is implemented by the +`Gen_rules` module inside the `dune_rules` library. `dune_rules` is +the library that is responsible for parsing, interpreting and +compiling `dune` files down to low-level build rules. + +### `Dune_rules.Gen_rules` + +The entry of `Dune_rules.Gen_rules` is the `gen_rules` function. Its +API looks like: + +```ocaml +val gen_rules : + Build_config.Context_or_install.t -> + dir:Path.Build.t -> + string list -> + Build_config.gen_rules_result Memo.t +``` + +Where `Build_config.gen_rules_result` is, in most cases —when the value +returned is `Build_config.Rules _`—, a "raw" set of rules. Raw in the sense +that there is no overlap checks or any other checks. During the rule +production phase, we merely accumulate a set of rules that is later +processed. The API of `gen_rules` is in fact a bit more complex, but +the above definition is enough for the purpose of this document. + +The first thing `gen_rules` does is analyse the directory it is +given. If the directory corresponds to a source directory with a `dune` +file, `gen_rules` will dispatch the call to the part of `dune_rules` +that parses and interprets the `dune` file. This is the simplest case, +but even in this case there are some things worth mentioning. + +For instance, when compiling an OCaml library dune stores the +artifacts for the library in generated dot-directories. For instance, +the cmi files for library `foo` living in source directory `src` will +end up in `_build/default/src/.foo.objs/byte`. We could produce these +rules when `gen_rules` is called with directory +`_build/default/src/.foo.objs/byte`, however that would spread out the +logic for interpreting `library` stanzas. It is much simpler to +produce all the build rules corresponding to a `library` stanza in one +go. This is what is happening at the moment: when called with +directory `_build/default/src`, `gen_rules` will not only produce +rules for this directory but will also produce rules for +`_build/default/src/.foo.objs/byte` and various other directories. + +`Load_rules` doesn't know anything about this. And in particular, it +doesn't know that it is the `gen_rules` call for directory +`_build/default/src/` that will produce the rules for the dot +subdirectories. When `Load_rules` loads the rules for the +`.../.foo.objs/byte` sub-directory, it simply calls `gen_rules` with +this directory. It is `gen_rules` that "redirects" the call to the +`_build/default/src` directory by calling +`Load_rules.load_dir_and_produce_its_rules`. This function simply +calls `Load_rules.load_dir` and re-emits all the raw rules that were +returned by the corresponding `gen_rules` call. + +This works because `Load_rules.load_dir` accepts the facts that +`gen_rules` produces rules for many directory at once. It simply +filters out the result. But for things to behave well, the unwritten +following invariant must hold: `gen_rules ~dir:d` is allowed to +generate rules for directory `d'` iff `gen_rules ~dir:d'` emits a call +to `Load_rules.load_dir ~dir:d`. + +This scenario happens in a number of cases. All these cases share a +common pattern: the redirections are always to an ancestor +directory. At the moment, there is one exception to this pattern in +the odoc rules, however it is easy to remove. + +Finally, the `copy_files` stanza creates another form of dependency +between directory. In order to calculate the targets produced by +`copy_files`, which needs to be known at rule production time, we need +to evaluate the glob given to `copy_files`. Which requires doing a +call to `Load_rules.load_dir` as previously described. Contrary to the +other form of dependency we just describe, this ones can go from any +directory to any other directory. For instance, the following stanza +in `src/dune`: + +``` +(copy_files foo/*.txt) +``` + +would create a dependency from `_build/default/src` to + `_build_default/src/foo`. + +So in the end, if we were looking at the internal computation graph of +Dune and narrowing it to just the calls to `Load_rules.load_dir`, we +would see a graph with many edges going from a directory to one of its +ancestor. These would mostly be between generated dot-subdirectories +and their first ancestor that has a corresponding directory in the +source tree. Plus a few other arbitrary ones for each `copy_files` +stanza. + +## Directory targets + +Before directory targets, answering the question "what rules produces +file X?" was easy. Dune would just call `Load_rules.load_dir` and +lookup `X` in the result. With directory targets, things are a bit +more complicated. Indeed, `X` might also be produced by a directory +target in an ancestor directory. This means that `Load_rules.load_dir` +now need to look in parent directories as well, which introduce more +dependencies from directories to their parents and can create cycles +because of `copy_files` stanza that create dependencies in the other +direction. + +At a result, some combinations of `copy_files` and directory targets +don't produce the expected result. This is documented in the test +suite. diff --git a/unikernel/duniverse/dune_/doc/dev/rule-streaming.md b/unikernel/duniverse/dune_/doc/dev/rule-streaming.md new file mode 100644 index 00000000..84698103 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dev/rule-streaming.md @@ -0,0 +1,82 @@ +# Rule streaming + +This document describes a new design for the production of build rules +in Dune. The new design aims to be more natural, easier to reason +about and to make existing features work well with newer ones such as +directory targets. + +It was originally written by Jérémie Dimino as part of the +[streaming RFC](https://github.com/ocaml/dune/pull/5251), and later on moved +into the dev documentation. + + +## Problem + +The [rule production](./rule-production.md) document exposes a concrete problem +with directory targets, but there is also a general sense of messiness in the +way things work. Generating rules for multiple directories at once is +natural, but the current encoding is odd. + +## Proposal + +The proposal is to add the following rule: `gen_rules ~dir` is allowed +to produced rules in `dir` or any of its descendant only. It is not +allowed to produce rules anywhere else. + +`Load_rules.load_dir ~dir` will then always call itself recursively on +the parent of `dir` and take the union of the rules produced by +`gen_rules` for `dir` and the ones produced by the recursive +call. `gen_rules` will no longer have to redirect a call via +`Load_rules.load_dir_and_produce_its_rules`, which we would simply +remove. + +This introduces a cycle with all `copy_files` stanza that copy files +from a sub-directory. We propose the break this cycle by introducing +laziness in the rule production code. + +### Generating rules with a mask + +The idea is that when we produce rules, we will produce rules under +a current active "mask" that tells us where we are allowed to generate +files or directories. Trying to produce a rule with targets not +matched by this mask will be a runtime error. + +When entering `gen_rules ~dir`, the initial mask will be: "any files +and directories that is a descendant of directory `dir`". + +We can then narrow the mask to a sub-mask: + +```ocaml +val narrow : Target_mask.t -> unit Memo.t -> unit Memo.t +``` + +With `narrow mask m`, `m` would only be allowed to produce rules whose +target are matched by the intersection of `mask` and the current +mask. `m` wouldn't be evaluated eagerly. Instead, `gen_rules` would +now return a set of direct rules as well as a list of +`(Target_mask.t * unit Memo.t)`. Let's call such a pair a +suspension. A suspension can be forced by evaluation its second +component. Doing so will yield a list of rules matched by the mask and +a new list of suspension. + +### Staged rules loading + +The next step is to stage `Load_rules.load_dir`. In addition to taking +a directory, `load_dir` will now also take a mask and will return the +set of rules for this mask. To do that, it might need to force a bunch of +suspensions recursively. + + +### How does that help? + +We will put `copy_rules` under a `narrow `. In order to determine if a directory is part of a directory +target in an ancestor directory, we wouldn't need to force this +suspension. + +### Difficulties + +Interpreting a `library` stanza requires knowing the set of `.ml` +files in the current directory. Knowing this requires interpreting +`copy_files` in the current directory. So the interpretation of +`library` stanzas will need to go under a `narrow` as well. diff --git a/unikernel/duniverse/dune_/doc/documentation.rst b/unikernel/duniverse/dune_/doc/documentation.rst new file mode 100644 index 00000000..f6563a04 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/documentation.rst @@ -0,0 +1,157 @@ +.. _documentation: + +************************ +Generating Documentation +************************ + +.. TODO(diataxis) + + Split between: + + - A "generating API documentation" how-to guide + - Some reference documentation + +Prerequisites +============= + +Documentation in Dune is done courtesy of the odoc_ tool. Therefore, to +generate documentation in Dune, you will need to install this tool. This +should be done with opam: + +:: + + $ opam install odoc + +Writing Documentation +===================== + +Documentation comments will be automatically extracted from your OCaml source +files following the syntax described in the section ``Text formatting`` of +the `OCaml manual `_. + +Additional documentation pages may be attached to a package using the +:doc:`/reference/dune/documentation` stanza. + +Building Documentation +====================== + +To generate documentation using the :doc:`/reference/aliases/doc` alias, all +that's required to is to build this alias: + +.. code:: console + + $ dune build @doc + +An index page containing links to all the opam packages in your project can be +found in: + +.. code:: console + + $ open _build/default/_doc/_html/index.html + +Documentation for private libraries may also be built with +:doc:`/reference/aliases/doc-private`: + +.. code:: console + + $ dune build @doc-private + +But these libraries will not be in the main HTML listing above, since they +don't belong to any particular package, but the generated HTML will still be +found in ``_build/default/_doc/_html/``. + + +Documentation Stanza: Examples +------------------------------ + +The :doc:`/reference/dune/documentation` stanza will attach all the +``.mld`` files in the current directory in a project with a single package. + +.. code-block:: dune + + (documentation) + +This stanza will attach three ``.mld`` files to package ``foo``. The ``.mld`` files should +be named ``foo.mld``, ``bar.mld``, and ``baz.mld`` + +.. code-block:: dune + + (documentation + (package foo) + (mld_files foo bar baz)) + +This stanza will attach all ``.mld`` files to the inferred package, +excluding ``wip.mld``, in the current directory: + +.. code-block:: dune + + (documentation + (mld_files :standard \ wip)) + +All ``.mld`` files attached to a package will be included in the generated +``.install`` file for that package. They'll be installed by opam. + +.. code-block:: dune + + (documentation + (files + (glob_files_rec + (doc/* with_prefix .)))) + +All files in the ``doc/`` folder will be attached to the inferred package. The +hierarchy between them will be preserved, relative to ``doc/`` considered as the +root. + +.. note:: + + ``dune`` does not yet support building the documentation with a non-flat + hierarchy, or with non-mld files. However, it supports installing those files + following a convention, so that ``odoc_driver`` can build the docs with + hierarchy and asset files. + + +Package Entry Page +------------------ + +The ``index.mld`` file (specified as ``index`` in ``mld_files``) is treated +specially by Dune. This will be the file used to generate the entry page for +the package, linked from the main package listing. + +To generate pleasant documentation, we recommend writing an ``index.mld`` file +with at least short description of your package and possibly some examples. + +If you do not write your own ``index.mld`` file, Dune will generate one with +the entry modules for your package. But this generated file will not be +installed. + +.. _odoc-options: + +Passing Options to ``odoc`` +=========================== + +.. code-block:: dune + + (env + ( + (odoc ))) + +See :doc:`/reference/dune/env` for more details on the ``(env ...)`` +stanza. ```` are: + +- ``(warnings )`` specifies how warnings should be handled. ```` + can be: ``fatal`` or ``nonfatal``. The default value is ``nonfatal``. This + field is available since Dune 2.4.0 and requires odoc_ 1.5.0. + +.. _odoc: https://github.com/ocaml-doc/odoc + +Local Documentation Search Using Sherlodoc +========================================== + +If Sherlodoc is installed, generated HTML documentation will include a +search bar. It supports search by name, documentation and fuzzy type search. + +In can be installed with: + +.. code:: console + + $ opam install sherlodoc diff --git a/unikernel/duniverse/dune_/doc/dune b/unikernel/duniverse/dune_/doc/dune new file mode 100644 index 00000000..677b5b08 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dune @@ -0,0 +1,36 @@ +(rule + (with-stdout-to + dune.1 + (run %{bin:dune} --help=groff))) + +(install + (section man) + (package dune) + (files dune.1)) + +(rule + (with-stdout-to + dune-config.5 + (run %{bin:dune} help config --man-format=groff))) + +(install + (section man) + (package dune) + (files dune-config.5)) + +(include dune.inc) + +(rule + (alias runtest) + (mode promote) + (deps + (package dune)) + (action + (with-stdout-to + dune.inc + (run bash %{dep:update-jbuild.sh})))) + +(documentation + (package dune)) + +(data_only_dirs tutorials) diff --git a/unikernel/duniverse/dune_/doc/dune-libs.rst b/unikernel/duniverse/dune_/doc/dune-libs.rst new file mode 100644 index 00000000..ae0228d1 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dune-libs.rst @@ -0,0 +1,193 @@ +************** +Dune Libraries +************** + +.. TODO(diataxis) Move into :doc:`reference/dune-libs` + +.. _configurator: + +Configurator +============ + +Configurator is a small library designed to query features available on the +system in order to generate configuration for Dune builds. Such generated +configuration is usually in the form of command line flags, generated headers, +and stubs, but there are no limitations on this. + +Configurator allows you to query for the following features: + +* Variables defined in ``ocamlc -config``, + +* pkg-config_ flags for packages, + +* Test features by compiling C code, + +* Extract compile time information such as ``#define`` variables. + +Configurator is designed to be cross-compilation friendly and avoids *running* +any compiled code to extract any of the information above. + +Configurator started as an `independent library +`__, but now lives in dune. It is +released as the package ``dune-configurator``. + +Usage +----- + +We'll describe configurator with a simple example. Everything else can be +easily learned by studying `configurator's API +`__. + +To use Configurator, write an executable that will query the system using +Configurator's API and output a set of targets reflecting the results. For +example: + +.. code-block:: ocaml + + module C = Configurator.V1 + + let clock_gettime_code = {| + #include + + int main(void) + { + struct timespec ts; + clock_gettime(CLOCK_REALTIME, &ts); + return 0; + } + |} + + let () = + C.main ~name:"foo" (fun c -> + let has_clock_gettime = + C.c_test c clock_gettime_code ~link_flags:["-lrt"] in + + C.C_define.gen_header_file c ~fname:"config.h" + [ "HAS_CLOCK_GETTIME", Switch has_clock_gettime ]); + +Usually, the module above would be named ``discover.ml``. The next step is to +invoke it as an executable and tell Dune about the targets that it produces: + +.. code-block:: dune + + (executable + (name discover) + (libraries dune-configurator)) + + (rule + (targets config.h) + (action (run ./discover.exe))) + +Another common pattern is to produce a flags file with Configurator and then +use this flag file using ``:include``: + +.. code-block:: dune + + (library + (name mylib) + (foreign_stubs (language c) (names foo)) + (c_library_flags (:include (flags.sexp)))) + +For this, generate the list of flags for your library (for example, using +``Configurator.V1.Pkg_config``), and then write them to a file: in the above +example, ``flags.sexp`` with ``Configurator.V1.write_flags "flags.sexp" +flags``. + +Upgrading From the Old Configurator +----------------------------------- + +The old Configurator is the independent `Configurator +`__ opam package. It's now +deprecated, and users are encouraged to migrate to Dune's own Configurator. The +advantage of the transition include: + +* No extra dependencies, + +* No need to manually pass ``-ocamlc`` flag, + +* New Configurator is cross-compilation compatible. + +The following steps must be taken to transition from the old Configurator: + +* Mentions of the ``configurator`` opam package should be replaced + with ``dune-configurator``. + +* The library name ``configurator`` should be changed ``dune-configurator``. + +* The ``-ocamlc`` flag in rules that runs Configurator scripts should be removed. + This information is now passed automatically by Dune. + +* The new Configurator API is versioned explicitly. The version that's + compatible with old Configurator is under the ``V1`` module. Hence, to + transition one's code, it's enough to add this module alias: + +.. code-block:: ocaml + + module Configurator = Configurator.V1 + +.. _pkg-config: https://www.freedesktop.org/wiki/Software/pkg-config/ + +.. _build-info: + +`dune-build-info` Library +========================= + +Dune can embed build information such as versions in executables +via the special ``dune-build-info`` library. This library exposes +some information about how the executable was built, such as the +version of the project containing the executable or the list of +statically linked libraries with their versions. Printing the version +at which the current executable was built is as simple as: + +.. code:: ocaml + + Printf.printf "version: %s\n" + (match Build_info.V1.version () with + | None -> "n/a" + | Some v -> Build_info.V1.Version.to_string v) + +You can specify the project version using the ``version`` field in the +``dune-project`` file. For example: + +.. code:: dune + + (version 1.2.3) + +For more details, refer to :doc:`/reference/dune-project/version`. + +For libraries and executables from development repositories that don't +have version information written directly in the ``dune-project`` +file, the version is obtained by querying the version control +system. For instance, the following Git command is used in Git +repositories: + +.. code:: console + + $ git describe --always --dirty --abbrev=7 + +which produces a human readable version string of the form +``--[-dirty]``. + +Note that in the case where the version string is obtained from the version +control system, the version string will only be written in the binary once it's +installed or promoted to the source tree. In particular, if you evaluate this +expression as part of your package build, it will return ``None``. This ensures +that committing doesn't hurt your development experience. Indeed, if Dune +stored the version directly inside the freshly built binaries, then every time +you commit your code, the version would change and Dune would need to rebuild +all the binaries and everything that depends on them, such as tests. Instead, +Dune leaves a placeholder inside the binary and fills it during installation or +promotion. + +.. _dune-action-plugin: + +(Experimental) Dune Action Plugin +================================= + +*This library is experimental and no backwards compatibility is implied. Use at +your own risk.* + +``Dune-action-plugin`` provides a monadic interface to express program +dependencies directly inside the source code. Programs using this feature +should be declared using :doc:`/reference/actions/dynamic-run` instead of usual +:doc:`/reference/actions/run`. diff --git a/unikernel/duniverse/dune_/doc/dune.inc b/unikernel/duniverse/dune_/doc/dune.inc new file mode 100644 index 00000000..2a6608db --- /dev/null +++ b/unikernel/duniverse/dune_/doc/dune.inc @@ -0,0 +1,316 @@ + +(rule + (with-stdout-to dune-printenv.1 + (run dune printenv --help=groff))) + +(install + (section man) + (package dune) + (files dune-printenv.1)) + +(rule + (with-stdout-to dune-promote.1 + (run dune promote --help=groff))) + +(install + (section man) + (package dune) + (files dune-promote.1)) + +(rule + (with-stdout-to dune-test.1 + (run dune test --help=groff))) + +(install + (section man) + (package dune) + (files dune-test.1)) + +(rule + (with-stdout-to dune-build.1 + (run dune build --help=groff))) + +(install + (section man) + (package dune) + (files dune-build.1)) + +(rule + (with-stdout-to dune-cache.1 + (run dune cache --help=groff))) + +(install + (section man) + (package dune) + (files dune-cache.1)) + +(rule + (with-stdout-to dune-clean.1 + (run dune clean --help=groff))) + +(install + (section man) + (package dune) + (files dune-clean.1)) + +(rule + (with-stdout-to dune-coq.1 + (run dune coq --help=groff))) + +(install + (section man) + (package dune) + (files dune-coq.1)) + +(rule + (with-stdout-to dune-describe.1 + (run dune describe --help=groff))) + +(install + (section man) + (package dune) + (files dune-describe.1)) + +(rule + (with-stdout-to dune-diagnostics.1 + (run dune diagnostics --help=groff))) + +(install + (section man) + (package dune) + (files dune-diagnostics.1)) + +(rule + (with-stdout-to dune-exec.1 + (run dune exec --help=groff))) + +(install + (section man) + (package dune) + (files dune-exec.1)) + +(rule + (with-stdout-to dune-external-lib-deps.1 + (run dune external-lib-deps --help=groff))) + +(install + (section man) + (package dune) + (files dune-external-lib-deps.1)) + +(rule + (with-stdout-to dune-fmt.1 + (run dune fmt --help=groff))) + +(install + (section man) + (package dune) + (files dune-fmt.1)) + +(rule + (with-stdout-to dune-format-dune-file.1 + (run dune format-dune-file --help=groff))) + +(install + (section man) + (package dune) + (files dune-format-dune-file.1)) + +(rule + (with-stdout-to dune-help.1 + (run dune help --help=groff))) + +(install + (section man) + (package dune) + (files dune-help.1)) + +(rule + (with-stdout-to dune-init.1 + (run dune init --help=groff))) + +(install + (section man) + (package dune) + (files dune-init.1)) + +(rule + (with-stdout-to dune-install.1 + (run dune install --help=groff))) + +(install + (section man) + (package dune) + (files dune-install.1)) + +(rule + (with-stdout-to dune-installed-libraries.1 + (run dune installed-libraries --help=groff))) + +(install + (section man) + (package dune) + (files dune-installed-libraries.1)) + +(rule + (with-stdout-to dune-internal.1 + (run dune internal --help=groff))) + +(install + (section man) + (package dune) + (files dune-internal.1)) + +(rule + (with-stdout-to dune-monitor.1 + (run dune monitor --help=groff))) + +(install + (section man) + (package dune) + (files dune-monitor.1)) + +(rule + (with-stdout-to dune-ocaml.1 + (run dune ocaml --help=groff))) + +(install + (section man) + (package dune) + (files dune-ocaml.1)) + +(rule + (with-stdout-to dune-ocaml-merlin.1 + (run dune ocaml-merlin --help=groff))) + +(install + (section man) + (package dune) + (files dune-ocaml-merlin.1)) + +(rule + (with-stdout-to dune-package.1 + (run dune package --help=groff))) + +(install + (section man) + (package dune) + (files dune-package.1)) + +(rule + (with-stdout-to dune-pkg.1 + (run dune pkg --help=groff))) + +(install + (section man) + (package dune) + (files dune-pkg.1)) + +(rule + (with-stdout-to dune-promotion.1 + (run dune promotion --help=groff))) + +(install + (section man) + (package dune) + (files dune-promotion.1)) + +(rule + (with-stdout-to dune-rpc.1 + (run dune rpc --help=groff))) + +(install + (section man) + (package dune) + (files dune-rpc.1)) + +(rule + (with-stdout-to dune-rules.1 + (run dune rules --help=groff))) + +(install + (section man) + (package dune) + (files dune-rules.1)) + +(rule + (with-stdout-to dune-runtest.1 + (run dune runtest --help=groff))) + +(install + (section man) + (package dune) + (files dune-runtest.1)) + +(rule + (with-stdout-to dune-show.1 + (run dune show --help=groff))) + +(install + (section man) + (package dune) + (files dune-show.1)) + +(rule + (with-stdout-to dune-shutdown.1 + (run dune shutdown --help=groff))) + +(install + (section man) + (package dune) + (files dune-shutdown.1)) + +(rule + (with-stdout-to dune-subst.1 + (run dune subst --help=groff))) + +(install + (section man) + (package dune) + (files dune-subst.1)) + +(rule + (with-stdout-to dune-tools.1 + (run dune tools --help=groff))) + +(install + (section man) + (package dune) + (files dune-tools.1)) + +(rule + (with-stdout-to dune-top.1 + (run dune top --help=groff))) + +(install + (section man) + (package dune) + (files dune-top.1)) + +(rule + (with-stdout-to dune-uninstall.1 + (run dune uninstall --help=groff))) + +(install + (section man) + (package dune) + (files dune-uninstall.1)) + +(rule + (with-stdout-to dune-upgrade.1 + (run dune upgrade --help=groff))) + +(install + (section man) + (package dune) + (files dune-upgrade.1)) + +(rule + (with-stdout-to dune-utop.1 + (run dune utop --help=groff))) + +(install + (section man) + (package dune) + (files dune-utop.1)) + diff --git a/unikernel/duniverse/dune_/doc/explanation/bootstrap.rst b/unikernel/duniverse/dune_/doc/explanation/bootstrap.rst new file mode 100644 index 00000000..b5a41b18 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/bootstrap.rst @@ -0,0 +1,53 @@ +How Dune Uses Dune to Build Dune +================================ + +Dune's build system is itself Dune. This works thanks to a bootstrap process. +This document explains how this works. + +``boot/bootstrap.ml`` +--------------------- + +``boot/bootstrap.ml`` is an OCaml script (it is interpreted, not compiled) that +is a mini-build system tailored to Dune itself. It computes dependencies +between the various modules by calling ``ocamldep``, and it will generate build +and link commands. It knows how to execute these commands in parallel. It does +not read any ``dune`` file. However, the project structure and its system +dependencies are encoded in ``boot/libs.ml``. + +This step produces ``_boot/dune.exe``. + +Completing the Opam Installation +-------------------------------- + +``_boot/dune.exe`` is the bootstrap Dune. Since it has been built from +the Dune sources, it will act like Dune: it can read ``dune`` files, etc. + +This is actually the ``dune`` executable that will get installed. This is the +same executable as the one obtained by running ``opam install dune``. At this +stage of the process, Opam does not know about this: it expects a +``dune.install`` file that explains what files to install. + +The next command run by the Opam instruction is the following: + +.. code:: console + + $ ./_boot/dune.exe build dune.install --release --profile dune-bootstrap + +By using the ``dune-bootstrap`` :term:`build profile`, it does not run a full +build, but only copy ``_boot/dune.exe`` to its install location (as the `dune` +binary), and generate ``dune.install``. + +``make dev``: Everything Else for Local Development +--------------------------------------------------- + +The above describes how Dune itself is built through Opam, but that's not all +there is it to it: the Dune repository contains other libraries that need to be +built. In fact, executing the ``boot/bootstrap.ml`` script did not generate +files useful for editor integration. + +So the main ``Makefile`` has a ``make dev`` target that will run +``_boot/dune.exe build @install``: this will rebuild the project using Dune +itself. + +As a special rule, this build will regenerate ``boot/libs.ml`` using the +locations of the internal libraries used to build Dune. diff --git a/unikernel/duniverse/dune_/doc/explanation/index.rst b/unikernel/duniverse/dune_/doc/explanation/index.rst new file mode 100644 index 00000000..8b8e4e57 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/index.rst @@ -0,0 +1,17 @@ +Explanation +=========== + +These documents explain how certain feature works, or how Dune integrates with +the rest of the OCaml ecosystem. + +.. toctree:: + :maxdepth: 1 + + scopes + preprocessing + ocaml-ecosystem + package-management + opam-integration + bootstrap + mental-model + tour/index diff --git a/unikernel/duniverse/dune_/doc/explanation/mental-model.rst b/unikernel/duniverse/dune_/doc/explanation/mental-model.rst new file mode 100644 index 00000000..8dda25a7 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/mental-model.rst @@ -0,0 +1,202 @@ +The Dune Mental Model +===================== + +It is not strictly necessary to understand Dune's underlying model to use it; +but knowing how it works under the hood will help writing build rules, and also +help understand some errors and what's possible with Dune. + +.. note:: + + This document is a simplification of the reality: the actual rules might be + different, it does not touch rule loading and glosses over how caching + works, but should be a useful tool to build an understanding of Dune. + +How Dune Works +-------------- + +The building block of Dune is the *rule*: + + A *rule* reads *dependencies* and writes *targets* using an *action* (and + it can be attached to *aliases*). + +When ``dune build`` is executed, it will first read the project's ``dune`` +files to determine the rules that apply to the project. Once it has done this, +it will determine what actions it needs to execute to build the required +targets. + +An Example +---------- + +Let's take the following example. + +- there's a CLI tool written in OCaml. +- it has some build-time configuration stored in ``config.json``. +- it has an integration test, in which the tool is executed with + ``testdata.txt`` as input. + +Configuration Generation +^^^^^^^^^^^^^^^^^^^^^^^^ + +To express the generation of the configuration module we could write: + +.. code:: dune + + (rule + (deps convert/json2ml.exe config.json) + (target config.ml) + (action + (run convert/json2ml.exe config.json -o config.ml))) + +This rule will: + +- read its dependencies: ``convert/json2ml.exe`` and ``config.json`` +- and write its target: ``config.ml`` +- using an action: ``(run convert/json2ml.exe config.json -o config.ml)`` + +This rule is very explicit: we write a stanza for a single Dune rule. + +Building the Executable +^^^^^^^^^^^^^^^^^^^^^^^ + +In contrast, to describe the compilation of the executable, we would write: + +.. code:: dune + + (executable + (name tool) + (modules main config)) + +Here, we use Dune's abstractions. Dune knows about the OCaml compilation model: +the modules need to be compiled and linked together. So it will generate the +following rules under the hood: + +- one rule to compile the ``Main`` module: + + - it will read its dependency: ``main.ml`` + - and write its output: ``main.cmx`` + - using an action: ``(run ocamlopt -c main.ml)`` + +- one rule to compile the ``Config`` module: + + - it will read its dependency: ``config.ml`` + - and write its output: ``config.cmx`` + - using an action: ``(run ocamlopt -c config.ml)`` + +- one rule to link the ``tool.exe`` executable: + + - it will read its dependencies: ``main.cmx`` and ``config.cmx`` + - and write its output: ``tool.exe`` + - using an action: ``(run ocamlopt -o tool.exe main.cmx config.cmx``) + +Note that in this example, some files are targets of a rule and dependencies of +another (``.cmx`` files). We are unlikely to ever interact with them directly, +so it can also be useful to think of the ``(executable)`` stanza as a group of +rules with ``main.ml`` and ``config.ml`` as inputs and ``tool.exe`` as output. + +Running the Tests +^^^^^^^^^^^^^^^^^ + +Some rules do not produce any output file, but we're still interested in +running their actions. A test is a good example: we want the build process to +exit with an error code if the action fails. In that case, the rule does not +have targets, but we "attach" it to an :term:`alias`, ``runtest`` in this case. +This gives us a way of requesting this rule to be executed. As we are about to +see, rules are executed lazily by asking for their targets to be built, so we +would not be able to execute such rules. + +.. code:: dune + + (rule + (deps tool.exe testdata.txt) + (alias runtest) + (action + (run tool.exe testdata.txt))) + +This rule: + +- reads its dependencies: ``tool.exe`` and ``testdata.txt`` +- writes no targets +- using an action: ``(run tool.exe testdata.txt)`` +- (and it is attached to ``runtest``) + +What to Build +------------- + +Dune can build *files* and *aliases*. These can be found on the command line: + +- ``dune build tool.exe`` will build the ``tool.exe`` file. +- ``dune build @example`` will build the ``example`` alias. +- ``dune build tool.exe @example`` will build both the file ``tool.exe`` and + the ``example`` alias. +- ``dune runtest`` is a shortcut for ``dune build @runtest``: it will build the + ``runtest`` alias. Passing a directory will build all tests in that directory. + Passing the path to a cram test will run that test individually. +- ``dune build`` is a shortcut for ``dune build @@default``: it will build the + default alias in the current directory (by default the ``all`` alias). + +In other words, each ``dune build`` or ``dune runtest`` command always +corresponds to a list of files and aliases to build. + +.. seealso:: :doc:`Reference information on aliases` + +How Dune Interprets Rules +------------------------- + +We have now seen that Dune sets up rules for a project, and that every build +command has a list of files and aliases that we are asking to build. + +Now let's see how this request is processed: + +- to build a file, Dune will first check if it is in the source tree. In that + case, there is nothing to do. Otherwise, it will check if it is the + target of a rule. In that case, it will execute this rule. (Dune will raise + an error in other cases: if the file is both in the source tree and the + target of a rule, or if it is neither) +- to build an alias, Dune will execute all the rules that are attached to this + alias. +- to execute a rule, Dune will first build all the dependencies (files or + aliases) of this rule. Then it will execute the action attached to the rule. + When Dune is about to execute an action, it checks (in various caches) if it + executed it before on the same set of dependencies, and, if yes, it can skip + executing it and reuse the previous result. + +In the case of our example, if we call ``dune runtest``, Dune will consider all +rules attached to the ``runtest`` alias. In this case it is just the +integration test rule. It needs to build its dependencies, ``tool.exe`` and +``testdata.txt``. The latter is present in the source tree. +However, ``tool.exe`` is the target of the linking rule defined by the +``(executable)`` stanza. This rule requires ``main.cmx`` and ``config.cmx``. +``main.cmx`` is the target of the compilation rule for the ``Main`` module, +which depends on ``main.ml``. This file is in the source tree, so let's copy it +under ``_build``. This rule has all its dependencies available, so we can run +its action, which writes ``main.cmx``. Getting back to the dependencies of +``tool.exe``, ``config.cmx`` is the target of the linking rule of the +``Config`` module. This rule has ``config.ml`` has a dependency. This file is +itself the target of the configuration module rule, which lists ``config.json`` +and ``convert/json2ml.exe``. The first is available in the source tree and to +simplify, let's assume that the second one has been built. This action has all +its dependencies available, so we can execute its action to produce its target, +``config.ml``. Now the module compilation rule for ``Config`` can be executed, +producing ``config.cmx``; and in turn the linking rule can be executed, +producing ``tool.exe``. Finally, ``tool.exe`` can be executed with +``testdata.txt`` as its argument. + +In a nutshell: we recursively copied all the dependencies of the test rule, and +executed the rules in the correct order. + +This is a "cold build", where there were no previous build artifacts. Note that +if we change only part of the project (say the ``main.ml`` file), only a small +number of rules will be evaluated, the ones that depend on ``main.ml``. + +Conclusion +---------- + +Dune's underlying model is based on rules. Stanzas are high-level constructs +that can generate multiple rules, that are not always visible. + +To build a target, Dune looks for the rule that produces that target and makes +its way back to source files. + +Rules define a directed acyclic graph which models dependency relations between +files. Most of the rules in that graph may be executed for a cold build, but +just the minimum will be executed for an incremental build. diff --git a/unikernel/duniverse/dune_/doc/explanation/ocaml-ecosystem.rst b/unikernel/duniverse/dune_/doc/explanation/ocaml-ecosystem.rst new file mode 100644 index 00000000..950f4913 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/ocaml-ecosystem.rst @@ -0,0 +1,94 @@ +The OCaml Ecosystem +=================== + +The OCaml ecosystem is not monolithic: the compiler and tools are not +maintained by the same entities. As such, it can be difficult to understand the +history and roles of the various pieces of this ecosystem. The goal of this +page is to give a quick overview of the situation and the role that Dune +plays in it. + +The OCaml Compiler Distribution: Compiling and Linking +------------------------------------------------------ + +The `OCaml compiler distribution `_ contains +"core" tools including the compilers (``ocamlc`` and ``ocamlopt``). They turn +source files (with extensions ``.ml`` and ``.mli``) into executables and +libraries. Dependencies between compiled objects only exist at the module +level, so this is a low-level tool. + +Findlib: Metadata for Libraries +------------------------------- + +Findlib_ is a tool that defines the concept of library, so that libraries can +depend on other libraries on top of the notion of module. Definitions of +libraries, and other pieces of metadata, are stored in ``META`` files. + +Findlib ships an executable named ``ocamlfind`` that can be used as a wrapper +on top of the compilers to perform tasks such as producing an executable from +compiled object files and external libraries. + +.. _findlib: https://github.com/ocaml/ocamlfind + +Opam: a Collection of Software Projects +--------------------------------------- + +Opam is a package manager. It is used to determine which packages are +necessary, and how to fetch and build them. Packages can contain libraries, +executables, and other kinds of files. + +The notion of version is specific to opam. If your project uses a function +named ``Png.read_file`` but this function has been added only in version +``1.2.0`` of that package, opam needs to know about it. + +Opam manages collections of installed packages, called switches. Using your +project's dependencies (names and version constraints), it is able to create a +switch that you'll be using to develop your project. + +Public definitions of packages are available in a database called +``opam-repository`` which is maintained as a public Git repository. Publishing a +package on opam (to make sure that external users can use your project) +consists in adding its definition to ``opam-repository``. + +Dune: Giving Structure to Your Source Tree +------------------------------------------ + +Dune is a build system. It is used to orchestrate the compilation of source +files into executables and libraries. + +Assuming you have a development switch set up, you communicate to Dune about how your +project is organized in terms of executables, libraries, and tests. It is then able to assemble the source files of your projects, with the dependencies installed in an opam switch, to create compiled assets for your project. + +How Dune Integrates With the Ecosystem +-------------------------------------- + +Dune is designed to integrate with the tools mentioned above: + +- By knowing how the OCaml compilers operate, it knows which build commands should be + re-executed if some source files change. +- It outputs metadata like dependency information into ``META`` files that + Findlib is able to make use of. This ensures that even if a project does not use Dune, it + can use a library that has been produced by Dune. Conversely, it can read + these files to determine dependency information for dependencies that have + not been produced by Dune. +- It is able to generate opam files with filenames consistent with how opam + looks for them. The generated files use build commands that make use of the + :doc:`/reference/aliases/install` and ``@runtest`` :term:`aliases ` so + that the Dune abstractions map to the opam ones. + +Dune is Opinionated +------------------- + +As described above, the OCaml ecosystem does not have a centralized toolchain. +Units such as modules, libraries, and packages operate at different levels, and +the relation between these can be confusing to users. + +Dune tries to simplify the picture by reducing the difference between these +objects: + +- By default, a library will only expose a single top-level module named after + the library (this is called a wrapped library). +- A library can only be installed in the package of the same name. This means + that the names found in ``dune-project`` and ``opam`` files (package names) + are consistent with the names found in ``dune`` files (library names). More + precisely, libraries ``foo``, ``foo.bar`` and ``foo.baz`` are part of the + ``foo`` package. diff --git a/unikernel/duniverse/dune_/doc/explanation/opam-integration.rst b/unikernel/duniverse/dune_/doc/explanation/opam-integration.rst new file mode 100644 index 00000000..841c460b --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/opam-integration.rst @@ -0,0 +1,119 @@ +How Dune integrates with opam +============================= + +.. highlight:: opam + +When instructed to do so (see :doc:`../howto/opam-file-generation`), Dune generates opam files with the following instructions:: + + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + +Let's see what this means in detail. + +Substitution +------------ + +The first step is to call ``dune subst``, but only if the ``{dev}`` opam +variable is set. This variable is only set when the package is pinned. +This means that :ref:`dune-subst` does not run for released versions, but it +does for development versions. + +This is not a problem since released versions should have a ``(version)`` field +set in ``dune-project``, and :term:`placeholder substitution` should have been +performed. `dune-release`_ takes care of these steps. + +.. _dune-release: https://github.com/tarides/dune-release + +Opam Variables +-------------- + +In the second command line, ``name`` is a variable that evaluates to the name +of the package being built, and ``jobs`` is a variable that corresponds to the +number of commands to run in parallel. + +What ``-p`` Means +----------------- + +The ``-p`` flag, shorthand for ``--release-of-packages``, is Dune's public interface to set up the options for an opam build. The exact semantics may change, but as of Dune 3.8 it is equivalent to the combination of: + +- ``--root .``: set the :term:`root` to prevent Dune from :ref:`looking it up `. +- ``--only-packages name``: ignore packages other than ``name`` defined in the project. +- ``--profile release``: set the :term:`build profile` to ``release``. In particular, this ensures that warnings are not fatal. +- ``--ignore-promoted-rules``: silently ignores all rules with ``(mode promote)``. +- ``--default-target @install``: make sure that ``dune build`` with no target argument builds ``@install``, not ``@@default`` (this is not used in the opam integration since an explicit target is passed) +- ``--no-config``: do not load the configuration file in the user's home directory. +- ``--always-show-command-line``: ensures that the programs executed by Dune end up in the opam logs. +- ``--promote-install-files``: ensures that ``*.install`` files are present in the source tree after the build. +- ``--require-dune-project-file``: fail if ``dune-project`` is not present. In some previous Dune versions, ``dune-project`` could be generated when it is not present. This is not desirable with opam since the version the package has been prepared with is not known. + +The Targets We're Building +-------------------------- + +The targets are specified as:: + + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + +The ``{with- }`` syntax is an opam filter. It means that the string before is +present or not depending on the opam variable. These variables, in turn, are set depending on the opam configuration. + +Concretely, in the next table, if the opam command on the left is executed, the Dune target on the right will be built: + +.. list-table:: + :header-rows: 1 + + * - opam command + - Dune target + * - ``opam install pkg`` + - ``@install`` + * - ``opam install pkg --with-test`` + - ``@install @runtest`` + * - ``opam install pkg --with-test --with-doc`` + - ``@install @runtest @doc`` + +This filtering mechanism is also used to declare dependencies. +If a package is using ``lwt`` and ``alcotest``, but the latter only in its test +suite, its ``depends:`` field is:: + + "lwt" + "alcotest" {with-test} + +This is expanded to just ``"lwt"`` in ``opam install pkg``, but to ``"lwt" +"alcotest"`` in ``opam install pkg --with-test``. + +The meaning of these :term:`aliases ` is the following: + +- :doc:`/reference/aliases/install` depends on all the ``*.install`` files in + the project. In turn, these depend on all the installable files (libraries and + executables with a public name and files that are manually installed through + ``(install)`` stanzas). +- :doc:`/reference/aliases/runtest` is the alias to which all tests are + attached, including ``(test)`` stanzas. ``dune build @runtest`` is equivalent + to ``dune runtest``. +- :doc:`/reference/aliases/doc` executes ``odoc`` to create HTML docs under + ``_build``. + +What Opam Expects From Dune +--------------------------- + +Given this ``build:`` lines and the fact that there is no ``install:`` line, +what happens is the following: + +- Opam executes ``dune subst``, if the package is being pinned. +- Opam executes the build instruction, usually just ``dune build -p pkg @install`` +- This Dune command builds all the installable files and creates a ``pkg.install`` file. +- This file contains the paths to built files (somewhere in the ``_build`` directory) and the opam sections they should be installed in. +- Opam interprets this file and copies the built files to their destination. The install file is also used as a manifest of which files belong to which package, which is used when uninstalling the package. diff --git a/unikernel/duniverse/dune_/doc/explanation/package-management.md b/unikernel/duniverse/dune_/doc/explanation/package-management.md new file mode 100644 index 00000000..b9f8a1f1 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/package-management.md @@ -0,0 +1,234 @@ +# How Package Management Works + +This document explains how Dune's package management works under the hood. It +requires a bit of familiarity with how opam repositories work and how Dune +builds packages. Thus it is aimed at people who want to understand how the +feature works, not how it is used. + +For a tour on how to apply package management to a project, refer to the +{doc}`/tutorials/dune-package-management/index` tutorial. + +## Motivation + +A core part of modern programming is using existing code to save time. The +OCaml package ecosystem has quite a long history with many projects building +upon each other over many years. A significant step forward was the creation of +the OCaml Package Manager, opam, along with the establishment of a public +package repository which made it a lot more feasible to share code between +people and projects. + +Over time, best practices have evolved, and while opam has incorporated some +changes, it couldn't adopt all the modern workflows due to its existing user +base and constraints. + +Thus the Dune Package Management has been designed with a few core goals in +mind: + +* No global state visible to users, everything is local to projects +* Package management is configured through files (`dune-project` and optionally + `dune-workspace`) +* Repositories are automatically kept up to date unless explicitly configured + to use specific versions +* Builds can only access packages they have declared dependencies on +* Reproducible builds through lockfiles + +Dune plays well with the existing OCaml ecosystem and does not introduce a new +type of packages. Rather, it uses the same package repository and Dune packages +stay installable with opam. + +## Package Management in a Project + +This section describes what happens in a Dune project using the package +management feature. + +## Dependency Selection + +The first step is to determine which packages need to be installed. +Traditionally this has been defined in the `depends` field of a project's opam +file(s). + +Since version 1.10 Dune has supported {doc}`opam file generation +` by specifying the package dependencies in the +`dune-project`. + +The package management feature uses the same metadata, as Dune will determine +the list of packages to install from the `depends` field in the `dune-project` +file. This allows projects to completely omit generation of `.opam` files, as +long as they use Dune for package management. Thus all dependencies on OCaml +packages are only declared in one single file. + +To maintain compatibility with a large number of existing projects, Dune +continues to support `.opam` files. While it is recommended to declare the +dependencies directly in the `dune-project` file, it is not mandatory to do so. +Dune will fall back to reading dependencies from `.opam` files when the package +is not defined in `dune-project`. + + +## Locking + +Given the list of the project's dependencies and their version +constraints, the next steps are: + +1. Find the transitive dependencies and figure out a version for each + dependency that satisfies the constraints +2. For each dependency, download it, build it, and make it available to the + project + +In opam, `opam install` does both of these. + +In Dune, these are separate steps: the first one is `dune pkg lock`, and the +second one happens implicitly as part of [building](#building). + +The idea of doing the first step and recording it for later is popular in other +programming language package managers like NPM and is usually called locking. +Creating a lock file ensures that the dependencies to be installed are +always the same - unless that lock file is updated of course. + +:::{note} +`opam` also supports creating lock files. However, these are not as central to +the opam workflow as they are in the case of package management in Dune, which +always requires a set of locked packages. +::: + +In the most general sense, a lock file is just a set of specific packages +and their versions to be installed. + +Instead of a lock file, Dune writes this information to a directory (the "lock +directory") with files that describe the dependencies. It includes the +package's name and version. Unlike many other package managers, the files +include a lot of other information as well, such as the location of the source +archives to download (since there is no central location for all archives), the +build instructions (since each package can use its own way of building), and +additional metadata like the system packages it depends upon. + +The information is stored in a directory (`dune.lock` by default) as separate +files, to reduce potential merge conflicts and simplify code review. Storing +additional files like patches is also simpler this way. + +### Package Repository Management + +To find a valid solution that allows a project to be built, it is necessary to +know what packages exist, what versions of these packages exist, and what other +packages these depend on, etc. + +In opam, this information is tracked in a central repository called +[`opam-repository`](https://github.com/ocaml/opam-repository), which contains +all the metadata for published packages. + +It is managed using Git; opam typically uses a snapshot to find the +dependencies when searching for a solution that satisfies the constraints. + +Likewise, Dune uses the same repository; however, instead of snapshots of the +contents, it uses the Git repository directly. + +:::{note} +Dune maintains a shared internal cache containing all Git repositories that +projects use. This way updates and checkouts are very fast because only new +revisions have to be retrieved. The downside is that to be included in the +cache, all the Git repos have to be cloned first which depending on the size of +the repositories can take a bit of time. +::: + +On every call to `dune pkg lock`, Dune will update the metadata repository +first (hence why efficiently updating that repository matters). This means that +each `dune pkg lock` will use the newest set of packages available. + +However, it is also possible to declare specific revisions of the repositories, +to get a reproducible solution. Due to using Git, any previous revision of the +repository can be used by specifying a commit hash. + +Dune uses two repositories by default: + +* `upstream` refers to the default branch of `opam-repository`, which contains + all the publicly released packages. +* `overlay` refers to + [opam-overlay](https://github.com/ocaml-dune/opam-overlays), which defines + packages patched to work with package management. The long-term goal is to + have as few packages as possible in this repository as more and more packages + work within Dune Package Management upstream. Check the + [compatibility](#compatibility) section for details. + +### Solving + +After Dune has read the constraints and loaded set of candidate packages, it is +necessary to determine which packages and versions should be selected for the +package lock. + +To do so, Dune uses +[`opam-0install-solver`](https://github.com/ocaml-opam/opam-0install-solver), +which is a variant of the [`0install`](https://github.com/0install/0install) +solver to find solutions for opam packages. + +Contrary to opam, the Dune solver always starts from a blank slate; it assumes +nothing is installed and everything needs to be installed. This has the +advantage that solving is now simpler, and previous solver solutions don't +interfere with the current one. Thus, given the same inputs, it should always +come up with the same result; no state is held between the solver runs. + +This can lead to more packages being installed (as opam won't install new +package versions by default if the existing versions satisfy the constraints), +but it avoids interference from already installed packages that lead to +potentially different solutions. + +After solving is done, the solution gets written into the lock directory with +all the metadata necessary to build and install the packages. From this point +on, there is no need to access the package metadata repositories. + +:::{note} +Solving and locking does not download the package sources. These are downloaded +in the build step. +::: + +(building)= +## Building + +When building, Dune will read the information from the lock directory and set +up rules for the packages. Check {doc}`/explanation/mental-model` for details +about rules. + +The rules that the package management sets up include: + +* Fetch rules to download and unpack the source archives, and also download any +additional sources such as patches +* Build rules to execute the build instructions stored in the lock directory +* Install rules to put the artifacts that were built into the appropriate + Dune-managed folders + +Creating these processes as rules mean that they will only be executed on +demand, so if the project has already downloaded the sources, it does not need +to download them again. Likewise, if packages are installed, they stay +installed. + +The results of the rules are stored in the project's `_build` directory and +managed automatically by Dune. Thus, when cleaning the build directory, the +installed packages are cleaned as well and will be reinstalled at the next +build. + +(compatibility)= +## Packaging for Dune Compatibility + +Dune can build and install most packages as dependencies, even if they are not +built with Dune themselves. Dune will execute the build instructions from the +lock directory, very similar to opam. + +However, packages must adhere to certain rules to be compatible with Dune. + +The most important one is that the packages must not use absolute paths to +refer to files. That means they cannot read the path they are being built or +installed in and expect this path to remain the same. Dune builds packages in a +sandbox location, and after the build has finished, it moves the files to the +actual destination. + +:::{note} +Unlike opam, Dune at the moment does not wrap the build in sandboxing tools +like [Bubblewrap](https://github.com/containers/bubblewrap). +::: + +To comply with these restrictions the usual solution is to use relative paths, +as Dune guarantees that packages installed into different sections are +installed in a way where their relative location stays the same. + +The `overlay` repository exists specifically to make currently non-compliant +packages compatible with Dune's package management. It does so by supplying +releases of packages where the current upstream releases don't support Dune +package management yet. diff --git a/unikernel/duniverse/dune_/doc/explanation/preprocessing.rst b/unikernel/duniverse/dune_/doc/explanation/preprocessing.rst new file mode 100644 index 00000000..2447761f --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/preprocessing.rst @@ -0,0 +1,55 @@ +How Preprocessing Works +======================= + +Preprocessing consists in transforming source code before it is compiled. The +goal of this document is to explain how this works in Dune. + +Dune supports two separate ways of applying preprocessors, the "classic pipeline" (used +with ``(staged_pps)``), and the "fast pipeline" (used for all other +:doc:`preprocessing specifications <../reference/preprocessing-spec>` including +``(pps)``). + +The OCaml compilers provide options for specifying a preprocessing step. The +``-pp`` option is used to invoke a textual preprocessor (something that reads +text and returns text). The ``-ppx`` option is used to invoke a `ppx rewriter` +(a function that takes an AST and outputs an AST). + +This is the "classic pipeline": preprocessing is part of the compilation +itself. This is simple, but has a problem: in order to compute the dependencies +of a module, it is necessary to pass the same ``-pp`` or ``-ppx`` option to +``ocamldep``. + +The classic pipeline has the following steps: + +- preprocessing (as part of ``ocamldep``) +- dependency analysis +- preprocessing (as part of compilation) +- compilation + +Dune supports a "fast pipeline" where the preprocessor is invoked separately +from the compiler and its output is saved. Afterwards the preprocessed code is +compiled directly. + +The fast pipeline has the following steps: + +- preprocessing +- dependency analysis +- compilation + +It has several advantages: it only invokes the preprocessor once per file, and +the preprocessed code is reused between dependency analysis and different kinds +of compilation. Also, when several preprocessors use ``ppxlib``, they can be +combined in a preprocessing program that traverses the AST only once. + +However, some specific code generators or preprocessors require direct +access to the compilation artefacts of their dependencies. Therefore they +need to be used with the classic pipeline, even if it is slower. Note that a +PPX is able to know if it was called as part of ``ocamldep -ppx`` or ``ocamlopt +-ppx``, so it can act differently in each phase. + +Dune chooses which pipeline to use depending on the +provided :doc:`../reference/preprocessing-spec`. It will select the fast pipeline, +unless ``(staged_pps)`` is used. In that case, the classic pipeline is used. + +In the case of the fast pipeline, a single executable is built and accepts +arguments for all preprocessors. diff --git a/unikernel/duniverse/dune_/doc/explanation/scopes.rst b/unikernel/duniverse/dune_/doc/explanation/scopes.rst new file mode 100644 index 00000000..de8ce53d --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/scopes.rst @@ -0,0 +1,43 @@ +Dune Projects and Workspaces +============================ + +Whenever Dune builds anything, it does so at the level of a *Dune workspace*. A +Dune workspace is a set of Dune projects. A typical workspace consists of a +single Dune project. + +A *Dune project* is defined by the presence of a +:doc:`/reference/dune-project/index` file. Each Dune project extends over the +file tree rooted at the directory containing the +:doc:`/reference/dune-project/index` file, excluding any nested Dune projects. + +Dune determines the root of the current workspace by finding the topmost +ancestor containing a :doc:`/reference/dune-project/index` file or by the +presence of a :doc:`/reference/dune-workspace/index` file (see +:ref:`finding-root` and :ref:`forcing-root` for details). + +Different Dune projects within the same Dune workspace are independent of each +other and no settings are shared between them, even if they are nested within +each other. + +Settings in :doc:`/reference/dune-workspace/index`, on the other hand, are +inherited by all Dune projects in the workspace. Some settings (those that make +sense for all projects) can be specified both in +:doc:`/reference/dune-project/index` and :doc:`/reference/dune-workspace/index` +files, with the former taking precedence. Note that all +:doc:`/reference/dune-workspace/index` files other than the one specifying the +root of the workspace are ignored. + +Within a Dune project, :doc:`/reference/dune/index` files are used to define all +objects of interest for Dune: libraries, executables, tests, etc. There are +typically many :doc:`/reference/dune/index` files in a Dune project: one per +directory, unless the directory does not contain anything relevant to Dune. In +each :doc:`/reference/dune/index` file, references are resolved relative to the +directory containing the file. + +Note that there are specific stanzas and actions that may result in exceptions +to some of the rules stated in the previous paragraph. See, for example, the +:doc:`/reference/dune/subdir` and :doc:`/reference/dune/include_subdirs` +stanzas, as well as the :doc:`/reference/actions/chdir` action. + +Finally, note that only public items (public libraries, public executables) of a +Dune project are visible to other Dune projects within the same Dune workspace. diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/cli.rst b/unikernel/duniverse/dune_/doc/explanation/tour/cli.rst new file mode 100644 index 00000000..e5766e5c --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/cli.rst @@ -0,0 +1,29 @@ +Command-Line Interface +---------------------- + +The command-line interface is defined using `cmdliner +`_. One thing to note is that we use +binding operators to compose terms: + +`bin/print_rules.ml `_ + .. code-block:: ocaml + :linenos: + :lineno-start: 174 + + let+ builder = Common.Builder.term + and+ out = + Arg.( + value + & opt (some string) None + & info [ "o" ] ~docv:"FILE" ~doc:"Output to a file instead of stdout.") + and+ recursive = + Arg.( + value + & flag + & info + [ "r"; "recursive" ] + ~doc: + "Print all rules needed to build the transitive dependencies of the given \ + targets.") + and+ syntax = Syntax.term + and+ targets = Arg.(value & pos_all dep [] & Arg.info [] ~docv:"TARGET") in diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/decoding.rst b/unikernel/duniverse/dune_/doc/explanation/tour/decoding.rst new file mode 100644 index 00000000..08e2ec6e --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/decoding.rst @@ -0,0 +1,69 @@ +Parsing of Dune Files +--------------------- + +Parsing ``dune`` files is done in two steps: + +- They are parsed as S-expressions using :file:`src/dune_sexp/parser.mli`; +- Then they are decoded using :file:`src/dune_sexp/decoder.mli`. The result of + this decoding step is added to an extensible variant using a mechanism in + :file:`src/dune_lang/stanza.mli`. + +Instead of writing a parser or using pattern matching, we define decoders, +which are abstract values of type ``'a Decoder.t`` (returning a value of type +``'a``). These decoders are assembled using combinators. For example, we can +use simple decoders to write a decoder for a record type. This decoder +abstraction is monadic, but the applicative subset is sufficient for most +decoders. + +As an example, here is how ``(copy_files)`` is parsed: + +`src/dune_rules/stanzas/copy_files.ml `_ + .. code-block:: ocaml + :linenos: + :lineno-start: 31 + + let long_form = + let check = Dune_lang.Syntax.since Stanza.syntax (2, 7) in + let+ alias = field_o "alias" (check >>> Dune_lang.Alias.decode) + and+ mode = field "mode" ~default:Rule.Mode.Standard (check >>> Rule_mode_decoder.decode) + and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (2, 8)) () + and+ files = field "files" (check >>> String_with_vars.decode) + and+ only_sources = + field_o + "only_sources" + (Dune_lang.Syntax.since Stanza.syntax (3, 14) >>> decode_only_sources) + and+ syntax_version = Dune_lang.Syntax.get_exn Stanza.syntax in + let only_sources = Option.value only_sources ~default:Blang.false_ in + { add_line_directive = false + ; alias + ; mode + ; enabled_if + ; files + ; only_sources + ; syntax_version + } + +The fields are queried individually, and a record is built using all the +intermediate results. This will automatically take care of generating "unknown +field X," "duplicate field X," and similar error messages. + +Another interesting thing to note is that the fields are not decoded directly, +but use the following pattern: + +.. code:: ocaml + + Syntax.since Stanza.syntax (x, y) >>> decoder + +Let's unpack this: ``(>>>)`` will run a ``unit Decoder.t`` on the input before +passing the input to an actual decoder. The first decoder can be used to +implement a check and trigger an error in some cases. + +Here, it is used for versioning. For example the ``(copy_files)`` stanza +started supporting ``(enabled_if``) in version 2.8. Decoding this field is +protected by this ``since`` call: it means that if the language version in +:doc:`/reference/dune-project/index` file is greater than 2.8. In particular, +this ensures that the project can not be built with Dune versions older than +``2.8.0``. + +Once decoding succeeds, various stanzas are turned into various types defined +in :file:`src/dune_rules/stanzas/`. diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/engine.rst b/unikernel/duniverse/dune_/doc/explanation/tour/engine.rst new file mode 100644 index 00000000..b4dca0b9 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/engine.rst @@ -0,0 +1,15 @@ +The Engine +========== + +The engine is the core, reusable part of Dune. It contains all the composable +primitives that make it a build system. + +The fact that it is split from the :doc:`rules part ` makes it +possible to create a different build system using this library. For example, +Jane Street internally uses a build system with this engine as a backend, but a +different frontend and CLI. + +In the context of Dune, the engine keeps track of the various directories and +the rules in them and is able to build files using them. In addition, it takes +care of the various caches that Dune uses, such as the one present in the +``_build`` directory, the :doc:`shared cache `, etc. diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/index.rst b/unikernel/duniverse/dune_/doc/explanation/tour/index.rst new file mode 100644 index 00000000..f751b9af --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/index.rst @@ -0,0 +1,34 @@ +A Tour of the Dune Codebase +=========================== + +.. note:: + + This document is based on Dune 3.15.0, whose source can be browsed `here + `_. The links in this tour point + to this version, but will not reflect how this works in other versions of + Dune. + +Let's start with a very high level tour of how ``dune build`` operates. + +As explained in :doc:`/explanation/mental-model`, ``dune build`` will interpret +the targets listed on the command line, interpret the ``dune`` files in the +workspace as rules, and execute the rules relevant to the requested targets. + +These steps correspond to areas of the Dune codebase: + +- the command-line interface is defined in :file:`bin/`; +- the ``dune`` files are interpreted using a library defined in + :file:`src/dune_rules/`; +- they are registered into an engine in :file:`src/dune_engine/`. + +Next, we will go deeper into these areas. + +.. toctree:: + + cli + decoding + rule-generation + engine + libraries + vendor + tests diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/libraries.rst b/unikernel/duniverse/dune_/doc/explanation/tour/libraries.rst new file mode 100644 index 00000000..09e82300 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/libraries.rst @@ -0,0 +1,12 @@ +Libraries +========= + +Dune, as a package, is primarily an executable, but its source tree embeds a +few public libraries. These are developed in :file:`otherlibs/`. + +Some of these have a special link to Dune, such as ``dune-build-info`` or +``dune-site``. Others are just helper libraries that we develop as part of +Dune, but they have a strong relation to the Dune internals, like ``dyn`` or +``xdg``. + +.. seealso:: :doc:`/dune-libs` diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/rule-generation.rst b/unikernel/duniverse/dune_/doc/explanation/tour/rule-generation.rst new file mode 100644 index 00000000..9eadc9d3 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/rule-generation.rst @@ -0,0 +1,168 @@ +Rule Generation +--------------- + +Using these parsed stanzas, the next step is to generate rules. This work +starts in :file:`src/dune_rules/gen_rules.ml`, which dispatches to various +modules in :file:`src/dune_rules/`. + +Rules are registered on the build engine using the following function from the +``Super_context`` module: + +.. code-block:: ocaml + + val add_rule + : t + -> ?mode:Rule.Mode.t + -> ?loc:Loc.t + -> dir:Path.Build.t + -> Action.Full.t Action_builder.With_targets.t + -> unit Memo.t + +A value of ``Super_context.t`` represents an OCaml toolchain (``Context.t``) as +well as various capabilities to expand variables and refer to :doc:`(env) +stanzas `. The last, unlabelled argument corresponds to +the fully annotated action. We'll go through its type below. + +The modules in :file:`src/dune_rules` often expose a function ``gen_rules`` +taking a parsed stanza, a ``Super_context.t`` value, a directory name (and +other arguments), and returning ``unit Memo.t``. + +.. note:: + + The ``Memo`` module is central to how Dune operates. It is a monadic + memoization framework that allows two things: + + - Sharing and caching expensive internal computations, such as computing the + list of libraries Dune knows about, or computing the list of flags that + should be used to compile a given module. + - Incremental recomputation of this cached data. ``Memo`` tracks dependencies + between memoized values and will only recompute the necessary ones when an + input changes. This is a mini in-memory build system that works like a + spreadsheet. It is essential to the watch mode. + +An example of rule is the :doc:`/reference/dune/mdx` stanza, implemented in +:file:`src/dune_rules/mdx.ml`. There are several steps in setting up rules for +a ``(mdx)`` stanza: + +- How to run ``ocaml-mdx deps`` on the input file to produce a ``.mdx.deps`` +- Run ``ocaml-mdx dune-gen`` to produce a ``mdx_gen.ml-gen`` OCaml source file +- Compile this executable +- Run this executable to produce a ``.corrected`` file +- Register a :doc:`/reference/actions/diff` action between the ``.corrected`` file + and the original file + +Let's walk through these rules. + +The first one is about producing a ``.mdx.deps`` file. It is a simple call to +``Super_context.add_rule``. + +.. code-block:: ocaml + :linenos: + :lineno-start: 312 + + let* () = Super_context.add_rule sctx ~loc ~dir (Deps.rule ~dir ~mdx_prog files) + +``Deps.rule`` is defined in a helper function: + +.. code-block:: ocaml + :linenos: + :lineno-start: 77 + + let rule ~dir ~mdx_prog (files : Files.t) = + Command.run_dyn_prog + ~dir:(Path.build dir) + mdx_prog + ~stdout_to:files.deps + [ Command.Args.A "deps"; Lazy.force color_always; Dep (Path.build files.Files.src) ] + +This is a rule made by just running a command, here ``mdx_prog`` (a resolved +path to ``ocaml-mdx``, meaning it can point to a binary in ``PATH`` or a built +version in the current workspace). Its arguments are a domain-specific language +defined in :file:`src/dune_rules/command.mli` where ``A`` refers to a plain +string, and ``Dep`` refers to a string that should be interpreted as a dependency. +Between that, and the ``~stdout_to`` parameter, it is enough for Dune to know +about the rule's dependencies (what it will read) and its target (what it will +produce). + +The second rule, which generates ``mdx_gen.ml-gen``, is similar. It is also done +by calling ``Command.run_dyn_prog``. + +The third rule, to build the executable, calls ``Exe.build_and_link`` that is a +helper function. + +Let's observe how the fourth rule (that calls the generated executable) is set +up. + +.. code-block:: ocaml + + let mdx_action ~loc:_ = + let open Action_builder.With_targets.O in + let mdx_input_dependencies = (* ... *) in + let executable, command_line = (* ... *) in + let deps, sandbox = (* ... *) in + let+ action = + Action_builder.with_no_targets deps + >>> Action_builder.with_no_targets + (Action_builder.env_var "MDX_RUN_NON_DETERMINISTIC") + >>> Action_builder.with_no_targets + (Action_builder.map mdx_input_dependencies ~f:(fun d -> (), d) + |> Action_builder.dyn_deps) + >>> Command.run_dyn_prog + ~dir:(Path.build dir) + ~stdout_to:files.corrected + executable + command_line + and+ locks = + Expander.expand_locks expander stanza.locks |> Action_builder.with_no_targets + in + Action.Full.add_locks locks action |> Action.Full.add_sandbox sandbox + in + Super_context.add_rule sctx ~loc ~dir (mdx_action ~loc) + +Here, the ``mdx_action`` that is set up is not just a single +``Command.run_dyn_prog`` call. It is assembled using combinators from +``Action_builder.With_targets``. This is another monad used in Dune. It +corresponds to what can happen at build time, like running commands or creating +files, or more complex actions such as reading a file that needs to be built by +another rule. It is also used to track dependencies and targets. The "thing" +that we register to the Dune engine using ``Super_context.add_rule`` has type +``Action.Full.t Action_builder.With_targets.t``. + +.. note:: + + This is different from ``Memo``, which corresponds to what happens within + Dune itself. But it is also possible to use ``Memo`` from an + ``Action_builder`` context. In that sense, ``Action_builder`` is more + powerful: at execution time, ``Action_builder`` will manage what happens in + the ``_build`` directory, while ``Memo`` is only concerned with what happens + in memory. + +Finally, to register the correction, the technique is to attach the +:doc:`/reference/actions/diff` action to the :doc:`/reference/aliases/runtest` +alias (a collection of rules) using this call: + +.. code-block:: ocaml + :linenos: + :lineno-start: 405 + + (* Attach the diff action to the @runtest for the src and corrected files *) + Files.diff_action files + |> Super_context.add_alias_action sctx (Alias.make Alias0.runtest ~dir) ~loc ~dir + +Where ``Files.diff_action`` is defined as: + +.. code-block:: ocaml + :linenos: + :lineno-start: 33 + + let diff_action { src; corrected; deps = _ } = + let src = Path.build src in + let open Action_builder.O in + let+ () = Action_builder.path src + and+ () = Action_builder.path (Path.build corrected) in + Action.Full.make (Action.diff ~optional:false src corrected) + ;; + +As explained above, ``Action_builder`` keeps tracks of dependencies, so using +``let+ () = Action_builder.path src`` is a way to declare ``src`` as a +dependency of the current action. diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/tests.rst b/unikernel/duniverse/dune_/doc/explanation/tour/tests.rst new file mode 100644 index 00000000..ced80b6b --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/tests.rst @@ -0,0 +1,33 @@ +Tests +===== + +The :file:`test/` directory contains all the tests for Dune itself. Additionally, +the tests for our :doc:`libraries` are stored in :file:`otherlibs/` next to the +library itself. + +We have 3 kind of tests: + +- Unit tests, in :file:`test/unit-tests` (we have very few of these, usually + preferring other kinds) +- Expect tests, in :file:`test/expect-tests` (using ``ppx_expect``) +- :doc:`Cram tests `, in :file:`test/blackbox-tests/`. This is + our preferred way of testing. + +The actual Cram tests are in :file:`test/expect-tests/test-cases`. There is a +mix of file tests and directory tests. For regression tests, the pattern +``githubNUMBER.t`` is used. + +The ``dune`` file at :file:`test/expect-tests/test-cases/dune` sets up some +metadata for the tests. For example, if a test has an external dependency like +``strace``, a dependency on ``%{bin:strace}`` will prevent the test from even +trying to start. Some tests are also disabled on some configurations using +``(enabled_if)``. + +Finally, some programs available in the Cram tests are defined in +:file:`test/expect-tests/blackbox-tests/utils`. For example, we have `a +dune_cmd program +`_ +that contains reimplementations of common utilities like ``stat``, which do not +have the same output on the different systems we use to test Dune. + +.. seealso:: :doc:`/hacking` diff --git a/unikernel/duniverse/dune_/doc/explanation/tour/vendor.rst b/unikernel/duniverse/dune_/doc/explanation/tour/vendor.rst new file mode 100644 index 00000000..0d832140 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/explanation/tour/vendor.rst @@ -0,0 +1,15 @@ +Vendored Libraries +================== + +As an opam package, Dune has no dependencies. But it uses some existing +libraries by copying, or "vendoring", their source code into the +:file:`vendor/` directory. + +In some cases, the external dependency is extracted from the upstream +repository. In other cases, we carry patches and refer to a fork in the +`ocaml-dune GitHub organization `_. + +The source code in the :file:`vendor/` directory is not meant to be edited +directly. Instead, it is edited in the external repository, and the copy in the +Dune source tree is updated by running an update script, such as +`update-spawn.sh `_. diff --git a/unikernel/duniverse/dune_/doc/exts/cram_lexer.py b/unikernel/duniverse/dune_/doc/exts/cram_lexer.py new file mode 100644 index 00000000..e406eb76 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/exts/cram_lexer.py @@ -0,0 +1,24 @@ +from pygments.lexer import DelegatingLexer, RegexLexer, bygroups, default +from pygments.lexers.shell import BashLexer +from pygments.token import Generic, Other, Comment + + +class CramBaseLexer(RegexLexer): + tokens = { + "root": [ + (r"( \$ )(.*\n)", bygroups(Generic.Prompt, Other.Code), "continuations"), + (r"^ .*\n", Generic.Output), + (r"^.*\n", Comment.Multiline), + ], + "continuations": [ + (r"( > )(.*\n)", bygroups(Generic.Prompt, Other.Code)), + default("#pop"), + ], + } + + +class CramLexer(DelegatingLexer): + name = "cram" + + def __init__(self, **options): + super().__init__(BashLexer, CramBaseLexer, Other.Code, **options) diff --git a/unikernel/duniverse/dune_/doc/exts/dune_lexer.py b/unikernel/duniverse/dune_/doc/exts/dune_lexer.py new file mode 100644 index 00000000..d19eb674 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/exts/dune_lexer.py @@ -0,0 +1,36 @@ +from pygments.token import Comment, Punctuation, Text, Name, String, Generic +from pygments.lexer import RegexLexer + + +def after_paren(r): + return r"(?<=\()(%s)" % r + + +class DuneLexer(RegexLexer): + name = "dune" + + atom = r'[^\s()"]+' + + tokens = { + "root": [ + (r";.*$", Comment.Single), + (r"(\(|\))", Punctuation), + # pforms (%{var} and %{fun:arg} + (r"%{[^}]+}", String.Backtick), + (r":[-\w]+", String.Symbol), + # placeholders like and ... that appear in docs + (r"<[-\w ]+>", Generic.Emph), + (r"\.\.\.", Generic.Emph), + (r'"\\\|', String.Double, "string-multiline"), + (r'"', String, "string"), + # instead of hardcoding "builtin" names, + # highlight the first atom in a list differently + (after_paren(atom), Name.Function), + (atom, Name), + (r"\s+", Text), + ], + "string": [ + (r'(\\\\|\\"|[^"])*"', String, "#pop"), + ], + "string-multiline": [(r"[^\n]*\n", String, "#pop")], + } diff --git a/unikernel/duniverse/dune_/doc/exts/opam_lexer.py b/unikernel/duniverse/dune_/doc/exts/opam_lexer.py new file mode 100644 index 00000000..8387ccaa --- /dev/null +++ b/unikernel/duniverse/dune_/doc/exts/opam_lexer.py @@ -0,0 +1,26 @@ +from pygments.lexer import RegexLexer +from pygments.token import ( + Keyword, + Number, + Punctuation, + String, + Text, + Whitespace, +) + + +ident = r"[-\w]+" + + +class OpamLexer(RegexLexer): + name = "opam" + tokens = { + "root": [ + (r"\d\.\d", Number), + (r"^" + ident + ":", Keyword), + (ident, Text), + (r"[\[\]{}>=]", Punctuation), + (r"\s+", Whitespace), + (r'"[^\"]*"', String), + ] + } diff --git a/unikernel/duniverse/dune_/doc/faq.rst b/unikernel/duniverse/dune_/doc/faq.rst new file mode 100644 index 00000000..8976b163 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/faq.rst @@ -0,0 +1,266 @@ +*** +FAQ +*** + +.. TODO(diataxis) + + This is an odd one - most of these questions are not frequently asked at all. + + Some of these are mini how-to guides, or sections of existing guides. + +Why do many Dune projects contain a ``Makefile``? +================================================= + +Many Dune projects contain a root ``Makefile``. It's often only there for +convenience for the following reasons: + +1. There are many different build systems out there, all with a different CLI. + If you have been hacking for a long time, the one true invocation you know + is ``make && make install``, possibly preceded by ``./configure``. + +2. You often have a few common operations that aren't part of the build, so + ``make `` is a good way to provide them. + +3. ``make`` is shorter to type than ``dune build @install`` + +How to add a configure step to a Dune project? +============================================== + +The with-configure-step_ example shows one way to add a configure step that +preserves composability; i.e., it doesn't require manually running the +``./configure`` script when working on multiple projects simultaneously. + +.. _with-configure-step: https://github.com/ocaml/dune/tree/master/example/with-configure-step.t + +Can I use ``topkg`` with Dune? +============================== + +While it's possible to use the topkg-jbuilder_, it's not recommended. +dune-release_ subsumes ``topkg-jbuilder`` and is specifically tailored to Dune +projects. + + +How do I publish my packages with Dune? +======================================= + +Dune is just a build system and considers publishing outside of its scope. +However, the dune-release_ project is specifically designed for releasing Dune +projects to opam. We recommend using this tool for publishing Dune packages. + +Where can I find some examples of projects using Dune? +====================================================== + +The dune-universe_ repository contains a snapshot of the latest versions of all +opam packages that depend on Dune. Therefore, it's a useful reference to find +different approaches for constructing build rules. + +What is Jenga? +============== + +jenga_ is a build system developed by Jane Street, mainly for internal use. It +was never usable outside of Jane Street, so it's not recommended for general +use. It has no relationship to Dune apart from Dune being the successor to +Jenga externally. Eventually, Dune is expected to replace Jenga internally at +Jane Street as well. + +.. _dune-universe: https://github.com/dune-universe/dune-universe +.. _topkg-jbuilder: https://github.com/samoht/topkg-jbuilder +.. _dune-release: https://github.com/samoht/dune-release +.. _jenga: https://github.com/janestreet/jenga + +How to make warnings non-fatal? +=============================== + +`jbuilder` formerly displayed warnings, but most of them wouldn't stop the +build. However, Dune makes all warnings fatal by default. This can be a +challenge when porting a codebase to Dune. There are two ways to make warnings +non-fatal: + +- The ``jbuilder`` compatibility executable works even with ``dune`` files. You + can use it while some warnings remain and then switch over to the ``dune`` + executable. This is the recommended way to handle the situation. +- You can pass ``--profile release`` to ``dune``. It will set up different + compilation options that usually make sense for release builds, including + making warnings non-fatal. This is done by default when installing packages + from opam. +- You can change the flags used by the ``dev`` profile by adding the following + stanza to a ``dune`` file: + +.. code:: dune + + (env + (dev + (flags (:standard -warn-error -A)))) + +How to turn specific errors into warnings? +========================================== + +Dune is strict about warnings by default in that all warnings are treated as +fatal errors. To change certain errors into warnings for a project, you can add +the following to ``dune-workspace``: + +.. code:: dune + + (env (dev (flags :standard -warn-error -27-32))) + +In this example, the warnings 27 (unused-var-strict) and 32 +(unused-value-declaration) are treated as warnings rather than errors. + +How to display the output of commands as they run? +================================================== + +When Dune runs external commands, it redirects and saves their output, then +displays it when complete. This ensures that there's no interleaving when +writing to the console. + +But this might not be what the you want. For example, when you debug a hanging +build. + +In that case, one can pass ``-j1 --no-buffer`` so the commands are directly +printed on the console (and the parallelism is disabled so the output stays +readable). + +How can I generate an ``mli`` file from an ``ml`` file? +======================================================= + +When a module starts as just an implementation (``.ml`` file), it can be +tedious to define the corresponding interface (``.mli`` file). + +It is possible to use the ``ocaml-print-intf`` program (available on opam +through ``$ opam install ocaml-print-intf``) to generate the right ``mli`` +file: + +.. code:: console + + $ dune exec -- ocaml-print-intf ocaml_print_intf.ml + val root_from_verbose_output : string list -> string + val target_from_verbose_output : string list -> string + val build_cmi : string -> string + val print_intf : string -> unit + val version : unit -> string + val usage : unit -> unit + +The ``ocaml-print-intf`` program has special support for Dune, so it will +automatically understand external dependencies. + +How can I build a single library? +================================= + +You might want to do this when you don't have all the dependencies installed to +compile an entire project, or parts of the project don't build for whatever +reason. Maybe you want to check if your changes compile or produce build +artifacts needed by ``ocaml-lsp-server``. + +Suppose you have a library defined in ``src/foo/dune``: + +.. code:: dune + + (library + (public_name my_library) + ...) + +You can build this library on its own by running the following from the project +root directory: + +.. code:: console + + $ dune build %{cmxa:src/foo/my_library} + +Note that the path (``src/foo`` in the example above) is relative to the current +directory - not the project root. If the library defines a ``name`` distinct from +its ``public_name`` then that can be used interchangeably with the ``public_name`` +in this command. + +Why does ``source_tree`` ignore files and directories when they begin with a "." (period)? +========================================================================================== + +Dune's default behaviour is to ignore files and directories starting with "." +when copying directories with ``source_tree``. This is to avoid accidentally +copying the ``.git`` directory into the ``_build`` directory during a build. + +This is a common source of confusion when interoperating with other libraries +that use hidden directories for configuration, such as Rust. For example +consider this rule which builds a Rust library contained in a subdirectory +foo-rs: + +.. code:: dune + + (rule + (target foo.a) + (deps + (source_tree foo-rs)) + (action + (progn + (chdir + foo-rs + (run cargo build --release)) + (run mv foo-rs/target/release/%{target} %{target})))) + +The build config for the Rust project will be in a directory +``foo-rs/.cargo/config.toml``, and by default the ``.cargo`` directory won't +get copied into the ``_build`` directory and so the Rust project will build +with an incorrect configuration. + +To fix this, create a ``dune`` file at the top level of the Rust project (i.e., +``foo-rs/dune``): + +.. code:: dune + + (dirs :standard .cargo) + +If you're following the standard advice for embedding Rust projects into Dune +projects then you likely already have a ``dune`` project inside your Rust +project that looks like: + +.. code:: dune + + (dirs :standard \ target) + (data_only_dirs vendor) + +In this case you can update it to look like this: + +.. code:: dune + + (dirs :standard .cargo \ target) + (data_only_dirs vendor) + +Why can't I write inline tests in a package without users needing to install ``ppx_inline_test``? +================================================================================================= + +If you came to OCaml from Rust and noticed that Dune has a feature for running +inline tests you might be wondering how to do the OCaml equivalent of: + +.. code:: rust + + // define a private function + fn foo() { ... } + + // test the function right next to its definition + #[test] + fn test_of_foo() { ... } + +That is, writing tests for private functions right next to the definition of +those functions. The :ref:`inline_tests` documentation describes how to do this +using the ``ppx_inline_test`` package; however, if you do this in your package, +then your package must `unconditionally` depend on the ``ppx_inline_test`` +package. Opam has a notion of test-only dependencies (its ``with-test`` flag), +but you cannot use this with ``ppx_inline_test``. The consequence of this is +that anyone depending on your package is also transitively depending on +``ppx_inline_test`` as well as all of its dependencies. + +The reason for this is OCaml code with preprocessor directives (such as those +used for inline tests with ``ppx_inline_test``) is technically not valid OCaml +code until it has been preprocessed. Unlike the cargo build system used for +Rust, Dune does not have a preprocessor built into it. Instead, it relies on +external tools (such as ``ppx_inline_test``) to parse the code and replace any +preprocessor directives with valid OCaml. Dune doesn't know how to parse OCaml +code at all so it can't even remove inline tests from the code in cases where +``ppx_inline_test`` is unavailable. + +The blessed workaround for folks who want to use ``ppx_inline_test`` in their +packages but don't want to add it as a dependency is to create a new +(unreleased) package which contains all the tests. In the original package, +expose all the private APIs you intend to test via public modules named +something foreboding such as ``For_test`` so your users know not to rely on +their contents and then have the test package define tests that call your +"private" APIs through the ``For_test`` modules. diff --git a/unikernel/duniverse/dune_/doc/foreign-code.rst b/unikernel/duniverse/dune_/doc/foreign-code.rst new file mode 100644 index 00000000..41124a57 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/foreign-code.rst @@ -0,0 +1,392 @@ +****************************** +Dealing with Foreign Libraries +****************************** + +.. TODO(diataxis) + + There are various types of content here: + + - how-to guide for adding C stubs to an existing library + - tutorial for ctypes + - reference for ctypes field + +The OCaml programming language can interface with libraries written in foreign +languages such as C. This section explains how to do this with Dune. Note that +it does not cover how to write the C stubs themselves, but this is covered by +the `OCaml manual `_. + +More precisely, this section covers: + +- How to add C/C++ stubs to an OCaml library +- How to pass specific compilation flags for compiling the stubs +- How to build a library with a foreign build system + +In general, Dune has limited support for building source files written in +foreign languages. This support is suitable for most OCaml projects containing +C stubs, but it is too limited for building complex libraries written in C or +other languages. For such cases, Dune can integrate a foreign build system into +a normal Dune build. + +Adding C/C++ Stubs to an OCaml Library +====================================== + +To add C stubs to an OCaml library, simply list the C files without the ``.c`` +extension in the :doc:`(foreign_stubs) ` field. For +instance: + +.. code:: dune + + (library + (name mylib) + (foreign_stubs (language c) (names file1 file2))) + +You can also add C++ stubs to an OCaml library by specifying +``(language cxx)`` instead. + +Dune is currently not flexible regarding the extension of the C/C++ source +files. They have to be ``.c`` for C files and ``.cpp``, ``.cc`` or ``.cxx`` for +C++ files. If you have source files with other extensions and you want to build +them with Dune, you need to rename them first. Alternatively, you can use the +:ref:`foreign build sandboxing ` method described below. + +Header Files +------------ + +C/C++ source files may include header files in the same directory as the C/C++ +source files or in the same directory group when using +:doc:`/reference/dune/include_subdirs`. + +The header files must have the ``.h`` extension. + +Installing Header Files +----------------------- + +It is sometimes desirable to install header files with the library. For that +you have two choices: install them explicitly with an +:doc:`/reference/dune/install` stanza or use the ``install_c_headers`` +field of the :doc:`/reference/dune/library` stanza. This field takes a +list of header files names without the ``.h`` extension. When a library +installs header files, they are made visible to users of the library via the +include search path. + +.. _ctypes-stubgen: + +Stub Generation with Dune Ctypes +================================ + +Beginning in Dune 3.0, it's possible to use the ctypes_ field to generate +bindings for C libraries without writing any C code. + +Note that Dune support for this feature is experimental and is not subject to +backward compatibility guarantees. + +To use Dune ctypes stub generation, you must provide two OCaml modules: a "type +description" module for describing the C library types and constants, and a +"function description" module for describing the C library functions. +Additionally, you must list any C headers and a method for resolving build and +link flags. + +If you're binding a library distributed by your OS, you can use the pkg-config_ +utility to resolve any build and link flags. Alternatively, if you're using a +locally installed library or a vendored library, you can provide the flags +manually. + +The "type description" module must define a functor named ``Types`` with +signature ``Ctypes.TYPE``. The "function description" module must define a +functor named ``Functions`` with signature ``Ctypes.FOREIGN``. + +A Toy Example +------------- + +To begin, you must declare the ``ctypes`` extension in your ``dune-project`` +file: + +.. code:: dune + + (lang dune 3.20) + (using ctypes 0.3) + + +Next, here is a ``dune`` file you can use to define an OCaml program that binds +a C system library called ``libfoo``, which offers ``foo.h`` in a standard +location. + +.. code:: dune + + (executable + (name foo) + (libraries core) + ; ctypes backward compatibility shims warn sometimes; suppress them + (flags (:standard -w -9-27)) + (ctypes + (external_library_name libfoo) + (build_flags_resolver pkg_config) + (headers (include "foo.h")) + (type_description + (instance Types) + (functor Type_description)) + (function_description + (concurrency unlocked) + (instance Functions) + (functor Function_description)) + (generated_types Types_generated) + (generated_entry_point C))) + +This field will introduce a module named ``C`` into your project, with the +sub-modules ``Types`` and ``Functions`` that will have your fully-bound C +types, constants, and functions. + +Given ``libfoo`` with the C header file ``foo.h``: + +.. code:: c + + #define FOO_VERSION 1 + + int foo_init(void); + + int foo_fnubar(char *); + + void foo_exit(void); + +Your example ``type_description.ml`` file is: + +.. code:: ocaml + + open Ctypes + + module Types (F : Ctypes.TYPE) = struct + open F + + let foo_version = constant "FOO_VERSION" int + end + +Your example ``function_description.ml`` file is: + +.. code:: ocaml + + open Ctypes + + (* This Types_generated module is an instantiation of the Types + functor defined in the type_description.ml file. It's generated by + a C program that Dune creates and runs behind the scenes. *) + module Types = Types_generated + + module Functions (F : Ctypes.FOREIGN) = struct + open F + + let foo_init = foreign "foo_init" (void @-> returning int) + + let foo_fnubar = foreign "foo_fnubar" (string_opt @-> returning int) + + let foo_exit = foreign "foo_exit" (void @-> returning void) + end + +Finally, the entry point of your executable named above, ``foo.ml``, +demonstrates how to access the bound C library functions and values: + +.. code:: ocaml + + let () = + if (C.Types.foo_version <> 1) then + failwith "foo only works with libfoo version 1"; + + match C.Functions.foo_init () with + | 0 -> + C.Functions.foo_fnubar "fnubar!"; + C.Functions.foo_exit () + | err_code -> + Printf.eprintf "foo_init failed: %d" err_code; + ;; + +From here, one only needs to run ``dune build ./foo.exe`` to generate the stubs +and build and link the example ``foo.exe`` program. + +Complete information about the ``ctypes`` combinators used above is available +at the ctypes_ project. + +Ctypes Field Reference +------------------------ + +The ``ctypes`` field can be used in any ``executable(s)`` or ``library`` +stanza. + +.. code:: dune + + ((executable|library) + ... + (ctypes + (external_library_name ) + (type_description + (instance ) + (functor )) + (function_description + (instance ) + (functor ) + ) + (generated_entry_point ) + ) + ) + +- ``type_description``: the ``functor`` module is a description of the C + library types and constants written in the ``ctypes`` domain-specific + language you wish to bind. The ``instance`` module is the name of the + instantiated functor, inserted into the top-level of the + ``generated_entry_point`` module. + +- ``function_description``: the ``functor`` module is a description of the C + library functions written in the ``ctypes`` domain-specific language you wish + to bind. The ``instance`` module is the name of the instantiated functor, + inserted into the top-level of the ``generated_entry_point`` module. The + ``function_description`` field can be repeated. This is useful if you need + to specify sets of functions with different concurrency policies (see below). + +The instantiated types described above can be accessed from the function +descriptions by referencing them as the module specified in optional +``generated_types`` field. + +```` are: + +- ``(build_flags_resolver )`` tells Dune how to + compile and link your foreign library. Specifying ``pkg_config`` will use + the pkg-config_ tool to query the compilation and link flags for + ``external_library_name``. For vendored libraries, provide the build and link + flags using ``vendored`` field. If ``build_flags_resolver`` is not + specified, the default of ``pkg_config`` will be used. + +- ``(generated_types )`` is the name of an intermediate module. By + default, it's named ``Types_generated``. You can use this module to access + the types defined in ``Type_description`` from your ``Function_description`` + module(s). + +- ``(generated_entry_point )`` is the name of a generated module + that your instantiated ``Types`` and ``Functions`` modules will instantiated + under. We suggest calling it ``C``. + +- Headers can be added to the generated C files: + + - ``(headers (include "include1" "include2" ...))`` adds ``#include + ``, ``#include ``. It uses the + :doc:`reference/ordered-set-language`. + - ``(headers (preamble )`` adds directly the preamble. Variables + can be used in ```` such as ``%{read: }``. + +- Since the Dune's ``ctypes`` feature is still experimental, it could be useful to + add additional dependencies in order to make sure that local + headers or libraries are available: ``(deps )``. See + :doc:`concepts/dependency-spec` for more details. + +```` are: + +- ``(concurrency )`` tells ``ctypes + stubgen`` whether to call your C functions with the runtime lock held or + released. These correspond to the ``concurrency_policy`` type in the + ``ctypes`` library. If ``concurrency`` is not specified, the default of + ``sequential`` will be used. + +- ``(errno_policy )`` specifies the errno_policy_ + passed to the code generator. With ``ignore_errno``, the errno variable is + not accessed or returned by function calls. With ``return_errno``, all + functions will return the tuple ``(retval, errno)``. + +```` is: + +- ``(vendored (c_flags ) (c_library_flags ))`` provide the build + and link flags for binding your vendored code. You must also provide + instructions in your ``dune`` file on how to build the vendored foreign + library; see the :doc:`/reference/dune/foreign_library` stanza. Usually + the ```` should contain ``:standard`` in order to add the default + flags used by the OCaml compiler for C files + :doc:`/reference/dune-project/use_standard_c_and_cxx_flags`. + +.. _foreign-sandboxing: + +Foreign Build Sandboxing +======================== + +When the build of a C library is too complicated to express in the +Dune language, it's possible to simply *sandbox* a foreign +build. Note that this method can be used to build other things, not +just C libraries. + +To do that, follow the following procedure: + +- Put all the foreign code in a sub-directory +- Tell Dune not to interpret configuration files in this directory via an + :doc:`/reference/dune/data_only_dirs` stanza +- Write a custom rule that: + + - depends on this directory recursively via :ref:`source_tree ` + - invokes the external build system + - copies the generated files + - the C archive ``.a`` must be built with ``-fpic`` + - the ``libfoo.so`` must be copied as ``dllfoo.so``, and no ``libfoo.so`` + should appear, otherwise the dynamic linking of the C library will be + attempted. However, this usually fails because the ``libfoo.so`` isn't available at + the time of the execution. +- *Attach* the C archive files to an OCaml library via + :doc:`/reference/foreign-archives`. + +For instance, let's assume that you want to build a C library +``libfoo`` using ``libfoo``'s own build system and attach it to an +OCaml library called ``foo``. + +The first step is to put the sources of ``libfoo`` in your project, +for instance in ``src/libfoo``. Then tell Dune to consider +``src/libfoo`` as raw data by writing the following in ``src/dune``: + +.. code:: dune + + (data_only_dirs libfoo) + +The next step is to setup the rule to build ``libfoo``. For this, +writing the following code ``src/dune``: + +.. code:: dune + + (rule + (deps (source_tree libfoo)) + (targets libfoo.a dllfoo.so) + (action + (no-infer + (progn + (chdir libfoo (run make)) + (copy libfoo/libfoo.a libfoo.a) + (copy libfoo/libfoo.so dllfoo.so))))) + +We copy the resulting archive files to the top directory where they can be +declared as ``targets``. The build is done in a +:doc:`/reference/actions/no-infer` action because ``libfoo/libfoo.a`` and +``libfoo/libfoo.so`` are dependencies produced by an external build system. + +The last step is to attach these archives to an OCaml library as follows: + +.. code:: dune + + (library + (name bar) + (foreign_archives foo)) + +Then, whenever you use the ``bar`` library, you'll also be able to +use C functions from ``libfoo``. + +Limitations +----------- + +When using the sandboxing method, the following limitations apply: + +- The build of the foreign code will be sequential +- The build of the foreign code won't be incremental + +Both these points could be improved. If you're interested in helping make this +happen, please let the Dune team know and someone will guide you. + +Real Example +------------ + +The `re2 project `_ uses this method to +build the ``re2`` C library. You can look at the file ``re2/src/re2_c/dune`` in +this project to see a full working example. + +.. _ctypes: https://github.com/ocamllabs/ocaml-ctypes +.. _pkg-config: https://www.freedesktop.org/wiki/Software/pkg-config/ +.. _errno_policy: https://ocaml.org/p/ctypes/0.20.1/doc/Cstubs/index.html#type-errno_policy diff --git a/unikernel/duniverse/dune_/doc/getting-started/index.rst b/unikernel/duniverse/dune_/doc/getting-started/index.rst new file mode 100644 index 00000000..f3d57c78 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/getting-started/index.rst @@ -0,0 +1,12 @@ +Getting Started and Core Concepts +================================= + +These documents should be the first ones read by new Dune users. They explain +what Dune is, how it works, and how to use it. + +.. toctree:: + :maxdepth: 2 + + ../overview + ../quick-start + ../usage diff --git a/unikernel/duniverse/dune_/doc/goals.rst b/unikernel/duniverse/dune_/doc/goals.rst new file mode 100644 index 00000000..d2f27cd5 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/goals.rst @@ -0,0 +1,149 @@ +************ +Goal of Dune +************ + +.. TODO(diataxis) + This is an important page and should go in a sort of meta section together + with the history of the project and the glossary for example. + +The Dune project strives to provide the best possible build tool for the entire +OCaml community, including individual developers contributing to open source +projects in their free time, larger companies (such as Jane Street), and +communities, like MirageOS and Irmin. Additionally, we aim to provide the same +features for other neighbouring communities, such as Coq and possibly +Reason/Bucklescript, in the future. + +We haven't reached this goal yet, as Dune still requires development in some +areas to be such a tool, but we're steadily working towards that goal. On a +practical level, a few boxes must be checked, and a considerable number of +details needs to be sorted out. At a high-level, we think a tool that works for +everyone in the OCaml community should at least: + +1. have excellent backward compatibility properties +2. have a robust and scalable core +3. remain a no-brainer dependency +4. remain accessible +5. have very good support for the OCaml language +6. be extensible + +At this point, we've done a good job at 1, 3, 4, and 5. We're currently working +towards 2 and are doing the preparatory work for 6. Once all these boxes have +been checked, we'll consider the Dune project complete. + +Below, we develop each point and give some +insights into our current and future focuses. + +Have Excellent Backward-Compatibility Properties +================================================ + +In an open source community, two types of groups exist: those with enough +resources to continuously bring their projects up-to-date and those who work on +them in their free time. The latter obviously can't provide the same level of +continuous support and updates as the former. + +From the Dune point of view, we consider every released project with ``dune`` +files a precious piece that will potentially never change, so we discourage +changing Dune in a way where it could no longer understand a released project. + +Of course, we can't give a 100% guarantee that Dune will always behave exactly +the same. That would be unrealistic and would prevent the project from moving +forward. In order to provide good backward-compatibility properties while still +keeping the project fresh and dynamic, we need to properly delimit, document, +and version the set of behaviours on which users rely. For this to be +manageable, the surface Dune API must remain small. + +A distinguishing feature of Dune allows the user to declare which version of +the ``dune`` tool they wrote the project against, and ``dune`` will morph +itself to behave the same as this version of the ``dune`` binary, even if it's +a newer version. As a result, a recent ``dune`` binary version can understand a +wide range of Dune projects written against many different versions of Dune, +and while we strictly follow `semantic versioning`_, new major versions of Dune +effectively introduce very few breaking changes. Most projects don't need upper +bounds on Dune. + +This guarantee is of course limited to documented behaviours. + +.. _semantic versioning: https://semver.org/ + +Have a Robust and Scalable Core +=============================== + +Tech companies tend be fond of big mono repositories, so for compatibility, +Dune must consume large repositories without blinking. It not only needs to +build fast, but more importantly, it must not impede fast feedback during +development, no matter the size of the repository. + +Note that we'll only test Dune on repositories as large as people participating +in Dune's development require. Currently, the largest user is Jane Street. If +someone wanted to use Dune on much larger repositories than the ones used at +Jane Street, and this required a significant amount of effort on Dune, this +wouldn't be considered unless we get some help to do so and we can keep the +other promises. + +In particular, while making Dune scalable, we must also ensure Dune doesn't +turn into a monster, because no one wants to force their users to install a +monster to build their project. This brings us to the next point of Dune being +a no-brainer dependency: + +Remain a No-Brainer Dependency +============================== + +Dune is a hard dependency of any Dune project. Anyone using Dune to develop +their project will have to ask their user to install Dune. For this reason, it +is very important to keep Dune as lean as possible. + +We need to be careful when we start relying on an external piece of software or +when we introduce new concepts. We must not introduce duplication or useless +stuff. The overall projects has to remain lean. + +It's also important to keep Dune as easy to install as possible. Currently, the +only requirement to build Dune is a working OCaml compiler. Nothing else is +required, not even a shell, and we should keep it this way. + +Remain Accessible +================= + +Since Dune aims to be the best possible tool for the whole OCaml community, +it's important to keep Dune accessible. Getting started and learning Dune +should be straightforward. + +For that purpose, when designing the language (the command line interface or +the documentation), we must take on the new-user perspective, one who just +discovered Dune and its features, because Dune should be suitable for everyone! +It also needs to provide advanced and more complex features for expert users. +However, the documentation should always flow from the simpler concepts and +common tasks to the more complex ones, even if the simpler features can be +explained as instances of the more general ones. + +Have Excellent Support for the OCaml Language +============================================= + +There are many, many build systems out there. Dune stands out because it +primarily targets the OCaml community, so Dune must come with excellent support +for the OCaml language and OCaml projects in general. + +If it didn't, Dune would just be yet another generic build system. + +Perhaps in the future some of the general build system will take over, and Dune +might just become a plugin in this system. It could even disappear into the +language, if the compiler gains significant high-level features. But for now, +Dune is a standalone build system that primarily serves the OCaml community's +needs, and to the extent that is reasonably possible, the needs of other +functional language communities. + +Be Extensible +============= + +No matter the quality of the OCaml language's support, it will never be enough +to cover every single project need. For this reason, Dune must provide some +form of openness for projects with need that don't completely fit in the Dune +model. + +In the long run, extensibility tends to obstruct innovation, and we should +always strive to ensure that we cover all the general needs of the main Dune +language; however, we'll always need an escape hatch for Dune to remain a +practical choice. + +It's pretty clear that extensibility must be done via OCaml code, and currently +it's a bit difficult to use OCaml as a proper extension language, though some +work is being done to help on that front. diff --git a/unikernel/duniverse/dune_/doc/hacking.rst b/unikernel/duniverse/dune_/doc/hacking.rst new file mode 100644 index 00000000..84d82ff6 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/hacking.rst @@ -0,0 +1,800 @@ +**************************** +Working on the Dune Codebase +**************************** + +.. TODO(diataxis) + This can be folded either in a meta section or as an how-to guide. + +This section gives guidelines for working on Dune itself. Many of these are +general guidelines specific to Dune. However, given that Dune is a large project +developed by many different people, it's important to follow these guidelines in +order to keep the project in a good state and pleasant to work on for everybody. + +Dependencies +============ + +To create a directory-local opam switch with the dependencies necessary to build the tests, run: + +.. code:: console + + $ make dev-switch + +This can also be used to keep the switch updated when dependencies change. + +The ``Makefile`` also has a ``make dev-deps`` which will install just the +dependencies used by tests. These are marked ``{ with-dev-setup }`` in Dune's +opam file. + +Bootstrapping +============= + +Dune uses Dune as its build system, which requires some specific commands to +work. Running ``make dev`` bootstraps (if necessary) and runs ``./dune.exe +build @install``. + +If you want to just run the bootstrapping step itself, build the ``bootstrap`` +phony target with + +.. code:: console + + $ make bootstrap + +You can always rerun this to bootstrap again. + +Once you've bootstrapped Dune, you should be using it to develop Dune itself. +Here are the most common commands you'll be running: + +.. code:: console + + # to make sure everything compiles: + $ ./dune.exe build @check + # run all the tests + $ ./dune.exe runtest + # run a particular cram foo.t: + $ ./dune.exe build @foo + + +Note that tests are currently written for version 5.3.0 of the OCaml compiler. +Some tests depend on the specific wording of compilation errors which can change +between compiler versions, so to reliably run the tests make sure that +``ocaml.5.3.0`` is installed. The ``TEST_OCAMLVERSION`` in the ``Makefile`` at +the root of the Dune repo contains the current compiler version for which tests +are written. + +.. seealso:: :doc:`explanation/bootstrap` + +Writing Tests +============= + +Most of our tests are written as expectation-style tests. While creating such +tests, the developer writes some code and then lets the system insert the output +produced during the code execution. The system puts it right next to the code in +the source file. + +Once you write and commit a test, the system checks that the captured output +matches the one produced by a fresh code execution. When the two don't match, +the test fails. The system then displays a diff between what was expected and +what the code produced. + +We write both our unit tests and integration tests in this way. For unit tests, +we use the ppx_expect_ framework, where we introduce tests via +``let%expect_test``, and ``[%expect ...]`` nodes capture expectations: + +.. code:: ocaml + + let%expect_test "" = + print_string "Hello, world!"; + [%expect {| + Hello, world! + |}] + +For integration tests, we use a system similar to `Cram tests +`_ for testing shell commands and their behavior: + +.. code:: console + + $ echo 'Hello, world!' + Hello, world! + + $ false + [1] + + $ cat < multi + > line + > EOF + multi + line + +.. _ppx_expect: https://github.com/janestreet/ppx_expect + +.. seealso:: + + `actions_to_sh tests `_ + An example of expect-tests. + + `mdx-stanza/locks.t `_ + An example of Cram test. + +When running Dune inside tests, the ``INSIDE_DUNE`` environment variable is set. +This has the following effects: + +* Change the default root detection behaviour to use the current directory + rather than the top most ``dune-project`` / ``dune-workspace`` file. +* Be less verbose when Dune outputs a user message. +* Error reporting is deterministic by default. +* Prefer not to use a diff program for displaying diffs. + +This list is not exhaustive and may change in the future. In order to find the +exact behaviour, it is recommended to search for ``INSIDE_DUNE`` in the +codebase. + +Guidelines +---------- + +As with any long running software project, code written by one person will +eventually be maintained by another. Just like normal code, it's important to +document tests, especially since test suites are most often composed of many +individual tests that must be understood on their own. + +A well-written test case should be easily understood. A reader should be able to +quickly understand what property the test is checking, how it's doing it, and +how to convince oneself that the test outcome is the right one. A well-written +test makes it easier for future maintainers to understand the test and react +when the test breaks. Most often, the code will need to be adapted to preserve +the existing behavior; however, in some rare cases, the test expectation will +need to be updated. + +It's crucial that each test case makes its purpose and logic crystal clear, so +future maintainers know how to deal with it. + +When writing a test, we generally have a good idea of what we want to test. +Sometimes, we want to ensure a newly developed feature behaves as expected. +Other times, we want to add a reproduction case for a bug reported by a user to +ensure future changes won't reintroduce the faulty behaviour. Just like when +programming, we turn such an idea into code, which is a formal language that a +computer can understand. While another person reading this code might be able to +follow and understand what the code does step by step, it isn't clear that +they'll be able to reconstruct the original developer's idea. Even worse, they +might understand the code in a completely different way, which would lead them +to update it incorrectly. + +Setting Up Your Development Environment Using Nix +================================================= + +You can use Nix to setup the development environment. This can be done by +running ``nix develop`` in the root of the Dune repository. + +Note that Dune only takes OCaml as a dependency and the rest of the dependencies +are used when running the test suite. + +Running ``nix develop`` can take a while the first time, therefore it is +advisable to save the state in a profile. + +```sh +nix develop --profile nix/profiles/dune +``` + +And to load the profile: + +```sh +nix develop nix/profiles/dune +``` + +This profile might need to be updated from time to time, since the bootstrapped +version of Dune may become stale. This can be done by running the first command. + +We have the following shells for specific tasks: + +- ``nix develop .#slim`` for a dev environment with fewer dependencies that is + faster to build. +- ``nix develop .#slim-melange``: same as above, but additionally includes the + ``melange`` and ``mel`` packages +- Building documentation requires ``nix develop .#doc``. +- For running the Coq tests, you can use ``nix develop .#coq``. NB: Coq native + is not currently installed; this will cause some of the tests to fail. It's + currently better to fallback to opam in this case. + +Releasing Dune +============== + +Dune's release process relies on dune-release_. Make sure you install and +understand how this software works before proceeding. Publishing a release +consists of two steps: + +* Updating ``CHANGES.md`` to reflect the version being published. +* Running ``$ make opam-release`` to create the release tarball. Then publish it + to GitHub and submit it to opam. + +.. _dune-release: https://github.com/tarides/dune-release + +Major & Feature Releases +------------------------ + +Given a new version ``x.y.z``, a major release increments ``x``, and a feature +release increments ``y``. Such a release must be done from the ``main`` branch. +Once you publish the release, be sure to publish a release branch named ``x.y``. + +Point Releases +-------------- + +Point releases increment the ``z`` in ``x.y.z``. Such releases are done from the +respective ``x.y`` branch of the respective feature release. Once released, be +sure to update ``CHANGES.md`` in the ``main`` branch. + +Adding Stanzas +============== + +Adding new stanzas is the most natural way to extend Dune with new features. +Therefore, we try to make this as easy as possible. The minimal amount of steps +to add a new stanza is: + +- Extend ``Stanza.t`` with a new constructor to represent the new stanza +- Modify ``Dune_file`` to parse the Dune language into this constructor +- Modify the rules to interpret this stanza into rules, usually done in + ``Gen_rules`` + +Versioning +---------- + +Dune is incredibly strict with versioning of new features, modifications visible +to the user, and changes to existing rules. This means that any added stanza +must be guarded behind the version of the Dune language in which it was +introduced. For example: + +.. code:: ocaml + + ; ( "cram" + , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 7) + and+ t = Cram_stanza.decode in + [ Cram t ] ) + +Here, Dune 2.7 introduced the Cram stanza, so the user must enable +``(lang dune 2.7)`` in their ``dune`` project file to use it. + +``since`` isn't the only primitive for making sure that versions are respected. +See ``Dune_lang.Syntax`` for other commonly used functions. + +Experimental & Independent Extensions +------------------------------------- + +Sometimes, Dune's versioning policy is too strict. For example, it doesn't work +in the following situations: + +- When most Dune independent extensions only exist inside Dune for development + convenience, e.g., build rules for Coq. Such extensions would like to impose + their own versioning policy. + +- When experimental features cannot guarantee Dune's strict backwards + compatibility. Such features may dropped or modified at any time. + +To handle both of these use cases, Dune allows the definition of new languages +(with the same syntax). These languages have their own versioning scheme and +their own stanzas (or fields). In Dune itself, ``Syntax.t`` represents such +languages. Here's an example of how the Coq syntax is defined: + +.. code:: ocaml + + let coq_syntax = + Dune_lang.Syntax.create ~name:"coq" ~desc:"the coq extension (experimental)" + [ ((0, 1), `Since (1, 9)); ((0, 2), `Since (2, 5)) ] + +The list provides which versions of the syntax are provided and which version of +Dune introduced them. + +Such languages must be enabled in the ``dune`` project file separately: + +.. code:: dune + + (lang dune 3.20) + (using coq 0.8) + +If such extensions are experimental, it's recommended that they pass +``~experimental:true``, and that their versions are below 1.0. + +We also recommend that such extensions introduce stanzas or fields of the form +``ext_name.stanza_name`` or ``ext_name.field_name`` to clarify which extensions +provide a certain feature. + +Dune Rules +========== + +Creating Rules +-------------- + +A Dune rule consists of 3 components: + +- *Dependencies* that the rule may read when executed (files, aliases, etc.), + described by ``'a Action_builder.t`` values. + +- *Targets* that the rule produces (files and/or directories), described by + ``'a Action_builder.With_targets.t'`` values. + +- *Action* that Dune must execute (external programs, redirects, etc.). Actions + are represented by ``Action.t`` values. + +Combined, one needs to produce an ``Action.t Action_builder.With_targets.t`` +value to create a rule. The rule may then be added by ``Super_context.add_rule`` +or a related function. + +To make this maximally convenient, there's a ``Command`` module to make it +easier to create actions that run external commands and describe their targets +and dependencies simultaneously. + +Loading Rules +------------- + +Dune rules are loaded lazily to improve performance. Here's a sketch of the +algorithm that tries to load the rule that generates some target file ``t``. + +- Get the directory that contains ``t``. Call it ``d``. + +- Load all rules in ``d`` into a map from targets in that directory to rules + that produce it. + +- Look up the rule for ``t`` in this map. + +To adhere to this loading scheme, we must generate our rules as part of the +callback that creates targets in that directory. See the ``Gen_rules`` module +for how this callback is constructed. + +Documentation +============= + +User documentation lives in the ``./doc`` directory. + +In order to build the user documentation, you must install python-sphinx_, +sphinx-design_, sphinx-copybutton_, myst-parser_, and furo_. + +Build the documentation with + +.. code:: console + + $ make doc + +For automatically updated builds, you can install sphinx-autobuild_, and run + +.. code:: console + + $ make livedoc + +.. seealso:: + ``doc/requirements.txt`` for an always up-to-date list of packages to install + +.. _python-sphinx: http://www.sphinx-doc.org/en/master/usage/installation.html +.. _sphinx-design: https://sphinx-design.readthedocs.io/en/latest/index.html +.. _sphinx-copybutton: https://sphinx-copybutton.readthedocs.io/en/latest/index.html +.. _sphinx-autobuild: https://pypi.org/project/sphinx-autobuild/ +.. _myst-parser: https://myst-parser.readthedocs.io/en/latest/ +.. _furo: https://sphinx-themes.org/sample-sites/furo/ + +Nix users may drop into a development shell with the necessary dependencies for +building docs ``nix develop .#doc``. + +Structure +--------- + +For structure, we use the `Diátaxis framework`_. The core idea is that +documents should fit in one of the following categories: + +.. _Diátaxis framework: https://diataxis.fr/ + +- Tutorials, focused on learning +- How-to guides, focused on task solving +- Reference, focused on information +- Explanations, focused on understanding + +Most features do not need a document in each category, but the important part +is that a single document should not try to be in several categories at once. + +ReStructured Text +----------------- + +For code blocks containing Dune files, use ``.. code:: dune`` and indent with 3 +spaces. Use formatting consistent with how Dune formats Dune files (most +importantly, do not leave orphan closing parentheses). + +In a document that only contains Dune code blocks, it is possible to use the +``.. highlight:: dune`` directive to have ``dune`` be the default lexer, and +then it is possible to use the ``::`` shortcut to end a line with a single +``:`` and start a code block. See the source of +:doc:`reference/lexical-conventions` for an example. + +For links, prefer references that use ``:doc:`` (link to a whole document) or +``:term:`` (link to a definition in the glossary) to ``:ref:``. + +Use the right lexers: +- ``dune`` for ``dune`` and related files +- ``opam`` for opam files +- ``console`` for shell sessions and commands (start with ``$``) +- ``cram`` for cram tests + +Style +----- + +Use American spelling. + +Use `Title Case`_ for titles and headings (every word except "little words" +like of, and, or, etc.). + +.. _Title Case: https://apastyle.apa.org/style-grammar-guidelines/capitalization/title-case + +For project names, use the following capitalization: + +- **Dune** is the project, ``dune`` is the command. Files are called ``dune`` + files. +- ``dune-project`` should always be written in monospace. +- **OCaml** +- **OCamlFormat**, and ``ocamlformat`` is the command. +- ``odoc``, always in monospace. +- **opam**. Can be capitalised as Opam at the beginning of sentences only, as + the official name is formatted opam. Even in titles, headers, and subheaders, + it should be all lowercase: opam. The command is ``opam``. +- **esy**. Can be capitalised as Esy. +- **Nix**. The command is ``nix``. +- **Js_of_ocaml** can be abbreviated **JSOO**. +- **MDX**, rather than mdx or Mdx +- **PPX,** rather than ppx or Ppx; ``ppxlib`` +- **UTop,** rather than utop or Utop. + +Vendoring +========= + +Dune vendors some code that it uses internally. This is done to make installing +Dune easy as it requires nothing but an OCaml compiler as well as to prevent +circular dependencies. Before vendoring, make sure that the license of the code +allows it to be included in Dune. + +The vendored code lives in the ``vendor/`` subdirectory. To vendor new code, +create a shell script ``update-.sh``, that will be launched from the +``vendor/`` folder to download and unpack the source and copy the necessary +source files into the ``vendor/`` folder. Try to keep the amount of +source code imported minimal, e.g., leave out ``dune-project`` files. For the +most part, it should be enough to copy ``.ml`` and ``.mli`` files. Make sure to +also include the license if there is such a file in the code to be vendored to +stay compliant. + +As these sources get vendored not as subprojects but parts of Dune, you need +to deal with ``public_name``. The preferred way is to remove the +``public_name`` and only use the private name. If that is not possible, the +library can be renamed into ``dune-private-libs.``. + +To deal with the modified ``dune`` files in ``update-.sh`` scripts, +you can commit the modified files to ``dune`` and make the +``update-.sh`` script to use ``git checkout`` to restore the ``dune`` +file. + +For larger modifications, it is better to fork the upstream project in the +ocaml-dune_ organisation and then vendor the forked copy in Dune. This makes +the changes better visible and easier to update from upstream in the long run +while keeping our custom patches in sync. The changes to the ``dune`` files are +to be kept in the Dune repository. + +It is preferable to cut out as many dependencies as possible, e.g., ones that +are only necessary on older OCaml versions or build-time dependencies. + +.. _ocaml-dune: https://github.com/ocaml-dune/ + +General Guidelines +================== + +Dune has grown to be a fairly large project that over time has acquired its own +style. Below is an attempt to enumerate some important points of this style. +These rules aren't axioms and we may break them when justified. However, we +should have a good reason in mind when breaking them. Finally, the list isn't +exhaustive by any means and is subject to change. Feel free to discuss anything +in particular with the team. + +- Parameter signatures should be self descriptive. Use labels when the types + alone aren't sufficient to make the signature readable. + +Bad: + +.. code:: ocaml + + val display_name : string -> string -> _ Pp.t + +Good: + +.. code:: ocaml + + val display_name : first_name:string -> last_name:string -> _ Pp.t + +- Avoid type aliases when possible. Yes, they might make some type signatures + more readable, but they make the code harder to grep and make Merlin's + inferred types more confusing. + +- Every ``.ml`` file must have a corresponding ``.mli``. The only exception to + this rule is ``.ml`` files with only type definitions. + +- Do not write ``.mli`` only modules. They offer no advantages to ``.ml`` + modules with type definitions and one cannot define exceptions in ``.mli`` + only modules + +- Every module should have toplevel documentation that describes the module + briefly. This is a good place to discuss its purpose, invariants, etc. + +- Keep interfaces short & sweet. The less functions, types, etc., there are, the + easier it is for users to understand, use, and ultimately modify the + interface correctly. Instead of creating elaborate interfaces with the hope + of future-proofing every use case, embrace change and make it easier to throw + out or replace the interface. + + Ideally the interface should have one obvious way to use it. A particularly + annoying violator of this principle is the "logic-less chain of functions" + helper. For example: + +.. code:: ocaml + + let foo t = bar t |> baz + +If ``bar`` and ``baz`` are already public, then there's no need to add yet +another helper to save the caller a line of code. + +- Define bindings as close to their use site as possible. When they're far + apart, reading code requires scrolling and IDE tools to understand the code. + +Bad: + +.. code:: ocaml + + let dir = .. in + (* 50 odd lines or so that don't use [dir] *) + f dir + +Good: + +.. code:: ocaml + + let dir = .. in + f dir + +- A corollary to the previous guideline: keep the scope of bindings as small as + possible. + +Bad: + +.. code:: ocaml + + let x1 = f foo in let x2 = f bar in + let y1 = g foo in let y2 = g bar in + let dx = x2 -. x1 in + let dy = y2 -. y1 in + dx^2 +. dy^2 + +Good: + +.. code:: ocaml + + let dx = + let x1 = f foo in let x2 = f bar in + x2 -. x1 + in + let dy = + let y1 = g foo in let y2 = g bar in + y2 -. y1 + in + dx^2 +. dy^2 + +- Prefer ``Code_error.raise`` instead of ``assert false``. The reader often has + no idea what invariant is broken by the ``assert false``. Kindly describe it + to the reader in the error message. + +- Avoid meaningless names like ``x``, ``a``, ``b``, ``f``. Try to find a more + descriptive name or just inline it altogether. + +- If a module ``Foo`` has a module type ``Foo.S`` and you'd like to avoid + repeating its definition in the implementation and the signature, introduce + an ``.ml``-only module ``Foo_intf`` and write the ``S`` only once in there. + +- Instead of introducing a type ``foo``, consider introducing a module ``Foo`` + with a type ``t``. This is often the place to put functions related to + ``foo``. + +- Avoid optional arguments. They increase brevity at the expense of readability + and are annoying to grep. Furthermore, they encourage callers not to think + at all about these optional arguments even if they often should. + +- Avoid qualifying modules when accessing fields of records or constructors. + Avoid it altogether if possible, or add a type annotation if + necessary. + +Bad: + +.. code:: ocaml + + let result = A.b () in + match result.A.field with + | B.Constructor -> ... + +Good: + +.. code:: ocaml + + let result : A.t = A.b () in + match (result.field : B.t) with + | Constructor -> ... + +- When constructing records, use the qualified names in in the record. Do not + open the record. The local open syntax pulls in all kinds of names from the + opened module and might shadow the values that you're trying to put into the + record, leading to difficult debugging. + +Bad; if ``A.value`` exists, it will pick that over ``value``: + +.. code:: ocaml + + let value = 42 in + let record = A.{ field = value; other } in + ... + +Good: + +.. code:: ocaml + + let value = 42 in + let record = { A.field = value; other } in + ... + +- Stage functions explicitly with the ``Staged`` module. + +- Do not raise ``Invalid_argument``. Instead, raise with ``Code_error.raise`` + which allows to attach more informative payloads than just strings. + +- When ignoring the value of a let binding ``let _ = ...``, we add type + annotations to the ignored value ``let (_ : t) = ...``. We do this convention + because: + + * We need to make sure we never ignore ``Fiber.t`` accidentally. Functions that + return ``Fiber.t`` are always free of side effects so we need to bind on the + result to force the side effect. + + * Whenever a function is changed to return an error via its return value, we + want the compiler to notify all the callers that need to be updated. + +- To write a ``to_dyn`` function on a record type, use the following pattern. It + ensures that the pattern matching will break when a field is added. To ignore + a field, add ``; d = _``, not ``; _``. + +.. code:: ocaml + + let to_dyn {a; b; c} = + Dyn.record + [ ("a", A.to_dyn a) + ; ("b", B.to_dyn b) + ; ("c", C.to_dyn c) + ] + +- To write an equality function, use the following pattern (this applies to + other kinds of binary functions). The same remarks about about pattern + matching and ignoring fields apply. + +.. code:: ocaml + + let equal {a; b; c} t = + A.equal a t.a && + B.equal b t.b && + C.equal c t.c + +Subjective Style Points +----------------------- + +There's some stylistic decisions we made that don't have logical justification +and are basically a matter of taste. Nevertheless, it's useful to follow them +to keep the code consistent. + +- Match patterns should be sorted by the length of their RHS when possible. + Keep the shorter clauses near the top. + +- If a module ``Foo`` defines a type ``t``, all functions that take ``t`` in + this module should have ``t`` as their first argument. This is the "t comes + first" rule. + +- Do not mix ``|>`` and ``@@`` in the same expression. + +- Introduce bindings that will allow opportunities for record or label punning. + +- Do not write inverted if-else expressions. + +Bad: + +.. code:: ocaml + + (* try reading this out loud without short circuiting your brain *) + if not x then foo else bar + +Good: + +.. code:: ocaml + + if x then bar else foo + +- We prefer snake_casing identifiers. This includes the names of modules and + module types. + +- Avoid qualifying constructors and record fields. Instead, add type + annotations to the type being matched on or being constructed, e.g., + +Bad: + +.. code:: ocaml + + let foo = Command.Args.S [] + +Good: + +.. code:: ocaml + + let (foo : _ Command.Args.t) = S [] + +Benchmarking +============ + +Dune Bench +---------- + +You can benchmark Dune's performance by running ``make bench``. This will run a +subset of the Duniverse. If you are running the bench locally, make sure that +you bootstrap since that is the executable that the bench will run. + +The bench will build a specially selected portion of the Duniverse once, called +a "clean build". Afterwards, the build will be run 5 more times and are termed +the "Null builds". + +In each run of the CI, there will be an ``ocaml-benchmarks`` status in the +summary. Clicking ``Details`` will show a bench report. + +The report contains the following information: + +- The build times for Clean and Null builds +- The size of the ``dune.exe`` binary +- User CPU times for the Clean and Null builds +- System CPU times for the Clean and Null builds +- All the garbage collection stats apart from "forced collections" for Clean and + Null builds + +Pull requests that add new libraries are likely to increase the size of the dune +binary. + +Performance gains in Dune can be observed in the Clean and Null build times. + +Memory usage can be observed in the garbage collection stats. + +Inline Benchmarks +----------------- + +Certain performance-critical parts of Dune are benchmarked using the +``inline_benchmarks`` library. These benchmarks are run when running the tests. +Their outputs are currently not recorded and are only used to detect performance +regressions. + + +Build-Time Benchmarks +--------------------- + +We benchmark the build time of Dune in every PR. The times can be found here: + +https://bench.ci.dev/ocaml/dune?worker=autumn&image=bench.Dockerfile + + +Melange Bench +------------- + +We also benchmark a demo Melange project's build time: + +https://ocaml.github.io/dune/dev/bench/ + +Formatting +========== + +When changing the formatting configuration, it is possible to add the +reformatting commit to the :file:`.git-blame-ignore-revs` file. The commit will +disappear from blame views. It is also possible to configure ``git`` to have +the same behavior locally. + +It is recommended to edit that file in a second PR, to make sure that the +referenced commit has not changed. + +.. seealso:: + `GitHub - Ignore commits in the blame view + `_ diff --git a/unikernel/duniverse/dune_/doc/howto/bundle.rst b/unikernel/duniverse/dune_/doc/howto/bundle.rst new file mode 100644 index 00000000..9102e665 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/bundle.rst @@ -0,0 +1,41 @@ +How to Bundle Resources +======================= + +This guide will show you how to configure Dune to generate modules with string resources +from other files in your project. + +Folder Structure +---------------- + +.. code:: console + + $ tree src + src + └── lib +    └── my_lib +    ├── dune +    └── resources +       └── site.css + +Dune Configuration +------------------ + +See :doc:`/reference/actions/progn` and +:doc:`/reference/actions/with-outputs-to`. + +.. code:: dune + + (rule + (with-stdout-to + css.ml + (progn + (echo "let css = {|") + (cat resources/site.css) + (echo "|}")))) + +Using the Bundled Resource +-------------------------- + +.. code:: ocaml + + let () = Printf.printf "%s" Css.css diff --git a/unikernel/duniverse/dune_/doc/howto/formatting.rst b/unikernel/duniverse/dune_/doc/howto/formatting.rst new file mode 100644 index 00000000..cc9a1010 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/formatting.rst @@ -0,0 +1,87 @@ +How to Set up Automatic Formatting +================================== + +This guide will show you how to configure Dune so that it can check the formatting +of your source code. + +Formatting is defined per project. This ensures that if a project is reused +elsewhere, its formatting configuration will not interfere. + +Setting Up the Environment +-------------------------- + +First, let's open the ``dune-project`` file. Make sure that the version +specified in ``(lang dune X.Y)`` is at least ``2.0``. Most formatting +configuration happens in that file. If you want to format OCaml sources and +``dune`` files, you don't have anything to add. Otherwise, refer to the +:doc:`/reference/dune-project/formatting` stanza. + +Next we need to install some code formatting tools. For OCaml code, this means +installing OCamlFormat_ with ``opam install ocamlformat``. Formatting ``dune`` +files is built into Dune and does not require any extra tools. For Reason code, +this uses the ``refmt`` tool which is already installed if you are using Reason +syntax in your project. If your project uses a :term:`dialect`, a specific tool +might be required. + +.. _ocamlformat: https://github.com/ocaml-ppx/ocamlformat + +Using OCamlFormat requires some configuration. Take note of the version +returned by ``ocamlformat --version`` (let's name that ``X.Y.Z``) and create an +``.ocamlformat`` file in the same directory as ``dune-project`` with the +following contents: + +.. code:: + + version=X.Y.Z + profile=default + +The ``version`` line is checked by OCamlFormat and ensures that everybody +contributing to the project uses the same version. + +Note that you do not have to add ``ocamlformat`` to your opam files. + +Running the Formatters +---------------------- + +Run the ``dune build @fmt`` command. It will format the source files in the +corresponding project and display the differences: + +.. code:: console + + $ dune build @fmt + --- hello.ml + +++ hello.ml.formatted + @@ -1,3 +1 @@ + -let () = + - print_endline + - "hello, world" + +let () = print_endline "hello, world" + +Then it's possible to accept the correction by calling ``dune promote`` to +replace the source files with the corrected versions. + +.. code:: console + + $ dune promote + Promoting _build/default/hello.ml.formatted to hello.ml. + +As usual with promotion, it's possible to combine these two steps by running +``dune build @fmt --auto-promote``. This command can also be shortened to +``dune fmt``. See :doc:`../concepts/promotion` for more details. + +Setting Up Your CI +------------------ + +To check formatting in CI, the precise set up depends on the CI system used, +but in general it is easier to set up a dedicated job that just installs +``dune`` and the formatting tools, rather than doing that as part of the jobs +that run tests. + +If you use `ocaml-ci`_, you have nothing to do: a formatting job is set up +automatically. + +If you use `setup-ocaml`_, you can use the `lint-fmt` extend listed in the +README file. + +.. _ocaml-ci: https://ocaml.ci.dev/ +.. _setup-ocaml: https://github.com/ocaml/setup-ocaml diff --git a/unikernel/duniverse/dune_/doc/howto/index.rst b/unikernel/duniverse/dune_/doc/howto/index.rst new file mode 100644 index 00000000..15f85a69 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/index.rst @@ -0,0 +1,25 @@ +How-to Guides +============= + +These guides will help you use Dune's features in your project. + +.. toctree:: + :maxdepth: 1 + + install-dune + formatting + opam-file-generation + ../cross-compilation + ../foreign-code + ../documentation + ../sites + ../instrumentation + ../jsoo + ../wasmoo + ../melange + ../virtual-libraries + ../tests + bundle + toplevel + rule-generation + override-default-entrypoint diff --git a/unikernel/duniverse/dune_/doc/howto/install-dune.rst b/unikernel/duniverse/dune_/doc/howto/install-dune.rst new file mode 100644 index 00000000..ccefd077 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/install-dune.rst @@ -0,0 +1,39 @@ +How to Install Dune +=================== + +Dune is available as an Opam package. First, make sure that Opam is installed: + + .. code:: console + + $ opam --version + 2.1.5 + +Any version higher than 2.0.0 is supported, though preferably at least 2.1.0. + +If Opam is not available, follow `the official instructions on the Opam website +`_ to install it and then run its +global setup with ``opam init``. + +.. note:: + + Opam requires a "shell hook" to work properly. Make sure to set it up + correctly during ``opam init``. Otherwise you will have to run ``eval $(opam + env)`` every time you create an Opam switch or change directory. + +Then, you can install Dune in an Opam switch using the following command: + +.. code:: console + + $ opam install dune + +After the command completes, the following should display a version number: + +.. code:: console + + $ dune --version + 3.12.1 + +.. note:: + + In most cases, when using Opam you will not need to install Dune by hand. + Installing the project's dependencies will install it in the Opam switch. diff --git a/unikernel/duniverse/dune_/doc/howto/opam-file-generation.rst b/unikernel/duniverse/dune_/doc/howto/opam-file-generation.rst new file mode 100644 index 00000000..319a66ab --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/opam-file-generation.rst @@ -0,0 +1,143 @@ +How to Generate Opam Files from ``dune-project`` +================================================ + +.. highlight:: dune + +This guide will show you how to configure Dune so that it generates opam files. + +Declaring Package Dependencies +------------------------------ + +The goal of this first step is to add ``(package)`` stanzas in your +``dune-project`` file. These stanzas declare the metadata that your package +uses in the language of opam packages. See :ref:`declaring-a-package`. + +The next step depends on whether you are starting from a clean slate (new +package) or adapting an existing opam file. + +For a New Package (No Existing Opam File) +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +If your project does not have any opam files, you will have to find your +package dependencies. In the simple case, collect all the libraries +that appear in the ``(libraries)`` fields of your project and put this list in +the ``(depends)`` field of the corresponding ``(package)``. See +:doc:`../explanation/ocaml-ecosystem` for the difference between libraries and +packages. + +Example: you have a library that looks like:: + + (library + (public_name frobnitz) + (libraries lwt fmt)) + +You can declare the package as:: + + (package + (name frobnitz) + (depends lwt fmt)) + +Also add common metadata using ``(authors)``, ``(maintainers)``, ``(license)``, +``(source)``, as well as a ``(synopsis)`` and a ``(description)`` for + +For an Existing Package +^^^^^^^^^^^^^^^^^^^^^^^ + +If you already have an opam file (or several of them), you can convert it by +following the rules in :doc:`/reference/dune-project/package`. + +For example, if your opam file looks like: + +.. code:: opam + + opam-version: 2.0 + authors: ["Anil Madhavapeddy" "Rudi Grinberg"] + maintainer: ["team@mirage.org"] + name: "cohttp-async" + synopsis: "HTTP client and server for the Async library" + description: "A _really_ long description" + license: "ISC" + bug-reports: "https://github.com/mirage/ocaml-cohttp/issues" + homepage: "https://github.com/mirage/ocaml-cohttp/" + dev-repo: "git+https://github.com/mirage/ocaml-cohttp.git" + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + depends: [ + "dune" { >= "3.4" } + "odoc" { with-doc } + "cohttp" { >= "1.0.2" } + "conduit-async" { >= "1.0.3" } + "async" { >= "v0.10.0" } + ] + x-maintenance-intent: [ "(latest)" ] + +You can express this as:: + + (source (github mirage/ocaml-cohttp)) + (license ISC) + (authors "Anil Madhavapeddy" "Rudi Grinberg") + (maintainers "team@mirage.org") + (maintenance_intent "(latest)") + + (package + (name cohttp-async) + (synopsis "HTTP client and server for the Async library") + (description "A _really_ long description") + (depends + (cohttp (>= 1.0.2)) + (conduit-async (>= 1.0.3)) + (async (>= v0.10.0)))) + +General Notes and Tips +^^^^^^^^^^^^^^^^^^^^^^ + +- Do not declare a dependency on the ``dune`` and ``odoc`` packages. Dune will + generate them with the right constraints. +- For fields that are common between packages (like ``(authors)`` or + ``(license)``), you can use a global one rather than replicate it between + packages. +- If you use a platform such as GitHub you can use ``(source)`` as a shorthand + instead of specifying ``(bug_reports)``, ``(homepage)``, etc. +- ``(package)`` stanzas do not support all opam fields or complete syntax for + dependency specifications. If the package you are adapting requires this, + keep the corresponding opam fields in a ``pkg.opam.template`` file. See + :doc:`../reference/packages`. +- It is not necessary to specify ``(version)``, this will be added at release + time if you use `dune-release `_. +- To generate an opam variable such as ``version``, use a colon ``:`` followed + by the name of the variable. For example, to generate ``a { = version }`` in + the opam file, use ``(a (= :version))`` in ``dune-project``. + +Generating Opam Files +--------------------- + +If you have existing ``*.opam`` files, make a backup of them because the instructions in this section will overwrite them. + +Now that you have declared package metadata in ``dune-project``, you can add +``(generate_opam_files)`` in ``(dune-project)``. + +From now on, commands like ``dune build`` and ``dune runtest`` are going to regenerate the contents of opam files from the metadata in ``(package)`` stanzas. +If you only want to generate the opam file, run ``dune build .opam``. + +Run ``dune build`` once and observe that the opam files have been created or +updated. Make sure to add these changes to your version control system. + +.. seealso:: + + :token:`~pkg-dep:dep_specification` + How ``(depends)`` and similar fields are processed. + + :doc:`/explanation/opam-integration` + How ``with-test`` and related variables are used by opam. diff --git a/unikernel/duniverse/dune_/doc/howto/override-default-entrypoint.rst b/unikernel/duniverse/dune_/doc/howto/override-default-entrypoint.rst new file mode 100644 index 00000000..34f68470 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/override-default-entrypoint.rst @@ -0,0 +1,63 @@ +How to Override the Default C Entrypoint With C Stubs +----------------------------------------------------- + +In some cases, it may be necessary to override the default C entry point of an +OCaml program. For example, this is the case if you want to let your program +handle argument wildcards expansion on Windows. + +Let's consider a trivial "Hello world" program contained in a ``hello.ml`` +file: + +.. code:: ocaml + + let () = print_endline "Hello, world!" + +The default C entry point is a ``main`` function, originally defined in +`runtime/main.c `_. It +can be overridden by defining a ``main`` function that will at some point call +the OCaml runtime. Let's write such a minimal example in a ``main.c`` file: + +.. code:: C + + #include + + #define CAML_INTERNALS + #include "caml/misc.h" + #include "caml/mlvalues.h" + #include "caml/sys.h" + #include "caml/callback.h" + + /* This is the new entry point */ + int main(int argc, char_os **argv) + { + /* Here, we just print a statement */ + printf("Doing stuff before calling the OCaml runtime\n"); + + /* Before calling the OCaml runtime */ + caml_main(argv); + caml_do_exit(0); + return 0; + } + +The :doc:`foreign_stubs ` stanza can be leveraged to +compile and link our OCaml program with the new C entry point defined in +``main.c``: + +.. code:: dune + + (executable + (name hello) + (foreign_stubs + (language c) + (names main))) + +With this ``dune`` file, the whole program can be compiled by merely calling +``dune build``. When run, the output shows that it calls the custom entry point +we defined: + +.. code:: shell-session + + $ dune build + $ _build/default/hello.exe + Doing stuff before calling the OCaml runtime + Hello, world! diff --git a/unikernel/duniverse/dune_/doc/howto/rule-generation.rst b/unikernel/duniverse/dune_/doc/howto/rule-generation.rst new file mode 100644 index 00000000..19e5e9c4 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/rule-generation.rst @@ -0,0 +1,266 @@ +Using Rule Generation +===================== + +Sometimes it can be useful to generate Dune rules that depend on the file system +layout or on the content of configuration files. This often happens for +integration tests. + +In this document, we will see two ways to encode this behavior. + +We suppose that we are testing an executable named ``tool``. There are some +input files named ``*.input``, output files named ``*.output``, and we want to +ensure that when running ``tool`` on ``x.input``, the standard output +corresponds to ``x.output``. + +The Generate-Include-Commit Pattern +----------------------------------- + +.. note:: + + This is the most common way to do this. It has a couple drawbacks listed + below, but you should start with this pattern. + +What we are going to do is: + +- generate a ``dune.inc`` file; +- include it in our main ``dune`` file; +- commit the generated code in the source repository. + +This creates a loop: a program (the "generator") looks at the file system and +creates a ``dune.inc`` file. Changes to the file system (for example, if a test +is added) mean that a change in ``dune.inc`` will be promoted. These generated +rules are included in the main ``dune`` file, so ``dune runtest`` will run the +tests. Finally, the generated file is part of the source repository, so it is +not necessary to run several commands to run the test suite. + +Let's expand a bit on how to achieve this. + +Generating a ``dune.inc`` File +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +Create a ``gen`` subdirectory and create a ``gen.ml`` file in it: + +``gen/gen.ml`` + .. code:: ocaml + + let generate_rules base = + Printf.printf + {| + (rule + (with-stdout-to %s.gen + (run %%{bin:tool} %s.input))) + + (rule + (alias runtest) + (action + (diff %s.output %s.gen))) + |} + base base base base + + let () = + Sys.readdir "." + |> Array.to_list + |> List.sort String.compare + |> List.filter_map (Filename.chop_suffix_opt ~suffix:".input") + |> List.iter generate_rules + +Create a ``dune`` file in that directory: + +``gen/dune`` + .. code:: dune + + (executable + (name gen)) + +This defines an executable that lists ``*.input`` files in the current +directory and outputs rules on its standard output. + +.. note:: + + It is important to sort the input files to ensure that the output is + independent from the order in which ``Sys.readdir`` returns the files . + +For each input file, we output two rules: + +- The first one creates a ``x.gen`` file that corresponds to the actual output. +- The second uses a :doc:`/reference/actions/diff` action to compare the actual output to the expected output. If it is different, ``dune runtest`` will display the difference, which can be accepted by ``dune promote``. + +.. note:: + + It is possible to have more complicated logic here. For example, to pass + different arguments to ``tool`` depending on the presence of a ``*.args`` + file. To do that, check if ``*.args`` exists in ``generate_rules`` and emit + a different ``(run ...)`` action. + +Including it in the Main ``dune`` File +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +Our main test ``dune`` file contains the following: + +``dune`` + .. code:: dune + + (include dune.inc) + + (rule + (deps (source_tree .)) + (with-stdout-to + dune.inc.gen + (run gen/gen.exe))) + + (rule + (alias runtest) + (action + (diff dune.inc dune.inc.gen))) + +In addition to including the contents of ``dune.inc``, we use the same pattern +as before: ``dune.inc.gen`` is the actual output of the generator, and +``dune.inc`` is the expected output. At runtime, the generator will read the +contents of the current directory (where the ``*.input`` and ``*.output`` files +are located), so we record ``(source_tree .)`` as a dependency to make it run +again if a file is created, for example. + +Commit the Generated Code In The Source Repository +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +To make this work, we have a final step to do. We have to add the generated +file to our source tree. But since it is generated, we will have to first +create an empty file, run the test, and promote the result. + +.. code:: console + + $ touch dune.inc + $ dune runtest + + (rule + + (with-stdout-to a.gen + + (run %{bin:tool} a.input))) + + + + (rule + + (alias runtest) + + (action + + (diff a.output a.gen))) + $ dune promote dune.inc + $ git add dune.inc + +Now, running ``dune runtest`` will run the test suite. + +Notes +^^^^^ + +This pattern is "correct": it will execute all tests and make sure the +list of tests is up to date. But when adding a test, it is necessary to first +run ``dune runtest``, promote the result, and then re-run ``dune runtest`` to +actually run the test (and possibly promote the result of the test itself). + +There is a variant of this pattern which will promote the output automatically +instead of using a manual promotion step. This variant can be used either for +the test list or for the individual tests. + +To use it in the test list, replace the ``dune`` file by this version: + +``dune`` (alternative version) + .. code:: dune + + (include dune.inc) + + (rule + (mode promote) + (alias runtest) + (deps (source_tree .)) + (with-stdout-to + dune.inc + (run gen/gen.exe))) + +Using this version, ``dune runtest`` will directly replace ``dune.inc`` with an +updated version. + +Another caveat of this approach is that the generator needs to emit the same +output on all systems. For example, if some tests should be skipped on Linux, +the generator can not just filter the corresponding tests depending on +``Sys.os_type``. It has to consistently emit a ``(enabled_if)`` field for the +rules. + +Using ``(dynamic_include)`` +--------------------------- + +.. versionadded:: 3.14 + +This technique relies on :doc:`/reference/dune/dynamic_include`, which is +more flexible than :doc:`/reference/dune/include`. The difference is that +the intermediate ``dune.inc`` file does not need to be part of the source tree. +It will only be generated by a rule and be present in the ``_build`` directory. + +At first it looks like it would be possible to reuse the same pattern as above: +change ``include`` to ``dynamic_include`` and delete the ``dune.inc`` file. +However, it is not possible. The reason is that rules are loaded per directory, +and there needs to be a strict order (no cycles) between directories for this +to work. + +So, instead we are going to: + +- generate ``dune.inc`` in a subdirectory named ``generate``, and +- include these rules in a subdirectory named ``run``. + +These subdirectories do not need to be actual directories. They can be emulated +through :doc:`/reference/dune/subdir`. + +To do this, we can create the following ``dune`` file in the same directory as +the ``*.input`` and ``*.output`` files. + +``dune`` + .. code:: dune + + (executable + (name gen)) + + (subdir run + (dynamic_include ../generate/dune.inc)) + + (subdir generate + (rule + (deps (glob_files ../*.input)) + (action + (with-stdout-to dune.inc + (run ../gen.exe))))) + +Then create the following ``gen.ml`` file. Note that here we can define it in +the same directory. + +``gen.ml`` + .. code:: ocaml + + let generate_rules base = + Printf.printf + {| + (rule + (with-stdout-to %s.gen + (run %%{bin:tool} ../%s.input))) + + (rule + (alias runtest) + (action + (diff ../%s.output %s.gen))) + |} + base base base base + + let () = + Sys.readdir ".." |> Array.to_list |> List.sort String.compare + |> List.filter_map (Filename.chop_suffix_opt ~suffix:".input") + |> List.iter generate_rules + +There are a few differences from the generator above because this one +is going to be invoked from subdirectories, so it is necessary to refer to the +``..`` directory both in the input (which files to read) and in the output (how +the rules are executed). + +These two files are enough. ``dune runtest`` is going to generate the rules and +interpret them in a single command. + +Notes +^^^^^ + +This approach is shorter, but it might be more difficult to debug because changes +to the generated rules will not be visible. Also, it works in that case, but it +is not possible to generate all kinds of stanzas with that pattern. See +:doc:`/reference/dune/dynamic_include` for more information about the +limitations. diff --git a/unikernel/duniverse/dune_/doc/howto/toplevel.rst b/unikernel/duniverse/dune_/doc/howto/toplevel.rst new file mode 100644 index 00000000..3656728f --- /dev/null +++ b/unikernel/duniverse/dune_/doc/howto/toplevel.rst @@ -0,0 +1,55 @@ +How to Load a Project in a Toplevel +=================================== + +It is possible to use OCaml code in an interactive way, by typing an +expression, which gets evaluated and its result printed. Such a program is +called a `toplevel`, or REPL (Read-Eval-Print Loop). + +The compiler distribution comes with a small REPL called simply ``ocaml``, and +the community has developed enhanced versions such as `UTop +`_. + +Building a Specialized UTop Executable +-------------------------------------- + +It is possible to generate a specialized version of UTop that embeds the +current project. To do so, use the following command: + +.. code:: console + + $ dune utop + +The interactive session will start with all the modules loaded. + +If some of the libraries are PPX rewriters, the phrases you type in the +toplevel will be rewritten with these PPX rewriters. Similarly, PPX derivers +defined in the project will be available. + +Loading the Project in a Toplevel +--------------------------------- + +It is also possible to load Dune projects in any toplevel. To do that, simply +execute the following in your toplevel: + +.. code:: ocaml + + # #use_output "dune ocaml top";; + +``dune ocaml top`` is a Dune command that builds all the libraries in the +current directory and subdirectories and outputs the relevant toplevel +directives (``#directory`` and ``#load``) to make the various modules +available in the toplevel. + +Loading a Single Module in a Toplevel +------------------------------------- + +It's also possible to load individual modules for interactive development. Use +the following dune command: + +.. code:: ocaml + + # #use_output "dune ocaml top-module foo.ml";; + +This will print directives that will load ``foo.ml`` without sealing it behind +``foo.mli``. This is particularly useful for peeking and prodding at a module's +internals. diff --git a/unikernel/duniverse/dune_/doc/index.mld b/unikernel/duniverse/dune_/doc/index.mld new file mode 100644 index 00000000..8a981d9f --- /dev/null +++ b/unikernel/duniverse/dune_/doc/index.mld @@ -0,0 +1,6 @@ +{1 [dune] - Fast, portable, and opinionated build system } + +The documentation for [dune] is available here: + +- {{: https://dune.readthedocs.io/en/stable/} latest release} +- {{: https://dune.readthedocs.io/en/latest/} development version} diff --git a/unikernel/duniverse/dune_/doc/index.rst b/unikernel/duniverse/dune_/doc/index.rst new file mode 100644 index 00000000..eb488832 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/index.rst @@ -0,0 +1,16 @@ +Dune Documentation +================== + +Dune is a build system for OCaml projects. Using it, you can build executables, +libraries, run tests, and much more. + +.. toctree:: + :maxdepth: 2 + + getting-started/index + tutorials/index + howto/index + reference/index + explanation/index + advanced/index + misc/index diff --git a/unikernel/duniverse/dune_/doc/instrumentation.rst b/unikernel/duniverse/dune_/doc/instrumentation.rst new file mode 100644 index 00000000..5a964993 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/instrumentation.rst @@ -0,0 +1,139 @@ +*************** +Instrumentation +*************** + +.. TODO(diataxis) + + Split between: + + - reference about ``(instrumentation)`` + - :doc:`howto/code-coverage` + - specific reference about ``(instrumentation.backend)`` + +In this section, we'll explain how to define and use instrumentation backends +(such as ``bisect_ppx`` or ``landmarks``) so that you can enable and disable +coverage via ``dune-workspace`` files or by passing a command-line flag or +environment variable. In addition to providing an easy way to toggle +instrumentation of your code, this setup avoids creating a hard dependency on +the precise instrumentation backend in your project. + +Specifying What to Instrument +============================= + +When an instrumentation backend is activated, Dune will only instrument +libraries and executables for which the user has requested instrumentation. + +To request instrumentation, one must add the following field to a library or +executable stanza: + +.. code:: dune + + (library + (name ...) + (instrumentation + (backend ) + )) + +The backend ```` can be passed into arguments using ````. + +This field can be repeated multiple times in order to support various +backends. For instance: + +.. code:: dune + + (library + (name foo) + (modules foo) + (instrumentation (backend bisect_ppx --bisect-silent yes)) + (instrumentation (backend landmarks))) + +This will instruct Dune that when either the ``bisect_ppx`` or ``landmarks`` +instrumentation is activated, the library should be instrumented with this +backend. + +By default, these fields are simply ignored; however, when the corresponding +instrumentation backend is activated, Dune will implicitly add the relevant +``ppx`` rewriter to the list of ``ppx`` rewriters. + +At the moment, it isn't possible to instrument code that's preprocessed via an +action preprocessors. As these preprocessors are quite rare nowadays, there is +no plan to add support for them in the future. + +```` are: + +- ``(deps )`` specifies extra instrumentation dependencies, for + instance, if it reads a generated file. The dependencies are only applied + when the instrumentation is actually enabled. The specification of + dependencies is described in :doc:`concepts/dependency-spec`. + +Enabling/Disabling Instrumentation +================================== + +Activating an instrumentation backend can be done via the command line or the +``dune-workspace`` file. + +Via the command line, it is done as follows: + +.. code:: console + + $ dune build --instrument-with + +Here ```` is a comma-separated list of instrumentation backends. For +example: + +.. code:: console + + $ dune build --instrument-with bisect_ppx,landmarks + +This will instruct Dune to activate the given backend globally, i.e., in all +defined build contexts. + +It's also possible to enable instrumentation backends via the +``dune-workspace`` file, either globally or for specific builds contexts. + +To enable an instrumentation backend globally, type the following in your +``dune-workspace`` file: + +.. code:: dune + + (lang dune 3.20) + (instrument_with bisect_ppx) + +or for each context individually: + +.. code:: dune + + (lang dune 3.20) + (context default) + (context (default (name coverage) (instrument_with bisect_ppx))) + (context (default (name profiling) (instrument_with landmarks))) + +If both the global and local fields are present, the precedence is the same as +the ``profile`` field: the per-context setting takes precedence over the +command-line flag, which takes precedence over the global field. + +Declaring an Instrumentation Backend +==================================== + +Instrumentation backends are libraries with the special field +``(instrumentation.backend)``. This field instructs Dune that the library can +be used as an instrumentation backend, and it also provides the parameters +specific to this backend. + +Currently, Dune will only support ``ppx`` instrumentation tools, and the +instrumentation library must specify the ``ppx`` rewriters that instruments the +code. This can be done as follows: + +.. code:: dune + + (library + ... + (instrumentation.backend + (ppx ))) + +When such an instrumentation backend is activated, Dune will implicitly add the +mentioned ``ppx`` rewriter to the list of ``ppx`` rewriters for libraries and +executables that specify this instrumentation backend. + +.. _bisect_ppx: https://github.com/aantron/bisect_ppx +.. _landmarks: https://github.com/LexiFi/landmarks diff --git a/unikernel/duniverse/dune_/doc/jsoo.rst b/unikernel/duniverse/dune_/doc/jsoo.rst new file mode 100644 index 00000000..89337f79 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/jsoo.rst @@ -0,0 +1,86 @@ +.. _jsoo: + +*************************************** +JavaScript Compilation With Js_of_ocaml +*************************************** + +.. TODO(diataxis) + + This is an how-to guide. + +Js_of_ocaml_ is a compiler from OCaml to JavaScript. The compiler works by +translating OCaml bytecode to JS files. The compiler can be installed with opam: + +.. code:: console + + $ opam install js_of_ocaml-compiler + +Compiling to JS +=============== + +Dune has full support building js_of_ocaml libraries and executables transparently. +There's no need to customize or enable anything to compile OCaml +libraries/executables to JS. + +To build a JS executable, just define an executable as you would normally. +Consider this example: + +.. code:: console + + $ echo 'print_endline "hello from js"' > foo.ml + +With the following ``dune`` file: + +.. code:: dune + + (executable (name foo) (modes js)) + +And then request the ``.js`` target: + +.. code:: console + + $ dune build ./foo.bc.js + $ node _build/default/foo.bc.js + hello from js + +Similar targets are created for libraries, but we recommend sticking to the +executable targets. + +If you're using the js_of_ocaml syntax extension, you must remember to add the +appropriate PPX in the ``preprocess`` field: + +.. code:: dune + + (executable + (name foo) + (modes js) + (preprocess (pps js_of_ocaml-ppx))) + +Separate Compilation +==================== + +Dune supports two modes of compilation: + +- Direct compilation of a bytecode program to JavaScript. This mode allows + js_of_ocaml to perform whole-program deadcode elimination and whole-program + inlining. + +- Separate compilation, where compilation units are compiled to JavaScript + separately and then linked together. This mode is useful during development as + it builds more quickly. + +The separate compilation mode will be selected when the build profile +is ``dev``, which is the default. It can also be explicitly specified +in an ``env`` stanza (see :doc:`/reference/dune/env`) or per executable +inside ``(js_of_ocaml (compilation_mode ...))`` (see :doc:`/reference/dune/executable`) + +Sourcemap +========= + +Js_of_ocaml can generate sourcemap for the generated JavaScript file. +It can either embed it at the end of the ``.js`` file or write it to separate file. +By default, it is inlined when using the ``dev`` build profile and is not generated otherwise. +The behavior can explicitly be specified in an ``env`` stanza (see :doc:`/reference/dune/env`) +or per executable inside ``(js_of_ocaml (sourcemap ...))`` (see :doc:`/reference/dune/executable`) + +.. _js_of_ocaml: http://ocsigen.org/js_of_ocaml/ diff --git a/unikernel/duniverse/dune_/doc/make-help.txt b/unikernel/duniverse/dune_/doc/make-help.txt new file mode 100644 index 00000000..0064d905 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/make-help.txt @@ -0,0 +1,36 @@ +Welcome to Dune! +================ + +For users +--------- + +To build dune in release mode, please run: + + $ make release + +You can then install dune on your system by typing: + + $ make install + +You can pass PREFIX= to "make install" in order to install Dune +in a specific directory. + +Note that "make release" won't rebuild Dune if you modify it. Use +"make dev" if you want to modify it. + +For developers +-------------- + +All the following commands build Dune in development mode, i.e. with +more warnings enabled. You should build Dune this way if you intend to +work on Dune. + +Here are the following commands you can use: + +- make bootstrap to build the bootstrapped version of dune +- make dev to build the dune binary +- make test to build and run the testsuite +- make doc to build the Dune manual (requires sphinx) +- make livedoc to build the Dune manual and serve it + +You can customize the default target by writing a Makefile.dev file. diff --git a/unikernel/duniverse/dune_/doc/melange.rst b/unikernel/duniverse/dune_/doc/melange.rst new file mode 100644 index 00000000..24e5641e --- /dev/null +++ b/unikernel/duniverse/dune_/doc/melange.rst @@ -0,0 +1,316 @@ +.. _melange_main: + +*********************************** +JavaScript Compilation With Melange +*********************************** + +Introduction +============ + +`Melange `_ compiles OCaml to +JavaScript. It produces one JavaScript file per OCaml module. Melange can +be installed with opam: + +.. code:: console + + $ opam install melange + +Dune can build projects using Melange, and it allows the user to produce +JavaScript files by defining a :ref:`melange-emit` stanza. Dune libraries can be +used with Melange by adding ``melange`` to ``(modes ...)`` in the +:doc:`/reference/dune/library` stanza. + +Melange support is still experimental in Dune and needs to be enabled in the +:doc:`/reference/dune-project/index` file: + +.. code:: dune + + (using melange 0.1) + +Once that's in place, you can use the Melange mode in +:doc:`/reference/dune/library` stanzas ``melange.emit`` stanzas. + +Simple Project +============== + +Let's start by looking at a simple project with Melange and Dune. Subsequent +sections explain the different concepts used here in further detail. + +First, make sure that the :doc:`/reference/dune-project/index` file +specifies at least version 3.8 of the Dune language, and the Melange extension +is enabled: + +.. code:: dune + + (lang dune 3.20) + (using melange 0.1) + +Next, write a :doc:`/reference/dune/index` file with a +:ref:`melange-emit` stanza: + +.. code:: dune + + (melange.emit + (target output)) + +Finally, add a source file to build: + +.. code:: console + + $ echo 'Js.log "hello from melange"' > hello.ml + +After running ``dune build @melange`` or just ``dune build``, Dune +produces the following file structure: + +.. code:: + + . + ├── _build + │ └── default + │ └── output + │ └── hello.js + ├── dune + ├── dune-project + └── hello.ml + +The resulting JavaScript can now be run: + +.. code:: console + + $ node _build/default/output/hello.js + hello from melange + + +Libraries +========= + +Adding Melange support to Dune libraries is done as follows: + +- ``(modes melange)``: adding ``melange`` to ``modes`` is required. This + field also supports the :doc:`reference/ordered-set-language`. + +- ``(melange.runtime_deps )``: optionally, define any runtime dependencies + using ``melange.runtime_deps``. This field is analog to the ``runtime_deps`` + field used in ``melange.emit`` stanzas. + +.. _melange-emit: + +melange.emit +============ + +.. versionadded:: 3.8 + +The ``melange.emit`` stanza allows the user to produce JavaScript files +from Melange libraries and entry-point modules. It's similar to the OCaml +:doc:`/reference/dune/executable` stanza, with the exception that there +is no linking step. + +.. code:: dune + + (melange.emit + (target ) + ) + +```` is the name of the folder where resulting JavaScript artifacts will +be placed. In particular, the folder will be placed under +``_build/default/$path-to-directory-of-melange-emit-stanza``. + +The result of building a ``melange.emit`` stanza will match the file structure +of the source tree. For example, given the following source tree: + +.. code:: + + ├── dune # (melange.emit (target output) (libraries lib)) + ├── app.ml + └── lib + ├── dune # (library (name lib) (modes melange)) + └── helper.ml + +The resulting layout in ``_build/default/output`` will be as follows: + +.. code:: + + output + ├── app.js + └── lib + ├── lib.js + └── helper.js + +```` are: + +- ``(alias )`` specifies an alias to which to attach the targets of + the ``melange.emit`` stanza. + + - These targets include the ``.js`` files generated by the stanza + modules, the targets for the ``.js`` files of any library that the stanza + depends on, and any copy rules for runtime dependencies (see + ``runtime_deps`` field below). + + - By default, all stanzas will have their targets attached to an alias + ``melange``. The behavior of this default alias is exclusive: if an alias + is explicitly defined in the stanza, the targets from this stanza will + be excluded from the ``melange`` alias. + + - The targets of ``melange.emit`` are also attached to the Dune default + alias (:doc:`/reference/aliases/all`), regardless of whether the + ``(alias ...)`` field is present. + +- ``(module_systems )`` specifies the JavaScript import and + export format used. The values allowed for ```` are ``es6`` + and ``commonjs``. + + - ``es6`` will follow `JavaScript modules `_, + and will produce ``import`` and ``export`` statements. + + - ``commonjs`` will follow `CommonJS modules `_, + and will produce `require` calls and export values with ``module.exports``. + + - If no extension is specified, the resulting JavaScript files will use + ``.js``. You can specify a different extension with a pair + ``( )``, e.g. ``(module_systems (es6 mjs))``. + + - Multiple module systems can be used in the same field as long as their + extensions are different. For example, + ``(module_systems commonjs (es6 mjs))`` will produce one set of JavaScript + files using CommonJS and the ``.js`` extension, and another using ES6 and + the ``.mjs`` extension. + +- ``(modules )`` specifies what modules will be built with Melange. By + default, if this field is not defined, Dune will use all the ``.ml/.re`` files + in the same directory as the ``dune`` file. This includes module sources + present in the file system as well as modules generated by user rules. You can + restrict this list by using an explicit ``(modules )`` field. + ```` uses the :doc:`reference/ordered-set-language`, where elements + are module names and don't need to start with an uppercase letter. For + instance, to exclude module ``Foo``, use ``(modules :standard \ foo)``. + +- ``(libraries )`` specifies Melange library dependencies. + Melange libraries can only use the simple form, like + ``(libraries foo pkg.bar)``. Keep in mind the following limitations: + + - The ``re_export`` form is not supported. + + - All the libraries included in ```` have to support + the ``melange`` mode (see the section about libraries below). + + +- ``(package )`` allows the user to define the JavaScript package to + which the artifacts produced by the ``melange.emit`` stanza will belong. + +- ``(runtime_deps )`` specifies dependencies that should be + copied to the build folder together with the ``.js`` files generated from the + sources. These runtime dependencies can include assets like CSS files, images, + fonts, external JavaScript files, etc. ``runtime_deps`` adhere to the formats + in :doc:`concepts/dependency-spec`. For example + ``(runtime_deps ./path/to/file.css (glob_files_rec ./fonts/*))``. + +- ``(emit_stdlib )`` allows the user to specify whether the Melange + standard library should be included as a dependency of the stanza or not. The + default is ``true``. If this option is ``false``, the Melange standard library + and runtime JavaScript files won't be produced in the target directory. + +- ``(promote )`` promotes the generated ``.js`` files to the + source tree. The options are the same as for the + :ref:`rule promote mode `. + Adding ``(promote (until-clean))`` to a ``melange.emit`` stanza will cause + Dune to copy the ``.js`` files to the source tree and ``dune clean`` to + delete them. + +- ``(preprocess )`` specifies how to preprocess files when + needed. The default is ``no_preprocessing``. Additional options are described + in the :doc:`reference/preprocessing-spec` section. + +- ``(preprocessor_deps ())`` specifies extra preprocessor + dependencies, e.g., if the preprocessor reads a generated file. + The dependency specification is described in the :doc:`concepts/dependency-spec` + section. + +- ``(compile_flags )`` specifies compilation flags specific to + ``melc``, the main Melange executable. + ```` is described in detail in the + :doc:`reference/ordered-set-language` section. It also supports + ``(:include ...)`` forms. The value for this field can also be taken + from ``env`` stanzas. It's therefore recommended to add flags + with e.g. ``(compile_flags :standard )`` rather than + replace them. + +- ``(root_module )`` specifies a ``root_module`` that collects all + listed dependencies in ``libraries``. See the documentation for + ``root_module`` in the :doc:`/reference/dune/library` stanza. + +- ``(allow_overlapping_dependencies)`` is the same as the corresponding field + of :doc:`/reference/dune/library`. + +- ``(enabled_if )`` conditionally disables a melange emit + stanza. The JavaScript files associated with the stanza won't be built. The + condition is specified using the :doc:`reference/boolean-language`. + +Recommended Practices +===================== + +Keep Bundles Small by Reducing the Number of ``melange.emit`` Stanzas +--------------------------------------------------------------------- + +It is recommended to minimize the number of ``melange.emit`` stanzas +that a project defines: using multiple ``melange.emit`` stanzas will cause +multiple copies of the JavaScript files to be generated if the same libraries +are used across them. As an example: + +.. code:: dune + + (melange.emit + (target app1) + (libraries foo)) + + (melange.emit + (target app2) + (libraries foo)) + +The JavaScript artifacts for library ``foo`` will be emitted twice in the +``_build`` folder. They will be present under ``_build/default/app1`` +and ``_build/default/app2``. + +This can have unexpected impact on bundle size when using tools like Webpack or +Esbuild, as these tools will not be able to see shared library code as such, +as it would be replicated across the paths of the different stanzas +``target`` folders. + + +Faster Builds With ``subdir`` and ``dirs`` Stanzas +-------------------------------------------------- + +Melange libraries might be installed from the ``npm`` package repository, +together with other JavaScript packages. To avoid having Dune inspect +unnecessary folders in ``node_modules``, it is recommended to explicitly +include only the folders that are relevant for Melange builds. + +This can be accomplished by combining :doc:`/reference/dune/subdir` and +:doc:`/reference/dune/subdir` stanzas in a ``dune`` file next to the +``node_modules`` folder. The :doc:`/reference/dune/vendored_dirs` stanza +can be used to avoid warnings in Melange libraries during the application +build. The :doc:`/reference/dune/data_only_dirs` stanza can be useful as +well if you need to override the build rules in one of the packages. + +.. code:: dune + + (subdir + node_modules + (vendored_dirs reason-react) + (dirs reason-react)) + + +Design choices +===================== + +Melange support in Dune follows the following design choices: + +- :ref:`melange-emit` produces a "total" directory: the artifacts in the + ``target`` dir contain all the JavaScript and ``runtime_deps`` assets + necessary to run the application either through a JS framework, a bundler, or + otherwise a deployment (excluding external dependencies installed via a JS + package manager). The structure is designed such that relative paths and + dependencies work out of the box relative to their paths in the source tree, + before compilation. +- public libraries are compiled to ``%{target}/node_modules/%{lib_name}`` such + that the `resolution algorithm `_ + works to resolve Melange libraries from compiled JS code. diff --git a/unikernel/duniverse/dune_/doc/misc/index.rst b/unikernel/duniverse/dune_/doc/misc/index.rst new file mode 100644 index 00000000..6659e93a --- /dev/null +++ b/unikernel/duniverse/dune_/doc/misc/index.rst @@ -0,0 +1,12 @@ +Miscellaneous +============= + +These documents contain tidbits of info that do not fit anywhere else, and +information about the project itself. + +.. toctree:: + :maxdepth: 2 + + ../faq + ../goals + ../hacking diff --git a/unikernel/duniverse/dune_/doc/overview.rst b/unikernel/duniverse/dune_/doc/overview.rst new file mode 100644 index 00000000..830ff8de --- /dev/null +++ b/unikernel/duniverse/dune_/doc/overview.rst @@ -0,0 +1,179 @@ +******** +Overview +******** + +.. TODO(diataxis) + + Split into: + + - info on the index page + - :doc:`glossary` + - a history page that could also explain the various actors + +Introduction +============ + +Dune is a build system for OCaml (with support for Reason and Coq). It is not +intended as a completely generic build system that's able to build any project +in any language. On the contrary, it makes lots of choices in order to encourage +a consistent development style. + +This scheme is inspired from the one used inside Jane Street and adapted to the +opam world. It has matured over a long time and is used daily by hundreds of +developers, which means that it is highly tested and productive. + +When using Dune, you give very little, high-level information to the build +system, which in turn takes care of all the low-level details from the +compilation of your libraries, executables, and documentation to the +installation, setting up of tests, and setting up development tools such as +Merlin, etc. + +In addition to the normal features expected from an OCaml build system, Dune +provides a few additional ones that separate it from the crowd: + +- You never need to tell Dune the location of things such as libraries. Dune + will discover them automatically. In particular, this means that when you + want to reorganise your project, you need nothing other than to rename your + directories, Dune will do the rest. + +- Things always work the same whether your dependencies are local or installed + on the system. In particular, this means that you can insert the source for a + project dependency in your working copy, and Dune will start using it + immediately. This makes Dune a great choice for multi-project development. + +- Cross-platform: as long as your code is portable, Dune will be able to + cross-compile it. Read more in the :ref:`cross-compilation` section. + +- Release directly from any revision: Dune needs no setup stage. To release + your project, simply point to a specific Git tag (named revision). Of course, + you can add some release steps if you'd like, but it isn't necessary. For + more information, please refer to dune-release_. + +.. _dune-release: https://github.com/tarides/dune-release + +The first section below defines some terms used in this manual. The second +section specifies the Dune metadata format, and the third one describes how to +use the ``dune`` command. + +Terminology +=========== + +.. glossary:: + root + The top-most directory in a GitHub repo, workspace, and project, + differentiated by variables such as ``%{workspace_root}`` and + ``%{project_root}``. Dune builds things from this directory. It knows how to + build targets that are descendants of the root. Anything outside of the tree + starting from the root is considered part of the :term:`installed world`. + Refer to :ref:`finding-root` to learn how the workspace root is determined. + + workspace + The subtree starting from each root. It can contain any number of projects + that will be built simultaneously by Dune, and it must contain a + ``dune-workspace`` file. + + project + A collection of source files that must include a ``dune-project`` file. It + may also contain one or more packages. A project consists in a hierarchy + of directories. Every directory (at the root, or a subdirectory) can + contain a ``dune`` file that contains instructions to build files in that + directory. Projects can be shared between different applications. + + package + A set of libraries and executables that opam builds and installs as one. + + installed world + Anything outside of the workspace. Dune doesn't know how to build things + in the installed world. + + installation + The action of copying build artifacts or other files from the + ``/_build`` directory to the :term:`installed world`. + + scope + Defined by any directory that contains at least one `.opam` file. + Typically, every project defines a single scope that is a subtree starting + from this directory. Moreover, scopes are separate from your project's + dependencies. The scope also determines where private items are visible. + Private items include libraries or binaries that will not be installed. + See :doc:`/explanation/scopes` for more details. + + build context + A specific configuration written in a + :doc:`/reference/dune-workspace/index` file, which has a + corresponding subdirectory in the ``/_build`` directory. It contains + all the workspace's build artifacts. Without this specific configuration + from the user, there is always a ``default`` build context that + corresponds to the executed Dune environment. + + build context root + The root of a build context named ``foo`` is ``/_build/``. + + build target + Specified on the command line, e.g., ``dune build ``. All + targets that Dune knows how to build live in the ``_build`` directory. + + alias + A build target that doesn't produce any file and has configurable + dependencies. Targets starting with ``@`` on the command line are + interpreted as aliases (e.g., ``dune build @src/runtest``). Aliases are + per-directory. See :doc:`reference/aliases`. + + environment + Determines the default values of various parameters, such as the + compilation flags. In Dune, each directory has an environment attached to + it. Inside a scope, each directory inherits the environment from its + parent. At the root of every scope, a default environment is used. At any + point, the environment can be altered using an + :doc:`/reference/dune/env` stanza. + + build profile + A global setting that influences various defaults. It can be set from the + command line using ``--profile `` or from ``dune-workspace`` + files. The following profiles are standard: + + - ``release`` which is the profile used for opam releases + - ``dev`` which is the default profile when none is set explicitly, it has + stricter warnings than the ``release`` one + + dialect + An alternative frontend to OCaml (such as ReasonML). It is described + by a pair of file extensions, one corresponding to interfaces and one to + implementations. It can use the standard OCaml syntax, or it can specify an + action to convert from a custom syntax to a binary OCaml abstract syntax + tree. It can also specify a custom formatter. + + placeholder substitution + A build step in which placeholders such as ``3.20.2`` in source files + are replaced by concrete values such as ``1.2.3``. It is performed by + :ref:`dune-subst` for development versions and dune-release_ for + releases. + + stanza + A fragment of a file interpreted by Dune, that will appear as a + s-expression at the top-level of a file. For example, the + :doc:`/reference/dune/library` stanza describes a library. This can be + either a generic term ("the library stanza") or it can refer to a + particular instance in a file ("the executable stanza in ``bin/dune``"). + +Project Layout +============== + +A typical Dune project will have a ``dune-project`` and one or more +``.opam`` files at the root as well as ``dune`` files wherever +interesting things are: libraries, executables, tests, documents to install, +etc. + +We recommend organising your project to have exactly one library per +directory. You can have several executables in the same directory, as long as +they share the same build configuration. If you'd like to have multiple +executables with different configurations in the same directory, you will have +to make an explicit module list for every executable using ``modules``. + +History +======= + +Dune started as ``jbuilder`` in late 2016. When its 1.0.0 version was released +in 2018, the name has been changed to ``dune``. It used to be configured with +``jbuild`` and ``jbuild-workspace`` files with a slightly different syntax. +After a transition period, this syntax is not supported anymore. diff --git a/unikernel/duniverse/dune_/doc/papers/.gitignore b/unikernel/duniverse/dune_/doc/papers/.gitignore new file mode 100644 index 00000000..a1363379 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/papers/.gitignore @@ -0,0 +1 @@ +*.pdf diff --git a/unikernel/duniverse/dune_/doc/papers/ocaml-2022/README.md b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/README.md new file mode 100644 index 00000000..ae62d818 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/README.md @@ -0,0 +1,4 @@ +A paper describing the Memo library presented at the OCaml Users and +Developers Workshop 2022. + +To render a PDF version, run `pandoc memo.md --citeproc -H header.tex -o memo.pdf`. diff --git a/unikernel/duniverse/dune_/doc/papers/ocaml-2022/header.tex b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/header.tex new file mode 100644 index 00000000..20166017 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/header.tex @@ -0,0 +1,10 @@ +% Run Pandoc with -H header.tex to apply these changes + +\usepackage{url} + +\definecolor{inline_code_colour}{HTML}{000080} + +\let\oldtexttt\texttt +\renewcommand{\texttt}[1]{\textcolor{inline_code_colour}{\oldtexttt{#1}}} + +\urlstyle{sf} diff --git a/unikernel/duniverse/dune_/doc/papers/ocaml-2022/memo.md b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/memo.md new file mode 100644 index 00000000..03e15117 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/memo.md @@ -0,0 +1,151 @@ +--- +geometry: "left=2cm,right=2cm,top=2.4cm,bottom=2.1cm" +bibliography: refs.bib +csl: refs.csl +--- + +# Memo: an incremental computation library that powers Dune + +Andrey Mokhov, Arseniy Alekseyev + +*Jane Street, London, United Kingdom* + +### Abstract + +We present Memo, an incremental computation library that supports a new, faster +and more scalable, file-watching build mode in Dune 3.0. The requirements from +the build systems domain make Memo a unique point in the design space of +incremental computation libraries. Specifically, Memo needs to cope with +concurrency, dynamic dependencies, dependency cycles, and non-determinism; +provide support for efficiently collecting and reporting user-friendly errors; +and scale to computation graphs containing tens of millions of incremental +nodes. + +## Introduction + +The OCaml build system Dune [@dune] supports a continuous file-watching build +mode, where rebuilds are triggered automatically as the user is editing source +files. A simple and naive way to implement this functionality is to restart Dune +on any file change but that is too slow for large projects. To avoid re-scanning +the project's source tree, re-parsing all build specification files, and +re-generating all build rules from scratch every time, Dune uses an incremental +computation library called Memo. Below we briefly introduce the Memo's API. + +Memo provides a monadic API built on top of the *structured concurrency monad* +`Fiber`. Dune uses `Fiber` to speed up builds by executing external commands in +parallel, e.g., running multiple instances of `ocamlopt` to compile independent +source files. To inject a *fiber* into the `Memo` monad, and to extract it back, +one can use the following pair of functions: + +```ocaml + val of_fiber : 'a Fiber.t -> 'a Memo.t + val run : 'a Memo.t -> 'a Fiber.t +``` + +More interestingly, functions in the `Memo` monad can be memoized and cached +between different build runs[^1]: + +[^1]: The function `create` takes a few more arguments, e.g., for reporting good +error messages, which we omit for the sake of clarity. + +```ocaml + val create : ('i -> 'o Memo.t) -> ('i, 'o) Memo.Table.t + val exec : ('i, 'o) Memo.Table.t -> 'i -> 'o Memo.t +``` + +Here `Memo.Table.t` is a table that stores the input/output mapping computed in +the current run, along with the *dependencies* that are automatically captured +when memoized functions call one another. Such explicit memoization, instead of, +e.g., memoizing every `Memo.map` and `Memo.bind` call, makes it easy to control +the degree of incrementality. + +Finally, Memo provides a way to *invalidate* a specific input/output pair, or a +*cell*, via the following API: + +```ocaml + val cell : ('i, 'o) Memo.Table.t -> 'i -> ('i, 'o) Cell.t + val invalidate : ('i, 'o) Cell.t -> Invalidation.t (* [Invalidation.t]s can be combined *) + val restart : Invalidation.t -> unit +``` + +When Dune receives new events from the file-watching backend, it cancels the +build run by interrupting the currently running external commands (if any), and +then calls `restart` to let Memo know which files changed and initiate a new +build run. When evaluating future calls to `run`, Memo will consider all outputs +that transitively depend on the invalidated cells as out of date, and will +recompute them when/if needed. + +## Key features + +This section discusses the most interesting features of Memo and some aspects of +the implementation. + +Firstly, to *capture dependencies*, Memo maintains a call stack, where stack +frames correspond to `exec` calls. The call stack is also used for reporting +good error messages: when a user-supplied function raises an exception, we +extend it with the current Memo stack trace using human-readable annotations +provided to `create` via an optional argument. + +Memo supports two ways of *error reporting*: *early* (to show errors to the user +as soon as they occur during a build), and *deterministic* (to provide a stable +error summary at the end of the build). To speed up rebuilds, Memo also supports +*error caching*: by default, it doesn't recompute a `Memo` function that +previously failed if its dependencies are up to date. This behaviour can be +overridden for *non-reproducible errors* that should not be cached, for example, +the errors that occur while Dune cancels the current build by interrupting the +execution of external commands. + +One of the most interesting features of Memo compared to other incremental +computation libraries is *dependency cycle detection*. +Since Dune supports *dynamic build dependencies* [@mokhov2020build], the +dependency graph is not known before the build starts. During the build, new +computation nodes and dependency edges are discovered concurrently, and Memo +uses an incremental cycle detection algorithm [@gueneau2019cycles] to detect and +report dependency cycles as soon as they are created. This is a unique feature +of Memo: Incremental [@incremental] and Adapton [@hammer2014adapton] libraries +do not support concurrency; the Tenacious library (used by Jane Street's +internal build system Jenga) does support concurrency but it detects cycles by +"stopping the world" and traversing the "frozen" dependency graph to see if +concurrent computations might have deadlocked by waiting for each other. The +approach used by Tenacious is conceptually simple but introduces a delay between +the creation of a dependency cycle and its detection. Memo reports dependency +cycle errors without delay, and uses the human-readable annotations supplied to +`create` to make it easier to understand and debug cycles. + +Compared to the incremental computation libraries mentioned above, the current +implementation of Memo makes one unusual design choice. Incremental, Adapton and +Tenacious are all *push based*, i.e., they trigger recomputation starting from +the leaves of the computation graph. Memo is *pull based*: `invalidate` calls +merely mark leaves (cells) as out of date, but recomputation is driven from the +top-level `run` calls. The main drawback of our approach is that Memo traverses +the whole graph on each rebuild. The main benefits are: (i) Memo +doesn't need to store reverse dependencies, which saves space and eliminates +various garbage collection pitfalls; (ii) the pull based approach makes it +easier to avoid "spurious" recomputations, where a node is recomputed but +subsequently becomes unreachable from the top due to a new dependency structure. +Our current experiments show that traversing the whole graph on each rebuild +isn't prohibitively expensive even for large builds where computation graphs +contain tens of millions of nodes. We may rethink this design decision in future +as Dune and Memo need to scale to larger projects. Having said that, we consider +the pull based approach to incremental computation to be under-researched, and +are keen to investigate how far we can take it in practice. + +## Development status + +Memo is still in active development and we welcome feedback from the OCaml +community on how to make it better. While the current implementation is tied to +Dune's lightweight concurrency library Fiber, the core functionality can be made +available as a functor over an arbitrary concurrency monad, making it usable +with Async and Lwt. + +## Acknowledgements + +We thank Jeremie Dimino for driving the design of Memo and for his work on +incrementalising Dune. We are also grateful to Rudi Horn, Rudi Grinberg, Emilio Jesús Gallego +Arias and other Dune developers for their many contributions, and to Armaël +Guéneau for helping us integrate the incremental cycle detection library in +Memo. + +# References + + diff --git a/unikernel/duniverse/dune_/doc/papers/ocaml-2022/refs.bib b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/refs.bib new file mode 100644 index 00000000..455350f5 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/refs.bib @@ -0,0 +1,43 @@ +@unpublished{dune, + title = {{Dune: A composable build system}}, + author = {{Jane~Street}}, + year = {2018}, + note = "\url{https://dune.build}" +} + +@article{mokhov2020build, + title={Build systems {\`a} la carte: Theory and practice}, + author={Mokhov, Andrey and Mitchell, Neil and Peyton Jones, Simon}, + journal={Journal of Functional Programming}, + volume={30}, + year={2020}, + publisher={Cambridge University Press}, + note={\url{https://doi.org/10.1017/S0956796820000088}} +} + +@inproceedings{gueneau2019cycles, + title={Formal proof and analysis of an incremental cycle detection algorithm}, + author={Gu{\'e}neau, Arma{\"e}l and Jourdan, Jacques-Henri and Chargu{\'e}raud, Arthur and Pottier, Fran{\c{c}}ois}, + booktitle={Interactive Theorem Proving}, + number={141}, + year={2019}, + organization={Schloss Dagstuhl--Leibniz-Zentrum fuer Informatik} +} + +@unpublished{incremental, + title = {{Incremental: Library for incremental computations}}, + author = {{Jane~Street}}, + year = {2015}, + note = "\url{https://opensource.janestreet.com/incremental}" +} + +@article{hammer2014adapton, + title={Adapton: Composable, demand-driven incremental computation}, + author={Hammer, Matthew and Phang, Khoo Yit and Hicks, Michael and Foster, Jeffrey}, + journal={ACM SIGPLAN Notices}, + volume={49}, + number={6}, + pages={156--166}, + year={2014}, + publisher={ACM New York, NY, USA} +} diff --git a/unikernel/duniverse/dune_/doc/papers/ocaml-2022/refs.csl b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/refs.csl new file mode 100644 index 00000000..784d5e93 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/papers/ocaml-2022/refs.csl @@ -0,0 +1,69 @@ + + diff --git a/unikernel/duniverse/dune_/doc/quick-start.rst b/unikernel/duniverse/dune_/doc/quick-start.rst new file mode 100644 index 00000000..a2e0a70f --- /dev/null +++ b/unikernel/duniverse/dune_/doc/quick-start.rst @@ -0,0 +1,498 @@ +********** +Quickstart +********** + +.. TODO(diataxis) + + Split this into: + + - :doc:`tutorials/from-zero-to-opam` + - :doc:`tutorials/developing-with-dune` + - :doc:`howto/changing-flags` + - an how-to guide about ``cppo`` + - an how-to guide about staged programming / generators + - an how-to guide about testing + +This document gives simple usage examples of Dune. You can also look at +`examples `__ for complete +examples of projects using Dune with `CRAM stanzas `__. + +To try these examples, you will need to have Dune installed. See +:doc:`howto/install-dune`. + +Initializing Projects +===================== + +The following subsections illustrate basic usage of the ``dune init proj`` +subcommand. For more documentation, see :ref:`initializing_components` and the +inline help available from ``dune init --help``. + +.. _initializing-an-executable: + +Initializing an Executable +-------------------------- + +To initialize a project that will build an executable program, run the following +(replacing ``project_name`` with the name of your project): + +.. code:: console + + $ dune init proj project_name + +This creates a project directory that includes the following contents: + +.. code:: + + project_name/ + ├── dune-project + ├── test + │ ├── dune + │ └── test_project_name.ml + ├── lib + │   └── dune + ├── bin + │   ├── dune + │   └── main.ml + └── project_name.opam + +Now, enter your project's directory: + +.. code:: console + + $ cd project_name + +Then, you can build your project with: + +.. code:: console + + $ dune build + +You can run your tests with: + +.. code:: console + + $ dune test + +You can run your program with: + +.. code:: console + + $ dune exec project_name + +This simple project will print "Hello World" in your shell. + +The following itemization of the generated content isn't necessary to review at +this point. But whenever you are ready, it will provide jump-off points from +which you can dive deeper into Dune's capabilities: + +* The ``dune-project`` file specifies metadata about the project, including its + name, packaging data (including dependencies), and information about the + authors and maintainers. Open this in your editor to fill in the + placeholder values. See :doc:`/reference/dune-project/index` for + details. +* The ``test`` directory contains a skeleton for your project's tests. Add to + the tests by editing ``test/test_project_name.ml``. See :ref:`writing-tests` for + details on testing. +* The ``lib`` directory will hold the library you write to provide your executable's core + functionality. Add modules to your library by creating new + ``.ml`` files in this directory. See :doc:`/reference/dune/library` for + details on specifying libraries manually. +* The ``bin`` directory holds a skeleton for the executable program. Within the + modules in this directory, you can access the modules in your ``lib`` under + the namespace ``project_name.Mod``, where ``project_name`` is replaced with + the name of your project and ``Mod`` corresponds to the name of the file in + the ``lib`` directory. You can run the executable with ``dune exec + project_name``. See :ref:`hello-world-program` for an example of specifying + an executable manually and :doc:`/reference/dune/executable` for + details. +* The ``project_name.opam`` file will be freshly generated from the + ``dune-project`` file whenever you build your project. You shouldn't need to + worry about this, but you can see :doc:`explanation/opam-integration` for + details. +* The ``dune`` files in each directory specify the component to be built with + the files in that directory. For details on ``dune`` files, see :doc:`/reference/dune/index`. + +Initializing a Library +---------------------- + +To initialize a project for an OCaml library, run the following (replacing +``project_name`` with the name of your project): + +.. code:: console + + $ dune init proj --kind=lib project_name + +This creates a project directory that includes the following contents: + +.. code:: + + project_name/ + ├── dune-project + ├── lib + │   └── dune + ├── test + │ ├── dune + │ └── test_project_name.ml + └── project_name.opam + +Now, enter your project's directory: + +.. code:: console + + $ cd project_name + +Then, you can build your project with: + +.. code:: console + + $ dune build + +You can run your tests with: + +.. code:: console + + $ dune test + +All of the subcomponents generated are the same as those described in +:ref:`initializing-an-executable`, with the following exceptions: + +* There is no ``bin`` directory generated. +* The ``dune`` file in the ``lib`` directory specifies that the library should + be *public*. See :doc:`/reference/dune/library` for details. + +.. _hello-world-program: + +Building a Hello World Program From Scratch +=========================================== + +Create a new directory within a Dune project (:ref:`initializing-an-executable`). +Since OCaml is a compiled language, first create a ``dune`` file in Nano, Vim, +or your preferred text editor. Declare the ``hello_world`` executable by including the following stanza +(shown below). Name this initial file ``dune`` and save it. + +.. code:: dune + + (executable + (name hello_world)) + +Create a second file containing the following code and name it ``hello_world.ml`` (including +the .ml extension). It will implement the executable stanza in the ``dune`` file when built. + +.. code:: ocaml + + print_endline "Hello, world!" + +Next, build your new program in a shell using this command: + +.. code:: console + + $ dune build hello_world.exe + +This will create a directory called ``_build`` and build the +program: ``_build/default/hello_world.exe``. Note that +native code executables will have the ``.exe`` extension on all platforms +(including non-Windows systems). + +Finally, run it with the following command to see that it worked. In +fact, the executable can both be built and run in a single +step: + +.. code:: console + + $ dune exec -- ./hello_world.exe + +Voila! This should print "Hello, world!" in the command line. + +Building a Hello World Program Using Lwt +======================================== + +Lwt is a concurrent library in OCaml. + +In a directory of your choice, write this ``dune`` file: + +.. code:: dune + + (executable + (name hello_world) + (libraries lwt.unix)) + +This ``hello_world.ml`` file: + +.. code:: ocaml + + Lwt_main.run (Lwt_io.printf "Hello, world!\n") + +And build it with: + +.. code:: console + + $ dune build hello_world.exe + +The executable will be built as ``_build/default/hello_world.exe`` + +Building a Hello World Program Using Core and Jane Street PPXs +============================================================== + +Write this ``dune`` file: + +.. code:: dune + + (executable + (name hello_world) + (libraries core) + (preprocess (pps ppx_jane))) + +This ``hello_world.ml`` file: + +.. code:: ocaml + + open Core + + let () = + Sexp.to_string_hum [%sexp ([3;4;5] : int list)] + |> print_endline + +And build it with: + +.. code:: console + + $ dune build hello_world.exe + +The executable will be built as ``_build/default/hello_world.exe`` + + +Defining a Library Using Lwt and ``ocaml-re`` +============================================= + +Write this ``dune`` file: + +.. code:: dune + + (library + (name mylib) + (public_name mylib) + (libraries re lwt)) + +The library will be composed of all the modules in the same directory. +Outside of the library, module ``Foo`` will be accessible as +``Mylib.Foo``, unless you write an explicit ``mylib.ml`` file. + +You can then use this library in any other directory by adding ``mylib`` +to the ``(libraries ...)`` field. + +Building a Hello World Program in Bytecode +============================================ + +In a directory of your choice, write this ``dune`` file: + +.. code:: dune + + ;; This declares the hello_world executable implemented by hello_world.ml + ;; to be build as native (.exe) or bytecode (.bc) version. + (executable + (name hello_world) + (modes byte exe)) + +This ``hello_world.ml`` file: + +.. code:: ocaml + + print_endline "Hello, world!" + +And build it with: + +.. code:: console + + $ dune build hello_world.bc + +The executable will be built as ``_build/default/hello_world.bc``. +The executable can be built and run in a single +step with ``dune exec ./hello_world.bc``. This bytecode version allows the usage of +``ocamldebug``. + +Setting the OCaml Compilation Flags Globally +============================================ + +Write this ``dune`` file at the root of your project: + +.. code:: dune + + (env + (dev + (flags (:standard -w +42))) + (release + (ocamlopt_flags (:standard -O3)))) + +`dev` and `release` correspond to build profiles. The build profile +can be selected from the command line with ``--profile foo`` or from a +`dune-workspace` file by writing: + +.. code:: dune + + (profile foo) + +Using Cppo +========== + +Add this field to your ``library`` or ``executable`` stanzas: + +.. code:: dune + + (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) + +Additionally, if you want to include a ``config.h`` file, you need to +declare the dependency to this file via: + +.. code:: dune + + (preprocessor_deps config.h) + +Using the ``.cppo.ml`` Style Like the ``ocamlbuild`` Plugin +----------------------------------------------------------- + +Write this in your ``dune`` file: + +.. code:: dune + + (rule + (targets foo.ml) + (deps (:first-dep foo.cppo.ml) ) + (action (run %{bin:cppo} %{first-dep} -o %{targets}))) + +Defining a Library with C Stubs +=============================== + +Assuming you have a file called ``mystubs.c``, that you need to pass +``-I/blah/include`` to compile it and ``-lblah`` at link time, write +this ``dune`` file: + +.. code:: dune + + (library + (name mylib) + (public_name mylib) + (libraries re lwt) + (foreign_stubs + (language c) + (names mystubs) + (flags -I/blah/include)) + (c_library_flags (-lblah))) + +Defining a Library with C Stubs using ``pkg-config`` +==================================================== + +Same context as before, but using ``pkg-config`` to query the +compilation and link flags. Write this ``dune`` file: + +.. code:: dune + + (library + (name mylib) + (public_name mylib) + (libraries re lwt) + (foreign_stubs + (language c) + (names mystubs) + (flags (:include c_flags.sexp))) + (c_library_flags (:include c_library_flags.sexp))) + + (rule + (targets c_flags.sexp c_library_flags.sexp) + (action (run ./config/discover.exe))) + +Then create a ``config`` subdirectory and write this ``dune`` file: + +.. code:: dune + + (executable + (name discover) + (libraries dune-configurator)) + +as well as this ``discover.ml`` file: + +.. code:: ocaml + + module C = Configurator.V1 + + let () = + C.main ~name:"foo" (fun c -> + let default : C.Pkg_config.package_conf = + { libs = ["-lgst-editing-services-1.0"] + ; cflags = [] + } + in + let conf = + match C.Pkg_config.get c with + | None -> default + | Some pc -> + match (C.Pkg_config.query pc ~package:"gst-editing-services-1.0") with + | None -> default + | Some deps -> deps + in + + + C.Flags.write_sexp "c_flags.sexp" conf.cflags; + C.Flags.write_sexp "c_library_flags.sexp" conf.libs) + + +Using a Custom Code Generator +============================= + +To generate a file ``foo.ml`` using a program from another directory: + +.. code:: dune + + (rule + (targets foo.ml) + (deps (:gen ../generator/gen.exe)) + (action (run %{gen} -o %{targets}))) + +Defining Tests +============== + +Write this in your ``dune`` file: + +.. code:: dune + + (test (name my_test_program)) + +And run the tests with: + +.. code:: console + + $ dune runtest + +It will run the test program (the main module is ``my_test_program.ml``) and +error if it exits with a nonzero code. + +In addition, if a ``my_test_program.expected`` file exists, it will be compared +to the standard output of the test program and the differences will be +displayed. It is possible to replace the ``.expected`` file with the last output +using: + +.. code:: console + + $ dune promote + +Building a Custom Toplevel +========================== + +A toplevel is simply an executable calling ``Topmain.main ()`` and linked with +the compiler libraries and ``-linkall``. Moreover, currently toplevels can only +be built in bytecode. + +As a result, write this in your ``dune`` file: + +.. code:: dune + + (executable + (name mytoplevel) + (libraries compiler-libs.toplevel mylib) + (link_flags (-linkall)) + (modes byte)) + +And write this in ``mytoplevel.ml``: + +.. code:: ocaml + + let () = exit (Topmain.main ()) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/bash.rst b/unikernel/duniverse/dune_/doc/reference/actions/bash.rst new file mode 100644 index 00000000..e582c192 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/bash.rst @@ -0,0 +1,12 @@ +bash +---- + +.. highlight:: dune + +.. describe:: (bash ) + + Execute a command using ``/bin/bash``. This is obviously not very portable. + + Example:: + + (bash "echo $PATH") diff --git a/unikernel/duniverse/dune_/doc/reference/actions/cat.rst b/unikernel/duniverse/dune_/doc/reference/actions/cat.rst new file mode 100644 index 00000000..f2443f0a --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/cat.rst @@ -0,0 +1,12 @@ +cat +--- + +.. highlight:: dune + +.. describe:: (cat ...) + + Sequentially print the contents of files to stdout. + + Example:: + + (cat data.txt) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/chdir.rst b/unikernel/duniverse/dune_/doc/reference/actions/chdir.rst new file mode 100644 index 00000000..df5aeaeb --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/chdir.rst @@ -0,0 +1,13 @@ +chdir +----- + +.. highlight:: dune + +.. describe:: (chdir ) + + Run an action in a different directory. + + Example:: + + (chdir src + (run ./build.exe)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/cmp.rst b/unikernel/duniverse/dune_/doc/reference/actions/cmp.rst new file mode 100644 index 00000000..5e154c7c --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/cmp.rst @@ -0,0 +1,13 @@ +cmp +--- + +.. highlight:: dune + +.. describe:: (cmp ) + + ``(cmp )`` is similar to ``(run cmp )`` but + allows promotion. See :doc:`/concepts/promotion` for more details. + + Example:: + + (cmp bin.expected bin.output) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/concurrent.rst b/unikernel/duniverse/dune_/doc/reference/actions/concurrent.rst new file mode 100644 index 00000000..0f0a4f5a --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/concurrent.rst @@ -0,0 +1,19 @@ +concurrent +---------- + +.. highlight:: dune + +.. describe:: (concurrent ...) + + Execute several commands concurrently and collect all resulting errors, if any. + + .. warning:: The concurrency is limited by the ``-j`` flag passed to Dune. + In particular, if Dune is running with ``-j 1``, these commands will + actually run sequentially, which may cause a deadlock if they talk to + each other. + + Example:: + + (concurrent + (run ./proga.exe) + (run ./progb.exe)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/copy#.rst b/unikernel/duniverse/dune_/doc/reference/actions/copy#.rst new file mode 100644 index 00000000..39f80e34 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/copy#.rst @@ -0,0 +1,27 @@ +copy# +----- + +.. highlight:: dune + +.. describe:: (copy# ) + + Copy a file and add a line directive at the beginning. + + Example:: + + (copy# config.windows.ml config.ml) + + More precisely, ``copy#`` inserts the following line: + + .. code:: ocaml + + # 1 "" + + Most languages recognize such lines and update their current location to + report errors in the original file rather than the copy. This is important + because the copy exists only under the ``_build`` directory, and in order + for editors to jump to errors when parsing the build system's output, errors + must point to files that exist in the source tree. In the beta versions of + Dune, ``copy#`` was called ``copy-and-add-line-directive``. However, most of + time, one wants this behavior rather than a bare copy, so it was renamed to + something shorter. diff --git a/unikernel/duniverse/dune_/doc/reference/actions/copy.rst b/unikernel/duniverse/dune_/doc/reference/actions/copy.rst new file mode 100644 index 00000000..e7d8c5b4 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/copy.rst @@ -0,0 +1,14 @@ +copy +---- + +.. highlight:: dune + +.. describe:: (copy ) + + Copy a file. If these files are OCaml sources, you should follow the + ``module_name.xxx.ml`` :ref:`naming convention ` to + preserve Merlin's functionality. + + Example:: + + (copy data.txt.template data.txt) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/diff.rst b/unikernel/duniverse/dune_/doc/reference/actions/diff.rst new file mode 100644 index 00000000..974d9445 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/diff.rst @@ -0,0 +1,14 @@ +diff +---- + +.. highlight:: dune + +.. describe:: (diff ) + + ``(diff )`` is similar to ``(run diff )`` but + is better and allows promotion. See :doc:`/concepts/promotion` for more + details. + + Example:: + + (diff test.expected test.output) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/diffq.rst b/unikernel/duniverse/dune_/doc/reference/actions/diffq.rst new file mode 100644 index 00000000..bfe77291 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/diffq.rst @@ -0,0 +1,16 @@ +diff? +----- + +.. highlight:: dune + +.. describe:: (diff? ) + + ``(diff? )`` is similar to ``(diff )`` except + that ```` should be produced by a part of the same action rather than + be a dependency, is optional and will be consumed by ``diff?``. + + Example:: + + (progn + (with-stdout-to test.output (run ./test.exe)) + (diff? test.expected test.output)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/dynamic-run.rst b/unikernel/duniverse/dune_/doc/reference/actions/dynamic-run.rst new file mode 100644 index 00000000..6e83343c --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/dynamic-run.rst @@ -0,0 +1,13 @@ +dynamic-run +----------- + +.. highlight:: dune + +.. describe:: (dynamic-run ) + + Execute a program that was linked against the ``dune-action-plugin`` library. + ```` is resolved in the same way as in :doc:`run`. + + Example:: + + (dynamic-run ./plugin.exe) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/echo.rst b/unikernel/duniverse/dune_/doc/reference/actions/echo.rst new file mode 100644 index 00000000..fc50b13b --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/echo.rst @@ -0,0 +1,12 @@ +echo +---- + +.. highlight:: dune + +.. describe:: (echo ) + + Output a string on ``stdout``. + + Example:: + + (echo "Hello, world") diff --git a/unikernel/duniverse/dune_/doc/reference/actions/format-dune-file.rst b/unikernel/duniverse/dune_/doc/reference/actions/format-dune-file.rst new file mode 100644 index 00000000..9dc5a3e8 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/format-dune-file.rst @@ -0,0 +1,14 @@ +cat +--- + +.. highlight:: dune + +.. describe:: (format-dune-file ) + + Output the formatted contents of the file ```` to ````. The source + file is assumed to contain S-expressions. Note that the precise formatting + can depend on the version of the Dune language used by containing project. + + Example:: + + (format-dune-file file.sexp file.sexp.formatted) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/ignore-outputs.rst b/unikernel/duniverse/dune_/doc/reference/actions/ignore-outputs.rst new file mode 100644 index 00000000..940eeb70 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/ignore-outputs.rst @@ -0,0 +1,14 @@ +ignore- +---------------- + +.. highlight:: dune + +.. describe:: (ignore- ) + + Ignore the output, where ```` is one of: ``stdout``, ``stderr``, or + ``outputs``. + + Example:: + + (ignore-stderr + (run ./get-conf.exe)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/index.rst b/unikernel/duniverse/dune_/doc/reference/actions/index.rst new file mode 100644 index 00000000..9a31b198 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/index.rst @@ -0,0 +1,120 @@ +Actions +======= + +.. highlight:: dune + +``(action ...)`` fields describe user actions. + +User actions are always run from the same subdirectory of the current build +context as the ``dune`` file they are defined in, so for instance, an action defined +in ``src/foo/dune`` will be run from ``$build//src/foo``. + +The argument of ``(action ...)`` fields is a small DSL that's interpreted by +Dune directly and doesn't require an external shell. All atoms in the DSL +support :doc:`/concepts/variables`. Moreover, you don't need to specify +dependencies explicitly for the special ``%{:...}`` forms; these are +recognized and automatically handled by Dune. + +The DSL is currently quite limited, so if you want to do something complicated, +it's recommended to write a small OCaml program and use the DSL to invoke it. +You can use `shexp `__ to write portable +scripts or :ref:`configurator` for configuration related tasks. You can also +use :ref:`dune-action-plugin` to express program dependencies directly in the +source code. + +The following constructions are available: + +.. grid:: 1 1 2 2 + + .. grid-item:: + + .. toctree:: + :caption: Running commands + + run + system + bash + dynamic-run + chdir + setenv + with-accepted-exit-codes + + .. grid-item:: + + .. toctree:: + :caption: Input and output + + echo + with-outputs-to + with-stdin-from + ignore-outputs + cat + copy + copy# + write-file + pipe-outputs + format-dune-file + + .. grid-item:: + + .. toctree:: + :caption: Comparing files + + diff + diffq + cmp + + .. grid-item:: + + .. toctree:: + :caption: Control structures + + progn + concurrent + no-infer + +Note: expansion of the special ``%{:...}`` is done relative to the current +working directory of the DSL being executed. So for instance, if you +have this action in a ``src/foo/dune``: + +.. code:: dune + + (action (chdir ../../.. (echo %{dep:dune}))) + +Then ``%{dep:dune}`` will expand to ``src/foo/dune``. When you run various +tools, they often use the filename given on the command line in error messages. +As a result, if you execute the command from the original directory, it will +only see the basename. + +To understand why this is important, let's consider this ``dune`` file living in +``src/foo``:: + + (rule + (target blah.ml) + (deps blah.mll) + (action + (run ocamllex -o %{target} %{deps}))) + +Here the command that will be executed is: + +.. code:: console + + $ ocamllex -o blah.ml blah.mll + +And it will be executed in ``_build//src/foo``. As a result, if there +is an error in the generated ``blah.ml`` file, it will be reported as: + +:: + + File "blah.ml", line 42, characters 5-10: + Error: ... + +Which can be a problem, as your editor might think that ``blah.ml`` is at the root +of your project. Instead, this is a better way to write it:: + + (rule + (target blah.ml) + (deps blah.mll) + (action + (chdir %{workspace_root} + (run ocamllex -o %{target} %{deps})))) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/no-infer.rst b/unikernel/duniverse/dune_/doc/reference/actions/no-infer.rst new file mode 100644 index 00000000..c8a0d7f1 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/no-infer.rst @@ -0,0 +1,17 @@ +no-infer +-------- + +.. highlight:: dune + +.. describe:: (no-infer ) + + Perform an action without inference of dependencies and targets. This is + useful if you are generating dependencies in a way that Dune doesn't know + about, for instance by calling an external build system. + + Example:: + + (no-infer + (progn + (run make) + (copy mylib.a lib.a))) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/pipe-outputs.rst b/unikernel/duniverse/dune_/doc/reference/actions/pipe-outputs.rst new file mode 100644 index 00000000..b5cbd085 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/pipe-outputs.rst @@ -0,0 +1,18 @@ +pipe- +-------------- + +.. highlight:: dune + +.. describe:: (pipe- ...) + + .. versionadded:: 2.7 + + Execute several actions (at least two) in sequence, filtering the + ```` of the first command through the other command, piping the + standard output of each one into the input of the next. + + Example:: + + (pipe-stdout + (run ./list-tests.exe) + (run ./exec-tests.exe)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/progn.rst b/unikernel/duniverse/dune_/doc/reference/actions/progn.rst new file mode 100644 index 00000000..caae33b9 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/progn.rst @@ -0,0 +1,14 @@ +progn +----- + +.. highlight:: dune + +.. describe:: (progn ...) + + Execute several commands in sequence. + + Example:: + + (progn + (run ./proga.exe) + (run ./progb.exe)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/run.rst b/unikernel/duniverse/dune_/doc/reference/actions/run.rst new file mode 100644 index 00000000..60117dd2 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/run.rst @@ -0,0 +1,13 @@ +run +--- + +.. highlight:: dune + +.. describe:: (run ) + + Execute a program. ```` is resolved locally if it is available in the + current workspace, otherwise it is resolved using the ``PATH``. + + Example:: + + (run capnp compile -o %{bin:capnpc-ocaml} schema.capnp) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/setenv.rst b/unikernel/duniverse/dune_/doc/reference/actions/setenv.rst new file mode 100644 index 00000000..c78eb77b --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/setenv.rst @@ -0,0 +1,14 @@ +setenv +------ + +.. highlight:: dune + +.. describe:: (setenv ) + + Run an action with an environment variable set. + + Example:: + + (setenv + VAR value + (bash "echo $VAR")) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/system.rst b/unikernel/duniverse/dune_/doc/reference/actions/system.rst new file mode 100644 index 00000000..eda86963 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/system.rst @@ -0,0 +1,12 @@ +system +------ + +.. highlight:: dune + +.. describe:: (system ) + + Execute a command using the system shell: ``sh`` on Unix and ``cmd`` on Windows. + + Example:: + + (system "command arg1 arg2") diff --git a/unikernel/duniverse/dune_/doc/reference/actions/with-accepted-exit-codes.rst b/unikernel/duniverse/dune_/doc/reference/actions/with-accepted-exit-codes.rst new file mode 100644 index 00000000..799e33a6 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/with-accepted-exit-codes.rst @@ -0,0 +1,20 @@ +with-accepted-exit-codes +------------------------ + +.. highlight:: dune + +.. describe:: (with-accepted-exit-codes ) + + .. versionadded:: 2.0 + + Specifies the list of expected exit codes for the programs executed in + ````. ```` is a predicate on integer values, and it's specified + using the :doc:`/reference/predicate-language`. ```` can only contain + nested occurrences of ``run``, ``bash``, ``system``, ``chdir``, ``setenv``, + ``ignore-``, ``with-stdin-from``, and ``with--to``. + + Example:: + + (with-accepted-exit-codes + (or 1 2) + (run false)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/with-outputs-to.rst b/unikernel/duniverse/dune_/doc/reference/actions/with-outputs-to.rst new file mode 100644 index 00000000..e3470eb0 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/with-outputs-to.rst @@ -0,0 +1,14 @@ +with--to +----------------- + +.. highlight:: dune + +.. describe:: (with--to ) + + Redirect the output to a file, where ```` is one of: ``stdout``, + ``stderr`` or ``outputs`` (for both ``stdout`` and ``stderr``). + + Example:: + + (with-stdout-to conf.txt + (run ./get-conf.exe)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/with-stdin-from.rst b/unikernel/duniverse/dune_/doc/reference/actions/with-stdin-from.rst new file mode 100644 index 00000000..123db0d7 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/with-stdin-from.rst @@ -0,0 +1,13 @@ +with-stdin-from +--------------- + +.. highlight:: dune + +.. describe:: (with-stdin-from ) + + Redirect the input from a file. + + Example:: + + (with-stdin-from data.txt + (run ./tests.exe)) diff --git a/unikernel/duniverse/dune_/doc/reference/actions/write-file.rst b/unikernel/duniverse/dune_/doc/reference/actions/write-file.rst new file mode 100644 index 00000000..0ab8b93f --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/actions/write-file.rst @@ -0,0 +1,12 @@ +write-file +---------- + +.. highlight:: dune + +.. describe:: (write-file ) + + Writes ```` to ````. + + Example:: + + (write-file users.txt jane,joe) diff --git a/unikernel/duniverse/dune_/doc/reference/aliases.rst b/unikernel/duniverse/dune_/doc/reference/aliases.rst new file mode 100644 index 00000000..b94e5be3 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases.rst @@ -0,0 +1,93 @@ +Aliases +======= + +:term:`Aliases ` are build targets that do not correspond to specific +files. For example, the ``runtest`` alias corresponds to running tests. + +Model and Syntax +---------------- + +Dependencies and actions can be attached to an alias. When this alias is +requested to be built, these dependencies are built and these actions are +executed. Aliases are attached to specific directories. + +In commands such as ``dune build``, the syntax to refer to the ``x`` alias is +``@x``, for example ``dune build @x``. This is why it is common to refer to it +as "the ``@x`` alias", or "attaching a rule to ``@x``". + +Building ``@x`` will build ``x`` in all subdirectories of the current +directory. This is the most common case, but it is possible to restrict this +using different syntaxes: + +- ``@sub/dir/x`` will build ``x`` in ``sub/dir`` and its subdirectories. +- ``@@x`` will build ``x`` in the current directory only. +- ``@@sub/dir/x`` will build ``x`` in ``sub/dir`` only. + +If ``dir`` is the directory of a :term:`build context`, it restricts the alias +to this context. + +To summarize, the syntax is: + +- ``@`` (recursive) or ``@@`` (non-recursive): determine if subdirectories are + included +- optional :term:`build context root`: restrict to a particular :term:`build + context` +- optional directory: only consider this subdirectory +- alias name + +Examples: + +- ``dune build @_build/foo/runtest`` only runs the tests for + the ``foo`` build context +- ``dune build @runtest`` will run the tests for all build contexts + +User-Defined Aliases +-------------------- + +It is possible to use any name for alias names; it will then be available on +the command line. For example, if a Dune file contains the following, then +``dune build @deploy`` will execute that command. + +.. code:: dune + + (rule + (alias deploy) + (action ./run-deployer.exe)) + +Built-In Aliases +---------------- + +Some aliases are defined and managed by Dune itself: + +.. grid:: 1 3 2 3 + + .. grid-item:: + + .. toctree:: + :caption: Builds + + aliases/all + aliases/default + aliases/install + aliases/pkg-install + aliases/empty + + .. grid-item:: + + .. toctree:: + :caption: Checks + + aliases/check + aliases/ocaml-index + aliases/runtest + aliases/fmt + aliases/lint + + .. grid-item:: + + .. toctree:: + :caption: Docs + + aliases/doc + aliases/doc-private + aliases/doc-json diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/all.rst b/unikernel/duniverse/dune_/doc/reference/aliases/all.rst new file mode 100644 index 00000000..813b5f19 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/all.rst @@ -0,0 +1,9 @@ +@all +==== + +This alias corresponds to every known file target in a directory. + +Since version 2.0 of the dune language, JS targets of executables are no longer +included in the `all` alias by default. To get back the old behavior of +including the JS targets in `all`, one can add the ``js`` target to the +executable's ``modes`` field. diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/check.rst b/unikernel/duniverse/dune_/doc/reference/aliases/check.rst new file mode 100644 index 00000000..1e2c8de8 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/check.rst @@ -0,0 +1,11 @@ +@check +====== + +This alias corresponds to the set of targets necessary for development tools to +work correctly. For example, it will build ``*.cmi``, ``*.cmt``, and ``*.cmti`` +files so that Merlin and ``ocaml-lsp-server`` can be used in the project. +It is also useful in the development loop because it will catch compilation +errors without executing expensive operations such as linking executables. + +.. seealso:: :doc:`ocaml-index` for a fast feedback loop that + also indexes the project. diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/default.rst b/unikernel/duniverse/dune_/doc/reference/aliases/default.rst new file mode 100644 index 00000000..8057790c --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/default.rst @@ -0,0 +1,27 @@ +@default +======== + +This alias corresponds to the default argument for ``dune build``: ``dune +build`` is equivalent to ``dune build @@default`` (``@@`` indicates a +:doc:`non-recursive alias <../aliases>`). Similarly, ``dune build dir`` is +equivalent to ``dune build @@dir/default``. + +When a directory doesn't explicitly define what the ``default`` alias means via +an :doc:`/reference/dune/alias` stanza, the following implicit definition is +assumed: + +.. code:: dune + + (alias + (name default) + (deps (alias_rec all))) + +But if such a stanza is present in the ``dune`` file in a directory, it will be +used instead. For example, if the following is present in ``tests/dune``, +``dune build tests`` will run tests there: + +.. code:: dune + + (alias + (name default) + (deps (alias_rec runtest))) diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/doc-json.rst b/unikernel/duniverse/dune_/doc/reference/aliases/doc-json.rst new file mode 100644 index 00000000..9f110692 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/doc-json.rst @@ -0,0 +1,6 @@ +@doc-json +========= + +This alias builds documentation for public libraries as JSON files. These are +produced by ``odoc``'s option ``--as-json`` and can be consumed by external +tools. diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/doc-private.rst b/unikernel/duniverse/dune_/doc/reference/aliases/doc-private.rst new file mode 100644 index 00000000..67d56ea2 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/doc-private.rst @@ -0,0 +1,4 @@ +@doc-private +============ + +This alias builds documentation for all libraries, both public & private. diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/doc.rst b/unikernel/duniverse/dune_/doc/reference/aliases/doc.rst new file mode 100644 index 00000000..4979e6dc --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/doc.rst @@ -0,0 +1,6 @@ +@doc +==== + +This alias builds documentation for public libraries as HTML pages. + +.. seealso:: :doc:`/documentation` diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/empty.rst b/unikernel/duniverse/dune_/doc/reference/aliases/empty.rst new file mode 100644 index 00000000..9181c091 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/empty.rst @@ -0,0 +1,9 @@ +@empty +====== + +The `empty` alias contains no targets. + +As of Dune language version 3.20, user-defined :doc:`rule <../dune/rule>` and +:doc:`alias <../dune/alias>` stanzas are no longer permitted to extend the +`empty` alias. + diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/fmt.rst b/unikernel/duniverse/dune_/doc/reference/aliases/fmt.rst new file mode 100644 index 00000000..e65d2538 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/fmt.rst @@ -0,0 +1,24 @@ +@fmt +==== + +This alias is used by formatting rules: when it is built, code formatters will +be executed (using :doc:`promotion `). + +``dune fmt`` is a shortcut for ``dune build @fmt --auto-promote``. + +It is possible to build on top of this convention. If some actions are manually +attached to the ``fmt`` alias, they will be executed by ``dune fmt``. + +Example: + +.. code:: dune + + (rule + (with-stdout-to + data.json.formatted + (run jq . %{dep:data.json}))) + + (rule + (alias fmt) + (action + (diff data.json data.json.formatted))) diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/install.rst b/unikernel/duniverse/dune_/doc/reference/aliases/install.rst new file mode 100644 index 00000000..1f970ed8 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/install.rst @@ -0,0 +1,6 @@ +@install +======== + +Building this alias will create the ``*.install`` files used by the :doc:`opam +integration `. In turn, these depend on +installable files. diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/lint.rst b/unikernel/duniverse/dune_/doc/reference/aliases/lint.rst new file mode 100644 index 00000000..195f6fef --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/lint.rst @@ -0,0 +1,4 @@ +@lint +===== + +This alias runs linting tools. diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/ocaml-index.rst b/unikernel/duniverse/dune_/doc/reference/aliases/ocaml-index.rst new file mode 100644 index 00000000..f45909f2 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/ocaml-index.rst @@ -0,0 +1,9 @@ +@ocaml-index +============ + +This alias corresponds to the set of targets necessary for development tools to +provide project-wide queries such as "get all references of this value". These +targets are indexes built using the required `ocaml-index` binary. Since this +alias also includes the ``*.cmi``, ``*.cmt``, and ``*.cmti`` files usually built +by ``check``, it can be used in most projects as a replacement to get a fast +feedback loop while maintaining the indexes up-to-date. diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/pkg-install.rst b/unikernel/duniverse/dune_/doc/reference/aliases/pkg-install.rst new file mode 100644 index 00000000..4c897f27 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/pkg-install.rst @@ -0,0 +1,23 @@ +@pkg-install +============ + +This alias is only relevant when using Dune with *package management* (see +:doc:`/tutorials/dune-package-management/index`). Running ``dune build +@pkg-install`` will fetch the dependencies described in the ``depends`` field +of your ``dune-project`` (see :doc:`/reference/dune-project/package`) and build +them. It will not build your project. + +Indeed, if you need to build the project, you need to use the regular ``dune +build`` command. Note that if the dependencies have not been already fetch and +downloaded, ``dune build`` will **also** take care of getting and building them. + +.. note:: + ``dune build @pkg-install`` is particularly useful when you are building + projects using per-layer caching systems, e.g., Docker images. Using this + alias, you will be able to cache the dependencies building stage as they + change less regularly. + +If you are building the ``@pkg-install`` alias in a repository where package +management is not activated, the command will fail. + +.. seealso:: :doc:`/explanation/package-management` diff --git a/unikernel/duniverse/dune_/doc/reference/aliases/runtest.rst b/unikernel/duniverse/dune_/doc/reference/aliases/runtest.rst new file mode 100644 index 00000000..28768665 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/aliases/runtest.rst @@ -0,0 +1,10 @@ +@runtest +======== + +Actions that run tests are attached to this alias. For example this convention +is used by the ``(test)`` stanza. + +``dune runtest`` is a shortcut for ``dune build @runtest`` but is also able to +run individual tests. + +.. seealso:: :doc:`/tests` diff --git a/unikernel/duniverse/dune_/doc/reference/boolean-language.rst b/unikernel/duniverse/dune_/doc/reference/boolean-language.rst new file mode 100644 index 00000000..16d9d096 --- /dev/null +++ b/unikernel/duniverse/dune_/doc/reference/boolean-language.rst @@ -0,0 +1,25 @@ +Boolean Language +================ + +The Boolean language allows the user to define simple Boolean expressions that +Dune can evaluate. Here's a semiformal specification of the language: + +.. productionlist:: blang + op : '=' | '<' | '>' | '<>' | '>=' | '<=' + expr : (and +) + : (or +) + : (